File:  [local] / rpl / examples / obele.rpl
Revision 1.8: download - view: text, annotated - select for diffs - revision graph
Fri Jun 24 09:10:36 2011 UTC (12 years, 10 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_9, rpl-4_1_8, rpl-4_1_7, rpl-4_1_6, rpl-4_1_5, rpl-4_1_4, rpl-4_1_35, rpl-4_1_34, rpl-4_1_33, rpl-4_1_32, rpl-4_1_31, rpl-4_1_30, rpl-4_1_3, rpl-4_1_29, rpl-4_1_28, rpl-4_1_27, rpl-4_1_26, rpl-4_1_25, rpl-4_1_24, rpl-4_1_23, rpl-4_1_22, rpl-4_1_21, rpl-4_1_20, rpl-4_1_2, rpl-4_1_19, rpl-4_1_18, rpl-4_1_17, rpl-4_1_16, rpl-4_1_15, rpl-4_1_14, rpl-4_1_13, rpl-4_1_12, rpl-4_1_11, rpl-4_1_10, rpl-4_1_1, rpl-4_1_0, HEAD
Modification des règles de compilation pour lier rplcas à l'exécutable
rpl et à la bibliothèque librpl.a.

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

CVSweb interface <joel.bertrand@systella.fr>