Annotation of rpl/examples/obele.rpl, revision 1.1.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>