      6     1      	Program EXPERT (input,output,namen,werte);     2      	'     3      	(*** Globale Parameter ***) F     4      	Const knoten_max=20;   (*** sollte groesser 0 sein !! ***)F     5      	      bsp_max=20;      (*** sollte groesser 0 sein !! ***)F     6      	      erg_max=10;      (*** sollte groesser 0 sein !! ***)F     7      	      var_max=20;      (*** sollte groesser 0 sein !! ***)O     8      	      wort_max=10;     (*** sollte zwischen 2 und 24 liegen !! ***) J     9      	      zeichen_zeile=80;(*** sollte grosser als 20 sein !! ***)"    10      	      minimum=-MAXINT;(    11      	      warteschleife=2000000;    12      	3    13      	Type datei_bezeichnung=File of Integer; <    14      	     knotenfeld=Array[1..knoten_max] of Integer;5    15      	     wortfeld=Array[1..wort_max] of Char; @    16      	     zeichenkette=Packed Array[1..wort_max] of Char;     17      	     beispiel=RecordB    18      	                var_wert:Array[1..var_max] of Integer;-    19      	                erg_nr:1..erg_max     20      	              End;     21      	     variable=Record.    22      	                name:zeichenkette;1    23      	                wert,min,max:Integer; 4    24      	                knoten:datei_bezeichnung    25      	              End;    26      	<    27      	Var bsp_anzahl,erg_anzahl,var_anzahl:knotenfeld;A    28      	    vari:Array[1..var_max,1..knoten_max] of variable; @    29      	    bsp:Array[1..bsp_max,1..knoten_max] of beispiel;@    30      	    prio:Array[1..var_max,1..erg_max] of knotenfeld;I    31      	    ergebnis:Array[1..erg_max,1..knoten_max] of zeichenkette; 1    32      	    knot,knoten_anzahl:0..knoten_max; &    33      	    leerwort:zeichenkette;    34      	    blank:wortfeld;     35      	    init:Boolean; C    36      	    knoten_name:Array[1..knoten_max+1] of zeichenkette; +    37      	    namen:File of zeichenkette; (    38      	    werte:datei_bezeichnung;    39      	=    40      	(*** Lokale Parameter fuer das Hauptprogramm ***)     41      	    42      	    wahl:0..9;    43      	    lesen:Char; &    44      	    ziffer1,w:1..wort_max;#    45      	    z:1..zeichen_zeile;     46      	Y    47      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * Z    48      	 *                 PROZEDUR  N A M E N _ A N Z E I G E                      *)    49      	7    50      	Procedure NAMEN_ANZEIGE(name:zeichenkette);     51      	Var wort:wortfeld;(    52      	    index,blank:1..wort_max;    53      	    54      	Begin "    55      	  Unpack(name,wort,1);          56      	  blank:=wort_max;8    57      	  While name[blank]=' ' Do blank:=blank - 1;9    58      	  For index:=1 to blank Do Write(wort[index])     59      	End;    60      	    61      	Z    62      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * Z    63      	 *                 PROZEDUR  A N Z E I G E                                  *)    64      	    65      	Procedure ANZEIGE;    66      	Var antwort:Char; )    67      	    zeile,rest,index:Integer; $    68      	    return:zeichenkette;?    69      	(*** Globale Parameter in der Prozedur ANZEIGE ***)     70      	    va:1..var_max;!    71      	    kn:1..knoten_max; !    72      	    beisp:0..bsp_max; !    73      	    ergeb:1..erg_max;     74      	?    75      	(*** Prozedur ERG_ANZEIGE in ANZEIGE           ***)     76      	4    77      	  Procedure ERG_ANZEIGE(nummer:Integer);     78      	  Var wort:wortfeld;*    79      	      index,blank:0..wort_max;    80      	    81      	  Begin     82      	    Write('I'); 3    83      	    Unpack(ergebnis[nummer,kn],wort,1);      84      	    blank:=wort_max;:    85      	    While wort[blank]=' ' Do blank:=blank - 1;G    86      	    For index:=1 to (wort_max - blank) Div 2 Do Write(' '); <    87      	    For index:=1 to blank Do Write(wort[index]);W    88      	    For index:=(wort_max - blank) Div 2 to (wort_max - blank) Do Write(' ') 7    89      	  End;(* Prozedur ERG_ANZEIGE in ANZEIGE *)     90      	?    91      	(*** Prozedur WERT_ANZEIGE in ANZEIGE          ***)     92      	7    93      	  Procedure WERT_ANZEIGE(anz_wert:Integer); *    94      	  Var blank,index:1..wort_max;    95      	      zahl:Integer;     96      	    97      	  Begin     98      	    Write('I');     99      	    zahl:=anz_wert;    100      	    blank:=0;    101      	    Repeat#   102      	      blank:=blank + 1; #   103      	      zahl:=zahl Div 10    104      	    Until zahl=0; 4   105      	    If anz_wert<0 Then blank:=blank + 1;G   106      	    For index:=1 to (wort_max - blank) Div 2 Do Write(' '); &   107      	    Write(anz_wert:blank);W   108      	    For index:=(wort_max - blank) DIV 2 to (wort_max - blank) Do Write(' ') 8   109      	  End;(* Prozedur WERT_ANZEIGE in ANZEIGE *)   110      	      ?   111      	(*** Prozedur VAR_ANZEIGE in ANZEIGE           ***)    112      	/   113      	  Procedure VAR_ANZEIGE(b:integer);    114      	  Var i:Integer;   115      	      v:1..var_max; %   116      	      strich:1..wort_max;    117      	   118      	  Begin    119      	    Page; F   120      	    Writeln('                    EXPERTENSYSTEM');Writeln;N   121      	    Writeln('                    ------------------------------');N   122      	    Writeln('                    > Eingabewerte der Variablen <');V   123      	    Writeln('                    ------------------------------');Writeln;C   124      	    Writeln(kn:2,'. Knoten :',knoten_name[kn]);Writeln; )   125      	    Write('Beispielnummer:');     126      	    For i:=1 to b Do   127      	     Begin"   128      	       beisp:=beisp+1;&   129      	       WERT_ANZEIGE(beisp)   130      	     End; 1   131      	    Writeln;Write('Variablen:     '); !   132      	    For i:=1 to b Do  ;   133      	     For strich:=1 to wort_max+1 Do Write('-');    134      	    Writeln;-   135      	    For v:=1 to var_anzahl[kn] Do    136      	     Begin8   137      	       Write(v:2,'.',vari[v,kn].name,': '); [   138      	       For i:=beisp-b+1 to beisp Do WERT_ANZEIGE(bsp[i,kn].var_wert[v]);Writeln    139      	     End; )   140      	    Write('---------------'); !   141      	    For i:=1 to b Do  =   142      	     For strich:=1 to wort_max + 1 Do Write('-'); 1   143      	    Writeln;Write('Ergebnis:      '); K   144      	    For i:=beisp-b+1 to beisp Do ERG_ANZEIGE(bsp[i,kn].erg_nr); D   145      	    Writeln;Writeln;Write('Bitte <RETURN> druecken - ');&   146      	    Readln(return);Writeln   147      	  End;   148      	C   149      	(***  Prozedur PRIO_ANZEIGE in ANZEIGE             ***)    150      	0   151      	  Procedure PRIO_ANZEIGE(e:Integer);   152      	  Var i:Integer;   153      	      v:1..var_max; %   154      	      strich:1..wort_max;    155      	   156      	  Begin    157      	    Page; F   158      	    Writeln('                    EXPERTENSYSTEM');Writeln;N   159      	    Writeln('                    ------------------------------');N   160      	    Writeln('                    > Prioritaeten der Variablen <');V   161      	    Writeln('                    ------------------------------');Writeln;C   162      	    Writeln(kn:2,'. Knoten :',knoten_name[kn]);Writeln; )   163      	    Write('      Ergebnis:'); !   164      	    For i:=1 to e Do     165      	     Begin      "   166      	       ergeb:=ergeb+1;%   167      	       ERG_ANZEIGE(ergeb)    168      	     End; 1   169      	    Writeln;Write('Variablen:     '); !   170      	    For i:=1 to e Do  ;   171      	     For strich:=1 to wort_max+1 Do Write('-');    172      	    Writeln;-   173      	    For v:=1 to var_anzahl[kn] Do    174      	     Begin7   175      	       Write(v:2,'.',vari[v,kn].name,'  '); K   176      	       For i:=ergeb-e+1 to ergeb Do WERT_ANZEIGE(prio[v,i,kn]);    177      	       Writeln   178      	     End; <   179      	    Writeln;Write('Bitte <RETURN> druecken - ');'   180      	    Readln (return);Writeln    181      	  End;   182      	8   183      	(*** Hauptprogramm der Prozedur ANZEIGE ***)   184      	Begin    185      	  Page; D   186      	  Writeln('                    EXPERTENSYSTEM');Writeln;%   187      	  If knoten_anzahl>2 Then    188      	   BeginL   189      	     Write('Ab welchem Knoten moechten Sie beginnen ?');Writeln;R   190      	     For kn:=1 to knoten_anzahl Do Writeln(kn:2,'. ',knoten_name[kn]);   191      	     Writeln;    192      	     Repeat G   193      	       Write('Bitte die NUMMER des Knotens eingeben ! ->'); %   194      	       Readln(kn);Writeln /   195      	     Until kn In [1..knoten_anzahl]    196      	   End   197      	  Else kn:=1; =   198      	  zeile:=(zeichen_zeile - 15) Div (wort_max + 1);    199      	  Repeat   200      	    beisp:=0; O   201      	    For index:=1 to bsp_anzahl[kn] Div zeile Do VAR_ANZEIGE(zeile); /   202      	    rest:=bsp_anzahl[kn] Mod zeile; 2   203      	    If rest<>0 Then VAR_ANZEIGE(rest);   204      	    ergeb:=0; P   205      	    For index:=1 to erg_anzahl[kn] Div zeile Do PRIO_ANZEIGE(zeile);/   206      	    rest:=erg_anzahl[kn] Mod zeile; 3   207      	    If rest<>0 Then PRIO_ANZEIGE(rest); .   208      	    For va:=1 to var_anzahl[kn] Do$   209      	     With vari[va,kn] Do   210      	      Begin "   211      	        Reset(knoten);,   212      	        While Not Eof(knoten) Do   213      	         Begin.   214      	           Write('Die Variable ');+   215      	           NAMEN_ANZEIGE(name); 8   216      	           Write(' gibt es als ',knoten^:2);#   217      	           Get(knoten); a   218      	           Writeln('. Variable am ',knoten^:2,'.Knoten: ',knoten_name[knoten^],' !'); "   219      	           Get(knoten)   220      	         End         221      	      End;   222      	    Writeln;(   223      	    If kn=knoten_anzahl Then   224      	     Begin7   225      	       Write('Bitte <RETURN> druecken ->'); "   226      	       Readln(return);   227      	       antwort:='n'    228      	     End   229      	    Else   230      	     Begin   231      	       kn:=kn+1;M   232      	       Write('Wollen Sie den ',kn:2,'. Knoten sehen ? (J/N) ->'); *   233      	       Readln(antwort);Writeln   234      	     End(   235      	  Until antwort In ['n','N']&   236      	End;(* Prozedur ANZEIGE *)   237      	   238      	5   239      	Function KNOTENSUCHHILFE:Integer;Forward;    240      	   241      	Z   242      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * Z   243      	 *                 PROZEDUR  R E G E L                                      *)   244      	(   245      	Procedure REGEL(kn:Integer);-   246      	Type laufmenge=Set of 1..bsp_max;     247      	Var er,e:1..erg_max;#   248      	    v_anz,v:1..var_max; &   249      	    b,b_nummer:0..bsp_max;.   250      	    index,erg_wert,v_wert:Integer;+   251      	    hauptmenge,lauf1:laufmenge; $   252      	    return:zeichenkette;   253      	   254      	Begin    255      	  Writeln;H   256      	  Writeln('                    --------------------------');H   257      	  Writeln('                    > Prioritaetenermittlung <');P   258      	  Writeln('                    --------------------------');Writeln;$   259      	  v_anz:=var_anzahl[kn];   260      	  hauptmenge:=[]; 2   261      	  For b_nummer:=1 to bsp_anzahl[kn] Do   262      	   Begin5   263      	     hauptmenge:=hauptmenge + [b_nummer]; <   264      	     For v:=1 to v_anz Do prio[v,b_nummer,kn]:=0   265      	   End;     266      	  lauf1:=hauptmenge;   267      	  index:=0;    268      	  Repeat   269      	    erg_wert:=0;   270      	    b:=0; /   271      	    Repeat b:=b+1 Until b In lauf1; !   272      	    With bsp[b,kn] Do    273      	     BeginY   274      	       For v:=1 to v_anz Do erg_wert:=erg_wert+var_wert[v]*prio[v,erg_nr,kn]; &   275      	       lauf1:=lauf1 - [b];      0   276      	       For e:=1 to erg_anzahl[kn] Do%   277      	        If e<>erg_nr Then    278      	         Begin!   279      	           v_wert:=0; X   280      	           For v:=1 to v_anz Do v_wert:=v_wert + var_wert[v] * prio[v,e,kn];/   281      	           If v_wert>=erg_wert Then    282      	            Begin X   283      	              For v:=1 to v_anz Do prio[v,e,kn]:=prio[v,e,kn] - var_wert[v];1   284      	              If Not(b In lauf1) Then     285      	               Begin(   286      	                 er:=erg_nr;.   287      	                 index:=index + 1;/   288      	                 lauf1:=hauptmenge; \   289      	                 For v:=1 to v_anz Do prio[v,er,kn]:=prio[v,er,kn] + var_wert[v]   290      	               End   291      	            End    292      	         End(   293      	     End(* With-Anweisung *)B   294      	  Until ((lauf1=[]) Or (index>bsp_anzahl[kn] * 1000));1   295      	  If index>bsp_anzahl[kn] * 1000 Then    296      	   BeginZ   297      	     Writeln('Durch falsche Beispieleingabe ist eine Prioritaetenermittlung');W   298      	     Writeln('am ',kn:2,'. Knoten : ',knoten_name[kn],' nicht moeglich !'); X   299      	     Writeln('Bitte Beispiel loeschen oder Knoten neu eingeben !!');Writeln;5   300      	     Write('Bitte <RETURN> druecken ->');    301      	     Readln(return)    302      	   End$   303      	End;(* Prozedur REGEL *)   304      	   305      	Z   306      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * Z   307      	 *                 PROZEDUR  E X A M P L E                                  *)   308      	*   309      	Procedure EXAMPLE(kn:Integer);   310      	Var v:1..var_max;    311      	    e:1..erg_max;     312      	    erg_neu:Boolean;   313      	       314      	Begin    315      	  Page; D   316      	  Writeln('                    EXPERTENSYSTEM');Writeln;6   317      	  For z:=1 to zeichen_zeile Do Write('-');[   318      	  Writeln('     > Beispieleingabe am ',kn:2,'. Knoten :',knoten_name[kn],' <'); >   319      	  For z:=1 to zeichen_zeile Do Write('-');Writeln;1   320      	  bsp_anzahl[kn]:=bsp_anzahl[kn] + 1; 1   321      	  erg_anzahl[kn]:=erg_anzahl[kn] + 1;    322      	  RepeatQ   323      	    Writeln;Writeln('Beispielnummer ',bsp_anzahl[kn]:2,' :');Writeln; -   324      	    For v:=1 to var_anzahl[kn] Do /   325      	     With bsp[bsp_anzahl[kn],kn] Do    326      	      Repeat?   327      	        Write('Welchen Wert hat die Variable   >'); @   328      	        NAMEN_ANZEIGE(vari[v,kn].name);Writeln('<');`   329      	        Write(', im Berich von ',vari[v,kn].min:3,' bis ',vari[v,kn].max:3,' ? ->');'   330      	        Readln(var_wert[v])       X   331      	      Until (var_wert[v]>=vari[v,kn].min) And (var_wert[v]<=vari[v,kn].max);8   332      	    For z:=1 to zeichen_zeile Do Write('-');U   333      	    Writeln('Wie lautet das Ergebnis (max.',wort_max:2,' Buchstaben) ?'); Z   334      	    Writeln('Falls Sie sich vertippt haben, ohne Eingabe <RETURN> druecken ');   335      	    Write('->');3   336      	    Readln(ergebnis[erg_anzahl[kn],kn]) :   337      	  Until ergebnis[erg_anzahl[kn],kn]<>leerwort;   338      	  erg_neu:=True;-   339      	  For e:=1 to erg_anzahl[kn]-1 Do A   340      	   If ergebnis[erg_anzahl[kn],kn]=ergebnis[e,kn] Then    341      	    Begin !   342      	      erg_neu:=False; 2   343      	      bsp[bsp_anzahl[kn],kn].erg_nr:=e   344      	    End;K   345      	  If erg_neu Then bsp[bsp_anzahl[kn],kn].erg_nr:=erg_anzahl[kn] @   346      	             Else erg_anzahl[kn]:=erg_anzahl[kn] - 1&   347      	End;(* Prozedur EXAMPLE *)   348      	   349      	K   350      	Function SUCHZAHL(index:Integer;name:wortfeld):Integer;Forward;    351      	   352      	Y   353      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * Z   354      	 *                PROZEDUR  B S P W E G                                     *)   355      	   356      	Procedure BSPWEG; %   357      	Var bsp_nummer,b:Integer;    358      	    v:1..var_max; !   359      	    kn:1..knoten_max; %   360      	    antwort:zeichenkette; "   361      	    bsp_name:wortfeld;   362      	   363      	Begin "   364      	  kn:=KNOTENSUCHHILFE;   365      	  Page; D   366      	  Writeln('                    EXPERTENSYSTEM');Writeln;[   367      	  Writeln('ACHTUNG!! Es wird ein Beispiel unwiderruflich geloescht !!ACHTUNG');2   368      	  Writeln;   369      	  RepeatD   370      	    Writeln('Welches Beispiel soll geloescht werden ?');   371      	    bsp_nummer:=0;]   372      	    Write('Geben Sie bitte die Nummer oder das Ergebnis des Beispiels ein ! ->');     373      	    Readln(antwort);+   374      	    Unpack(antwort,bsp_name,1);l^   375      	    If bsp_name[ziffer1] in ['0'..'9'] Then bsp_nummer:=SUCHZAHL(ziffer1,bsp_name)   376      	    Else   377      	     Repeat -   378      	       bsp_nummer:=bsp_nummer + 1 d   379      	     Until(ergebnis[bsp[bsp_nummer,kn].erg_nr,kn]=antwort)Or(bsp_nummer>bsp_anzahl[kn]);/   380      	  Until bsp_nummer<=bsp_anzahl[kn];]1   381      	  bsp_anzahl[kn]:=bsp_anzahl[kn] - 1;r4   382      	  For b:=bsp_nummer to bsp_anzahl[kn] Do"   383      	   With bsp[b+1,kn] Do   384      	    Begin]S   385      	      For v:=1 to var_anzahl[kn] Do bsp[b,kn].var_wert[v]:=var_wert[v];  n    *   386      	      bsp[v,kn].erg_nr:=erg_nr   387      	    End;   388      	  Writeln;&   389      	  If bsp_anzahl[kn]=0 Then   390      	   Begin+   391      	     bsp_anzahl[kn]:=1;Writeln; J   392      	     Writeln('Dieses Beispiel kann nicht geloescht werden !!')   393      	   End   394      	  Else   395      	   Begin   396      	     REGEL(kn); G   397      	     Write('Beispiel ',bsp_nummer:2,' mit dem Ergebnis "'); U   398      	     NAMEN_ANZEIGE(ergebnis[bsp[bsp_nummer,kn].erg_nr,kn]);Writeln;      1W   399      	     Writeln('" ist am ',kn:2,'. Knoten : ',knoten_name[kn],' geloescht !')m   400      	   End;    401      	  Writeln;1   402      	  Write('Bitte <RETURN> druecken -');n   403      	  Readln(antwort)n%   404      	End;(* Prozedur BSPWEG *)c   405      	   406      	Y   407      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * Z   408      	 *                   PROZEDUR D A T E I K O P I E                           *)
   409      	  A   410      	Procedure DATEIKOPIE(Var von,nach:datei_bezeichnung);    411      	   412      	Begin '   413      	  Reset(von);Rewrite(nach); #   414      	  While Not Eof(von) Do*   415      	   Begin   416      	     nach^:=von^;    417      	     Put(nach);E   418      	     Get(von)    419      	   End%   420      	End;(* Prozedur BSPWEG *)z   421      	   422      	C   423      	Function VAR_VERGLEICH(va,kn:Integer):Boolean;Forward;     424      	   425      	Y   426      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *ld   427      	 *                        PROZEDUR F I L E _ L O E S C H E N                          *)   428      	3   429      	Procedure FILE_LOESCHEN(va,kn:Integer);    430      	Var v:1..var_max;*    431      	    k:1..knoten_max;   432      	    ende:Boolean; (   433      	    datei:datei_bezeichnung;   434      	   435      	Begin (   436      	  Reset(vari[va,kn].knoten);2   437      	  While Not Eof(vari[va,kn].knoten) Do   438      	   Begin   439      	     ende:=False; (   440      	     v:=vari[va,kn].knoten^; d    )   441      	     Get(vari[va,kn].knoten);;(   442      	     k:=vari[va,kn].knoten^;)   443      	     Get(vari[va,kn].knoten);	"   444      	     With vari[v,k] Do   445      	      Beginu-   446      	        DATEIKOPIE(knoten,datei); !   447      	        Reset(datei);_$   448      	        Rewrite(knoten);   449      	        Repeat&   450      	          If datei^=v Then   451      	           Begin$   452      	             Get(datei);)   453      	             If datei^=k Then,   454      	              Begin_'   455      	                ende:=True; '   456      	                Get(datei);o3   457      	                While Not Eof(datei) Do "   458      	                 Begin/   459      	                   knoten^:=datei^;n+   460      	                   Put(knoten);b)   461      	                   Get(datei)P6   462      	                 End(* While - Schleife *)5   463      	              End(* If gleicher Knoten *)*   464      	             Else    465      	              Beginn'   466      	                knoten^:=v;.(   467      	                Put(knoten);,   468      	                knoten^:=datei^;(   469      	                Put(knoten);&   470      	                Get(datei)7   471      	              End(* Else gleicher Knoten *)k3   472      	           End(* If gleiche Variable *)    473      	          Else   474      	           Begin)   475      	             knoten^:=datei^;e%   476      	             Put(knoten);t$   477      	             Get(datei);)   478      	             knoten^:=datei^;t%   479      	             Put(knoten);k#   480      	             Get(datei)*5   481      	           End(* Else gleiche Variable *)    482      	         Until ende_   483      	      End(* With *)    484      	   End(* While *)r'   485      	End;(* Prozedur LOESCHEN *)    486      	   487      	Z   488      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * Z   489      	 *                       PROZEDUR K N O T E N W E G                         *)   490      	    491      	Procedure KNOTENWEG;#   492      	Var k,kn:1..knoten_max;-   493      	    e:1..erg_max;l   494      	    v:1..var_max;e   495      	    b:1..bsp_max;       %   496      	    antwort:zeichenkette;-   497      	    c:Char;r   498      	   499      	Beginn1   500      	  Write('Sin Sie sicher ? (J/N) ->');    501      	  Readln(c);$   502      	  If c In ['j','J'] Then   503      	   Begin  %   504      	     kn:=KNOTENSUCHHILFE;;   505      	     Page;G   506      	     Writeln('                    EXPERTENSYSTEM');Writeln;V^   507      	     Writeln('ACHTUNG!!Es wird nun ein Knoten unwiderruflich geloescht!!ACHTUNG');   508      	     Writeln; *   509      	     antwort:=knoten_name[kn];C   510      	     For v:=1 to var_anzahl[kn] Do FILE_LOESCHEN(v,kn);i0   511      	     For k:=kn to knoten_anzahl-1 Do   512      	      Beginb2   513      	        For v:=1 to var_anzahl[k+1] Do(   514      	         With vari[v,k+1] Do   515      	          Begin -   516      	            vari[v,k].name:=name; +   517      	            vari[v,k].min:=min;)+   518      	            vari[v,k].max:=max; <   519      	            DATEIKOPIE(knoten,vari[v,k].knoten);Q   520      	            For e:=1 to erg_anzahl[k+1] Do prio[v,e,k]:=prio[v,e,k+1]e   521      	          End;R   522      	        For e:=1 to erg_anzahl[k+1] Do ergebnis[e,k]:=ergebnis[e,k+1];2   523      	        For b:=1 to bsp_anzahl[k+1] Do'   524      	         With bsp[b,k+1] DoE   525      	          Begina0   526      	            bsp[b,k].erg_nr:=erg_nr;X   527      	            For v:=1 to var_anzahl[k+1] Do bsp[b,k].var_wert[v]:=var_wert[v]   528      	          End;5   529      	        knoten_name[k]:=knoten_name[k+1];53   530      	        bsp_anzahl[k]:=bsp_anzahl[k+1];-3   531      	        erg_anzahl[k]:=erg_anzahl[k+1]; 2   532      	        var_anzahl[k]:=var_anzahl[k+1]   533      	      End;   534      	     Writeln;-_   535      	     If knoten_anzahl=1 Then Writeln('Dieser Knoten kann nicht geloescht werden !')n   536      	     Elset   537      	      Begin ]   538      	        Writeln('Es wurde soeben der ',kn:2,'. Knoten :',antwort,' geloescht !');e4   539      	        knoten_anzahl:=knoten_anzahl - 1   540      	      End;   541      	     Writeln;a4   542      	     Write('Bitte <RETURN> druecken !');    543      	     Readln(antwort)   544      	   End(   545      	End;(* Prozedur KNOTENWEG *)   546      	   547      	Y   548      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * Z   549      	 *                 PROZEDUR  K N O T E N D A Z U                            *)
   550      	        !   551      	Procedure KNOTENDAZU;l'   552      	Var b,beisp_anz:0..bsp_max; %   553      	    ja_nein,ende:Boolean;    554      	    antwort:Char;	    555      	    va,v:1..var_max;#   556      	    kn,k:1..knoten_max;	   557      	             558      	  Beginr   559      	    Page; F   560      	    Writeln('                    EXPERTENSYSTEM');Writeln;?   561      	    Writeln('                    ---------------');c?   562      	    Writeln('                    > KNOTENDATEN <');tG   563      	    Writeln('                    ---------------');Writeln;n_   564      	    Writeln('Sollen keine Daten eingegben werden, ohne Eingabe <RETURN> druecken');>T   565      	    Write('Name des ',knoten_anzahl+1:2,'. Sachgebietes (Knoten) ? ->');E   566      	    Readln(knoten_name[knoten_anzahl+1]);Writeln;Writeln; H   567      	    If knoten_name[knoten_anzahl+1]=leerwort Then init:=True   568      	    Else   569      	     Begin   570      	       init:=False;i"   571      	       ja_nein:=False;4   572      	       knoten_anzahl:=knoten_anzahl + 1;&   573      	       kn:=knoten_anzahl;;U   574      	       Writeln('Falls kein neuer Variablenname eingegeben werden soll,'); P   575      	       Writeln('einfach OHNE Eingabe <RETURN> druecken !!');Writeln;%   576      	       var_anzahl[kn]:=0;)   577      	       Repeat=8   578      	         var_anzahl[kn]:=var_anzahl[kn] + 1;(   579      	         va:=var_anzahl[kn];?   580      	         Write('Name der ',va:2,'. Variable ? ->'); 6   581      	         Readln(vari[va,kn].name);Writeln;6   582      	         If vari[va,kn].name=leerwort Then/   583      	          If var_anzahl[kn]=1 Then     584      	           Begin+   585      	             var_anzahl[kn]:=0; $   586      	             ende:=FALSE   587      	           End%   588      	          Else ende:=TRUE    589      	         Else    590      	          Begin $   591      	            ende:=FALSE;4   592      	            If VAR_VERGLEICH(va,kn) Then-   593      	             If Not(ja_nein) ThenR   594      	              Begin "   595      	                Repeat&   596      	                  Writeln;T   597      	                  Write('Wie klein ist das MINIMUM der Variablen ? ->');6   598      	                  Readln(vari[va,kn].min);T   599      	                  Write('Wie gross ist das MAXIMUM der Variablen ? ->');=   600      	                  Readln(vari[va,kn].max);WritelnoE   601      	                Until vari[va,kn].min <= vari[va,kn].max;E(   602      	                If va=1 ThenP   603      	                 If (vari[va,kn].min=0) And (vari[va,kn].max=1) Then#   604      	                  Begin	(   605      	                    Writeln;      d   606      	                    Write('Haben alle Variablen in diesem Knoten 0/1-Werte ? (J/N) ->');8   607      	                    Readln(antwort);Writeln;J   608      	                    If antwort In ['j','J'] Then ja_nein:=True!   609      	                  End_   610      	             End   611      	            Else   612      	             Begin.   613      	               vari[va,kn].min:=0;-   614      	               vari[va,kn].max:=1    615      	             End*   616      	          End;(* IF-abfrage *)   617      	         Writeln   618      	       Until ende;4   619      	       var_anzahl[kn]:=var_anzahl[kn]-1;P   620      	       Writeln('Falls Sie sich vertippt haben, bitte <0> eingeben');M   621      	       Write('Wieviele Beispiele gibt es an diesem Knoten ? ->'); %   622      	       Readln(beisp_anz); &   623      	       If beisp_anz=0 Then   624      	        Begin,7   625      	          knoten_anzahl:=knoten_anzahl - 1;eH   626      	          Writeln('Knotendaten bitte nochmals eingeben !!');3   627      	          For b:=1 to warteschleife Do;e    628      	          KNOTENDAZU   629      	        End]   630      	       Elseg   631      	        Beginv3   632      	          bsp_anzahl[knoten_anzahl]:=0;,F   633      	          For b:=1 to beisp_anz Do EXAMPLE(knoten_anzahl);*   634      	          REGEL(knoten_anzahl)   635      	        End_   636      	   End)   637      	End;(* Prozedur KNOTENDAZU *)w   638      	   639      	Y   640      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * Z   641      	 *               PROZEDUR  L A D E N                                        *)   642      	   643      	Procedure LADEN;   644      	Var v:1..var_max;    645      	    b:1..bsp_max;e!   646      	    kn:1..knoten_max;n   647      	    ende:Boolean;e   648      	    antwort:Char;    649      	   650      	Begin    651      	  Page; O   652      	  Writeln('                               EXPERTENSYSTEM');Writeln;,I   653      	  Writeln('                              -----------------'); I   654      	  Writeln('                              >Beispiele laden<');nQ   655      	  Writeln('                              -----------------');Writeln;94   656      	  Writeln('Nach jeder Anzeige');Writeln;0   657      	  Writeln(' L (Knoten laden) oder');?   658      	  Writeln(' W (Knoten NICHT laden - weiter) oder'); .   659      	  Writeln(' A (Abbruch)');Writeln;$   660      	  Writeln('eingeben !');         661      	  Reset(namen);l   662      	  Reset(werte);b   663      	  ende:=FALSE;/   664      	  While Not (Eof(namen) Or ende) Do0   665      	   Begin2   666      	     knoten_anzahl:=knoten_anzahl + 1;#   667      	     kn:=knoten_anzahl; )   668      	     knoten_name[kn]:=namen^; (   669      	     var_anzahl[kn]:=werte^;.   670      	     For v:=1 to var_anzahl[kn] Do   671      	      Begin    672      	        Get(namen); ,   673      	        vari[v,kn].name:=namen^;   674      	      End;   675      	     Get(werte);(   676      	     bsp_anzahl[kn]:=werte^;*   677      	     Write(kn:2,'. Knoten >');0   678      	     NAMEN_ANZEIGE(knoten_name[kn]);>   679      	     Writeln('< mit den folgenden Ergebnissen :');#   680      	     erg_anzahl[kn]:=1;    681      	     Get(namen);   682      	     Repeat.9   683      	       Writeln(erg_anzahl[kn]:2,'. ',namen^);t7   684      	       ergebnis[erg_anzahl[kn],kn]:=namen^;_6   685      	       erg_anzahl[kn]:=erg_anzahl[kn] + 1;   686      	       Get(namen) '   687      	     Until namen^=leerwort;l4   688      	     erg_anzahl[kn]:=erg_anzahl[kn] - 1;   689      	     Writeln; .   690      	     For b:=1 to bsp_anzahl[kn] Do#   691      	      With bsp[b,kn] Do    692      	       Begin2   693      	         For v:=1 to var_anzahl[kn] Do   694      	          BeginE#   695      	            Get(werte);'+   696      	            var_wert[v]:=werte^n   697      	          End;    698      	         Get(werte);#   699      	         erg_nr:=werte^    700      	       End;n.   701      	     For v:=1 to var_anzahl[kn] Do$   702      	      With vari[v,kn] Do   703      	       Begin    704      	         Get(werte);!   705      	         min:=werte^;.    706      	         Get(werte);    707      	         max:=werte^   708      	       End;e   709      	     Repeatn>   710      	       Write('>L<aden, >W<eiter, >A<bbruch ? ->');+   711      	       Readln(antwort);Writeln; D   712      	     Until antwort In ['l','L','w','W','a','A'];Writeln;2   713      	     If Not(antwort In ['l','L']) Then   714      	      Beging<   715      	        If antwort In ['a','A'] Then ende:=True; 4    4   716      	        knoten_anzahl:=knoten_anzahl - 1   717      	      Ende   718      	     Else    719      	      BeginTF   720      	        For v:=1 to var_anzahl[kn] Do VAR_VERGLEICH(v,kn);   721      	        REGEL(kn)n   722      	      End;   723      	     Get(werte);   724      	     Get(namen)    725      	   End   726      	End;   727      	   728      	Y   729      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * Z   730      	 *               PROZEDUR S P E I C H E R N                                 *)   731      	    732      	Procedure SPEICHERN;   733      	Var e:1..erg_max;G   734      	    v:1..var_max;b   735      	    b:1..bsp_max;.!   736      	    kn:1..knoten_max;n$   737      	    return:zeichenkette;   738      	    antwort:Char;s   739      	    ende:Boolean;    740      	   741      	Begin 2   742      	  Write('Sind Sie sicher ? (J/N) ->');   743      	  Readln(antwort);*   744      	  If antwort In ['j','J'] Then   745      	   Begin%   746      	     kn:=KNOTENSUCHHILFE;c   747      	     Page;O   748      	     Writeln('                            EXPERTENSYSTEM');Writeln; J   749      	     Writeln('                        ---------------------');J   750      	     Writeln('                        >Beispiele speichern<');R   751      	     Writeln('                        ---------------------');Writeln;   752      	     ende:=False;f   753      	     Reset(namen);2   754      	     While Not (Eof(namen) Or ende) Do   755      	      Begin 2   756      	        If namen^=knoten_name[kn] Then   757      	         BeginQ   758      	           Writeln('Der Knoten mit den Variablen und Ergebnissen :');	"   759      	           Get(namen);   760      	           Repeat=)   761      	             Writeln(namen^);b#   762      	             Get(namen) -   763      	           Until namen^=leerwort;eD   764      	           Writeln;Writeln('hat den gleichen Namen !!');S   765      	           Write('Soll die Speicherung abgebrochen werden ? (J/N) ->');	'   766      	           Readln(antwort); >   767      	           If antwort In ['j','J'] Then ende:=True   768      	         EndA   769      	        Else Repeat Get(namen) Until namen^=leerwort;e   770      	        Get(namen) d       771      	      End;!   772      	     If Not ende ThenG   773      	      Begin    774      	        Writeln;a   775      	        Writeln('ACHTUNG!! Dieser Knoten wird nun unwiederruflich abgespeichert !!');W$   776      	        Truncate(namen);,   777      	        namen^:=knoten_name[kn];   778      	        Put(namen);	2   779      	        For v:=1 to var_anzahl[kn] Do    780      	         Begin/   781      	           namen^:=vari[v,kn].name;	!   782      	           Put(namen)    783      	         End; 1   784      	        For e:=1 to erg_anzahl[kn] Do    785      	         Begin.   786      	           namen^:=ergebnis[e,kn];!   787      	           Put(namen)    788      	         End; %   789      	        namen^:=leerwort;n   790      	        Put(namen); !   791      	        Reset(werte); 7   792      	        While Not Eof(werte) Do Get(werte); $   793      	        Truncate(werte);+   794      	        werte^:=var_anzahl[kn];    795      	        Put(werte);t+   796      	        werte^:=bsp_anzahl[kn];*   797      	        Put(werte);	1   798      	        For b:=1 to bsp_anzahl[kn] Dov&   799      	         With bsp[b,kn] Do   800      	          Begin 5   801      	            For v:=1 to var_anzahl[kn] Do    802      	             Begin/   803      	               werte^:=var_wert[v];E%   804      	               Put(werte)    805      	             End; '   806      	            werte^:=erg_nr; "   807      	            Put(werte)   808      	          End;1   809      	        For v:=1 to var_anzahl[kn] Do '   810      	         With vari[v,kn] Do    811      	          Begin	$   812      	            werte^:=min;#   813      	            Put(werte);n$   814      	            werte^:=max;"   815      	            Put(werte)   816      	          End;   817      	        Writeln;&   818      	        Write('Knoten >');3   819      	        NAMEN_ANZEIGE(knoten_name[kn]);k7   820      	        Writeln('< gespeichert !');Writeln; 6   821      	        Write('Bitte <RETURN> druecken ');"   822      	        Readln(return)   823      	      End    824      	   End   825      	End;         826      	   827      	Z   828      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * Z   829      	 *               PROZEDUR  D U R C H L A U F                                *)   830      	    831      	Procedure DURCHLAUF;   832      	A   833      	(*** Gobale Parameter in der Prozedur DURCHLAUF :***)	   834      	Type zgr=^liste;D   835      	     liste=Record                                       %   836      	             naechst:zgr; #   837      	             nr:Integer    838      	           End;S5   839      	     tabelle=Record wert,num:Integer End; 2   840      	     anfang=Record variab,erg:zgr End;   841      	    842      	Var loesung:tabelle;3   843      	    anf:Array[1..knoten_max] of anfang;n#   844      	    k,kn:1..knoten_max;n"   845      	    rate,v:1..var_max;   846      	    e:1..erg_max; =   847      	    schaetze,v_wert:Array[0..erg_max] of Integer;l=   848      	(*** Lokale Parameter der Prozedur DURCHLAUF ***)    849      	    antwort:Char; /   850      	    neu_durchlauf,training:Boolean;    851      	    v_zgr:zgr;$   852      	    return:zeichenkette;   853      	J   854      	(***    Prozedur LIST in DURCHLAUF                        ***)   855      	:   856      	  Procedure LIST(Var zeiger:zgr;zahl:Integer);   857      	         858      	  Begini"   859      	    If zeiger=NIL Then   860      	     Begin   861      	       New(zeiger); $   862      	       zeiger^.nr:=zahl;'   863      	       zeiger^.naechst:=NIL    864      	     End/   865      	    Else LIST(zeiger^.naechst,zahl) ?   866      	  End;(* Prozedur LIST in der Prozedur DURCHLAUf *)    867      	H   868      	(***       Prozedur LOESCHEN in DURCHLAUF               ***)   869      	>   870      	  Procedure LOESCHEN(Var zeig:zgr;nummer:Integer);   871      	  Var zeiger,z:zgr;v   872      	   873      	  Beginm'   874      	    If zeig^.nr=nummer Thenc   875      	     Begin   876      	       z:=zeig; '   877      	       zeig:=zeig^.naechst;n   878      	       Dispose(z)0   879      	     End   880      	    Else     '         881      	     Begin    882      	       zeiger:=zeig;5   883      	       If zeiger^.naechst^.nr=nummer Thenn   884      	        BeginT(   885      	         z:=zeiger^.naechst;1   886      	         zeiger^.naechst:=z^.naechst;h   887      	         Dispose(z)    888      	        End 8   889      	       Else LOESCHEN(zeiger^.naechst,nummer)   890      	     End(* else *)D   891      	  End;(* Prozedure LOESCHEN in der Prozedur DURCHLAUF *)
   892      	 eG   893      	(***      Prozedur VAR_LOESCHEN in DURCHLAUF           ***)    894      	R   895      	  Procedure VAR_LOESCHEN(ganz_wert:Integer;var dat:datei_bezeichnung);"   896      	  Var k:1..knoten_max;$   897      	      nummer:1..var_max;   898      	   899      	  Begin	   900      	    Reset(dat);,%   901      	    While Not Eof(dat) Do    902      	     Begin    903      	       nummer:=dat^;   904      	       Get(dat);   905      	       k:=dat^;:   906      	       Get(dat);2   907      	       LOESCHEN(anf[k].variab,nummer);1   908      	       vari[nummer,k].wert:=ganz_wertt   909      	     End:   910      	  End;(* Prozedur VAR_LOESCHEN in Durchlauf *)   911      	G   912      	(***      Prozedur VERVOLLSTAENDIGEN in Durchlauf      ***)t   913      	    7   914      	  Procedure VERVOLLSTAENDIGEN(var_zgr:zgr);m   915      	  Var v:1..var_max;    916      	   917      	  Beginh   918      	    Page; F   919      	    Writeln('                    EXPERTENSYSTEM');Writeln;T   920      	    Writeln('                    ------------------------------------');T   921      	    Writeln('                    > Vervollstaendigung der Variablen <');\   922      	    Writeln('                    ------------------------------------');Writeln;%   923      	    While var_zgr<>NIL Doc-   924      	     With vari[var_zgr^.nr,kn] Doo   925      	      Begin    926      	        Repeat4   927      	          Write('Welchen Wert hatte >');*   928      	          NAMEN_ANZEIGE(name);&   929      	          Write('< ? ->');"   930      	          Readln(wert)>   931      	        Until (wert>=min) And (wert<=max);Writeln;.   932      	        VAR_LOESCHEN(wert,knoten);-   933      	        var_zgr:=var_zgr^.naechstE   934      	      End;   935      	    Writeln; 	    3   936      	    bsp_anzahl[kn]:=bsp_anzahl[kn] + 1; .   937      	    With bsp[bsp_anzahl[kn],kn] Do   938      	     Begin'   939      	       erg_nr:=loesung.num; M   940      	       For v:=1 To var_anzahl[kn] Do var_wert[v]:=vari[v,kn].wert    941      	     End;i   942      	    REGEL(kn)    943      	  End;   944      	G   945      	(***      Prozedur LERNEN in DURCHLAUF                 ***)    946      	:   947      	  Procedure LERNEN(Var neu_durchlauf:Boolean);!   948      	  Var e,l:1..erg_max;    949      	      v:1..var_max;-%   950      	      erg_falsch:Boolean;    951      	      c:Char;e'   952      	      antwort:zeichenkette;    953      	   954      	  Begin(   955      	    Page;hF   956      	    Writeln('                    EXPERTENSYSTEM');Writeln;<   957      	    Writeln('                      ----------');<   958      	    Writeln('                      > LERNEN <');D   959      	    Writeln('                      ----------');Writeln;Z   960      	    Writeln('Welches Ergebnis war richtig (max.',wort_max:2,' Buchstaben) ?');\   961      	    Write('Falls KEIN Ergebnis richtig war, ohne Eingabe <RETURN> druecken ->');    962      	    Readln(antwort);)   963      	    If antwort<>leerwort Thene   964      	     Begin$   965      	       erg_falsch:=True;0   966      	       For e:=1 to erg_anzahl[kn] Do2   967      	        If antwort=ergebnis[e,kn] Then   968      	         Begin&   969      	           loesung.num:=e;(   970      	           erg_falsch:=False   971      	         End;G*   972      	       If Not(erg_falsch) Then   973      	        Begini8   974      	          VERVOLLSTAENDIGEN(anf[kn].variab);%   975      	          l:=loesung.num;t3   976      	          For e:=1 to erg_anzahl[kn] Dol?   977      	          If (v_wert[e]>=v_wert[l]) And (e<>l) Thene`   978      	           For v:=1 to var_anzahl[kn] Do prio[v,e,kn]:=prio[v,e,kn]-vari[v,kn].wert;^   979      	          For v:=1 to var_anzahl[kn] Do prio[v,l,kn]:=prio[v,l,kn]+vari[v,kn].wert   980      	        Endl-   981      	       Else LERNEN(neu_durchlauf)e   982      	     End   983      	    Else   984      	     BeginG   985      	       Writeln;Writeln('Nochmaliger Durchlauf ? (J/N) ->'); %   986      	       Readln(c);Writeln;w5   987      	       If c In ['j','J'] Then kn:=kn - 1; &   988      	       neu_durchlauf:=True   989      	     EndA   990      	  End;(* Prozedur LERNEN in der Prozedur DURCHLAUF *)o :    
   991      	 ]N   992      	(***             Funktion VAR_ERMITTLUNG in DURCHLAUF         ***)
   993      	 	.   994      	  Function VAR_ERMITTLUNG:Integer;   995      	  Var var_zgr:zgr;1   996      	      rate_wert,rate_max,mittel:Real; )   997      	      rate_nummer:1..var_max;n%   998      	      divisor:0..erg_max;    999      	H  1000      	    (***   Funktion MI in VAR_ERMITTLUNG in DURCHLAUF   ***)  1001      	U  1002      	    Function MI(erg_zgr:zgr;var_num:Integer;Var divisor:Integer):Integer;t  1003      	    Var m:Integer;  1004      	          1005      	    Beginn&  1006      	      If erg_zgr<>NIL Then  1007      	       Begin*  1008      	         divisor:=divisor + 1;[  1009      	         MI:=prio[var_num,erg_zgr^.nr,kn]+MI(erg_zgr^.naechst,var_num,divisor);   1010      	       End  1011      	      Else MI:=0;	Q  1012      	    End;(* Funktion MI in der Funktion VAR_ERMITTLUNG in DURCHLAUF *)   1013      	    E  1014      	    (*** Funktion RA in VAR_ERMITTLUNG in DURCHLAUF  ***)   1015      	J  1016      	    Function RA(erg_zgr:zgr;var_num:Integer;mittel:Real):Real;$  1017      	    Var bereich:Integer;"  1018      	        standart:Real;
  1019      	    1020      	    BeginW&  1021      	      If erg_zgr<>NIL Then  1022      	       BeginE  1023      	         standart:=prio[var_num,erg_zgr^.nr,kn] - mittel;	D  1024      	         With vari[var_num,kn] Do bereich:=abs(max-min);X  1025      	         RA:=(bereich * sqr(standart)) + RA(erg_zgr^.naechst,var_num,mittel)  1026      	       End  1027      	      Else RA:=0Q  1028      	    End;(* Funktion RA in der Funktion VAR_ERMITTLUNG in DURCHLAUF *)(  1029      	[  1030      	  (*** Hauptprogramm der Funktion VAR_ERMITTLUNG in der Prozedur DURCHLAUF ***)d  1031      	  Begin (  1032      	    var_zgr:=anf[kn].variab;  1033      	    rate_max:=0.0;%  1034      	    While var_zgr<>NIL Do*  1035      	     Begin  1036      	       divisor:=0;I  1037      	       mittel:=MI(anf[kn].erg,var_zgr^.nr,divisor) / divisor;rA  1038      	       rate_wert:=RA(anf[kn].erg,var_zgr^.nr,mittel); -  1039      	       If rate_wert>rate_max Theny  1040      	        Begin	/  1041      	          rate_nummer:=var_zgr^.nr; )  1042      	          rate_max:=rate_wertr  1043      	        End;,  1044      	       var_zgr:=var_zgr^.naechst  1045      	     End;e c    5  1046      	    LOESCHEN(anf[kn].variab,rate_nummer);v+  1047      	    VAR_ERMITTLUNG:=rate_nummer	I  1048      	  End;(* Funktion VAR_ERMITTLUNG in der Prozedur DURCHLAUF *)   1049      	?  1050      	(***       Funktion ABSCHAETZUNG in DURCHLAUF  ***)   1051      	K  1052      	  Function ABSCHAETZUNG(Var loesung:tabelle;v:Integer):Boolean; &  1053      	  Var erg_zgr,var_zgr:zgr;  1054      	      e:1..erg_max;	   1055      	      absch:tabelle;"  1056      	      bereich:Integer;   1057      	      va:1..var_max;  1058      	  1059      	  Begin5+  1060      	    If anf[kn].variab<>NIL Thenn  1061      	     Begin)  1062      	       loesung.wert:=minimum; 0  1063      	       For e:=1 to erg_anzahl[kn] Do  1064      	        Begin	L  1065      	          v_wert[e]:=v_wert[e] + vari[v,kn].wert * prio[v,e,kn];-  1066      	          schaetze[e]:=v_wert[e];i5  1067      	          If v_wert[e]>=loesung.wert Then   1068      	           Begin1  1069      	             loesung.wert:=v_wert[e]; '  1070      	             loesung.num:=er  1071      	           End  1072      	        End;+  1073      	       var_zgr:=anf[kn].variab;*  1074      	       va:=0;   1075      	       Repeatz  1076      	        va:=va + 1; *  1077      	        If va=var_zgr^.nr Then  1078      	         Begin4  1079      	           For e:=1 to erg_anzahl[kn] Do+  1080      	            With vari[va,kn] Do   1081      	             BeginL  1082      	               bereich:=prio[va,e,kn] - prio[va,loesung.num,kn];U  1083      	               If bereich>0 Then schaetze[e]:=schaetze[e] + bereich * max U  1084      	                            Else schaetze[e]:=schaetze[e] + bereich * mine  1085      	             End; 0  1086      	           var_zgr:=var_zgr^.naechst  1087      	         End%  1088      	       Until var_zgr=NIL;E'  1089      	       absch.wert:=minimum;90  1090      	       For e:=1 to erg_anzahl[kn] Do  1091      	        Begino5  1092      	          If schaetze[e]>=absch.wert Then   1093      	           Begin1  1094      	             absch.wert:=schaetze[e]; %  1095      	             absch.num:=er  1096      	           End; +  1097      	          erg_zgr:=anf[kn].erg; @  1098      	          If schaetze[e]<schaetze[loesung.num] Then ,  1099      	           While erg_zgr<>NIL Do-  1100      	            If e=erg_zgr^.nr Then       /  1101      	                              Begint9  1102      	                                erg_zgr:=NIL;tC  1103      	                                LOESCHEN(anf[kn].erg,e) -  1104      	                              End G  1105      	                             Else erg_zgr:=erg_zgr^.naechst   1106      	        End;W  1107      	       If schaetze[loesung.num]=schaetze[absch.num] Then ABSCHAETZUNG:=TRUE	X  1108      	                                                    Else ABSCHAETZUNG:=FALSE  1109      	     End'  1110      	    Else ABSCHAETZUNG:=TRUE G  1111      	  End;(* Prozedur ABSCHAETZUNG in der Prozedur DURCHLAUF *)   1112      	>  1113      	(***** Hauptprogramm der Prozedur DURCHLAUF *****)  1114      	Begin +  1115      	  For kn:=1 to knoten_anzahl Doi  1116      	   Begin%  1117      	     anf[kn].variab:=NIL;-F  1118      	     For v:=1 to var_anzahl[kn] Do LIST(anf[kn].variab,v);"  1119      	     anf[kn].erg:=NIL;B  1120      	     For e:=1 to erg_anzahl[kn] Do LIST(anf[kn].erg,e)  1121      	   End;	  1122      	  kn:=0;  1123      	  Repeat  1124      	    Page;EF  1125      	    Writeln('                    EXPERTENSYSTEM');Writeln;@  1126      	    Writeln('                  ------------------');@  1127      	    Writeln('                  > EXPERT ON WORK <');H  1128      	    Writeln('                  ------------------');Writeln;K  1129      	    Write('Ist das Ergebnis bekannt (Uebungslauf) ? (J/N) ->');k(  1130      	    Readln(antwort);Writeln;2  1131      	    If antwort='j' Then training:=True4  1132      	                   Else training:=False;  1133      	    kn:=kn + 1;w&  1134      	    loesung.wert:=minimum;  1135      	    loesung.num:=0;n-  1136      	    For e:=1 to erg_anzahl[kn] Do   1137      	     Begin   1138      	       v_wert[e]:=0;"  1139      	       schaetze[e]:=0;)  1140      	       v_zgr:=anf[kn].variab; 0  1141      	       For v:=1 to var_anzahl[kn] Do(  1142      	        If v=v_zgr^.nr Then F  1143      	         If v_zgr^.naechst<>NIL Then v_zgr:=v_zgr^.naechst1  1144      	                                Else    1145      	        Else  1146      	         BeginA  1147      	           v_wert[e]:=vari[v,kn].wert * prio[v,e,kn];n.  1148      	           schaetze[e]:=v_wert[e];6  1149      	           If v_wert[e]>=loesung.wert Then  1150      	            Begin72  1151      	              loesung.wert:=v_wert[e];(  1152      	              loesung.num:=e  1153      	            End7  1154      	         End  1155      	     End;       D  1156      	    Writeln(kn:2,'. Knoten : ',knoten_name[kn]);Writeln;  1157      	    Repeat-  1158      	      If anf[kn].variab<>NIL Thent  1159      	       Begin*  1160      	         rate:=VAR_ERMITTLUNG;  1161      	         Writeln;z*  1162      	         With vari[rate,kn] Do  1163      	          Repeat7  1164      	            Writeln('Bitte den Wert von ');>-  1165      	            Write('          >');a,  1166      	            NAMEN_ANZEIGE(name);%  1167      	            Writeln('<'); X  1168      	            Write(' eingeben, im Bereich von ',min:3,' bis ',max:3,' : ->');$  1169      	            Readln(wert)8  1170      	          Until (wert>=min) And (wert<=max);K  1171      	          VAR_LOESCHEN(vari[rate,kn].wert,vari[rate,kn].knoten) )  1172      	        End(* If-Operation *)S1  1173      	    Until ABSCHAETZUNG(loesung,rate); 8  1174      	    For z:=1 to zeichen_zeile Do Write('-');%  1175      	    neu_durchlauf:=False;    1176      	    If training Then  1177      	     Begin'  1178      	       Write('Kann ich >');t;  1179      	       NAMEN_ANZEIGE(ergebnis[loesung.num,kn]); 2  1180      	       Write('< annehmen ? (J/N) ->');+  1181      	       Readln(antwort);Writeln;dE  1182      	       If antwort In ['n','N'] Then LERNEN(neu_durchlauf)v  1183      	       Else   1184      	        Begin   1185      	          Writeln;T  1186      	          Write('Wollen Sie das Beispiel vervollstaendigen ? (J/N) ->');&  1187      	          Readln(antwort);T  1188      	          If antwort In ['j','J'] Then VERVOLLSTAENDIGEN(anf[kn].variab)!  1189      	        End(* ELSE *) "  1190      	     End(* Training *)  1191      	    Else  1192      	     Begin(  1193      	       Write('Ich nehme >');;  1194      	       NAMEN_ANZEIGE(ergebnis[loesung.num,kn]);'%  1195      	       Writeln('< an !!')   1196      	     End;   1197      	    Writeln;*  1198      	    If Not(neu_durchlauf) Then)  1199      	     If knoten_anzahl<>1 Then   1200      	      Begin -  1201      	        If knoten_anzahl<>kn Then   1202      	         Begin@  1203      	           Write('Soll ich zum naechsten Knoten (');8  1204      	           NAMEN_ANZEIGE(knoten_name[kn+1]);8  1205      	           Writeln(') uebergehen <N>, oder')  1206      	         End;pO  1207      	        Writeln('soll ein bestimmter Knoten gewaehlt werden <B>,'); B  1208      	        Write('oder zurueck zum Hauptmenue <H> ? ->');$  1209      	        Readln(antwort);1  1210      	        If antwort In ['b','B'] Then   n      1211      	         Begin*  1212      	           k:=KNOTENSUCHHILFE;$  1213      	           If k<=kn Then  1214      	            Begint-  1215      	              anf[k].variab:=NIL;UM  1216      	              For v:=1 to var_anzahl[k] Do LIST(anf[k].variab,v);v*  1217      	              anf[k].erg:=NIL;I  1218      	              For e:=1 to erg_anzahl[k] Do LIST(anf[k].erg,e)n  1219      	            End;   1220      	           kn:=k - 1  1221      	         End  1222      	      End;  1223      	     Else*  1224      	      Begin 8  1225      	        Write('Bitte <RETURN> druecken ->');#  1226      	        Readln(return);    1227      	        antwort:='h'  1228      	      End "  1229      	    Else antwort:='n' (  1230      	  Until antwort In ['H','h'](  1231      	End;(* Prozedur DURCHLAUF *)  1232      	  1233      	V  1234      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *W  1235      	 *                PROZEDUR  R E N A M E                                  *)   1236      	  1237      	Procedure RENAME;W   1238      	Var antwort:Integer;  1239      	W  1240      	(***              Prozedur VAR_RENAME in RENAME                        ***)   1241      	"  1242      	 Procedure VAR_RENAME;"  1243      	 Var kn:1..knoten_max;  1244      	     v:1..var_max;  1245      	  1246      	 Begin#  1247      	   kn:=KNOTENSUCHHILFE;K  1248      	   Writeln;5Y  1249      	   For v:=1 to var_anzahl[kn] Do Writeln(v:2,'. Variable :',vari[v,kn].name);b  1250      	   Writeln;   1251      	   Repeat 0  1252      	     Writeln('0 <- letzter Ausweg');U  1253      	     Write('Welche Variable soll gewaehlt werden (NUMMER angeben) ? ->'); #  1254      	     Readln(v);Writeln; .  1255      	   Until v In [0..var_anzahl[kn]];  1256      	   If v<>0 Then_  1257      	    Begin &  1258      	      FILE_LOESCHEN(v,kn);#  1259      	      Write('Statt >'); 1  1260      	      NAMEN_ANZEIGE(vari[v,kn].name); G  1261      	      Write('< wird (max.',wort_max:2,' Buchstaben) : ->');i)  1262      	      Readln(vari[v,kn].name);  1263      	    End;"  1264      	   VAR_VERGLEICH(v,kn)  1265      	 End;7        1266      	W  1267      	(***              Prozedur ERG_RENAME in RENAME                        ***)e  1268      	"  1269      	 Procedure ERG_RENAME;"  1270      	 Var kn:1..knoten_max;)  1271      	     erg_nummer,e:1..erg_max;p  1272      	     b:1..bsp_max;  1273      	  1274      	 Begin#  1275      	   kn:=KNOTENSUCHHILFE;l  1276      	   Writeln; X  1277      	   For e:=1 to erg_anzahl[kn] Do Writeln(e:2,'. Ergebnis :',ergebnis[e,kn]);  1278      	   Writeln;r  1279      	   Repeat 0  1280      	     Writeln('0 <- letzter Ausweg');W  1281      	     Write('Welches Ergebnis soll umbenannt werden (NUMMER angeben) ? ->');p#  1282      	     Readln(e);Writeln; .  1283      	   Until e In [0..erg_anzahl[kn]];  1284      	   If e<>0 Theni  1285      	    Begin #  1286      	      Write('Statt >'); 0  1287      	      NAMEN_ANZEIGE(ergebnis[e,kn]);G  1288      	      Write('< wird (max.',wort_max:2,' Buchstaben) : ->'); )  1289      	      Readln(ergebnis[e,kn]);    1290      	      erg_nummer:=1;  1291      	      RepeatB  1292      	        If ergebnis[e,kn]=ergebnis[erg_nummer,kn] Then*  1293      	         If e<>erg_nummer Then  1294      	          Begin 5  1295      	            For b:=1 to bsp_anzahl[kn] DoeQ  1296      	             If bsp[b,kn].erg_nr=e Then bsp[b,kn].erg_nr:=erg_nummer;?;  1297      	            erg_anzahl[kn]:=erg_anzahl[kn] - 1;    1298      	            Writeln;C  1299      	            Writeln('Das Ergebnis wird gestrichen !!');L"  1300      	            REGEL(kn);6  1301      	            erg_nummer:=erg_anzahl[kn] + 1  1302      	          End;/  1303      	         erg_nummer:=erg_nummer + 1 2  1304      	       Until erg_nummer>erg_anzahl[kn]  1305      	    End   1306      	 End;t  1307      	W  1308      	(***              Prozedur KN_RENAME in RENAME                         ***)   1309      	!  1310      	 Procedure KN_RENAME;n"  1311      	 Var kn:1..knoten_max;  1312      	  1313      	 Begin  1314      	   Writeln;*X  1315      	   For kn:=1 to knoten_anzahl Do Writeln(kn:2,'. Knoten :',knoten_name[kn]);  1316      	   Writeln;   1317      	   Repeat 0  1318      	     Writeln('0 <- letzter Ausweg');U  1319      	     Write('Welcher Knoten soll umbenannt werden (NUMMER angeben) ? ->'); $  1320      	     Readln(kn);Writeln; n    .  1321      	   Until kn In [0..knoten_anzahl];  1322      	   If kn<>0 Then  1323      	    Beginn#  1324      	      Write('Statt >'); 1  1325      	      NAMEN_ANZEIGE(knoten_name[kn]);/G  1326      	      Write('< wird (max.',wort_max:2,' Buchstaben) : ->');	)  1327      	      Readln(knoten_name[kn])-  1328      	    End   1329      	 End;   1330      	W  1331      	(***            Hauptprogramm der Prozedur RENAME                      ***)   1332      	  1333      	Begin   1334      	  Page;rC  1335      	  Writeln('                    EXPETENSYSTEM');Writeln;s;  1336      	  Writeln('                  ---------------'); ;  1337      	  Writeln('                  >UMBENENNUNGEN<');TC  1338      	  Writeln('                  ---------------');Writeln;   1339      	  Repeat+  1340      	    Writeln(' Sollen');Writeln; *  1341      	    Writeln('1 <- Variablen');+  1342      	    Writeln('2 <- Ergebnisse');g'  1343      	    Writeln('3 <- Knoten');c/  1344      	    Writeln('4 <- nichts');Writeln;	6  1345      	    Write('umbenannt werden ? (1..4) ->');  1346      	    Readln(antwort)S&  1347      	  Until antwort In [1..4];+  1348      	  Case antwort of 1:VAR_RENAME; +  1349      	                  2:ERG_RENAME; *  1350      	                  3:KN_RENAME;   1351      	                  4:  1352      	  Endz%  1353      	End;(* Prozedur RENAME *)a  1354      	  1355      	Y  1356      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * Z  1357      	 *                    FUNKTION  V A R _ V E R G L E I C H                   *)  1358      	#  1359      	Function VAR_VERGLEICH;    1360      	Var k:1..knoten_max;   1361      	    v:1..var_max;   (  1362      	    datei:datei_bezeichnung;  1363      	    antwort:Char;T  1364      	  1365      	Begin "  1366      	  VAR_VERGLEICH:=True;*  1367      	  Rewrite(vari[va,kn].knoten);!  1368      	  For k:=1 to kn-1 Do:+  1369      	   For v:=1 to var_anzahl[k] Do !  1370      	    With vari[v,k] DoC0  1371      	       If name=vari[va,kn].name Then  1372      	        Begine  1373      	          Writeln;.  1374      	          Write('Die Variable >');*  1375      	          NAMEN_ANZEIGE(name); m    C  1376      	          Write('< taucht schon im ',k:2,'. Knoten >'); 4  1377      	          NAMEN_ANZEIGE(knoten_name[k]);)  1378      	          Writeln('< auf !');nL  1379      	          Writeln('Mit einem Bereich von ',min:3,' bis ',max:3);L  1380      	          Write('Ist das hier die gleiche Variable ? (J/N) ->');.  1381      	          Readln(antwort);Writeln;2  1382      	          If antwort In ['j','J'] Then  1383      	           Begin.  1384      	             VAR_VERGLEICH:=False;.  1385      	             vari[va,kn].min:=min;.  1386      	             vari[va,kn].max:=max;0  1387      	             vari[va,kn].knoten^:=v;1  1388      	             Put(vari[va,kn].knoten);o0  1389      	             vari[va,kn].knoten^:=k;1  1390      	             Put(vari[va,kn].knoten);_2  1391      	             DATEIKOPIE(knoten,datei);$  1392      	             datei^:=va;$  1393      	             Put(datei);$  1394      	             datei^:=kn;$  1395      	             Put(datei);2  1396      	             DATEIKOPIE(datei,knoten);2  1397      	           End(*If gleiche Variable *)6  1398      	       End;(* If gleicher Variablenname *)'  1399      	  Reset(vari[va,kn].knoten)+,  1400      	End;(* Funktion VAR_VERGLEICH *)  1401      	  1402      	Y  1403      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *H[  1404      	 *                    FUNKTION  S U C H Z A H L                              *)r  1405      	  1406      	  1407      	Function SUCHZAHL;$  1408      	Var ex,exponent:Integer;  1409      	  1410      	Begin	&  1411      	  If name[index]<>' ' Then  1412      	   Begin  1413      	     exponent:=1; C  1414      	     For ex:=1 to index - 1 Do exponent:=exponent * 10;3[  1415      	     SUCHZAHL:=(Ord(name[index])-Ord('0')) * exponent + SUCHZAHL(index+1,name);r  1416      	   End  1417      	  Else SUCHZAHL:=0  1418      	End;  1419      	  1420      	V  1421      	(*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *W  1422      	 *                FUNKTION  K N O T E N S U C H H I L F E                *)]  1423      	%  1424      	Function KNOTENSUCHHILFE;G  1425      	Var c:Char; %  1426      	    antwort:zeichenkette;e!  1427      	    kn_name:wortfeld; !  1428      	    kn:1..knoten_max; 
  1429      	    1430      	Begin1        1431      	  Page;cD  1432      	  Writeln('                    EXPERTENSYSTEM');Writeln;I  1433      	  Writeln('Ich werde Sie gleich nach einem Knoten fragen -');	P  1434      	  Writeln('falls Sie sich nicht schluessig sind, dann tippen Sie ');6  1435      	  Writeln('                       JETZT');Y  1436      	  Writeln('<h> wie Hilfe ein ! Dann zeige ich nochmals alle Knotenpunkte !');:>  1437      	  Write('Anderfalls <s> wie "sonst" eingeben - ');   1438      	  Readln(c);Writeln;-  1439      	  If c In ['h','H'] Then ANZEIGE;.  1440      	  Repeat  1441      	    Writeln;X  1442      	    Write('Welche Knotennummer oder Knotennamen soll gewaehlt werden ? ->');   1443      	    Readln(antwort);*  1444      	    Unpack(antwort,kn_name,1);T  1445      	    If kn_name[ziffer1] In ['0'..'9'] Then kn:=SUCHZAHL(ziffer1,kn_name)  1446      	    Else  1447      	     Begin  1448      	       kn:=0; [  1449      	       Repeat kn:=kn + 1 Until (knoten_name[kn]=antwort) Or (kn>knoten_anzahl);_  1450      	     End&  1451      	  Until kn<=knoten_anzahl;!  1452      	  KNOTENSUCHHILFE:=kn1.  1453      	End;(* Funktion KNOTENSUCHHILFE *)  1454      	  1455      	W  1456      	(**************************************************************************	W  1457      	 *           H A U P T P R O G R A M M                                    * X  1458      	 **************************************************************************)
  1459      	    1460      	Begin   1461      	  knoten_anzahl:=0;8  1462      	  ziffer1:=1; 4  1463      	  For w:=1 to wort_max Do blank[w]:=' ';%  1464      	  Pack(blank,1,leerwort);   1465      	  Page;hA  1466      	  Writeln('                         EXPERTENSYSTEM');eQ  1467      	  Writeln('                         --------------');Writeln;Writeln;sZ  1468      	  Writeln('Damit dieses Programm richtig ablaufen kann, sind folgende Werte');?  1469      	  Writeln('im Quellprogramm festgelegt :');Writeln; F  1470      	  Writeln('1. Maximale Knotenanzahl    -> ',knoten_max:2);C  1471      	  Writeln('2. Maximale Beispielanzahl  -> ',bsp_max:2); C  1472      	  Writeln('3. Maximale Ergebnisanzahl  -> ',erg_max:2);	C  1473      	  Writeln('4. Maximale Variablenanzahl -> ',var_max:2); D  1474      	  Writeln('5. Maximale Wortlaenge      -> ',wort_max:2);I  1475      	  Writeln('6. Zeichen pro Zeile        -> ',zeichen_zeile:2);_Q  1476      	  Writeln('7. Warteschleifenindex      -> ',warteschleife:5);Writeln;eV  1477      	  Writeln('Falls Sie einige Werte korrigieren moechten, muessen Sie das');]  1478      	  Writeln('Programm an dieser Stelle abbrechen, und die Werte im Quellprogramm'); %  1479      	  Writeln('veraendern.'); L  1480      	  Writeln('Alle Zahlen muessen GANZZAHLIG eingegeben werden !');X  1481      	  Writeln('Als erstes muessen die Variablen initialisiert werden.');Writeln;S  1482      	  Write('Wollen Sie schon gespeicherte Beispiele benutzen ? (J/N) ->');r  1483      	  Readln(lesen);K  1484      	  If lesen In ['j','J'] Then Repeat LADEN Until knoten_anzahl>0]H  1485      	  Else Repeat KNOTENDAZU Until (init) And (knoten_anzahl>0); )      1486      	  Repeat  1487      	    Page;2I  1488      	    Writeln('                       EXPERTENSYSTEM');Writeln; C  1489      	    Writeln('                       ----------------'); C  1490      	    Writeln('                       >> HAUPTMENUE <<'); K  1491      	    Writeln('                       ----------------');Writeln;-3  1492      	    Writeln('1 <- Normaler Durchlauf');dY  1493      	    Writeln('2 <- Wertanzeige von Variablen in Beispielen und Prioritaeten'); =  1494      	    Writeln('3 <- Einrag eines neuen Beispiels');	B  1495      	    Writeln('4 <- Eintrag eines neuen Knotenpunktes');9  1496      	    Writeln('5 <- Loeschen eines Beispiels'); 7  1497      	    Writeln('6 <- Loeschen eines Knotens');k:  1498      	    Writeln('7 <- Abspeichern der Beispiele');0  1499      	    Writeln('8 <- Beispiele laden');3  1500      	    Writeln('9 <- Namenumbenennungen'); 2  1501      	    Writeln('0 <- Keine Lust mehr !');8  1502      	    For z:=1 to zeichen_zeile Do Write('-');E  1503      	    Write('----->>   Bitte eine Zahl waehlen   ----->>');   1504      	    Readln(wahl); &  1505      	    Case wahl of 9:RENAME;)  1506      	                 1:DURCHLAUF;w'  1507      	                 2:ANZEIGE; $  1508      	                 3:Begin7  1509      	                     knot:=KNOTENSUCHHILFE;	/  1510      	                     EXAMPLE(knot);s,  1511      	                     REGEL(knot)#  1512      	                   End; *  1513      	                 4:KNOTENDAZU;&  1514      	                 5:BSPWEG;)  1515      	                 6:KNOTENWEG;;)  1516      	                 7:SPEICHERN; %  1517      	                 8:LADEN;1  1518      	                 0:   1519      	    EndE  1520      	  Until wahl=0  1521      	End.