![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_m3.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src|
Return to instructions_m3.c CVS log | Up to [local] / rpl / src |
1.1 bertrand 1: /*
2: ================================================================================
1.33 ! bertrand 3: RPL/2 (R) version 4.1.7
1.31 bertrand 4: Copyright (C) 1989-2012 Dr. BERTRAND Joël
1.1 bertrand 5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
1.11 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 24:
25:
26: /*
27: ================================================================================
28: Fonction 'mean'
29: ================================================================================
30: Entrées : pointeur sur une structure struct_processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_mean(struct_processus *s_etat_processus)
40: {
41: struct_objet *s_objet_statistique;
42: struct_objet *s_objet_resultat;
43: struct_objet *s_objet_temporaire;
44:
45: unsigned long nombre_colonnes;
46:
47: (*s_etat_processus).erreur_execution = d_ex;
48:
49: if ((*s_etat_processus).affichage_arguments == 'Y')
50: {
51: printf("\n MEAN ");
52:
53: if ((*s_etat_processus).langue == 'F')
54: {
55: printf("(moyenne)\n\n");
56: }
57: else
58: {
59: printf("(mean)\n\n");
60: }
61:
62: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
63:
64: return;
65: }
66: else if ((*s_etat_processus).test_instruction == 'Y')
67: {
68: (*s_etat_processus).nombre_arguments = -1;
69: return;
70: }
71:
72: if (test_cfsf(s_etat_processus, 31) == d_vrai)
73: {
74: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
75: {
76: return;
77: }
78: }
79:
80: /*
81: * Recherche d'une variable globale référencée par SIGMA
82: */
83:
1.19 bertrand 84: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
1.1 bertrand 85: {
86: /*
87: * Aucune variable SIGMA
88: */
89:
90: (*s_etat_processus).erreur_systeme = d_es;
1.19 bertrand 91:
92: if ((*s_etat_processus).erreur_execution == d_ex)
93: {
94: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
95: }
96:
1.1 bertrand 97: return;
98: }
99: else
100: {
1.19 bertrand 101: if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
102: .type != MIN) && ((*(*(*s_etat_processus)
103: .pointeur_variable_courante).objet).type != MRL))
1.1 bertrand 104: {
1.19 bertrand 105: (*s_etat_processus).erreur_execution =
106: d_ex_matrice_statistique_invalide;
1.1 bertrand 107: return;
108: }
109:
1.19 bertrand 110: nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
111: .pointeur_variable_courante).objet).objet)).nombre_colonnes;
1.1 bertrand 112: }
113:
1.19 bertrand 114: s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
115: .objet;
1.1 bertrand 116:
117: if (((*s_objet_statistique).type == MIN) ||
118: ((*s_objet_statistique).type == MRL))
119: {
120: if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL)
121: {
122: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
123: return;
124: }
125:
126: if (((*s_objet_resultat).objet = moyenne_statistique((struct_matrice *)
127: (*s_objet_statistique).objet)) == NULL)
128: {
129: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
130: return;
131: }
132:
133: if (nombre_colonnes == 1)
134: {
135: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
136: {
137: (*s_objet_resultat).type = VIN;
138: s_objet_temporaire = s_objet_resultat;
139:
140: if ((s_objet_resultat = allocation(s_etat_processus, INT))
141: == NULL)
142: {
143: (*s_etat_processus).erreur_systeme =
144: d_es_allocation_memoire;
145: return;
146: }
147:
148: (*((integer8 *) (*s_objet_resultat).objet)) =
149: ((integer8 *) (*((struct_vecteur *)
150: (*s_objet_temporaire).objet)).tableau)[0];
151:
152: liberation(s_etat_processus, s_objet_temporaire);
153: }
154: else
155: {
156: (*s_objet_resultat).type = VRL;
157: s_objet_temporaire = s_objet_resultat;
158:
159: if ((s_objet_resultat = allocation(s_etat_processus, REL))
160: == NULL)
161: {
162: (*s_etat_processus).erreur_systeme =
163: d_es_allocation_memoire;
164: return;
165: }
166:
167: (*((real8 *) (*s_objet_resultat).objet)) =
168: ((real8 *) (*((struct_vecteur *)
169: (*s_objet_temporaire).objet)).tableau)[0];
170:
171: liberation(s_etat_processus, s_objet_temporaire);
172: }
173: }
174: else
175: {
176: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
177: {
178: (*s_objet_resultat).type = VIN;
179: }
180: else
181: {
182: (*s_objet_resultat).type = VRL;
183: }
184: }
185:
186: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
187: s_objet_resultat) == d_erreur)
188: {
189: return;
190: }
191: }
192: else
193: {
194: (*s_etat_processus).erreur_execution =
195: d_ex_matrice_statistique_invalide;
196: return;
197: }
198:
199: return;
200: }
201:
202:
203: /*
204: ================================================================================
205: Fonction 'mins'
206: ================================================================================
207: Entrées : pointeur sur une structure struct_processus
208: --------------------------------------------------------------------------------
209: Sorties :
210: --------------------------------------------------------------------------------
211: Effets de bord : néant
212: ================================================================================
213: */
214:
215: void
216: instruction_mins(struct_processus *s_etat_processus)
217: {
218: long i;
219: long j;
220:
221: struct_objet *s_objet_statistique;
222: struct_objet *s_objet_resultat;
223:
224: unsigned long nombre_colonnes;
225:
226: (*s_etat_processus).erreur_execution = d_ex;
227:
228: if ((*s_etat_processus).affichage_arguments == 'Y')
229: {
230: printf("\n MINS ");
231:
232: if ((*s_etat_processus).langue == 'F')
233: {
234: printf("(minimum de la matrice statistique)\n\n");
235: }
236: else
237: {
238: printf("(statistical matrix minimum)\n\n");
239: }
240:
241: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
242:
243: return;
244: }
245: else if ((*s_etat_processus).test_instruction == 'Y')
246: {
247: (*s_etat_processus).nombre_arguments = -1;
248: return;
249: }
250:
251: if (test_cfsf(s_etat_processus, 31) == d_vrai)
252: {
253: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
254: {
255: return;
256: }
257: }
258:
259: /*
260: * Recherche d'une variable globale référencée par SIGMA
261: */
262:
1.19 bertrand 263: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
1.1 bertrand 264: {
265: /*
266: * Aucune variable SIGMA
267: */
268:
269: (*s_etat_processus).erreur_systeme = d_es;
1.19 bertrand 270:
271: if ((*s_etat_processus).erreur_execution == d_ex)
272: {
273: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
274: }
275:
1.1 bertrand 276: return;
277: }
278: else
279: {
1.19 bertrand 280: if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
281: .type != MIN) && ((*(*(*s_etat_processus)
282: .pointeur_variable_courante).objet).type != MRL))
1.1 bertrand 283: {
1.19 bertrand 284: (*s_etat_processus).erreur_execution =
285: d_ex_matrice_statistique_invalide;
1.1 bertrand 286: return;
287: }
288:
1.19 bertrand 289: nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
290: .pointeur_variable_courante).objet).objet)).nombre_colonnes;
1.1 bertrand 291: }
292:
1.19 bertrand 293: s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
294: .objet;
1.1 bertrand 295:
296: if (nombre_colonnes == 1)
297: {
298: if ((*s_objet_statistique).type == MRL)
299: {
300: if ((s_objet_resultat = allocation(s_etat_processus, REL))
301: == NULL)
302: {
303: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
304: return;
305: }
306:
307: (*((real8 *) (*s_objet_resultat).objet)) = ((real8 **)
308: (*((struct_matrice *) (*s_objet_statistique).objet))
309: .tableau)[0][0];
310:
311: for(i = 1; i < (long) (*((struct_matrice *) (*s_objet_statistique)
312: .objet)).nombre_lignes; i++)
313: {
314: if ((*((real8 *) (*s_objet_resultat).objet)) > ((real8 **)
315: (*((struct_matrice *) (*s_objet_statistique).objet))
316: .tableau)[i][0])
317: {
318: (*((real8 *) (*s_objet_resultat).objet)) = ((real8 **)
319: (*((struct_matrice *) (*s_objet_statistique).objet))
320: .tableau)[i][0];
321: }
322: }
323: }
324: else
325: {
326: if ((s_objet_resultat = allocation(s_etat_processus, INT))
327: == NULL)
328: {
329: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
330: return;
331: }
332:
333: (*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 **)
334: (*((struct_matrice *) (*s_objet_statistique).objet))
335: .tableau)[0][0];
336:
337: for(i = 1; i < (long) (*((struct_matrice *) (*s_objet_statistique)
338: .objet)).nombre_lignes; i++)
339: {
340: if ((*((integer8 *) (*s_objet_resultat).objet)) > ((integer8 **)
341: (*((struct_matrice *) (*s_objet_statistique).objet))
342: .tableau)[i][0])
343: {
344: (*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 **)
345: (*((struct_matrice *) (*s_objet_statistique).objet))
346: .tableau)[i][0];
347: }
348: }
349: }
350: }
351: else
352: {
353: if ((*s_objet_statistique).type == MRL)
354: {
355: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
356: == NULL)
357: {
358: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
359: return;
360: }
361:
362: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
363: nombre_colonnes;
364:
365: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
366: malloc(nombre_colonnes * sizeof(real8))) == NULL)
367: {
368: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
369: return;
370: }
371:
372: for(j = 0; j < (long) nombre_colonnes; j++)
373: {
374: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
375: .tableau)[j] = ((real8 **) (*((struct_matrice *)
376: (*s_objet_statistique).objet)).tableau)[0][j];
377:
378: for(i = 1; i < (long) (*((struct_matrice *)
379: (*s_objet_statistique).objet)).nombre_lignes; i++)
380: {
381: if (((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
382: .objet)).tableau)[j] > ((real8 **)
383: (*((struct_matrice *) (*s_objet_statistique).objet))
384: .tableau)[i][j])
385: {
386: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
387: .objet)).tableau)[j] = ((real8 **)
388: (*((struct_matrice *) (*s_objet_statistique)
389: .objet)).tableau)[i][j];
390: }
391: }
392: }
393: }
394: else
395: {
396: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
397: == NULL)
398: {
399: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
400: return;
401: }
402:
403: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
404: nombre_colonnes;
405:
406: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
407: malloc(nombre_colonnes * sizeof(integer8))) == NULL)
408: {
409: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
410: return;
411: }
412:
413: for(j = 0; j < (long) nombre_colonnes; j++)
414: {
415: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
416: .tableau)[j] = ((integer8 **) (*((struct_matrice *)
417: (*s_objet_statistique).objet)).tableau)[0][j];
418:
419: for(i = 1; i < (long) (*((struct_matrice *)
420: (*s_objet_statistique).objet)).nombre_lignes; i++)
421: {
422: if (((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
423: .objet)).tableau)[j] > ((integer8 **)
424: (*((struct_matrice *) (*s_objet_statistique).objet))
425: .tableau)[i][j])
426: {
427: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
428: .objet)).tableau)[j] = ((integer8 **)
429: (*((struct_matrice *) (*s_objet_statistique)
430: .objet)).tableau)[i][j];
431: }
432: }
433: }
434: }
435: }
436:
437: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
438: s_objet_resultat) == d_erreur)
439: {
440: return;
441: }
442:
443: return;
444: }
445:
446:
447: /*
448: ================================================================================
449: Fonction 'maxs'
450: ================================================================================
451: Entrées : pointeur sur une structure struct_processus
452: --------------------------------------------------------------------------------
453: Sorties :
454: --------------------------------------------------------------------------------
455: Effets de bord : néant
456: ================================================================================
457: */
458:
459: void
460: instruction_maxs(struct_processus *s_etat_processus)
461: {
462: long i;
463: long j;
464:
465: struct_objet *s_objet_statistique;
466: struct_objet *s_objet_resultat;
467:
468: unsigned long nombre_colonnes;
469:
470: (*s_etat_processus).erreur_execution = d_ex;
471:
472: if ((*s_etat_processus).affichage_arguments == 'Y')
473: {
474: printf("\n MAXS ");
475:
476: if ((*s_etat_processus).langue == 'F')
477: {
478: printf("(maximum de la matrice statistique)\n\n");
479: }
480: else
481: {
482: printf("(statistical matrix maximum)\n\n");
483: }
484:
485: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
486:
487: return;
488: }
489: else if ((*s_etat_processus).test_instruction == 'Y')
490: {
491: (*s_etat_processus).nombre_arguments = -1;
492: return;
493: }
494:
495: if (test_cfsf(s_etat_processus, 31) == d_vrai)
496: {
497: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
498: {
499: return;
500: }
501: }
502:
503: /*
504: * Recherche d'une variable globale référencée par SIGMA
505: */
506:
1.19 bertrand 507: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
1.1 bertrand 508: {
509: /*
510: * Aucune variable SIGMA
511: */
512:
513: (*s_etat_processus).erreur_systeme = d_es;
1.19 bertrand 514:
515: if ((*s_etat_processus).erreur_execution == d_ex)
516: {
517: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
518: }
519:
1.1 bertrand 520: return;
521: }
522: else
523: {
1.19 bertrand 524: if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
525: .type != MIN) && ((*(*(*s_etat_processus)
526: .pointeur_variable_courante).objet).type != MRL))
1.1 bertrand 527: {
1.19 bertrand 528: (*s_etat_processus).erreur_execution =
529: d_ex_matrice_statistique_invalide;
1.1 bertrand 530: return;
531: }
532:
1.19 bertrand 533: nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
534: .pointeur_variable_courante).objet).objet)).nombre_colonnes;
1.1 bertrand 535: }
536:
1.19 bertrand 537: s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
538: .objet;
1.1 bertrand 539:
540: if (nombre_colonnes == 1)
541: {
542: if ((*s_objet_statistique).type == MRL)
543: {
544: if ((s_objet_resultat = allocation(s_etat_processus, REL))
545: == NULL)
546: {
547: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
548: return;
549: }
550:
551: (*((real8 *) (*s_objet_resultat).objet)) = ((real8 **)
552: (*((struct_matrice *) (*s_objet_statistique).objet))
553: .tableau)[0][0];
554:
555: for(i = 1; i < (long) (*((struct_matrice *) (*s_objet_statistique)
556: .objet)).nombre_lignes; i++)
557: {
558: if ((*((real8 *) (*s_objet_resultat).objet)) < ((real8 **)
559: (*((struct_matrice *) (*s_objet_statistique).objet))
560: .tableau)[i][0])
561: {
562: (*((real8 *) (*s_objet_resultat).objet)) = ((real8 **)
563: (*((struct_matrice *) (*s_objet_statistique).objet))
564: .tableau)[i][0];
565: }
566: }
567: }
568: else
569: {
570: if ((s_objet_resultat = allocation(s_etat_processus, INT))
571: == NULL)
572: {
573: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
574: return;
575: }
576:
577: (*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 **)
578: (*((struct_matrice *) (*s_objet_statistique).objet))
579: .tableau)[0][0];
580:
581: for(i = 1; i < (long) (*((struct_matrice *) (*s_objet_statistique)
582: .objet)).nombre_lignes; i++)
583: {
584: if ((*((integer8 *) (*s_objet_resultat).objet)) < ((integer8 **)
585: (*((struct_matrice *) (*s_objet_statistique).objet))
586: .tableau)[i][0])
587: {
588: (*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 **)
589: (*((struct_matrice *) (*s_objet_statistique).objet))
590: .tableau)[i][0];
591: }
592: }
593: }
594: }
595: else
596: {
597: if ((*s_objet_statistique).type == MRL)
598: {
599: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
600: == NULL)
601: {
602: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
603: return;
604: }
605:
606: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
607: nombre_colonnes;
608:
609: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
610: malloc(nombre_colonnes * sizeof(real8))) == NULL)
611: {
612: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
613: return;
614: }
615:
616: for(j = 0; j < (long) nombre_colonnes; j++)
617: {
618: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
619: .tableau)[j] = ((real8 **) (*((struct_matrice *)
620: (*s_objet_statistique).objet)).tableau)[0][j];
621:
622: for(i = 1; i < (long) (*((struct_matrice *)
623: (*s_objet_statistique).objet)).nombre_lignes; i++)
624: {
625: if (((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
626: .objet)).tableau)[j] < ((real8 **)
627: (*((struct_matrice *) (*s_objet_statistique).objet))
628: .tableau)[i][j])
629: {
630: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
631: .objet)).tableau)[j] = ((real8 **)
632: (*((struct_matrice *) (*s_objet_statistique)
633: .objet)).tableau)[i][j];
634: }
635: }
636: }
637: }
638: else
639: {
640: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
641: == NULL)
642: {
643: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
644: return;
645: }
646:
647: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
648: nombre_colonnes;
649:
650: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
651: malloc(nombre_colonnes * sizeof(integer8))) == NULL)
652: {
653: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
654: return;
655: }
656:
657: for(j = 0; j < (long) nombre_colonnes; j++)
658: {
659: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
660: .tableau)[j] = ((integer8 **) (*((struct_matrice *)
661: (*s_objet_statistique).objet)).tableau)[0][j];
662:
663: for(i = 1; i < (long) (*((struct_matrice *)
664: (*s_objet_statistique).objet)).nombre_lignes; i++)
665: {
666: if (((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
667: .objet)).tableau)[j] < ((integer8 **)
668: (*((struct_matrice *) (*s_objet_statistique).objet))
669: .tableau)[i][j])
670: {
671: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
672: .objet)).tableau)[j] = ((integer8 **)
673: (*((struct_matrice *) (*s_objet_statistique)
674: .objet)).tableau)[i][j];
675: }
676: }
677: }
678: }
679: }
680:
681: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
682: s_objet_resultat) == d_erreur)
683: {
684: return;
685: }
686:
687: return;
688: }
689:
690: // vim: ts=4