Annotation of rpl/examples/obele.rpl, revision 1.1
1.1 ! bertrand 1: #!/usr/local/bin/rpl -cs
! 2:
! 3: /*
! 4: ================================================================================
! 5: Algorithme de l'Obèle
! 6: Copyright 2001, BERTRAND Joël.
! 7: ================================================================================
! 8: Entrées : néant
! 9: --------------------------------------------------------------------------------
! 10: Sorties : néant
! 11: --------------------------------------------------------------------------------
! 12: Effets de bord : néant
! 13: ================================================================================
! 14: */
! 15:
! 16: OBELE
! 17: <<
! 18: rad 31 cf
! 19:
! 20: erase
! 21: "" disp
! 22: "Algorithme de l'obèle" disp
! 23: "{\Large\sl Algorithme de l'obèle}" pr1 drop
! 24:
! 25: { "standard*(*)" }
! 26:
! 27: if
! 28: "lambda" "existence" inquire
! 29: then
! 30: { { "name" "lambda" } "sequential" "replace" "writeonly" "formatted" }
! 31: open
! 32: else
! 33: { { "name" "lambda" } "sequential" "new" "writeonly" "formatted" } open
! 34: end
! 35:
! 36: format
! 37:
! 38: /* Paramètres d'entrée */
! 39:
! 40: 4 // Nombre d'antennes
! 41: 64 // Nombre de mobiles
! 42: 64 // Facteur d'étalement
! 43: true // Présence de bruit
! 44: 1 // Seuil (contrainte à tenir en terme de C/I)
! 45: 1E-5 // Niveau de bruit
! 46: 1E-8 // Critère de convergence
! 47: "Statistique" // Modèle de canal ("Statistique" ou "Aléatoire")
! 48: .5 // Distance entre les différents capteurs de l'antenne
! 49: { } // Directions des trajets (simple déclaration de variable)
! 50: true // Initialisation omnidirectionnelle (ou par un contrôle
! 51: // de puissance élémentaire)
! 52: true // Normalisation des diagrammes
! 53: true // Diagrammes d'antenne en coordonnées polaires
! 54: true // Impression du résultat
! 55: 3 // Nombre de paquets de mobiles (modèle Statistique)
! 56: .02 // Dispersion en fraction de '2*PI' (modèle Statistique)
! 57: true // Egalité des puissance émises (modèle Statistique)
! 58: true // Un mobile par paquet tracé dans les diagrammes
! 59: -> UNITE N_ANTENNES N_MOBILES FACTEUR_ETALEMENT ALGORITHME_BRUITE SEUIL
! 60: BRUIT EPS MODELE_CANAL DIST DIRECTIONS INITIALISATION_OMNIDIRECTIONNELLE
! 61: DIAGRAMME_NORMALISE DIAGRAMMES_POLAIRES AUTORISATION_IMPRESSION PAQUETS
! 62: DISPERSION EQUIPUISSANCE TRACE_UN_MOBILE
! 63: <<
! 64: "" disp
! 65: "\vskip 3ex\noindent" pr1 drop
! 66: "Configuration" pr1 drop
! 67: "\hrule\vskip 1ex" pr1 drop
! 68: cr "Nombre d'antennes : " N_ANTENNES ->str + pr1 disp
! 69: cr "Nombre de mobiles : " N_MOBILES ->str + pr1 disp
! 70: cr "Type de canal : " MODELE_CANAL ->str + pr1 disp
! 71:
! 72: PAQUETS 1 ->list 0 con
! 73: -> REPARTITION
! 74: <<
! 75: PAQUETS DISPERSION DIST EQUIPUISSANCE
! 76: N_ANTENNES N_MOBILES MODELE_CANAL
! 77: INITIALISATION_R 'DIRECTIONS' sto 'REPARTITION' sto
! 78: if
! 79: ALGORITHME_BRUITE
! 80: then
! 81: SEUIL CONVERSION_ALGORITHME_BRUITE
! 82: end
! 83:
! 84: if
! 85: INITIALISATION_OMNIDIRECTIONNELLE
! 86: then
! 87: N_ANTENNES 1 2 ->list 0 con { 1 1 } 1 put
! 88: N_MOBILES 1 - dupn N_MOBILES ->list
! 89: else
! 90: dup FACTEUR_ETALEMENT ALGORITHME_BRUITE SEUIL
! 91: OPTIMISATION_SIMPLE
! 92: end
! 93:
! 94: N_MOBILES N_MOBILES 2 ->list 0 con -1 0 0
! 95:
! 96: -> LISTE_R V_PONDERATION F AVP VP PUISSANCES_INITIALES
! 97: <<
! 98: rclf 2 sci
! 99: 1 N_MOBILES for J
! 100: rclf std " Utilisateur " J ->str + disp stof
! 101: LISTE_R J get disp "" disp
! 102: next
! 103: stof
! 104:
! 105: /* Calcul des rapports C/I initiaux */
! 106:
! 107: LISTE_R V_PONDERATION
! 108:
! 109: 'F' { 1 1 }
! 110: 1 N_MOBILES for J
! 111: 1 N_MOBILES for K
! 112: if
! 113: J K same
! 114: then
! 115: 0
! 116: else
! 117: V_PONDERATION K get
! 118: dup trn
! 119: LISTE_R J get
! 120: rot * * { 1 1 } get
! 121: end
! 122: puti
! 123: next
! 124: next
! 125: drop2
! 126:
! 127: if
! 128: ALGORITHME_BRUITE not
! 129: then
! 130: F regv max swap drop list-> drop
! 131:
! 132: -> M C
! 133: <<
! 134: 1 N_MOBILES for J
! 135: M J C 2 ->list get re
! 136: next
! 137:
! 138: N_MOBILES 1 ->list ->array dup abs /
! 139: >>
! 140: else
! 141: N_MOBILES idn N_MOBILES 1 2 ->list SEUIL BRUIT * con swap
! 142: F - inv swap * re array-> list-> drop2 1 ->list ->array
! 143: end
! 144:
! 145: 2 sci
! 146: "\vskip 3ex\noindent" pr1 drop
! 147: " Rapports C/I initiaux" pr1 disp
! 148: "\hrule\vskip 1ex" pr1 drop
! 149: "" disp
! 150: dup array-> 1 get ->list 1
! 151:
! 152: true
! 153: -> AUTORISATION_CALCUL
! 154: <<
! 155: do
! 156: geti
! 157:
! 158: if
! 159: 0 <
! 160: then
! 161: false 'AUTORISATION_CALCUL' sto
! 162: end
! 163: until
! 164: dup 1 same
! 165: end
! 166:
! 167: drop2
! 168:
! 169: if
! 170: AUTORISATION_CALCUL
! 171: then
! 172: V_PONDERATION
! 173:
! 174: over 720 DIAGRAMMES_POLAIRES TRACE_UN_MOBILE
! 175: N_MOBILES N_ANTENNES DIST DIAGRAMME_NORMALISE
! 176: DIRECTIONS PAQUETS REPARTITION DIAGRAMME
! 177:
! 178: if
! 179: DIAGRAMMES_POLAIRES not
! 180: then
! 181: { "Azimut" "Puissance" } label
! 182: end
! 183:
! 184: "Diagrammes avant optimisation" title persist prlcd
! 185: cllcd
! 186:
! 187: dup
! 188: -> PUISSANCES
! 189: <<
! 190: 0
! 191: 1 PUISSANCES size 1 get for I
! 192: PUISSANCES I 1 ->list get +
! 193: next
! 194: >>
! 195:
! 196: 'PUISSANCES_INITIALES' sto
! 197:
! 198: if
! 199: ALGORITHME_BRUITE not
! 200: then
! 201: 0
! 202: else
! 203: BRUIT
! 204: end
! 205:
! 206: N_MOBILES FACTEUR_ETALEMENT
! 207: CALCUL_RAPPORTS_SIGNAUX_INTERFERENCE
! 208: else
! 209: 3 dropn
! 210: " Résolution impossible du système"
! 211: end
! 212:
! 213: pr1 disp
! 214: "" disp
! 215: >>
! 216:
! 217: /* Boucle principale */
! 218:
! 219: "\vskip 3ex\noindent" pr1 drop
! 220: " Minimisation de la plus grande valeur propre Lambda" disp
! 221: " Minimisation de la plus grande valeur propre $\lambda$"
! 222: pr1 drop
! 223: "\hrule\vskip 1ex" pr1 drop
! 224: "" disp std
! 225:
! 226: while
! 227: VP AVP - abs EPS >
! 228: repeat
! 229:
! 230: /* Normalisation des pondérations */
! 231:
! 232: 1 N_MOBILES for J
! 233: LISTE_R J get V_PONDERATION J get
! 234: FACTEUR_ETALEMENT ALGORITHME_BRUITE SEUIL
! 235: NORMALISATION array-> drop
! 236:
! 237: N_ANTENNES 1 2 ->list ->array
! 238: 'V_PONDERATION' swap J swap put
! 239: next
! 240:
! 241: /* Calcul de la matrice F */
! 242:
! 243: 'F' { 1 1 }
! 244: 1 N_MOBILES for J
! 245: 1 N_MOBILES for K
! 246: if
! 247: J K same
! 248: then
! 249: 0
! 250: else
! 251: V_PONDERATION K get
! 252: dup trn
! 253: LISTE_R J get
! 254: rot * * { 1 1 } get
! 255: end
! 256: puti
! 257: next
! 258: next
! 259: drop2
! 260:
! 261: /* Calcul du plus grand vecteur propre gauche de F */
! 262:
! 263: F legv
! 264: -> MATRICE
! 265: <<
! 266: /* Réécriture de la fonction max pour éviter les */
! 267: /* erreurs numériques d'arrondis apparaissant avec */
! 268: /* les racines doubles du polynôme caractéristique */
! 269:
! 270: do
! 271: MATRICE max
! 272: until
! 273: over re 0 >=
! 274:
! 275: if
! 276: dup not
! 277: then
! 278: swap 'MATRICE' swap 0 put swap drop
! 279: end
! 280: end
! 281: >>
! 282:
! 283: list-> drop rot swap
! 284: -> COLONNE
! 285: <<
! 286: 1 N_MOBILES for J
! 287: dup J COLONNE 2 ->list get re swap
! 288: next
! 289:
! 290: drop
! 291: >>
! 292:
! 293: VP 'AVP' sto
! 294: N_MOBILES 1 2 ->list ->array
! 295: swap re dup 'VP' sto pr1
! 296: UNITE over 1 ->list swap write
! 297: "Lambda = " swap ->str + disp
! 298:
! 299: /* Normalisation du plus grand vecteur gauche de F */
! 300:
! 301: dup abs /
! 302:
! 303: /* Calcul des matrices T */
! 304:
! 305: -> PG
! 306: <<
! 307: 1 N_MOBILES for J
! 308: LISTE_R 1 get 0 con
! 309:
! 310: 1 N_MOBILES for K
! 311: if
! 312: J K same not
! 313: then
! 314: LISTE_R K get PG K 1 2 ->list get * +
! 315: end
! 316: next
! 317: next
! 318: >>
! 319:
! 320: N_MOBILES ->list
! 321:
! 322: /* Calcul des vecteurs propres généralisés des matrices T */
! 323:
! 324: -> LISTE_T
! 325: <<
! 326: 1 N_MOBILES for J
! 327: LISTE_T J get LISTE_R J get gregv re min swap drop
! 328: list-> drop
! 329:
! 330: -> COLONNE
! 331: <<
! 332: 1 N_ANTENNES for K
! 333: dup K COLONNE 2 ->list get swap
! 334: next
! 335:
! 336: drop N_ANTENNES 1 ->list ->array dup abs /
! 337: N_ANTENNES 1 2 ->list rdm
! 338: 'V_PONDERATION' J rot put
! 339: >>
! 340: next
! 341: >>
! 342: end
! 343:
! 344: /* Normalisation des pondérations */
! 345:
! 346: 1 N_MOBILES for J
! 347: LISTE_R J get V_PONDERATION J get
! 348: FACTEUR_ETALEMENT ALGORITHME_BRUITE SEUIL
! 349: NORMALISATION array-> drop
! 350:
! 351: N_ANTENNES 1 2 ->list ->array
! 352: 'V_PONDERATION' swap J swap put
! 353: next
! 354:
! 355: /* Pondérations */
! 356:
! 357: "" disp
! 358: " Pondérations optimales" pr1 disp
! 359: "\hrule\vskip 1ex" pr1 drop
! 360: "" disp
! 361:
! 362: 1 N_MOBILES for J
! 363: "W(" std J ->str + ") = " + 2 sci
! 364: 'V_PONDERATION' J get N_ANTENNES 1 ->list
! 365: rdm pr1 ->str + disp
! 366: next
! 367:
! 368: /* Calcul des puissances par mobile nécessaires */
! 369:
! 370: "" disp
! 371: "\vskip 3ex\noindent" pr1 drop
! 372: " Calcul des puissances par mobile nécessaires" pr1 disp
! 373: "\hrule\vskip 1ex" pr1 drop
! 374: "" disp
! 375:
! 376: if
! 377: ALGORITHME_BRUITE not
! 378: then
! 379: F regv max swap drop list-> drop
! 380:
! 381: -> M C
! 382: <<
! 383: 1 N_MOBILES for J
! 384: M J C 2 ->list get re
! 385: next
! 386:
! 387: N_MOBILES 1 ->list ->array dup abs /
! 388: >>
! 389:
! 390: V_PONDERATION over 720 DIAGRAMMES_POLAIRES
! 391: TRACE_UN_MOBILE N_MOBILES N_ANTENNES DIST
! 392: DIAGRAMME_NORMALISE DIRECTIONS PAQUETS
! 393: REPARTITION DIAGRAMME
! 394:
! 395: if
! 396: DIAGRAMMES_POLAIRES not
! 397: then
! 398: { "Azimut" "Puissance" } label
! 399: end
! 400:
! 401: "Diagrammes après optimisation" title persist prlcd
! 402: else
! 403: if
! 404: VP 1 >
! 405: then
! 406: " Absence de solution physique !"
! 407: else
! 408: N_MOBILES idn N_MOBILES 1 2 ->list
! 409: SEUIL BRUIT * con swap
! 410: F - inv swap * re array-> list-> drop2
! 411: 1 ->list ->array
! 412:
! 413: V_PONDERATION over 720 DIAGRAMMES_POLAIRES
! 414: TRACE_UN_MOBILE N_MOBILES N_ANTENNES DIST
! 415: DIAGRAMME_NORMALISE DIRECTIONS PAQUETS
! 416: REPARTITION DIAGRAMME
! 417:
! 418: if
! 419: DIAGRAMMES_POLAIRES not
! 420: then
! 421: { "Azimut" "Puissance" } label
! 422: end
! 423:
! 424: "Diagrammes après optimisation" title persist prlcd
! 425: end
! 426: end
! 427:
! 428: V_PONDERATION over 2 ->list "resultat_obele" store
! 429: { "graphique.eps" "postscript eps enhanced monochrome dashed" }
! 430: lcd->
! 431:
! 432: dup
! 433:
! 434: if
! 435: dup type 2 same
! 436: then
! 437: pr1
! 438: else
! 439: dup array-> 1 get ->list pr1 drop
! 440: end
! 441:
! 442: if
! 443: dup type 2 same not
! 444: then
! 445: "P = " swap ->str + disp "" disp
! 446:
! 447: LISTE_R V_PONDERATION rot
! 448:
! 449: dup
! 450: -> PUISSANCES
! 451: <<
! 452: 0
! 453: 1 PUISSANCES size 1 get for I
! 454: PUISSANCES I 1 ->list get +
! 455: next
! 456: >>
! 457:
! 458: if
! 459: PUISSANCES_INITIALES 0 same not
! 460: then
! 461: rclf swap 3 fix PUISSANCES_INITIALES swap %ch neg ->str
! 462: " %" + swap stof
! 463: else
! 464: drop "absurde"
! 465: end
! 466:
! 467: "\vskip 3ex\noindent" pr1 drop
! 468: " Rapports C/I finaux "
! 469: "(amélioration de la puissance émise : " +
! 470: swap ->str + ")" + pr1 disp
! 471:
! 472: if
! 473: ALGORITHME_BRUITE not
! 474: then
! 475: 0
! 476: else
! 477: BRUIT
! 478: end
! 479:
! 480: N_MOBILES FACTEUR_ETALEMENT
! 481: CALCUL_RAPPORTS_SIGNAUX_INTERFERENCE
! 482:
! 483: "\hrule\vskip 1ex" pr1 drop
! 484: "" disp
! 485: pr1 disp
! 486: "" disp
! 487:
! 488: cllcd
! 489:
! 490: if
! 491: AUTORISATION_IMPRESSION
! 492: then
! 493: print
! 494: else
! 495: erase
! 496: end
! 497: else
! 498: drop disp "" disp
! 499: erase
! 500: cllcd
! 501: end
! 502: >>
! 503: >>
! 504:
! 505: UNITE close
! 506: >>
! 507:
! 508: " Temps CPU utilisé : " disp 2 fix time disp std
! 509: >>
! 510:
! 511:
! 512: /*
! 513: ================================================================================
! 514: Calcul des rapports C/I pour chaque mobile
! 515: ================================================================================
! 516: Entrées :
! 517: 4: liste contenant les matrices R de chaque mobile
! 518: 3: liste contenant les pondérations affectées à chaque mobile
! 519: 2: vecteur contenant les puissances
! 520: 1: sigma ** 2
! 521: --------------------------------------------------------------------------------
! 522: Sorties :
! 523: 1: liste contenant les rapports C/I
! 524: --------------------------------------------------------------------------------
! 525: Effets de bord : néant
! 526: ================================================================================
! 527: */
! 528:
! 529: CALCUL_RAPPORTS_SIGNAUX_INTERFERENCE
! 530: <<
! 531: -> R W P SIGMA N_MOBILES FACTEUR_ETALEMENT
! 532: <<
! 533: 1 N_MOBILES for I
! 534: P I 1 ->list get
! 535: W I get dup trn swap
! 536: R I get swap * * * { 1 1 } get re
! 537:
! 538: SIGMA
! 539: 1 N_MOBILES for J
! 540: if
! 541: I J same
! 542: then
! 543: cycle
! 544: end
! 545:
! 546: P J 1 ->list get
! 547: W J get dup trn swap
! 548: R I get swap * * * { 1 1 } get re +
! 549: next
! 550:
! 551: / FACTEUR_ETALEMENT *
! 552: next
! 553:
! 554: N_MOBILES ->list
! 555: >>
! 556: >>
! 557:
! 558:
! 559: /*
! 560: ================================================================================
! 561: Fonction de normalisation des vecteurs W de telle sorte que trn(W)*R*W = 1
! 562: ================================================================================
! 563: Entrées :
! 564: 2: matrice R
! 565: 1: vecteur W
! 566: --------------------------------------------------------------------------------
! 567: Sorties :
! 568: 1: vecteur W normalisé
! 569: --------------------------------------------------------------------------------
! 570: Effets de bord : néant
! 571: ================================================================================
! 572: */
! 573:
! 574: NORMALISATION
! 575: <<
! 576: -> R W FACTEUR_ETALEMENT ALGORITHME_BRUITE SEUIL
! 577: <<
! 578: W dup trn R FACTEUR_ETALEMENT *
! 579:
! 580: if
! 581: ALGORITHME_BRUITE
! 582: then
! 583: SEUIL /
! 584: end
! 585:
! 586: W * * abs sqrt /
! 587: >>
! 588: >>
! 589:
! 590:
! 591: /*
! 592: ================================================================================
! 593: Fonction renvoyant une liste contenant les différentes matrices R
! 594: ================================================================================
! 595: Entrées :
! 596: 3: nombre d'antennes (entier)
! 597: 2: nombre de mobiles (entier)
! 598: 1: nombre de trajets (entier)
! 599: --------------------------------------------------------------------------------
! 600: Sorties :
! 601: 2: liste contenant autant de matrices R qu'il y a de mobiles
! 602: 1: directions des mobiles
! 603: --------------------------------------------------------------------------------
! 604: Effets de bord : néant
! 605: ================================================================================
! 606: */
! 607:
! 608: INITIALISATION_R
! 609: <<
! 610: "" disp
! 611: " Initialisation des matrices d'autocorrélation du canal" disp
! 612: "" disp
! 613:
! 614: "\vskip 3ex\noindent" pr1 drop
! 615: "Positions et puissances des différents récepteurs" pr1 drop
! 616: "\hrule\vskip 1ex" pr1 drop
! 617:
! 618: { } dup
! 619: -> PAQUETS DISPERSION DIST EQUIPUISSANCE NA NM MODELE DIRECTIONS
! 620: REPARTITION_INTERNE
! 621: <<
! 622: rclf
! 623:
! 624: if
! 625: MODELE "Statistique" same
! 626: then
! 627: PAQUETS 1 ->list 0 con 'REPARTITION_INTERNE' sto
! 628:
! 629: /*
! 630: Génération de matrices de covariance du canal grâce
! 631: au modèle du Statistique
! 632: */
! 633:
! 634: deg 4 fix { 3 9 } 0 con
! 635: DIST 180 25 0 0 PAQUETS 1 ->list 0 con
! 636: -> COEFF // Coefficients du modèle :
! 637: // - ligne 1 : direction du trajet en degrés;
! 638: // - ligne 2 : puissance du trajet en dB;
! 639: // - ligne 3 : retard du trajet en ns.
! 640: D // Distance entre deux capteurs consécutifs comptée en
! 641: // longueur d'onde
! 642: SECTEUR // Demi angle d'ouverture d'un secteur (en degrés)
! 643: DTHETA // Paramètre d'ouverture du modèle (en degrés)
! 644: GISMIN // Gisement le plus faible vu du secteur
! 645: GISMAX // Gisement le plus grand vu du secteur
! 646: ANGLES_MOYENS
! 647: <<
! 648: SECTEUR neg DTHETA 4 * - 'GISMIN' sto
! 649: SECTEUR DTHETA 2 * + 'GISMAX' sto
! 650:
! 651: 'COEFF' { 1 1 }
! 652:
! 653: 0 puti
! 654: DTHETA 2 / puti
! 655: DTHETA 2 / neg puti
! 656: DTHETA 2 / 1 - puti
! 657: 1 DTHETA 2 / - puti
! 658: 2 DTHETA * puti
! 659: -2 DTHETA * puti
! 660: 3 DTHETA * puti
! 661: 4 DTHETA * puti
! 662:
! 663: -2 puti
! 664: -7 puti
! 665: -7 puti
! 666: -4 puti
! 667: -4 puti
! 668: -9 puti
! 669: -10 puti
! 670: -15 puti
! 671: -20 puti
! 672:
! 673: 0 puti
! 674: 0 puti
! 675: 0 puti
! 676: 310 puti
! 677: 310 puti
! 678: 710 puti
! 679: 1090 puti
! 680: 1730 puti
! 681: 2510 puti
! 682:
! 683: drop2
! 684:
! 685: 0 -> CUMUL
! 686: <<
! 687: 1 COEFF size 2 get for I
! 688: 'COEFF' 2 I 2 ->list 'COEFF' over get 10 / alog
! 689: dup 'CUMUL' sto+ put
! 690: next
! 691:
! 692: 1 COEFF size 2 get for I
! 693: 'COEFF' 2 I 2 ->list 'COEFF' over get CUMUL / put
! 694: next
! 695: >>
! 696:
! 697: // Calcul de la répartition des mobiles dans les paquets
! 698: 'REPARTITION_INTERNE' { 1 }
! 699: 1 PAQUETS for P
! 700: rand puti
! 701: next
! 702: drop2
! 703:
! 704: REPARTITION_INTERNE array-> 1 get 2 swap for P + next
! 705:
! 706: -> CLEF
! 707: <<
! 708: 1 PAQUETS for P
! 709: 'REPARTITION_INTERNE' dup P 1 ->list get NM * CLEF /
! 710: ip P 1 ->list swap
! 711:
! 712: if
! 713: dup 1 <
! 714: then
! 715: drop 1
! 716: end
! 717:
! 718: put
! 719: next
! 720: >>
! 721:
! 722: 0 1 PAQUETS for P
! 723: 'REPARTITION_INTERNE' P 1 ->list get +
! 724: next
! 725:
! 726: NM -
! 727: -> DIFFERENCE
! 728: <<
! 729: if
! 730: DIFFERENCE 0 >
! 731: then
! 732: while
! 733: DIFFERENCE
! 734: repeat
! 735: rand PAQUETS * ip 1 + 1 ->list dup
! 736: if
! 737: 'REPARTITION_INTERNE' swap get dup 1 >
! 738: then
! 739: 1 - 'REPARTITION_INTERNE' rot rot put
! 740: 'DIFFERENCE' 1 sto-
! 741: else
! 742: drop2
! 743: end
! 744: end
! 745: else
! 746: while
! 747: DIFFERENCE
! 748: repeat
! 749: rand PAQUETS * ip 1 + 1 ->list dup
! 750: if
! 751: 'REPARTITION_INTERNE' swap get dup NM <
! 752: then
! 753: 1 + 'REPARTITION_INTERNE' rot rot put
! 754: 'DIFFERENCE' 1 sto+
! 755: else
! 756: drop2
! 757: end
! 758: end
! 759: end
! 760: >>
! 761:
! 762: 'ANGLES_MOYENS' { 1 }
! 763: 1 PAQUETS for P
! 764: rand 2 SECTEUR * * SECTEUR - puti
! 765: next
! 766: drop2
! 767:
! 768: rclf std
! 769: "Répartition : " REPARTITION_INTERNE ->str + pr1
! 770: "\hrule\vskip 1ex" pr1 drop
! 771: disp "" disp stof
! 772:
! 773: // Boucle sur les paquets de mobiles
! 774: 1 PAQUETS for P
! 775:
! 776: // Boucle sur les mobiles
! 777: 1 REPARTITION_INTERNE P 1 ->list get for K
! 778: rand 2 SECTEUR * * SECTEUR - DISPERSION *
! 779: ANGLES_MOYENS P 1 ->list get +
! 780: DIRECTIONS over 1 ->list + 'DIRECTIONS' sto
! 781: "Azimut : " over ->hms ->str + dup " ° (HMS)" + disp
! 782: "\degre (HMS)" + cr pr1 drop
! 783:
! 784: NA COEFF size 2 get 2 ->list 0 con
! 785: COEFF size 2 get dup 2 ->list 0 con 0
! 786: -> AZIMUT MD P TRAJETS_RETENUS
! 787: <<
! 788: 1 COEFF size 2 get for I
! 789: 'COEFF' 1 I 2 ->list get AZIMUT +
! 790: -> G
! 791: <<
! 792: if
! 793: G SECTEUR <= G SECTEUR neg >= and
! 794: SECTEUR 180 >= or
! 795: then
! 796: 1 NA for J
! 797: 'MD' 2 i pi * * ->num
! 798: D J 1 - * * G sin * exp
! 799: J I 2 ->list swap put
! 800: next
! 801:
! 802: 'P' COEFF 2 I 2 ->list get
! 803: I dup 2 ->list swap put
! 804: 1 'TRAJETS_RETENUS' sto+
! 805: end
! 806: >>
! 807: next
! 808:
! 809: MD P
! 810:
! 811: if
! 812: EQUIPUISSANCE
! 813: then
! 814: 1
! 815: else
! 816: nrand sq
! 817: end
! 818:
! 819: "Puissance : " over ->str + cr pr1 disp
! 820: * over trn * *
! 821:
! 822: // Rajout de bruit pour éviter d'avoir une
! 823: // matrice R de rang non plein
! 824:
! 825: if
! 826: TRAJETS_RETENUS over size 1 get <
! 827: then
! 828: dup idn over abs 1E-6 / * +
! 829: end
! 830: >>
! 831: next
! 832: next
! 833: >>
! 834:
! 835: rad
! 836: else
! 837:
! 838: /* Génération de matrices R aléatoires */
! 839:
! 840: // Nombre de trajets
! 841: 4 -> NT
! 842: <<
! 843: // Boucle sur les mobiles
! 844: 1 NM for K
! 845: " Utilisateur " std K ->str + disp "" disp
! 846: NT NA 2 ->list 0 con
! 847:
! 848: // Boucle sur les trajets
! 849: 1 NT for L
! 850: L 1 2 ->list
! 851: rand 2 pi ->num * *
! 852: DIRECTIONS over r->d 1 ->list + 'DIRECTIONS' sto
! 853: nrand sq
! 854:
! 855: -> D P
! 856: <<
! 857: std
! 858: " Trajet " L ->str + disp
! 859: 4 sci " -> Puissance " P ->str + disp
! 860: 4 fix " -> Azimut " D r->d ->hms ->str +
! 861: "° (HMS)" + disp "" disp
! 862:
! 863: // Boucle sur les capteurs
! 864: 1 NA for J
! 865: i ->num D sin J 1 - * * DIST *
! 866: 2 pi ->num * 2E9 * * exp P * puti
! 867: next
! 868: drop
! 869: >>
! 870: next
! 871: trn conj dup trn *
! 872: next
! 873: >>
! 874:
! 875: NM 1 ->list 1 con 'REPARTITION_INTERNE' sto
! 876: end
! 877:
! 878: NM ->list
! 879: swap stof
! 880: REPARTITION_INTERNE
! 881: DIRECTIONS
! 882: >>
! 883:
! 884: "" disp
! 885: >>
! 886:
! 887:
! 888: /*
! 889: ================================================================================
! 890: Fonction permettant de convertir l'algorithme non bruité en sa version
! 891: bruitée
! 892: ================================================================================
! 893: Entrées :
! 894: 2: liste contenant les différentes matrices R
! 895: 1: seuil
! 896: --------------------------------------------------------------------------------
! 897: Sorties :
! 898: 1: liste contenant les nouvelles matrices R'
! 899: --------------------------------------------------------------------------------
! 900: Effets de bord : néant
! 901: ================================================================================
! 902: */
! 903:
! 904: CONVERSION_ALGORITHME_BRUITE
! 905: <<
! 906: -> L_R SEUIL
! 907: <<
! 908: 1 L_R size for J
! 909: 'L_R' dup J get SEUIL * J swap put
! 910: next
! 911:
! 912: L_R
! 913: >>
! 914: >>
! 915:
! 916:
! 917: /*
! 918: ================================================================================
! 919: Calcul simple des pondérations et des puissances
! 920: ================================================================================
! 921: Entrées :
! 922: 1: liste contenant les différentes matrices R
! 923: --------------------------------------------------------------------------------
! 924: Sorties :
! 925: 2: liste contenant les pondérations et les puissances
! 926: 1: valeur propre
! 927: --------------------------------------------------------------------------------
! 928: Effets de bord : néant
! 929: ================================================================================
! 930: */
! 931:
! 932: OPTIMISATION_SIMPLE
! 933: <<
! 934: -> LISTE FACTEUR_ETALEMENT ALGORITHME_BRUITE SEUIL
! 935: <<
! 936: 1 LISTE size for N
! 937: LISTE N get regv max swap drop
! 938: list-> drop over size 1 get 1 2 ->list 0 con
! 939:
! 940: -> INDICE TABLEAU
! 941: <<
! 942: 1 over size 1 get for M
! 943: dup M 1 2 ->list get 'TABLEAU' swap M 1 2 ->list swap put
! 944: next
! 945: drop LISTE N get TABLEAU FACTEUR_ETALEMENT ALGORITHME_BRUITE
! 946: SEUIL NORMALISATION
! 947: >>
! 948: next
! 949:
! 950: LISTE size ->list
! 951: >>
! 952: >>
! 953:
! 954:
! 955: /*
! 956: ================================================================================
! 957: Calcul du diagramme de rayonnement du réseau d'antennes
! 958: ================================================================================
! 959: Entrées :
! 960: 3: liste contenant tous les vecteurs de pondération
! 961: 2: puissances
! 962: 1: nombre de points à calculer par diagramme
! 963: --------------------------------------------------------------------------------
! 964: Sorties :
! 965: néant
! 966: --------------------------------------------------------------------------------
! 967: Effets de bord : néant
! 968: ================================================================================
! 969: */
! 970:
! 971: DIAGRAMME
! 972: <<
! 973: 0
! 974: -> PONDERATIONS PUISSANCES NB_POINTS DIAGRAMMES_POLAIRES
! 975: TRACE_UN_MOBILE N_MOBILES N_ANTENNES DIST DIAGRAMME_NORMALISE
! 976: DIRECTIONS PAQUETS REPARTITION MAXIMUM
! 977: <<
! 978: cllcd
! 979:
! 980: { { 60 "ticsonly" 2 } { "automatic" "ticsonly" 10 } } axes
! 981:
! 982: if
! 983: DIAGRAMMES_POLAIRES
! 984: then
! 985: 1 d->r
! 986: -> PAS
! 987: <<
! 988: 0
! 989: 1 N_MOBILES for I
! 990: 0 2 pi ->num * for T
! 991: if
! 992: DIST N_ANTENNES T PONDERATIONS I DIAGRAMME_NORMALISE
! 993: PUISSANCES FCT_DIAGRAMME dup 3 pick >
! 994: then
! 995: swap
! 996: end
! 997: drop PAS
! 998: step
! 999: next
! 1000: >>
! 1001:
! 1002: dup 'MAXIMUM' sto dup r->c dup pmax neg pmin
! 1003:
! 1004: parametric { T 0 'MAXIMUM' } indep MAXIMUM res
! 1005: << T I DIRECTIONS FCT_DIRECTIONS >> steq
! 1006:
! 1007: 1 N_MOBILES for I
! 1008: draw
! 1009: next
! 1010:
! 1011: polar { T 0 '2*PI' } indep 2 pi ->num * NB_POINTS / res
! 1012: << DIST N_ANTENNES T PONDERATIONS I DIAGRAMME_NORMALISE
! 1013: PUISSANCES FCT_DIAGRAMME >> steq
! 1014:
! 1015: if
! 1016: TRACE_UN_MOBILE
! 1017: then
! 1018: 1
! 1019: -> I
! 1020: <<
! 1021: 1 PAQUETS for POINTEUR
! 1022: draw
! 1023: 'I' REPARTITION POINTEUR 1 ->list get ip sto+
! 1024: next
! 1025: >>
! 1026: else
! 1027: 1 N_MOBILES for I
! 1028: draw
! 1029: next
! 1030: end
! 1031: else
! 1032: { X Y } autoscale 'Y' logscale
! 1033: parametric { T '-PI' 'PI' } indep 2 pi ->num * NB_POINTS / res
! 1034: << T r->d DIST N_ANTENNES T PONDERATIONS I DIAGRAMME_NORMALISE
! 1035: PUISSANCES FCT_DIAGRAMME r->c >> steq
! 1036:
! 1037: if
! 1038: TRACE_UN_MOBILE
! 1039: then
! 1040: 1
! 1041: -> I
! 1042: <<
! 1043: 1 PAQUETS for POINTEUR
! 1044: draw
! 1045: 'I' REPARTITION POINTEUR 1 ->list get ip sto+
! 1046: next
! 1047: >>
! 1048: else
! 1049: 1 N_MOBILES for I
! 1050: draw
! 1051: next
! 1052: end
! 1053: end
! 1054: >>
! 1055:
! 1056: drax
! 1057: >>
! 1058:
! 1059:
! 1060: FCT_DIRECTIONS
! 1061: <<
! 1062: -> T I DIRECTIONS
! 1063: <<
! 1064: rclf deg
! 1065: DIRECTIONS I get dup cos T * swap sin T * i ->num * +
! 1066: swap stof
! 1067: >>
! 1068: >>
! 1069:
! 1070:
! 1071: FCT_DIAGRAMME
! 1072: <<
! 1073: -> DIST N_ANTENNES T PONDERATIONS I DIAGRAMME_NORMALISE PUISSANCES
! 1074: <<
! 1075: N_ANTENNES 1 ->list i ->num 2 pi ->num * * T sin DIST * * con
! 1076:
! 1077: 1 N_ANTENNES for J
! 1078: dup J 1 ->list get J 1 - * exp
! 1079: J 1 ->list swap put
! 1080: next
! 1081:
! 1082: PONDERATIONS I get array-> 1 get 1 ->list ->array swap dot abs 2 /
! 1083:
! 1084: if
! 1085: DIAGRAMME_NORMALISE not
! 1086: then
! 1087: PUISSANCES I 1 ->list get *
! 1088: end
! 1089: >>
! 1090: >>
! 1091:
! 1092: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to obele.rpl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / examples