home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 01 / statis / statis.pro < prev   
Encoding:
Text File  |  1987-06-10  |  35.1 KB  |  742 lines
  1. code = 3500 /* Wir brauchen etwas Platz */
  2. /***************************************************************************/
  3. /*                  Globale Daten und Domains                              */
  4. /***************************************************************************/
  5.  
  6. domains
  7.     INTEGERLIST = INTEGER*
  8.     REALLIST = REAL*
  9.     
  10. database                              
  11.     setup_Daten( STRING, INTEGER, STRING, STRING, CHAR, STRING, STRING, CHAR)
  12.     /* Kennwort,Dim.,Variablenname X, Einheit X, X-Fehler bekannt ?,
  13.                      Variablenname Y, Einheit Y, Y-Fehler bekannt ? */
  14.     daten( STRING, REALLIST, REALLIST, REALLIST, REALLIST)
  15.     /* Kennwort, X-Liste, Y-Liste, X-Fehlerliste, Y-Fehlerliste */
  16.     eingabe_Daten( STRING, STRING) /* Kennwort,Eingabedaten */
  17.                                                         
  18. /****************************************************************/
  19. /*            Listen Handling                */
  20. /****************************************************************/
  21.  
  22. domains 
  23.     LIST = SYMBOL*
  24.     STRINGLIST = STRING*
  25.     
  26. PREDICATES
  27.   member(SYMBOL,LIST)              /* Symbol in Liste enthalten ? */
  28.   maxlen(LIST,INTEGER,INTEGER)       /* Find the length of the longest string */
  29.   listlen(LIST,INTEGER)           /* Find the length of a list */
  30.   reallist_len(REALLIST,INTEGER)   /* Ermittelt Laenge einer Liste von REALs */
  31.   writelist(INTEGER,INTEGER,LIST)  /* Used by the menu predicate */
  32.   convert_to_Nrs(STRINGLIST,REALLIST)   /* Tokenliste in REALliste umsetzen */
  33.   write_list(INTEGER,STRINGLIST)   /* Write the list separated by spaces */                                         
  34.   
  35. CLAUSES
  36.   member(X,[X|_]).
  37.   member(X,[_|L]) :- member(X,L).
  38.  
  39.   maxlen([H|T],MAX,MAX1):- 
  40.       str_len(H,LEN) AND LEN>MAX AND ! AND maxlen(T,LEN,MAX1).
  41.   maxlen([_|T],MAX,MAX1) :- maxlen(T,MAX,MAX1).
  42.   maxlen([],LEN,LEN).
  43.  
  44.   listlen([],0).
  45.   listlen([_|T],N) :- listlen(T,X), N=X+1.
  46.  
  47.   reallist_len([],0).
  48.   reallist_len([_|R],N) :- reallist_len(R,X), N=X+1.        
  49.     
  50.   writelist(_,_,[]).
  51.   writelist(LI,ANTKOL,[H|T]) :- 
  52.       field_str(LI,0,ANTKOL,H), LI1=LI+1, writelist(LI1,ANTKOL,T).
  53.         
  54.   convert_to_Nrs([],[]).
  55.   convert_to_Nrs([H1|T1],[H2|T2]) :- 
  56.       str_real(H1,Nr), H2 = Nr, convert_to_Nrs(T1,T2).
  57.       
  58.   write_list(_,[]).
  59.   write_list(_,[X]) :- ! AND write(X).
  60.   write_list(4,[H|T]) :- ! AND write(H), nl, write_list(0,T).
  61.   write_list(3,[H|T]) :- 
  62.       str_len(H,LEN) AND LEN>13 AND ! AND write(H), nl, write_list(0,T).
  63.   write_list(N,[H|T]) :- 
  64.       str_len(H,LEN) AND LEN>13 AND ! AND N1=N+2,writef("%-27 ",H),
  65.       write_list(N1,T).
  66.   write_list(N,[H|T]) :- N1=N+1, writef("%-13 ",H), write_list(N1,T).
  67.  
  68. /******************************************************************/
  69. /*              mathematischer Teil                               */
  70. /******************************************************************/
  71.  
  72. predicates
  73.     listsum(REALLIST,REAL)
  74.     listsum_of_squares(REALLIST,REAL)
  75.     listsum_x_mal_y(REALLIST,REALLIST,REAL)
  76.     mittelwert(REALLIST,REAL)
  77.     standardabweichung(REALLIST,REAL)
  78.     lineare_Regression(REALLIST,REALLIST,REALLIST)
  79.           /* X-Liste, Y-Liste, [Konstante,Steigung] */
  80.     horner(REALLIST,REAL,REAL)  /* Koeffizienten,X-Wert,Ergebniss */
  81.     regress_StandardAbweichung(REALLIST,REALLIST,REALLIST,REAL)
  82.   /* Standardabw. fuer Interpolationspolynome (Koefflist,XListe,YListe,Res) */
  83.         sum_Y_minus_YNeu_Square(REALLIST,REALLIST,REAL)
  84.        /* Hilfsrechnung fuer Regress_StandardAbweichung */            
  85.     make_polynomwerte(REALLIST,REALLIST,REALLIST)
  86.                      /* Koeffliste, X-Liste, --> Y-Liste */
  87.     
  88. clauses
  89.     listsum([],0).
  90.     listsum([H|T],Res) :- 
  91.         listsum(T,NRes), Res = NRes + H. 
  92.     
  93.     listsum_of_squares([],0).
  94.     listsum_of_squares([H|T],Res) :- 
  95.         listsum_of_squares(T,NRes), Res = NRes + H*H.
  96.  
  97.     listsum_x_mal_y([],[],0).
  98.     listsum_x_mal_y([HX|TX],[HY|TY],Res) :- 
  99.         listsum_x_mal_y(TX,TY,NRes), Res = NRes + HX*HY.
  100.  
  101.     mittelwert([],0).
  102.     mittelwert(Liste,Res) :- 
  103.         listsum(Liste,SumRes), reallist_len(Liste,Anzahl), Res = SumRes/Anzahl.
  104.  
  105.     standardabweichung(Liste,Res) :- 
  106.          listsum_of_squares(Liste,SqrSum), listsum(Liste,Sum),
  107.          mittelwert(Liste,MW), SumProd = MW*Sum,  Diff = SqrSum - SumProd,
  108.          reallist_len(Liste,Anzahl), Res = sqrt(Diff / (Anzahl - 1)).
  109.                           
  110.     lineare_Regression(XListe,YListe,[Offset,Steigung]) :- 
  111.         mittelwert(XListe,XQuer), mittelwert(YListe,YQuer),
  112.         listsum_x_mal_y(XListe,YListe,XY), listsum(XListe,XSum),
  113.         listsum_of_squares(XListe,XSquare),
  114.         Steigung = (XY - YQuer*XSum)/(XSquare - XQuer*XSum),
  115.         Offset = YQuer - Steigung*XQuer.
  116.  
  117.      horner([],_,0).
  118.      horner([H|T],X,Res) :- horner(T,X,NRes), Res = NRes*X + H.
  119.                          
  120.      regress_StandardAbweichung(KoeffListe,XListe,YListe,Sigma) :-
  121.          make_polynomwerte(KoeffListe,XListe,NeuYListe),
  122.          Sum_Y_minus_YNeu_Square(YListe,NeuYListe,Res),
  123.          reallist_len(XListe,Anzahl), reallist_len(KoeffListe,Grad_plus_1),
  124.          Sigma = sqrt(Res/(Anzahl - Grad_plus_1)).
  125.  
  126.         sum_Y_minus_YNeu_Square([],[],0).        
  127.         sum_Y_minus_YNeu_Square([HY|TY],[HYNeu|TYNeu],Res) :-
  128.             Sum_Y_minus_YNeu_Square(TY,TYNeu,NRes),
  129.             Diff = (HY - HYNeu), Res = Diff*Diff + NRes.                                 
  130.                                     
  131.       make_polynomwerte(_,[],[]).                                 
  132.       make_polynomwerte(KoeffListe,[XH|XT],[YH|YT]) :-
  133.           make_polynomwerte(KoeffListe,XT,YT), horner(KoeffListe,XH,YH).                                                 
  134.  
  135.                                                                 
  136. /******************************************************************/
  137. /*        READING THE KEYBORD                  */
  138. /******************************************************************/
  139.  
  140. DOMAINS
  141.   ROW,COL,LEN = INTEGER
  142.  
  143.   KEY    = cr ; esc ; break ; tab ; btab ; del ; bdel ; ins ;
  144.           end ; home ; ftast(INTEGER) ; up ; down ; left ; right ;
  145.           ctrlleft; ctrlright; ctrlend; ctrlhome; pgup; pgdn; 
  146.           chr(CHAR) ; otherspec
  147.  
  148. PREDICATES
  149.   readkey(KEY)
  150.   readkey1(KEY,CHAR,INTEGER)
  151.   readkey2(KEY,INTEGER)
  152.  
  153. CLAUSES
  154.   readkey(KEY):-readchar(T),char_int(T,VAL),readkey1(KEY,T,VAL).
  155.  
  156.   readkey1(KEY,_,0):-!,readchar(T),char_int(T,VAL),readkey2(KEY,VAL).
  157.   readkey1(cr,_,13):-!.
  158.   readkey1(esc,_,27):-!.
  159.   readkey1(chr(T),T,_) .
  160.   
  161.   readkey2(up,72):-!.
  162.   readkey2(down,80):-!.
  163.   readkey2(ftast(N),VAL):-VAL>58,VAL<70,N=VAL-58,!.
  164.   readkey2(otherspec,_).
  165.  
  166.  
  167. /****************************************************************/
  168. /*             menu                    */
  169. /* Implements a popup-menu                    */
  170. /* menu(FensterNr,FussZeile_Nr,KopfZeile_Nr,Line,Collum,        */
  171. /*      ListOfChoices,ChoiceNr)                                    */                  
  172. /* The following keys can be used:                */
  173. /*    arrows up and down: select choice            */
  174. /*    cr and F10: activate choice                */
  175. /*    Esc: abort                        */
  176. /* ACHTUNG : FensterNr. 127 wird fuer interne Zwecke benutzt.   */
  177. /****************************************************************/
  178.  
  179. domains Nr_des_MenueFensters, Nr_des_FussZeile_Fensters,
  180.                               Nr_des_KopfZeile_Fensters  = INTEGER
  181.  
  182. PREDICATES
  183.   menu(Nr_des_MenueFensters, Nr_des_FussZeile_Fensters, 
  184.        Nr_des_KopfZeile_Fensters,ROW,COL,STRING,LIST,INTEGER)
  185.   menu1(ROW,LIST,ROW,INTEGER,INTEGER)
  186.   menu2(ROW,LIST,ROW,INTEGER,INTEGER,KEY)
  187.  
  188. CLAUSES
  189.   menu(MenueWindowNr, FussZeile,KopfZeile,LI,KOL,TXT,LIST,CHOICE):-
  190.       shiftwindow(MenueWindowNr), maxlen(LIST,0,ANTKOL), listlen(LIST,LEN),
  191.       ANTLI=LEN, LEN>0, HH1=ANTLI+2, HH2=ANTKOL+2,
  192.       makewindow(127,7,7,TXT,LI,KOL,HH1,HH2), HH3=ANTKOL, writelist(0,HH3,LIST),
  193.       cursor(0,0), menu1(0,LIST,ANTLI,ANTKOL,CH),
  194.       CHOICE=1+CH, removewindow, shiftwindow(FussZeile), shiftwindow(KopfZeile).
  195.  
  196.   menu1(LI,LIST,MAXLI,ANTKOL,CHOICE):-
  197.       field_attr(LI,0,ANTKOL,112), cursor(LI,0), readkey(KEY),
  198.       menu2(LI,LIST,MAXLI,ANTKOL,CHOICE,KEY).
  199.  
  200.   menu2(_,_,_,_,-1,esc):-!.
  201.   menu2(LI,_,_,_,CH,ftast(10)):-!,CH=LI.
  202.   menu2(LI,_,_,_,CH,cr):-!,CH=LI.
  203.   menu2(LI,LIST,MAXLI,ANTKOL,CHOICE,up):-
  204.       LI>0, !, field_attr(LI,0,ANTKOL,7), LI1=LI-1, 
  205.       menu1(LI1,LIST,MAXLI,ANTKOL,CHOICE).
  206.  
  207.   menu2(LI,LIST,MAXLI,ANTKOL,CHOICE,down):-
  208.       LI<MAXLI-1, !, field_attr(LI,0,ANTKOL,7), LI1=LI+1,
  209.       menu1(LI1,LIST,MAXLI,ANTKOL,CHOICE).
  210.  
  211.   menu2(LI,LIST,MAXLI,ANTKOL,CHOICE,_):- menu1(LI,LIST,MAXLI,ANTKOL,CHOICE).
  212.  
  213.  
  214. /***************************************************************************/
  215. /*                       Graphikteil                                       */
  216. /***************************************************************************/
  217.  
  218.  
  219. predicates
  220.     transform_Koord(REALLIST,REAL,REAL,INTEGERLIST) 
  221.     /* transformiert Benutzerkoordianten in absolute Bildschirmkoordinaten */
  222.     transform_Koord_rel(REALLIST,REAL,REAL,INTEGERLIST) 
  223.     /* transformiert Benutzerkoordianten in relative Bildschirmkoordinaten */
  224.     cut_Koord(REAL,REAL) /* faengt Bereichsueberschreitungen ab */
  225.     cut_Koord(INTEGER,INTEGER) /* dito */
  226.     achsen(INTEGER,INTEGER,INTEGER,INTEGER) /* Zeichnet die Achsen */ 
  227.     /* X0,Y0,Schrittweite X-Teilung,Schrittweite Y-Teilung */
  228.     xachse(INTEGER,INTEGER,INTEGER)  /* dito */
  229.     yachse(INTEGER,INTEGER,INTEGER)  /* dito */
  230.     xachse1(INTEGER,INTEGER,INTEGER) /* dito */
  231.     yachse1(INTEGER,INTEGER,INTEGER) /* dito */
  232.     setz_Punkt(INTEGERLIST,INTEGERLIST,INTEGERLIST,INTEGERLIST)
  233.     /* Setzt die Punkte.  X-Liste, Y-Liste, X-Fehlerliste, Y-Fehlerliste */ 
  234.     kreuz(INTEGER,INTEGER) /* Macht ein Kreuzchen bei (X,Y) */
  235.     mach_FehlerBalk_X(INTEGER,INTEGER,INTEGERLIST,INTEGERLIST)/* Zeichnet */              
  236.     mach_FehlerBalk_Y(INTEGER,INTEGER,INTEGERLIST,INTEGERLIST)/* Fehlerbalken */                           
  237.     zeichne_Kurve(INTEGERLIST,INTEGERLIST) /* X-Liste, Y-Liste */
  238.         
  239. clauses
  240.     transform_Koord([],_,_,[]).
  241.     transform_Koord([HR|TR],Min,Max,[HI|TI]) :-
  242.        Wert = 31999 - 31999 * (HR - Min) / (Max - Min),
  243.        cut_Koord(Wert,NWert), HI = round(NWert),
  244.        transform_Koord(TR,Min,Max,TI).
  245.     transform_Koord_rel([],_,_,[]).
  246.     transform_Koord_rel([HR|TR],Min,Max,[HI|TI]) :-
  247.        Wert = 31999 * HR / (Max - Min),
  248.        cut_Koord(Wert,NWert), HI = round(NWert),
  249.        transform_Koord_rel(TR,Min,Max,TI).   
  250.     cut_Koord(Ein,Aus) IF Ein < 0 AND Aus = 0 AND !.
  251.     cut_Koord(Ein,Aus) IF Ein > 31999 AND Aus = 31999 AND !.
  252.     cut_Koord(Ein,Ein).
  253.                
  254.     achsen(X0,Y0,DX,DY) :-
  255.         cut_Koord(X0,NX0), cut_Koord(Y0,NY0), cut_Koord(DX,NDX), 
  256.         cut_Koord(DY,NDY), xachse(NX0,NY0,NDX), yachse(NX0,NY0,NDY).
  257.     xachse(X0,Y0,DX) :- 
  258.         line(0,Y0,31999,Y0,3), 
  259.         Parts = X0 div DX, XSTART = X0 - DX * PARTS, 
  260.         xachse1(Y0,DX,XSTART).
  261.     xachse1(_,_,LaufInd) IF LaufInd > 31999 AND !. /*Schon ueber Ende hinaus?*/
  262.     xachse1(_,_,LaufInd) IF LaufInd < 0 AND !. /*Schon ueber Ende hinaus?*/
  263.     /* Hinweis: Bereichsueberschreitungen bei Integers 
  264.                 fuehrt zu negativen Zahlen */
  265.     xachse1(Y,DX,LaufInd) :- /* Sonst Strich machen und weiterzaehlen */
  266.         YPlus = Y + 600, cut_Koord(YPlus,NYPlus),
  267.         YMinus = Y - 600, cut_Koord(YMinus,NYMinus),
  268.         line(LaufInd,NYPlus,LaufInd,NYMinus,3),
  269.         LaufInd1 = LaufInd + DX, xachse1(Y,DX,LaufInd1).    
  270.     yachse(X0,Y0,DY) :- /* Siehe X-Achse */
  271.         line(X0,0,X0,31999,3), 
  272.         Parts = Y0 div DY, YSTART = Y0 - DY * PARTS, yachse1(X0,DY,YSTART).
  273.     yachse1(_,_,LaufInd) IF LaufInd > 31999 AND !.    
  274.     yachse1(_,_,LaufInd) IF LaufInd < 0 AND !.    
  275.     yachse1(X,DY,LaufInd) :-
  276.         XPlus = X + 600, cut_Koord(XPlus,NXPlus),
  277.         XMinus = X - 600, cut_Koord(XMinus,NXMinus),
  278.         line(NXPlus,LaufInd,NXMinus,LaufInd,3),
  279.         LaufInd1 = LaufInd + DY, yachse1(X,DY,LaufInd1).
  280.         
  281.     setz_Punkt([],[],[],[]).
  282.     setz_Punkt([HX|TX],[HY|TY],FXL,FYL) :-
  283.         kreuz(HX,HY), mach_FehlerBalk_X(HX,HY,FXL,NFXL),               
  284.         mach_FehlerBalk_Y(HX,HY,FYL,NFYL),
  285.         setz_Punkt(TX,TY,NFXL,NFYL).
  286.     kreuz(X,Y) :-
  287.        XPlus = X + 600, cut_Koord(XPlus,NXPlus), XMinus = X - 600, 
  288.        cut_Koord(XMinus,NXMinus), YPlus = Y + 600, cut_Koord(YPlus,NYPlus), 
  289.        YMinus = Y - 600, cut_Koord(YMinus,NYMinus),
  290.        line(NXMinus,NYMinus,NXPlus,NYPlus,3), 
  291.        line(NXMinus,NYPlus,NXPlus,NYMinus,3).
  292.            
  293.     mach_FehlerBalk_X(_,_,[],[]).
  294.     mach_FehlerBalk_X(X,Y,[HF|TF],TF) :-
  295.         MaxX = X + HF, MinX = X - HF, cut_Koord(MaxX,NMaxX), 
  296.         cut_Koord(MinX,NMinX), line(NMinX,Y,NMaxX,Y,3), Yplus = Y + 400, 
  297.         YMinus = Y - 400, cut_Koord(YPlus,NYPlus), cut_Koord(YMinus,NYMinus),
  298.         line(NMaxX,NYPlus,NMaxX,NYMinus,3), line(NMinX,NYPlus,NMinX,NYMinus,3).
  299.     mach_FehlerBalk_Y(_,_,[],[]).
  300.     mach_FehlerBalk_Y(X,Y,[HF|TF],TF) :-
  301.         MaxY = Y + HF, MinY = Y - HF, cut_Koord(MaxY,NMaxY), 
  302.         cut_Koord(MinY,NMinY), line(X,NMinY,X,NMaxY,3), Xplus = X + 400, 
  303.         XMinus = X - 400, cut_Koord(XPlus,NXPlus), cut_Koord(XMinus,NXMinus),
  304.         line(NXPlus,NMaxY,NXMinus,NMaxY,3), line(NXPlus,NMinY,NXMinus,NMinY,3).
  305.     zeichne_Kurve([X1,X2],[Y1,Y2]) :- line(X1,Y1,X2,Y2,3) AND !.    
  306.     zeichne_Kurve([X1,X2|TX],[Y1,Y2|TY]) :-
  307.         line(X1,Y1,X2,Y2,3), zeichne_Kurve([X2|TX],[Y2|TY]).
  308.  
  309.  
  310. /***************************************************************************/
  311. /*               Daten - Editor & Mini-Parser                              */
  312. /***************************************************************************/
  313. domains
  314.    Var_Name, Einheit = STRING
  315. predicates
  316.     scanner(string,STRINGLIST) /* Zerpflueckt String zur String-Liste */
  317.     make_Header(STRING,STRING) /* Kopfzeile vom Dateneditor */
  318.     get_Part_2( INTEGER, STRING, STRING, STRING) /* Fuer Header */
  319.     get_Part_3( CHAR, STRING, STRING, CHAR, STRING, STRING, STRING) /* dito */              /* des Header   */
  320.     fill_to(STRING,INTEGER,STRING) /* Fuellt String bis zu N Stellen auf */            
  321.     string_dollar(CHAR,INTEGER,STRING)  /* Macht String aus N mal */
  322.                                       /* einem Zeichen */
  323.     edit_Daten(STRING) /* Daten zu einem Stichwort bearbeiten */
  324.     hole_Eingabe_Daten(STRING,STRING) /* Holt Eingabedaten aus DATABASE */                                    
  325.     einfuegen_Eingabe_Daten(STRING,STRING) /* Einfuegen Eingabedaten in
  326.                                                  DATABASE */
  327.     retract_first_Line(STRING,STRING)
  328.     retract_empty_Lines(STRING,STRING) /* Leere Zeilen aus Eingabe 
  329.                                           rausschmeissen */
  330.     retract_not_allowed(STRING,STRING) /* Nicht erlaubte Symbole raus */                                             
  331.     make_Bruch(STRING,STRING,STRING) /* Bruch aus Variable und Einheit */
  332.     make_Part(STRING,STRING,STRING,INTEGER,STRING) /* Teil vom Header */
  333.     
  334. clauses
  335.     scanner("",[]) :- !.
  336.     scanner(Str,Res) :-  /* Fuer nur Leerstellen im String */
  337.         NOT(fronttoken(Str,_,_)) AND ! AND scanner("",NRes), Res = NRes.
  338.     scanner(Str,[Tok|Rest]):-
  339.         fronttoken(Str,Sym,Str1), Tok = Sym, scanner(Str1,Rest).
  340.  
  341.     make_Header(StichW,Header) :- 
  342.         setup_Daten(StichW,Dim,NameX,EinhX,XFehl,NameY,EinhY,YFehl),
  343.         make_Part("",NameX,EinhX,15,Part1),
  344.         get_Part_2( Dim, NameY, EinhY, Part2),
  345.         get_Part_3( XFehl, NameX, EinhX, YFehl,NameY, EinhY, Part3),
  346.         concat(Part1,Part2,PartA), concat(PartA,Part3,Res),
  347.         fill_to(Res,78,Line), concat(Line,"\n",Line_with_CR),
  348.         Header = Line_with_CR.
  349.                                                
  350.     make_Bruch(Zaehler,Nenner,Bruch) :-
  351.         concat(Zaehler,"/",Res1), concat(Res1,Nenner,Res2), Bruch = Res2.
  352.     
  353.     make_Part(FrontStr,Zaehler,Nenner,Stellen,Part) :-
  354.         make_Bruch(Zaehler,Nenner,Bruch), concat(FrontStr,Bruch,Zeile),
  355.         N_minus_2 = Stellen - 2, fill_to(Zeile,N_minus_2,NeuBruch), 
  356.         concat(NeuBruch,"| ",Res), Part = Res.
  357.     
  358.     get_Part_2(1,_,_,"").
  359.     get_Part_2(2,Name,Einh,Res) :- make_Part("",Name,Einh,15,NRes), Res = NRes.
  360.  
  361.     get_Part_3( 'n',_,_,'n',_,_,"").                           
  362.     get_Part_3( 'j',NameX,EinhX, 'n',_,_,Res) :-
  363.         make_Part("Abs. Fehl. ",NameX,EinhX,23,Part), Res = Part.
  364.     get_Part_3('n',_,_,'j',NameY,EinhY,Res) :-
  365.         make_Part("Abs. Fehl. ",NameY,EinhY,23,Part), Res = Part.   
  366.     get_Part_3( 'j',NameX,EinhX, 'j',NameY,EinhY,Res) :-
  367.         make_Part("Abs. Fehl. ",NameX,EinhX,23,Res1),
  368.         make_Part("Abs. Fehl. ",NameY,EinhY,23,Res2), concat(Res1,Res2,NRes),
  369.         Res = NRes. 
  370.  
  371.     fill_to(RohString,Stellen,Res) :-
  372.         str_len(RohString,Laenge) AND Laenge <= Stellen AND ! AND
  373.         Blanks = Stellen - Laenge, string_dollar(' ',Blanks,BlankStr),
  374.         concat(RohString,BlankStr,NRes), Res = NRes.
  375.     fill_to(RohString,Stellen,Res) :- 
  376.         ! AND frontstr(Stellen,RohString,NRes,_), Res = NRes.
  377.  
  378.     string_dollar(_,0,"") :- !.
  379.     string_dollar(_,Nr,_) :-  /* Fuer "negative" Stringlaengen */
  380.         Nr < 0 AND ! AND FAIL. 
  381.     string_dollar(Zeichen,Nr,Res) :- 
  382.         ! AND N1 = Nr - 1, string_dollar(Zeichen,N1,NRes),
  383.         str_char(ZeichenStr,Zeichen), concat(ZeichenStr,NRes,NRes2),
  384.         Res = NRes2.                                   
  385.    
  386.     edit_Daten(StichW) :-
  387.         hole_Eingabe_Daten(Stichw,StrRes),
  388.         makewindow(126,7,7," Daten-Editor ",0,0,24,80),
  389.         make_Header(StichW,Header), concat(Header,StrRes,EdZeile),
  390.         editmsg(EdZeile,Res,"***** Bearbeitung der Daten *****","",
  391.                 ">>> Bitte vermeiden Sie es, die Kopfzeile zu zerstoeren <<<",
  392.                 100,"MYED.HLP",_), retract_first_Line(Res,Aus), 
  393.         retract_empty_Lines(Aus,NRes), retract_not_allowed(NRes,NRes2), 
  394.         einfuegen_Eingabe_Daten(StichW,NRes2), removewindow.
  395.                
  396.     hole_Eingabe_Daten(StichW,Res) :- 
  397.         eingabe_daten(Stichw,Str) AND ! AND Res = Str.
  398.     hole_Eingabe_Daten(_,"").
  399.     
  400.     einfuegen_Eingabe_Daten(StichW,Str) :-
  401.         retract(eingabe_Daten(StichW,_)) AND ! AND /* schon vorhanden ? */ 
  402.         assertz(eingabe_Daten(StichW,Str)). 
  403.     einfuegen_Eingabe_Daten(StichW,Str) :- assertz(eingabe_Daten(StichW,Str)).
  404.     retract_first_Line(Ein,Aus) :-
  405.         frontstr(1,Ein,Zeichen,Rest) AND Zeichen = "\n" AND ! AND Aus = Rest.
  406.     retract_first_Line(Ein,Aus) :-    
  407.         frontstr(1,Ein,_,Rest) AND retract_first_Line(Rest,Res), Aus = Res.
  408.     retract_empty_Lines(Ein,Aus) :-
  409.         fronttoken(Ein,Tok,Rest) AND str_real(Tok,_) AND ! AND
  410.         fronttoken(NRes,Tok,Rest), Aus = NRes.
  411.     retract_empty_Lines(Ein,Aus) :- 
  412.         fronttoken(Ein,_,Rest), retract_empty_Lines(Rest,NRes), Aus = NRes.    
  413.     retract_not_allowed("","") :-!.
  414.     retract_not_allowed(Ein,Aus) :- 
  415.         frontstr(1,Ein,Zeichen,Rest) AND Zeichen = "\n" AND ! AND
  416.         retract_not_allowed(Rest,NRes), concat(Zeichen,NRes,NRes2),
  417.         Aus = NRes2.
  418.     retract_not_allowed(Ein,Aus) :-
  419.         frontstr(1,Ein,Zeichen,Rest) AND Zeichen = " " AND ! AND
  420.         retract_not_allowed(Rest,NRes), concat(Zeichen,NRes,NRes2),
  421.         Aus = NRes2.    
  422.     
  423.     retract_not_allowed(Ein,Aus) :-
  424.         fronttoken(Ein,Tok,Rest),
  425.         Tok <> "w" AND TOK <> "W" AND not(str_real(Tok,_)) AND ! AND 
  426.         retract_not_allowed(Rest,Nres), Aus = NRes.
  427.     retract_not_allowed(Ein,Aus) :-
  428.         fronttoken(Ein,Tok,Rest), retract_not_allowed(Rest,Nres), 
  429.         concat(Tok," ",NRes2), concat(NRes2,NRes,NRes3), Aus = NRes3.    
  430.                
  431. /***************************************************************************/
  432. /*                     Hauptprogramm                                       */
  433. /***************************************************************************/
  434.                      
  435. predicates 
  436.     start
  437.     hauptmenue
  438.     option(INTEGER)      /* Optionen des Hauptmenues */
  439.     dV_Option(INTEGER)   /* Optionen des Datenverwaltungsmenue */
  440.     ja_nein(STRING,CHAR)         
  441.     fehler_Meldung(STRING)
  442.     input_SetUp_Daten(STRING, INTEGER, STRING, STRING, CHAR, 
  443.                                        STRING, STRING, CHAR)
  444.     frag_Stichwort(STRING)
  445.     frag_Verteilung(INTEGER)
  446.     frag_Variablen( INTEGER, STRING, STRING, CHAR, STRING, STRING, CHAR)    
  447.     frag_Var( STRING, STRING, STRING, CHAR)
  448.     frag_Koord(REAL,REAL,REAL,REAL,REAL,REAL,REAL,REAL)
  449.     frag_Ecken(REAL,REAL,REAL,REAL)
  450.     frag_Aufteilung(REAL,REAL,REAL,REAL)
  451.     make_Nr_Listen(STRING)
  452.     constellation( INTEGER, CHAR, CHAR, STRINGLIST, STRINGLIST, 
  453.                                         STRINGLIST, STRINGLIST, STRINGLIST)                
  454.     einfuegen_Daten(STRING, REALLIST, REALLIST, REALLIST, REALLIST)                
  455.     replace_Ws(STRINGLIST,STRINGLIST)
  456.     zeige_alle_Stichworte /* Zeigt in einem Fenster alle schon benutzten 
  457.                              Stichworte */
  458.     berechnung(STRING) /* Statistische Berechnung und Anzeige der zu einem 
  459.                           Stichwort gehoerenden Groessen */
  460.     graphik(STRING) /* graphische Darstellung von 2 dim. Verteilungen */                      
  461.     schreibe_Berech(INTEGER,STRING,STRING,CHAR,REALLIST,REALLIST,
  462.                             STRING,STRING,CHAR,REALLIST,REALLIST)
  463.     schreibe_Fehlermittel(CHAR,STRING,STRING,REALLIST)
  464.     /* Aufteilung der Eingabe in Spalten */
  465.     mache_2_Spalten(STRINGLIST,STRINGLIST,STRINGLIST)
  466.     mache_3_Spalten(STRINGLIST,STRINGLIST,STRINGLIST,STRINGLIST)
  467.     mache_4_Spalten(STRINGLIST,STRINGLIST,STRINGLIST,STRINGLIST,STRINGLIST)    
  468.    
  469. GOAL START.
  470.  
  471. clauses 
  472.     start :- 
  473.         makewindow(1,112,0,"",24,0,1,80),
  474.         FussZeileA = "ESC: Verlassen dieses Menue ",
  475.         FussZeileB = "-- Pfeiltasten fuer Auswahl, ",
  476.         FussZeileC = "RETURN zum Aktivieren.",
  477.         concat( FussZeileA, FussZeileB, FussZeileD),
  478.         concat( FussZeileD, FussZeileC, FussZeileGesamt),
  479.         write(FussZeileGesamt),
  480.         makewindow( 2, 112, 0, "", 24, 0, 1, 80),
  481.         write("ESC: Ausgang  Ctrl S: Unterbrechung der Ausgabe"),
  482.         makewindow( 3, 7, 7,
  483.                     " STATISTIKHELFER: Dialogorientiertes Statistikprogramm ",
  484.                        0 , 0, 24, 80),         
  485.         hauptmenue.
  486.  
  487.     hauptmenue :- 
  488.         menu( 1, 2, 3, 5, 30, " Hauptmenue ", ["Daten-Verwaltung",
  489.                                                "Berechnung",
  490.                                                "2 dim. Graphik "], Wahl),
  491.         Option(Wahl) AND Wahl = 0 AND ! AND removewindow, removewindow.
  492.     /***** Optionen des Hauptmenues *****/
  493.     option(0) :- /* Ausgang */
  494.         Message = "\nSie wollen das Programm verlassen. Sicher ? (j/n) : ",
  495.         ja_nein(Message,Wahl), str_char(WahlStr,Wahl)
  496.         AND member(WahlStr,["j","J"]) AND ! AND EXIT.
  497.     option(1) :- /* Datenverwaltungsmenue */
  498.         menu( 1, 2, 3, 5, 30, " Datenverwaltung",["Daten-Setup",
  499.                                                   "Bearbeiten Daten",
  500.                                                   "Speichern Sitzung",
  501.                                                   "Laden Sitzung"], Wahl),
  502.         dV_Option(Wahl) AND Wahl = 0 AND ! AND FAIL.              
  503.     option(2) :- /* Berechnung */ frag_Stichwort(SW) AND  berechnung(SW).                   
  504.     option(3) :- /* graphische Darstellung */ 
  505.         frag_Stichwort(SW) AND setup_Daten(SW,2,_,_,_,_,_,_) AND
  506.          graphik(SW).
  507.     option(_) :- ! AND hauptmenue. /* nix trifft zu */                 
  508.  
  509.     /***** Datenverwaltungsoptionen *****/
  510.     dV_Option(0) :- ! AND hauptmenue.
  511.     dV_Option(1) :- /* Daten-Setup */
  512.         input_SetUp_Daten( STRING, Anzahl, NameX, EinhX, XFehlbek,
  513.                                            NameY, EinhY, YFehlbek)
  514.         AND ! AND
  515.         assertz(setup_Daten( STRING, Anzahl,NameX, EinhX, XFehlbek,
  516.                                             NameY, EinhY, YFehlbek)),
  517.         option(1).
  518.     dV_Option(1) :- /* Falls Fehler bei Setup */ ! AND option(1).
  519.     dV_Option(2) :- /* Daten editieren */ 
  520.         frag_Stichwort(SW) AND ! AND edit_Daten(SW),
  521.         make_Nr_Listen(SW), option(1).
  522.     dV_Option(2) :- /* Falls Fehler bei editieren */ ! AND option(1).                
  523.     dV_Option(3) :- /* Daten speichern */
  524.         makewindow( 124, 120, 112, " Daten speichern ", 10, 9, 5, 62),
  525.         nl, write("Unter welchem Namen sollen die Daten gespeichert werden ? "),
  526.         nl, write("(Max. 8 Zeichen ! Abbruch Eingabe mit <ESC>) : "),
  527.         readln(Wahl) AND ! AND removewindow,
  528.         concat(Wahl,".DAT",Name), save(Name), option(1).
  529.     dV_Option(3) :- /* Falls Fehler */ ! AND removewindow, option(1).                
  530.     dV_Option(4) :- /* Daten laden */
  531.         makewindow( 124, 120, 112, " Daten laden ", 10, 9, 6, 62), nl,
  532.         write("                 IN DER FOLGENDEN AUSWAHL"), nl,
  533.         write("      Datei mit Cursortasten und <RETURN> auswaehlen ."), nl, 
  534.         write("                 Abbrechen mit ESC "), nl,
  535.         write("              >>> Taste druecken <<<"), readchar(_), 
  536.         dir("","*.DAT",Wahl) AND ! AND removewindow, consult(Wahl),
  537.         option(1).
  538.     dV_Option(4) :- /* Falls Laden abgebrochen wurde */ 
  539.          ! AND removewindow AND option(1).
  540.     dV_Option(_) :- ! AND option(1).
  541.  
  542.     berechnung(SW) :- daten(SW,XL,YL,XFL,YFL), 
  543.                       setup_Daten(SW,Dim,NameX,EinhX,XFehl,
  544.                                          NameY,EinhY,YFehl)
  545.                       AND ! AND
  546.                       clearwindow,
  547.                       schreibe_Berech(Dim,NameX,EinhX,XFehl,XL,XFL,
  548.                                           NameY,EinhY,YFehl,YL,YFL),
  549.                       nl,nl,nl, write(">>> Taste druecken <<<"),
  550.                       readchar(_). 
  551.     schreibe_Berech(1,NameX,EinhX,XFehl,XL,XFL,_,_,_,_,_) :- ! AND
  552.           mittelwert(XL,XM),
  553.           nl, nl, write("Mittelwert von ",NameX," : ",XM," ",EinhX),
  554.           schreibe_Fehlermittel(XFehl,NameX,EinhX,XFL),
  555.           standardabweichung(XL,XSTD),
  556.           nl, nl,write("Standardabweichung von ",NameX," :        "),
  557.           write("σ = ",XSTD," ",EinhX).
  558.     schreibe_Berech(2,NameX,EinhX,XFehl,XL,XFL,NameY,EinhY,YFehl,Yl,YFL) :- ! AND
  559.           schreibe_Berech(1,NameX,EinhX,XFehl,XL,XFL,NameY,EinhY,YFehl,Yl,YFL),
  560.           schreibe_Berech(1,NameY,EinhY,YFehl,YL,YFL,NameY,EinhY,YFehl,Yl,YFL),
  561.           lineare_Regression(XL,YL,[Offset,Steigung]),
  562.           nl, nl, write("Regressionsgleichung :    "),
  563.           write(NameY," = ",Steigung,EinhY,"/",EinhX,"*",NameX," + ",
  564.                 Offset,EinhY),
  565.           regress_StandardAbweichung([Offset,Steigung],XL,YL,Sigma),
  566.           nl, nl, write("Standardabweichung der Regressionsgrade :     "),
  567.           write("σ = ",Sigma,EinhY).
  568.  
  569.     schreibe_Fehlermittel('j',Name,Einh,FL) :-
  570.           mittelwert(FL,F),
  571.           nl, nl, write("Fehlermittel von ",Name," : ",F," ",Einh).
  572.     schreibe_Fehlermittel('n',_,_,_). /* Fehlermittel nicht bekannt */
  573.     
  574.     graphik(SW) :- 
  575.         makewindow( 4, 120, 112, " Graphik-SetUp ", 10, 9, 5, 62),
  576.         frag_Koord(Links,Rechts,Unten,Oben,X0,Y0,DX,DY),
  577.         removewindow,
  578.         daten(SW,XL,YL,XFL,YFL), transform_Koord(XL,Links,Rechts,IXL),
  579.         transform_Koord(YL,Unten,Oben,IYL), 
  580.         transform_Koord_rel(XFL,Links,Rechts,IXFL),
  581.         transform_Koord_rel(YFL,Unten,Oben,IYFL), 
  582.         lineare_Regression(XL,YL,KoeffL),
  583.         horner(KoeffL,Links,LY), horner(KoeffL,Rechts,RY), 
  584.         transform_Koord([Links,Rechts],Links,Rechts,IRegXL),
  585.         transform_Koord([LY,RY],Unten,Oben,IRegYL),
  586.         transform_Koord([X0],Links,Rechts,[IX0]),
  587.         transform_Koord_rel([DX],Links,Rechts,[IDX]),
  588.         transform_Koord([Y0],Unten,Oben,[IY0]),
  589.         transform_Koord_rel([DY],Links,Rechts,[IDY]),
  590.         graphics(1,1,0),
  591.         achsen(IX0,IY0,IDX,IDY), setz_Punkt(IXL,IYL,IXFL,IYFL),
  592.         zeichne_Kurve(IRegXL,IRegYL), write(">>> Taste druecken <<<"), 
  593.         readchar(_), text.
  594.      
  595.     frag_Koord(Links,Rechts,Unten,Oben,X0,Y0,DX,DY) :-
  596.         frag_Ecken(Links,Rechts,Unten,Oben),
  597.         frag_Aufteilung(X0,Y0,DX,DY).
  598.     frag_Ecken(Links,Rechts,Unten,Oben) :-
  599.         clearwindow, nl , write("EINGABE DER KOORDINATENGRENZEN"),
  600.         nl, write("Linke Grenze : "), readreal(L), Links = L,
  601.         nl, write("Rechte Grenze : "), readreal(R), Rechts = R,
  602.         nl, write("Untere Grenze : "), readreal(U), Unten = U,
  603.         nl, write("Obere Grenze : "), readreal(O), Oben = O AND !.
  604.     frag_Ecken(L,R,U,O) :- ! AND
  605.         clearwindow, nl,
  606.         write("***** Fehler bei Zahleingabe"), nl, 
  607.         write(">>> Taste druecken <<<"), clearwindow,
  608.         frag_Ecken(NL,NR,NU,NO), L = NL, R = NR, U = NU, O = NO.
  609.     frag_Aufteilung(X0,Y0,DX,DY) :-
  610.         clearwindow, nl , write("EINTEILUNG KOORDINATENSYSTEM"), nl,
  611.         write("X-Wert Schnittpunkt Koord.-Achsen : "), readreal(X), X0 = X, nl,
  612.         write("Y-Wert Schnittpunkt Koord.-Achsen : "), readreal(Y), Y0 = Y,
  613.         nl, write("Achsenteilung X : "), readreal(NDX), DX = NDX,
  614.         nl, write("Achsenteilung Y : "), readreal(NDY), DY = NDY AND !.
  615.     frag_Aufteilung(X,Y,DX,DY) :- ! AND 
  616.         clearwindow, nl,
  617.         write("***** Fehler bei Zahleingabe"), nl, 
  618.         write(">>> Taste druecken <<<"), clearwindow,
  619.         frag_Aufteilung(NX,NY,NDX,NDY), X = NX, Y = NY, DX = NDX, DY = NDY.    
  620.         
  621.     ja_nein(Message,Wahl) :- 
  622.         write(Message), readchar(Zeichen), str_char(ZeichenStr,Zeichen),
  623.         upper_lower(ZeichenStr,Low_Zeichen) AND member(Low_Zeichen,["j","n"])
  624.         AND ! AND str_char(Low_Zeichen,Res), Wahl = Res.
  625.     ja_nein(M,W) :- ! AND ja_nein(M,W). /* Solange wiederholen bis */
  626.                                         /* richtiges Zeichen */                                            
  627.     fehler_Meldung(Message) :- 
  628.          makewindow( 5, 18, 135, "Fehlermeldung ",10, 10, 6, 60),
  629.          cursor(3,18), write(">>> Taste druecken <<<"),
  630.          cursor(0,1), write(Message),
  631.          readchar(_) , removewindow AND !.            
  632.     
  633.     input_SetUp_Daten( SW, Dimension, NameX, EinheitX, XFehl,
  634.                                  NameY, EinheitY, YFehl) :-
  635.         makewindow( 4, 120, 112, " Daten-SetUp ", 10, 9, 5, 62),
  636.         frag_Stichwort(Wort) AND ! AND SW = Wort,  
  637.         frag_Verteilung(Dim), Dimension = Dim,
  638.         frag_Variablen(Dimension, XName, XEinh, XFehlBek, 
  639.                                   YName, YEinh, YFehlBek),
  640.         NameX = XName, EinheitX = XEinh, XFehl = XFehlbek,
  641.         NameY = YName, EinheitY = YEinh, YFehl = YFehlbek,       
  642.         removewindow.
  643.     input_SetUp_Daten(_,_,_,_,_,_,_,_) :- /* Fehler bei Setupdaten-Eingabe */
  644.         ! AND removewindow and FAIL.                             
  645.                                        
  646.     frag_Stichwort(SW) :- 
  647.         zeige_alle_Stichworte,
  648.         makewindow( 125, 120, 112, " Stichwort ", 10, 9, 5, 62),
  649.         nl, write("Welches Stichwort bei der Datenverwaltung ? "),
  650.         nl, write("(Abbruch Eingabe mit <ESC>) : "), readln(Wahl) 
  651.         AND ! AND removewindow, removewindow, SW = Wahl.
  652.     frag_Stichwort("") :- /* Fehler bei Stichwortfrage */
  653.         ! AND removewindow, removewindow AND FAIL.                       
  654.        
  655.     frag_Verteilung(Dimension) :- 
  656.         nl, write(" 1 oder 2 dim. Verteilung ? (1/2) : "), readchar(NrZeichen),
  657.         str_char(NrZeichenStr,NrZeichen) AND member(NrZeichenStr,["1","2"])
  658.         AND ! AND str_int(NrZeichenStr,Nr), Dimension = Nr, clearwindow.
  659.     frag_Verteilung(Dim) :- /* Bei Fehler meckern und nochmal fragen */
  660.         FehlertextA = "        Fehler bei Eingabe der Dimension !",
  661.         FehlertextB = "\n      Nur 1 und 2 dim. Verteilungen moeglich !",
  662.         concat(FehlertextA,FehlertextB,Fehlertext), fehler_Meldung(Fehlertext),
  663.         frag_Verteilung(Dim).                                                          
  664.                           
  665.     frag_Variablen(1,NameX, EinhX, FehlerX, "", "", 'n') :-
  666.         frag_Var("X",Name,Einh,Fehler),
  667.         NameX = Name, EinhX = Einh, FehlerX = Fehler.
  668.     frag_Variablen(2,NameX, EinhX, FehlerX, NameY, EinhY, FehlerY) :-
  669.         frag_Var("X",Name,Einh,Fehler),
  670.         NameX = Name, EinhX = Einh, FehlerX = Fehler,
  671.         frag_Var("Y",Name2,Einh2,Fehler2),
  672.         NameY = Name2, EinhY = Einh2, FehlerY = Fehler2.
  673.         
  674.     frag_Var( Bezeich, Name, Einheit, Fehler_bekannt) :-
  675.         nl, write(" Variablenname fuer ",Bezeich," : "), readln(Name_Wahl), 
  676.         Name = Name_Wahl, clearwindow, nl,
  677.         write(" Einheit von ",Name," : "), readln(Einheit_Wahl),
  678.         Einheit = Einheit_Wahl, clearwindow, nl,
  679.         Fehlerfrage = " Fehler von bekannt ? (j/n) : ",
  680.         ja_nein(Fehlerfrage,Res), Fehler_bekannt = Res, clearwindow.                    
  681.             
  682.     make_Nr_Listen(Stichw) :-
  683.         setup_Daten(Stichw,AnzVar,_,_,XFehlBek,_,_,YFehlBek),
  684.         eingabe_Daten(Stichw,Str),
  685.         scanner(Str,StrListe),
  686.         constellation(AnzVar,XFehlBek,YFehlBek,StrListe,XL,YL,XFL,YFL),
  687.         replace_Ws(XL,XL2), replace_Ws(YL,YL2), replace_Ws(XFL,XFL2),
  688.         replace_Ws(YFL,YFL2), convert_to_Nrs(XL2,XLNr), 
  689.         convert_to_Nrs(YL2,YLNr), convert_to_Nrs(XFL2,XFLNr), 
  690.         convert_to_Nrs(YFL2,YFLNr), einfuegen_Daten(StichW,XLNr,YLNr,XFLNr,YFLNr).
  691.     
  692.     /* Welche Konstellation beim SetUp */
  693.     constellation(1,'n','n',StrL,StrL,[],[],[]).
  694.     constellation(2,'n','n',StrL,XL,YL,[],[]) :-   
  695.         mache_2_Spalten(StrL,NeuXL,NeuYL), XL = NeuXL, YL = NeuYL.
  696.     constellation(1,'j','n',StrL,XL,[],XFL,[]) :-   
  697.         constellation(2,'n','n',StrL,NeuXL,NeuXFL,_,_), 
  698.         XL = NeuXL, XFL = NeuXFL.    
  699.     constellation(2,'j','n',StrL,XL,YL,XFL,[]) :-   
  700.         mache_3_Spalten(StrL,NeuXL,NeuYL,NeuXFL),
  701.         XL = NeuXL, YL = NeuYL, XFL = NeuXFL.        
  702.     constellation(2,'n','j',StrL,XL,YL,[],YFL) :-   
  703.         constellation(2,'j','n',StrL,NeuXL,NeuYL,NeuYFL,_),
  704.         XL = NeuXL, YL = NeuYL, YFL = NeuYFL.            
  705.     constellation(2,'j','j',StrL,XL,YL,XFL,YFL) :-
  706.         mache_4_Spalten(StrL,NeuXL,NeuYL,NeuXFL,NeuYFL),
  707.         XL = NeuXL, YL = NeuYL, XFL = NeuXFL, YFL = NeuYFL.
  708.         
  709.     /* Aufteilung in Spalten */    
  710.     mache_2_Spalten([],[],[]).
  711.     mache_2_Spalten([A,B|T],[A|TA],[B|TB]) :-  mache_2_Spalten(T,TA,TB).
  712.         
  713.     mache_3_Spalten([],[],[],[]).
  714.     mache_3_Spalten([A,B,C|T],[A|TA],[B|TB],[C|TC]) :- 
  715.          mache_3_Spalten(T,TA,TB,TC).
  716.         
  717.     mache_4_Spalten([],[],[],[],[]).
  718.     mache_4_Spalten([A,B,C,D|T],[A|TA],[B|TB],[C|TC],[D|TD]) :-
  719.         mache_4_Spalten(T,TA,TB,TC,TD).
  720.         
  721.     einfuegen_Daten(StichW,XL,YL,XFL,YFL) :-
  722.         retract(daten(StichW,_,_,_,_)) AND ! AND 
  723.         assertz(daten(StichW,XL,YL,XFL,YFL)).
  724.     einfuegen_Daten(StichW,XL,YL,XFL,YFL) :-
  725.         assertz(daten(StichW,XL,YL,XFL,YFL)).
  726.         
  727.     /* Ersetzen der "W's" */    
  728.     replace_Ws([],[]) :- !.    
  729.     replace_Ws([F,"w"|T],[HRes|TRes]) :- 
  730.         ! AND replace_Ws([F|T],NRes), HRes = F, TRes = NRes.
  731.     replace_Ws([F,"W"|T],[HRes|TRes]) :- 
  732.         ! AND replace_Ws([F|T],NRes), HRes = F, TRes = NRes.    
  733.     replace_Ws([H|T],[HRes|TRes]) :- 
  734.         ! AND  replace_Ws(T,NRes), HRes = H, TRes = NRes.
  735.     
  736.     zeige_alle_Stichworte :-
  737.         findall(SW,setup_Daten(SW,_,_,_,_,_,_,_),Res),
  738.         makewindow( 120, 7, 7, " Vorhandene Stichworte ", 16, 9, 5, 62),
  739.         write_list(5,Res).
  740.  
  741.  
  742.