File:  [local] / rpl / examples / obele.rpl
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs - revision graph
Tue Jan 26 15:23:06 2010 UTC (14 years, 3 months ago) by bertrand
Branches: JKB
CVS tags: start


Commit initial.

    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>