home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 04 / newton.pro < prev    next >
Encoding:
Text File  |  1987-03-13  |  33.1 KB  |  673 lines
  1. code = 2900
  2. /****************************************************************************/
  3. /*Wichtiger Hinweis: Stackgroesse vor Programmlauf mit Setup-Menue so gross */
  4. /*                   wie moeglich einstellen !!!!                           */
  5. /****************************************************************************/
  6.  
  7. /****************************************************************************/
  8. /**                       DEFINITION DER "WELT"                            **/
  9. /****************************************************************************/
  10.  
  11. /* Erstmal erzaehlen wir ihm, wie mathematische Terme aussehen koennen, */
  12. /* wobei dieser Datentyp rekursiv ist. Siehe z.B. Grundrechenarten      */
  13. domains
  14.     term =                   /* atomare Groessen  : symbolische Konstanten, 
  15.                                                     numerische Konstanten 
  16.                                                     und Variablen           */ 
  17.            const(STRING); nconst(REAL); var(STRING);
  18.  
  19.                                                               /* Funktionen */
  20.            funk(STRING,term); 
  21.                                                         /* Grundrechenarten */
  22.            plus(term,term); minus(term,term); mal(term,term); div(term,term);
  23.                                       /* Potenzen mit konstantem Exponenten */
  24.            npot(term,term) 
  25.     
  26.                                                 /* Hiernach wird abgeleitet */
  27.     nach = var(STRING) 
  28.  
  29. /****************************************************************************/
  30. /*                             "VEREINFACHER"                               */
  31. /*                                                                          */
  32. /* PREDIKAT: vereinfache(term,term)                                         */
  33. /* VORAUSSETZUNGEN: DOMAIN term                                             */
  34. /* Vereinfacht terme in der Baumnotation                                    */
  35. /****************************************************************************/
  36. /*       STEHT AUS DEKLARATIONSGRUENDEN VOR DEM ABLEITER/INTEGRATOR         */
  37. predicates
  38.     vereinfache(term,term)
  39.     vereinfache1(term,term,term,INTEGER,INTEGER)
  40.     vereinfache2(term,term)
  41.     eq(term,term)
  42.     
  43. clauses        
  44.     vereinfache(Term1,Term2) IF 
  45.         vereinfache2(Term1,Res) AND vereinfache1(Term1,Res,Term2,0,3) AND !.
  46.     vereinfache1(LastTerm,NewTerm,ResTerm,Counter,End) IF
  47.         Counter < End  AND not(eq(LastTerm,NewTerm)) AND 
  48.         vereinfache2(NewTerm,Res) AND Counter1 = Counter + 1 AND 
  49.         vereinfache1(NewTerm,Res,ResTerm,Counter1,End) AND !.
  50.     vereinfache1(_,Term,Term,_,_) IF !.        
  51.  
  52.     /* Addition von numerischen Konstanten */
  53.     vereinfache2(plus(nconst(A),nconst(B)),nconst(AB)) IF AB = A+B AND !.
  54.     vereinfache2(minus(nconst(A),nconst(B)),nconst(AB)) IF AB = A-B AND !.
  55.  
  56.     /*hier folgen diverse Vereinfachungen */
  57.     vereinfache2(mal(nconst(0),_),nconst(0)) IF !. 
  58.     vereinfache2(mal(_,nconst(0)),nconst(0)) IF !.
  59.     vereinfache2(div(nconst(0),_),nconst(0)) IF !.
  60.     vereinfache2(mal(nconst(1),A),AV) IF vereinfache2(A,AV) AND !.
  61.     vereinfache2(mal(A,nconst(1)),AV) IF vereinfache2(A,AV) AND !.
  62.     vereinfache2(div(X,nconst(1)),XV) IF vereinfache2(X,XV) AND !.
  63.     vereinfache2(div(X,nconst(-1)),XV) IF 
  64.          vereinfache2(mal(nconst(-1),X),XV) AND !.
  65.     vereinfache2(plus(nconst(0),A),AV) IF vereinfache2(A,AV) AND !.
  66.     vereinfache2(plus(A,nconst(0)),AV) IF vereinfache2(A,AV) AND !.
  67.     vereinfache2(minus(A,nconst(0)),AV) IF vereinfache2(A,AV) AND !.
  68.     vereinfache2(minus(nconst(0),A),AV) IF 
  69.         vereinfache2(mal(nconst(-1),A),AV) AND !.
  70.     vereinfache2(npot(_,nconst(0)),nconst(1)) IF !.
  71.     vereinfache2(funk(exp,nconst(0)),nconst(1)) IF !.
  72.     vereinfache2(npot(Arg,nconst(1)),ArgV) IF vereinfache2(Arg,ArgV) AND !.
  73.     vereinfache2(npot(Arg,nconst(-1)),div(nconst(1),ArgV)) IF 
  74.          vereinfache2(Arg,ArgV) AND !.
  75.     vereinfache2(npot(nconst(0),_),nconst(0)) IF !.
  76.     vereinfache2(npot(A,nconst(2)),funk(sqr,AV)) IF vereinfache2(A,AV) AND !.
  77.     vereinfache2(npot(nconst(1),_),nconst(1)) IF !.      
  78.     vereinfache2(npot(nconst(A),nconst(B)),nconst(C)) IF
  79.         D = ln(A), E = D*B, C=exp(E) AND !.
  80.     vereinfache2(npot(npot(X,A),B),npot(XV,mal(A,B))) IF 
  81.         vereinfache2(X,XV) AND !.
  82.     vereinfache2(mal(A,B),npot(AV,nconst(2))) IF
  83.         vereinfache2(A,AV) AND vereinfache2(B,BV) AND AV = BV AND !.
  84.     vereinfache2(mal(A,npot(B,N)),npot(AV,plus(nconst(1),N))) IF 
  85.         vereinfache2(A,AV) AND vereinfache2(B,BV) AND AV = BV AND !.    
  86.     vereinfache2(mal(npot(B,N),A),npot(AV,plus(nconst(1),N))) IF 
  87.         vereinfache2(A,AV) AND vereinfache2(B,BV) AND AV = BV AND !.        
  88.     vereinfache2(div(A,npot(B,N)),div(nconst(1),
  89.                  npot(AV,plus(nconst(1),N)))) IF 
  90.         vereinfache2(A,AV) AND vereinfache2(B,BV) AND AV = BV AND !.        
  91.     vereinfache2(div(npot(B,N),A),npot(AV,minus(N,nconst(1)))) IF 
  92.         vereinfache2(A,AV) AND vereinfache2(B,BV) AND AV = BV AND !.      
  93.     vereinfache2(div(A,B),nconst(1)) IF 
  94.         vereinfache2(A,AV) AND vereinfache2(B,BV) AND AV = BV AND !.        
  95.     vereinfache2(minus(A,B),nconst(0)) IF 
  96.         vereinfache2(A,AV) AND vereinfache2(B,BV) AND AV = BV AND !.         
  97.  
  98.     /* Ein bisschen sortieren */
  99.     vereinfache2(mal(nconst(A),mal(nconst(B),C)),R) IF 
  100.        vereinfache2(mal(nconst(A),nconst(B)),AB) AND vereinfache2(C,CV) AND 
  101.        vereinfache2(mal(AB,CV),Res) AND R = Res AND !.
  102.     vereinfache2(mal(nconst(A),mal(B,nconst(C))),R) IF
  103.        vereinfache2(mal(nconst(A),nconst(C)),AC) AND vereinfache2(B,BV) AND 
  104.        vereinfache2(mal(AC,BV),Res) AND R = Res AND !.
  105.     vereinfache2(mal(A,mal(nconst(B),nconst(C))),R) IF 
  106.        vereinfache2(mal(nconst(B),nconst(C)),BC) AND vereinfache2(A,AV) AND 
  107.        vereinfache2(mal(AV,BC),Res) AND R = Res AND !.    
  108.  
  109.     /* Zusammenziehen von Termen */   
  110.     vereinfache2(npot(Basis,Exp),npot(BasisV,ExpV)) IF 
  111.         vereinfache2(Basis,BasisV) AND vereinfache2(Exp,ExpV) AND !.    
  112.     vereinfache2(mal(nconst(A),nconst(B)),nconst(AB)) IF AB = A * B AND !.
  113.     vereinfache2(plus(A,B),mal(nconst(2),AV)) IF 
  114.         vereinfache2(A,AV) and vereinfache2(B,BV) AND AV = BV AND !.
  115.     vereinfache2(plus(A,mal(N,B)),mal(plus(nconst(1),N),AV)) IF
  116.         vereinfache2(A,AV) and vereinfache2(B,BV) AND AV = BV AND !.
  117.     vereinfache2(plus(mal(N,B),A),mal(plus(nconst(1),N),AV)) IF
  118.         vereinfache2(A,AV) and vereinfache2(B,BV) AND AV = BV AND !.    
  119.     vereinfache2(minus(A,mal(N,B)),mal(plus(nconst(1),N),AV)) IF
  120.         vereinfache2(A,AV) and vereinfache2(B,BV) AND AV = BV AND !.     
  121.     vereinfache2(minus(mal(N,B),A),mal(minus(N,nconst(1)),AV)) IF
  122.        vereinfache2(A,AV) and vereinfache2(B,BV) AND AV = BV AND !.                 
  123.  
  124.     /* Noch ein bisschen sortieren */
  125.     vereinfache2(plus(A,plus(B,C)),plus(Res1,C)) IF 
  126.         vereinfache2(plus(A,B),Res1) AND !.    
  127.     vereinfache2(plus(A,plus(B,C)),plus(Res1,B)) IF 
  128.         vereinfache2(plus(A,C),Res1) AND !.    
  129.     vereinfache2(plus(plus(B,C),A),plus(Res1,C)) IF 
  130.         vereinfache2(plus(A,B),Res1) AND !.    
  131.     vereinfache2(plus(plus(B,C),A),plus(Res1,B)) IF 
  132.         vereinfache2(plus(A,C),Res1) AND !.    
  133.     vereinfache2(mal(A,nconst(X)),mal(nconst(X),AV)) IF
  134.         vereinfache2(A,AV) AND !.
  135.     vereinfache2(mal(A,mal(nconst(X),B)),mal(nconst(X),mal(AV,BV))) IF 
  136.         vereinfache2(A,AV) AND vereinfache2(B,BV) AND !.
  137.     
  138.     /* Allgemeine Faelle */
  139.     vereinfache2(div(A,B),div(AV,BV)) IF
  140.        vereinfache2(A,AV) and vereinfache2(B,BV) AND !.          
  141.     vereinfache2(plus(A,B),plus(AV,BV)) IF
  142.         vereinfache2(A,AV) and vereinfache2(B,BV) AND !.       
  143.     vereinfache2(minus(A,B),minus(AV,BV)) IF
  144.         vereinfache2(A,AV) and vereinfache2(B,BV) AND !.             
  145.     vereinfache2(mal(A,B),mal(AV,BV)) IF
  146.         vereinfache2(A,AV) and vereinfache2(B,BV) AND !.                 
  147.            
  148.     vereinfache2(A,A) :- !. /* Terminiere */        
  149.     
  150.     eq(Term,Term).
  151.  
  152.           
  153. /****************************************************************************/
  154. /*                        ABLEITER/INTEGRATOR                               */
  155. /*                                                                          */
  156. /* PREDIKAT: stammf_ableit(term,nach,term)                                  */
  157. /* VORAUSSETZUNGEN : DOMAINS term,nach                                      */
  158. /* Bildet, je nachdem in welcher Richtung es angewendet wird, die Ableitung */
  159. /* oder Stammfunktion eines terms in der Baumnotation                       */
  160. /****************************************************************************/
  161.  
  162. predicates
  163.     stammf_ableit(term,nach,term)
  164.     part_I(term,nach,term)
  165.   
  166. clauses 
  167.     /* Hier bringen wir ihm Ableitungen und Stammfunktionen bei. Die Regeln */
  168.     /* die nur geschrieben wurden, um die Richtung Ableitung --> Stamm-     */
  169.     /*  funktion abzudecken, sind mit /*****/ gekennzeichnet.               */
  170.        
  171.     /* Konstanten */
  172.     stammf_ableit(const(A),_,nconst(0)) IF bound(A) AND !.
  173.     stammf_ableit(const(const),_,nconst(0)) IF !. /*****/ 
  174.     stammf_ableit(nconst(A),_,nconst(0)) IF bound(A) AND !.
  175.     /* Variablen */
  176.     stammf_ableit(var(Name),var(Name),nconst(1)) IF !.
  177.     stammf_ableit(var(A),var(B),nconst(0)) IF bound(A) AND A <> B AND !.       
  178.     stammf_ableit(mal(const(C),var(A)),var(A),const(C)) IF /*****/
  179.         bound(C) AND !.         
  180.     stammf_ableit(mal(nconst(C),var(A)),var(A),nconst(C)) IF /*****/
  181.         bound(C) AND !.        
  182.     /* Zweistellige Operatoren */
  183.     stammf_ableit(plus(U,V),Nach,plus(U_Strich,V_Strich)) IF
  184.         stammf_ableit(U,Nach,U_Strich) AND 
  185.         stammf_ableit(V,Nach,V_Strich) AND !.
  186.     stammf_ableit(minus(U,V),Nach,minus(U_Strich,V_Strich)) IF 
  187.         stammf_ableit(U,Nach,U_Strich) AND 
  188.         stammf_ableit(V,Nach,V_Strich) AND !.    
  189.     stammf_ableit(mal(U,V),Nach,plus(mal(U,V_Strich),mal(U_Strich,V))) IF
  190.         stammf_ableit(U,Nach,U_Strich) AND 
  191.         stammf_ableit(V,Nach,V_Strich) AND !.        
  192.     stammf_ableit(div(U,V),Nach,div(minus(mal(U_Strich,V),
  193.                   mal(U,V_Strich)), mal(V,V))) IF
  194.         stammf_ableit(U,Nach,U_Strich) AND 
  195.         stammf_ableit(V,Nach,V_Strich) AND !.                
  196.  
  197.     /******************************/    
  198.     /*      Fuer Integration      */
  199.     /******************************/
  200.  
  201.     stammf_ableit(mal(nconst(X),U),Nach,mal(nconst(X),U_Strich)) IF
  202.         stammf_ableit(U,Nach,U_Strich)  AND !.            
  203.     stammf_ableit(mal(nconst(X),U),Nach,mal(U_Strich,nconst(X))) IF
  204.         stammf_ableit(U,Nach,U_Strich)  AND !.                
  205.     stammf_ableit(mal(const(X),U),Nach,mal(const(X),U_Strich)) IF
  206.         stammf_ableit(U,Nach,U_Strich)  AND !.            
  207.     stammf_ableit(mal(const(X),U),Nach,mal(U_Strich,const(X))) IF
  208.         stammf_ableit(U,Nach,U_Strich)  AND !.                    
  209.     stammf_ableit(div(npot(var(X),nconst(2)),nconst(2)),var(X),var(X)) IF !.   
  210.  
  211.     /* natuerliche Potenzen */
  212.     stammf_ableit(npot(Arg,nconst(1)),Nach,Arg_Abl) 
  213.         IF FREE(Arg_Abl) AND stammf_ableit(Arg,Nach,Arg_Abl) AND !.
  214.     stammf_ableit(npot(Arg,nconst(X)),Nach,
  215.                   mal(Arg_Abl,mal(nconst(X),npot(Arg,nconst(X_minus_1))))) IF
  216.          X_minus_1 = X - 1 AND stammf_ableit(Arg,Nach,Arg_Abl) AND !.
  217.     stammf_ableit(npot(Arg,X),Nach,
  218.            mal(Arg_Abl,mal(X,npot(Arg,minus(X,nconst(1)))))) IF
  219.          stammf_ableit(Arg,Nach,Arg_Abl) AND !.    
  220.     stammf_ableit(div(npot(var(X),plus(Exp,nconst(1))),Exp),var(X),
  221.                    npot(var(X),Exp)) IF !.
  222.  
  223.     /* Ableitung von Funktionen ---> innere mal aeussere Ableitung */
  224.     stammf_ableit(funk(sqr,Arg),Nach,mal(mal(nconst(2),ArgAbl),Arg)) IF 
  225.         stammf_ableit(Arg,Nach,ArgAbl) AND !.        
  226.     stammf_ableit(funk(sqrt,Arg),Nach,
  227.                   mal(ArgAbl,div(nconst(0.5),funk(sqrt,Arg)))) IF 
  228.         stammf_ableit(Arg,Nach,ArgAbl) AND !.        
  229.     stammf_ableit(funk(exp,Arg),Nach,mal(Arg_Abl,funk(exp,Arg))) IF
  230.         stammf_ableit(Arg,Nach,Arg_Abl) AND !.
  231.     stammf_ableit(funk(sin,Arg),Nach,mal(Arg_Abl,funk(cos,Arg))) IF
  232.         stammf_ableit(Arg,Nach,Arg_Abl) AND !.    
  233.     stammf_ableit(funk(cos,Arg),Nach,mal(Arg_Abl,mal(nconst(-1),
  234.                   funk(sin,Arg)))) IF
  235.         stammf_ableit(Arg,Nach,Arg_Abl).
  236.     stammf_ableit(funk(ln,Arg),Nach,mal(Arg_Abl,div(nconst(1),Arg))) IF
  237.         stammf_ableit(Arg,Nach,Arg_Abl) AND !.
  238.  
  239.     /******************************/
  240.     /* Und wieder die Integration */
  241.     /******************************/
  242.     stammf_ableit(div(funk(sin,Arg),ArgAbl),Nach,funk(cos,Arg)) IF 
  243.         stammf_ableit(Arg,Nach,ArgAbl) AND !.    
  244.     stammf_ableit(mal(nconst(-1),div(funk(cos,Arg),ArgAbl)),
  245.                   Nach,funk(sin,Arg)) IF 
  246.         stammf_ableit(Arg,Nach,ArgAbl) AND !.        
  247.     stammf_ableit(div(funk(exp,Arg),ArgAbl),Nach,funk(exp,Arg)) IF 
  248.         stammf_ableit(Arg,Nach,ArgAbl) AND !.        
  249.     stammf_ableit(div(npot(Arg,nconst(1.5)),mal(nconst(2),ArgAbl)),Nach,
  250.                   funk(sqrt,Arg)) IF 
  251.         stammf_ableit(Arg,Nach,ArgAbl) AND !.         
  252.     stammf_ableit(div(npot(Arg,nconst(3)),mal(nconst(3),ArgAbl)),Nach,
  253.                   funk(sqr,Arg)) IF 
  254.         stammf_ableit(Arg,Nach,ArgAbl) AND !.        
  255.     stammf_ableit(mal(nconst(X),div(funk(ln,Arg),ArgAbl)),Nach,
  256.                   div(nconst(X),Arg)) IF 
  257.         stammf_ableit(Arg,Nach,ArgAbl) AND !.             
  258.     stammf_ableit(mal(const(X),div(funk(ln,Arg),ArgAbl)),Nach,
  259.                   div(const(X),Arg)) IF 
  260.         stammf_ableit(Arg,Nach,ArgAbl) AND !.                 
  261.  
  262.     /***********************************************************************/
  263.     /* Hierhin sollte man eine Haufen Integrale schreiben, um dem Programm */
  264.     /* das Leben leichter zu machen !.                                     */ 
  265.     /***********************************************************************/
  266.  
  267.     stammf_ableit(div(funk(sqr,funk(sin,Arg)),mal(nconst(2),ArgAbl)),Nach,
  268.                   mal(funk(sin,Arg),funk(cos,Arg))) IF 
  269.         stammf_ableit(Arg,Nach,ArgAbl) AND !.                           
  270.     stammf_ableit(div(funk(sqr,funk(sin,Arg)),mal(nconst(2),ArgAbl)),Nach,
  271.                   mal(funk(cos,Arg),funk(sin,Arg))) IF 
  272.         stammf_ableit(Arg,Nach,ArgAbl) AND !.                               
  273.     
  274.     /****** PARTIELLE INTEGRATION ******/    
  275.     stammf_ableit(Res,Nach,mal(A,B)) IF part_I(mal(A,B),Nach,Res) AND !.
  276.     
  277.     part_I(mal(U,V_Strich),Nach,minus(mal(U,V),I)) IF
  278.         stammf_ableit(V,Nach,V_Strich) AND stammf_ableit(U,Nach,U_Strich) AND
  279.         vereinfache(mal(V,U_Strich),Res1) AND stammf_ableit(I,Nach,Res1) AND !.
  280.     part_I(mal(V_Strich,U),Nach,minus(mal(U,V),I)) IF
  281.         stammf_ableit(V,Nach,V_Strich) AND stammf_ableit(U,Nach,U_Strich) AND
  282.         vereinfache(mal(V,U_Strich),Res1) AND stammf_ableit(I,Nach,Res1) AND !.
  283.         
  284.  
  285. /****************************************************************************/
  286. /**                             PARSER                                     **/
  287. /**                                                                        **/
  288. /** PREDIKAT: parse(STRING,TokenListe,term)                                **/
  289. /** VORAUSSETZUNGEN: DOMAIN term                                           **/
  290. /** Uebersetzt einen Funktionsterm in einem String in eine Baumnotation    **/
  291. /** Tokenliste enthaelt die gewuenschten Variablen                         **/
  292. /****************************************************************************/
  293.  
  294. domains
  295.   TokenListe = STRING*
  296.  
  297. predicates
  298.   replace(Term,TokenListe,Term)                   /* Tauscht Pseudovariablen 
  299.                                                        gegen Konstanten aus */
  300.   zaehle_Token(TokenListe,STRING,INTEGER) /* Vorkommen eines Zeich. zaehlen */
  301.   member(STRING,TokenListe)                 /* Zeichen in Liste enthalten ? */
  302.   richtiger_Term(TokenListe) 
  303.   entferne_Leerzeichen(STRING,STRING)
  304.   string_tokenliste(STRING,TokenListe)   /* Wandelt String in Tokenliste um */
  305.   aeussere_Klammern(TokenListe,TokenListe,TokenListe)  /* Entfernt aeussere 
  306.                 Klammern und gibt Argument und Rest hinter Klammer zurueck. 
  307.                                                      Benutzt rechte_Klammer */ 
  308.   rechte_Klammer(TokenListe,INTEGER,TokenListe,TokenListe) 
  309.   ordne_vorne(TokenListe,TokenListe)  /* Fuehrende - und + beruecksichtigen */
  310.   tokenliste_term(TokenListe,term)         /* Wandelt Tokenliste in Term um */
  311.   verknuepf(term,STRING,term,term) /* Verkn. zwei Terme ueber einen Funktor */
  312.   append(TokenListe,TokenListe,TokenListe)              /* Verkettet Listen */
  313.   parse(STRING,TokenListe,term)        /* parsed einen String zu einen Term */
  314.   split_in_two(TokenListe,TokenListe,TokenListe) 
  315.                  /* Teilt eine Tokenliste an einem Komma in zwei Listen auf */
  316.   
  317. /* Die folgenden Pred. pruefen, ob ein Zeichen ein bestimmter Operator ist  */
  318.   ist_Strichop(STRING)
  319.   ist_Punktop(STRING)
  320.   ist_Op(STRING)
  321.   ist_Klammer(String)
  322.  
  323. /* Diese pruefen die Zugehoerigkeit von Funktoren zu bestimmten Gruppen     */ 
  324.   ist_Strichfunk(term)
  325.   ist_Punktfunk(term)
  326.   ist_dual_funk(term)                        /* Funktor mit zwei Argumenten */
  327.  
  328. /* Aufspaltung in Teile die nur mit Punkt- bzw. Strichliste */ 
  329.   split_in_P_Liste(TokenListe,term)
  330.   split_in_S_Liste(TokenListe,term)
  331.   ist_iso_term(TokenListe)                        /* Abgeschlossener Term ? */
  332.  
  333.   
  334. clauses
  335.   parse(S,VL,T) IF 
  336.       bound(S) AND entferne_leerzeichen(S,NS), string_tokenliste(NS,TL),
  337.       ordne_vorne(TL,NTL), tokenliste_term(NTL,TT) AND replace(TT,VL,T) AND !. 
  338.   parse(S,_,T) IF 
  339.       free(S) AND tokenliste_term(TL,T) AND string_tokenliste(S,TL) AND !. 
  340.  
  341.   replace(var(A),VarListe,var(A)) IF member(A,VarListe) AND !.
  342.   replace(var(A),_,const(A)) IF !.
  343.   replace(nconst(A),_,nconst(A)) IF !.  
  344.   replace(plus(A,B),VarListe,plus(AN,BN)) IF 
  345.       replace(A,VarListe,AN) AND replace(B,VarListe,BN) AND !.
  346.   replace(minus(A,B),VarListe,minus(AN,BN)) IF 
  347.       replace(A,VarListe,AN) AND replace(B,VarListe,BN) AND !.    
  348.   replace(mal(A,B),VarListe,mal(AN,BN)) IF 
  349.       replace(A,VarListe,AN) AND replace(B,VarListe,BN) AND !.         
  350.   replace(div(A,B),VarListe,div(AN,BN)) IF 
  351.       replace(A,VarListe,AN) AND replace(B,VarListe,BN) AND !.    
  352.   replace(funk(N,Arg),VarListe,funk(N,ArgN)) IF
  353.       replace(Arg,VarListe,ArgN) AND !.
  354.   replace(npot(A,B),VarListe,npot(AN,BN)) IF 
  355.       replace(A,VarListe,AN) AND replace(B,VarListe,BN) AND !.              
  356.  
  357.   /* anstaendiger Term ? */
  358.   tokenliste_term(TokenListe,_) :- 
  359.       BOUND(TokenListe) AND NOT(richtiger_Term(TokenListe)) AND ! AND FAIL. 
  360.  
  361.   /* atomare Terme parsen */
  362.   tokenliste_term([Token],nconst(X)) :- bound(Token), str_real(Token,X) AND !.
  363.   tokenliste_term([Token],nconst(X)) :- bound(X), str_real(Token,X) AND !.
  364.   tokenliste_term([Token],var(Token)) :- bound(Token), isname(Token) AND !.
  365.   tokenliste_term([Token],const(Token)) :- bound(Token), isname(Token) AND !.
  366.  
  367.   /* Vorne ein bisschen ordnen */
  368.   tokenliste_term(["-",Atom],Res) :- 
  369.       BOUND(Atom) AND concat("-",Atom,Arg), 
  370.       tokenliste_term([Arg],Res) AND !. 
  371.  
  372.   /* Klammerterme parsen: Endstaendig oder in Funktionen */
  373.   tokenliste_term(["("|T],Res) IF 
  374.       BOUND(T) AND aeussere_Klammern(["("|T],NArg,[]) AND 
  375.       tokenliste_term(NArg,Res) AND !.        
  376.   tokenliste_term(["("|T],Res) IF 
  377.       BOUND(T) AND aeussere_Klammern(["("|T],NArg,[Op|Rest]) AND
  378.       string_tokenliste(Str1,["("|NArg]) AND concat(Str1,")",Str2) AND
  379.       tokenliste_term([Str2,Op|Rest],Res) AND !.      
  380.  
  381.   /* Funktionen parsen: endstaendig oder in Term */            
  382.   tokenliste_term([Name,"("|Arg_u_Klamm],funk(Name,FunkArg)) IF 
  383.       BOUND(Name) AND BOUND(Arg_u_Klamm) AND 
  384.       member(Name,[sqr,sqrt,arctan,arcsin,arccos,tan,sin,cos,ln,exp]),
  385.       aeussere_Klammern(["("|Arg_u_Klamm],Arg,[]) AND 
  386.       tokenliste_term(Arg,FunkArg) AND !.
  387.   tokenliste_term([Name,"("|Arg_u_Klamm],Res) IF 
  388.       BOUND(Name) AND BOUND(Arg_u_Klamm) AND 
  389.       member(Name,[sqr,sqrt,arctan,arcsin,arccos,tan,sin,cos,ln,exp]),    
  390.       aeussere_Klammern(["("|Arg_u_Klamm],Arg,Rest) AND 
  391.       string_tokenliste(Str1,[Name,"("|Arg]) AND concat(Str1,")",Str2) AND
  392.       tokenliste_term([Str2|Rest],Res) AND !.      
  393.  
  394.   /* Potenzen analog Funktionen */    
  395.   tokenliste_term([pot,"("|Arg_u_Klamm],npot(FunkArg1,FunkArg2)) IF 
  396.       BOUND(Arg_u_Klamm),
  397.       aeussere_Klammern(["("|Arg_u_Klamm],Arg,[]), split_in_two(Arg,Arg1,Arg2),
  398.       tokenliste_term(Arg1,FunkArg1), tokenliste_term(Arg2,FunkArg2) AND !.
  399.   tokenliste_term([pot,"("|Arg_u_Klamm],Res) IF 
  400.       BOUND(Arg_u_Klamm),
  401.       aeussere_Klammern(["("|Arg_u_Klamm],Arg,Rest),        
  402.       string_tokenliste(Str1,[pot,"("|Arg]) AND concat(Str1,")",Str2) AND
  403.       tokenliste_term([Str2|Rest],Res) AND !.      
  404.  
  405.   /* Aufspaltung in Punktrechnungs- und Strichrechnungsterme */
  406.   tokenliste_term(L,Res) IF BOUND(L) AND split_in_P_Liste(L,Res) AND !.    
  407.   tokenliste_term(L,Res) IF BOUND(L) AND split_in_S_Liste(L,Res) AND !.
  408.       
  409.   /************************************************/
  410.   /* Und hier die Klauseln fuer rechts ---> links */
  411.   /************************************************/
  412.   
  413.   tokenliste_term(FunkTerm,funk(FName,FunkArg)) IF /*****/ 
  414.       BOUND(FunkArg) AND BOUND(FNAME) AND tokenliste_term(NFunkArg,FunkArg),
  415.       append([FName,"("],NFunkArg,Res1), append(Res1,[")"],FunkTerm) AND !.
  416.   tokenliste_term(FunkTerm,npot(Basis,Exp)) IF /*****/ 
  417.       BOUND(Basis) AND BOUND(Exp) AND tokenliste_term(Term1,Basis),
  418.       tokenliste_term(Term2,Exp), append([pot,"("],Term1,Res1), 
  419.       append(Res1,[","|Term2],Res2), append(Res2,[")"],FunkTerm) AND !.    
  420.   tokenliste_term(XL,minus(nconst(0),X)) IF tokenliste_term(XL,X) AND !.    
  421.  
  422.   /* Division durch nicht geschlossenen Term */      
  423.   tokenliste_term(StrL,div(A,B)) IF 
  424.       BOUND(A) AND BOUND(B) AND not(ist_Strichfunk(A)) AND ist_dual_Funk(B) 
  425.       AND tokenliste_term(AL,A) AND tokenliste_term(BL,B) AND 
  426.       append(AL,["/","("|BL],L1) AND append(L1,[")"],StrL) AND !.     
  427.  
  428.   /* Punktrechnung mit Strichrechnung verknuepft */
  429.   tokenliste_term(StrL,div(A,B)) IF 
  430.       BOUND(A) AND BOUND(B) AND ist_Strichfunk(A) AND ist_Strichfunk(B) AND
  431.       tokenliste_term(AL,A) AND tokenliste_term(BL,B) 
  432.       AND append(["("|AL],[")","/","("|BL],L1) 
  433.       AND append(L1,[")"],StrL) AND !.     
  434.   tokenliste_term(StrL,mal(A,B)) IF 
  435.       BOUND(A) AND BOUND(B) AND ist_Strichfunk(A) AND ist_Strichfunk(B) AND
  436.       tokenliste_term(AL,A) AND tokenliste_term(BL,B) AND 
  437.       append(["("|AL],[")","*","("|BL],L1) AND append(L1,[")"],StrL) AND !.
  438.  
  439.   /* Punktrechnung mit einem Strichrechnungsterm verknuepft */         
  440.   tokenliste_term(StrL,div(A,B)) IF 
  441.       BOUND(A) AND BOUND(B) AND ist_Strichfunk(A) AND tokenliste_term(AL,A) 
  442.       AND tokenliste_term(BL,B) AND append(["("|AL],[")","/"|BL],StrL) AND !.
  443.   tokenliste_term(StrL,mal(A,B)) IF 
  444.       BOUND(A) AND BOUND(B) AND ist_Strichfunk(A) 
  445.       AND tokenliste_term(AL,A) AND tokenliste_term(BL,B) 
  446.       AND append(["("|AL],[")","*"|BL],StrL) AND !.         
  447.   tokenliste_term(StrL,mal(A,B)) IF 
  448.       BOUND(A) AND BOUND(B) AND ist_Strichfunk(B)
  449.       AND tokenliste_term(AL,A) AND tokenliste_term(BL,B) 
  450.       AND append(AL,["*","("|BL],StrL1) AND 
  451.       append(StrL1,[")"],StrL) AND !.
  452.              
  453.   /* Division durch geschlossenen Term */
  454.   tokenliste_term(StrL,div(A,B)) IF 
  455.       BOUND(A) AND BOUND(B) AND tokenliste_term(AL,A)
  456.       AND tokenliste_term(BL,B) AND append(AL,["/"|BL],StrL) AND !.          
  457.  
  458.   /* Minus Strichrechnungsterm */
  459.   tokenliste_term(StrL,minus(A,B)) IF 
  460.       BOUND(A) AND BOUND(B) AND ist_Strichfunk(B) 
  461.       AND tokenliste_term(AL,A) AND tokenliste_term(BL,B) 
  462.       AND append(AL,[" - ","("|BL],L1) AND append(L1,[")"],StrL) AND !. 
  463.  
  464.   /* Minus anderen Term */
  465.   tokenliste_term(StrL,minus(A,B)) IF 
  466.       BOUND(A) AND BOUND(B) AND tokenliste_term(AL,A) AND 
  467.       tokenliste_term(BL,B) AND append(AL,[" - "|BL],StrL) AND !.           
  468.  
  469.   /* Allgemeine Faelle */
  470.   tokenliste_term(StrL,plus(A,B)) IF 
  471.       BOUND(A) AND BOUND(B) AND tokenliste_term(AL,A) 
  472.       AND tokenliste_term(BL,B) AND append(AL,[" + "|BL],StrL) AND !.
  473.   tokenliste_term(StrL,mal(A,B)) IF 
  474.       BOUND(A) AND BOUND(B) AND tokenliste_term(AL,A) 
  475.       AND tokenliste_term(BL,B) AND append(AL,["*"|BL],StrL) AND !.                 
  476.   tokenliste_term(StrL,div(A,B)) IF 
  477.       BOUND(A) AND BOUND(B) AND tokenliste_term(AL,A) 
  478.       AND tokenliste_term(BL,B) AND append(AL,["/"|BL],StrL) AND !.               
  479.       
  480.   verknuepf(Term1,"+",Term2,plus(Term1,Term2)) IF !. 
  481.   verknuepf(Term1,"-",Term2,minus(Term1,Term2)) IF !. 
  482.   verknuepf(Term1,"*",Term2,mal(Term1,Term2)) IF !. 
  483.   verknuepf(Term1,"/",Term2,div(Term1,Term2)) IF !. 
  484.                   
  485.   append([],List,List) IF !.
  486.   append([X|L1], List2, [X|L3]) IF append(L1,List2,L3).  
  487.   
  488.   split_in_two([","|T],[],T) IF !.
  489.   split_in_two([H|T],[H|N1],N2) IF split_in_two(T,N1,N2) AND !.
  490.   
  491.   ist_Strichop(" + "). ist_Strichop("-").
  492.   ist_Punktop("*").  ist_Punktop("/").
  493.   ist_Op(Op) IF ist_Strichop(Op) AND ! OR ist_Punktop(OP) AND !.
  494.   
  495.   ist_Strichfunk(plus(_,_)). ist_Strichfunk(minus(_,_)).
  496.  
  497.   ist_Punktfunk(mal(_,_)). ist_Punktfunk(div(_,_)).                
  498.   
  499.   ist_dual_funk(Funktor) IF
  500.       ist_Strichfunk(Funktor) AND ! OR ist_Punktfunk(Funktor) AND !.
  501.  
  502. /* Dokumentation der Termaufspaltung im Begleitartikel */
  503.   split_in_P_Liste([Front,Op,Last],Res) IF
  504.      ist_Punktop(Op) AND string_tokenliste(Front,FrontL) AND
  505.      tokenliste_term(FrontL,FrontT) AND tokenliste_term([Last],LastT) AND
  506.      verknuepf(FrontT,Op,LastT,Res) AND !.   
  507.   split_in_P_Liste([Front,Op|Tail],Res) IF
  508.      ist_Punktop(Op) AND ist_iso_term(Tail) AND string_tokenliste(Front,FrontL)
  509.       AND tokenliste_term(FrontL,FrontT) AND tokenliste_term(Tail,TailT) 
  510.       AND verknuepf(FrontT,Op,TailT,Res) AND !.
  511.   split_in_P_Liste([Front,"+",Third|Tail],Res) IF
  512.      string_tokenliste(Front,FrontL) AND tokenliste_term(FrontL,FrontT) AND
  513.      tokenliste_term([Third|Tail],TailT) AND  verknuepf(FrontT,"+",TailT,Res)
  514.      AND !.         
  515.   split_in_P_Liste([Front,"-",Third|Tail],Res) IF
  516.      string_tokenliste(Front,FrontL) AND tokenliste_term(FrontL,FrontT) AND 
  517.      tokenliste_term([Third|Tail],TailT) AND NOT(ist_Strichfunk(TailT)) AND 
  518.      verknuepf(FrontT,"-",TailT,Res) AND !.            
  519.   split_in_P_Liste([Front,Op,Third|Tail],Res) IF
  520.      ist_Op(Op) AND bound(Third) AND not(ist_Klammer(Third)) AND 
  521.      not(member(Third,[sqr,sqrt,arctan,arcsin,arccos,tan,sin,cos,ln,exp,pot]))
  522.      AND string_tokenliste(NFront,[Front,Op,Third]) AND 
  523.      tokenliste_term([NFront|Tail],Res) AND !.
  524.   split_in_P_Liste([Front,Op,Third|Tail],Res) IF
  525.      ist_Op(Op) AND bound(Third) AND 
  526.      member(Third,[sqr,sqrt,arctan,arcsin,arccos,tan,sin,cos,ln,exp,pot]) AND
  527.      aeussere_Klammern(Tail,Arg,Rest) AND 
  528.      string_Tokenliste(Front1,[Front,Op,Third,"("|Arg]) AND 
  529.      concat(Front1,")",NFront) AND tokenliste_term([NFront|Rest],Res) AND !. 
  530.   split_in_P_Liste([Front,Op,Third|Tail],Res) IF
  531.      ist_Op(Op) AND bound(Third) AND ist_Klammer(Third) AND
  532.      aeussere_Klammern([Third|Tail],Arg,Rest), 
  533.      string_tokenliste(Str1,[Front,Op,Third|Arg]), concat(Str1,")",NFront), 
  534.      tokenliste_term([NFront|Rest],Res) AND !.            
  535.   split_in_P_Liste([Front,Op,Tail],Res) IF
  536.      ist_Op(Op) AND string_tokenliste(Front,FrontL) AND 
  537.      tokenliste_term(FrontL,FrontT) AND tokenliste_term([Tail],TailT) AND
  538.      verknuepf(FrontT,Op,TailT,Res) AND !.
  539.   
  540.   split_in_S_Liste([Front,Op,Last],Res) IF
  541.      ist_Strichop(Op) AND string_tokenliste(Front,FrontL) AND
  542.      split_in_S_Liste(FrontL,FrontT) AND tokenliste_term([Last],LastT) AND
  543.      verknuepf(FrontT,Op,LastT,Res) AND !.         
  544.   split_in_S_Liste([Front,Op|Tail],Res) IF
  545.      ist_Strichop(Op) AND ist_iso_term(Tail) 
  546.      AND string_tokenliste(Front,FrontL) AND tokenliste_term(FrontL,FrontT) 
  547.      AND tokenliste_term(Tail,TailT) AND verknuepf(FrontT,Op,TailT,Res) AND !.
  548.   split_in_S_Liste([Front,Op,Third|Tail],Res) IF
  549.      ist_Op(Op) AND bound(Third) AND not(ist_Klammer(Third)) AND
  550.      string_tokenliste(NFront,[Front,Op,Third]) AND 
  551.      tokenliste_term([NFront|Tail],Res) AND !.            
  552.   
  553.   ist_iso_term(["("|T]) IF BOUND(T) AND aeussere_Klammern(["("|T],_,[]) AND !. 
  554.   ist_iso_term([Name,"("|Arg_u_Klamm]) IF 
  555.       BOUND(Name) AND BOUND(Arg_u_Klamm) AND 
  556.       member(Name,[sqr,sqrt,arctan,arcsin,arccos,tan,sin,cos,ln,exp]),
  557.       aeussere_Klammern(["("|Arg_u_Klamm],_,[]) AND !.
  558.   ist_iso_term([pot,"("|Arg_u_Klamm]) IF 
  559.       BOUND(Arg_u_Klamm), aeussere_Klammern(["("|Arg_u_Klamm],_,[]) AND !.    
  560.   ist_Klammer("("). ist_Klammer(")").
  561.   
  562.   entferne_Leerzeichen(E_String,A_String) :-
  563.       fronttoken(E_String,Token,Rest) AND /* Token vorhanden ?! */ 
  564.       entferne_Leerzeichen(Rest,A_Rest), concat(Token,A_Rest,A_String) AND !.
  565.   entferne_Leerzeichen(_,"") IF !.  
  566.   
  567.   richtiger_Term(TokenListe) :-               /* Anzahl oeffnender Klammern 
  568.                                                           = schliessender ? */
  569.       zaehle_Token(TokenListe,"(",Anzahl) AND 
  570.       zaehle_Token(TokenListe,")",Anzahl) AND !.        
  571.       
  572.   zaehle_Token([],_,0) IF !.        
  573.   zaehle_Token([Token|RestList],Token,Aus) IF  
  574.       zaehle_Token(RestList,Token,Aus1), Aus = Aus1 + 1 AND !.
  575.   zaehle_Token([_|Tail],Token,Aus) IF zaehle_Token(Tail,Token,Aus) AND !.
  576.   
  577.   String_TokenListe("",[]) :- !.  
  578.   String_TokenListe(Str,[H|T]) :- 
  579.       BOUND(Str) AND  fronttoken(Str,H,Rest) 
  580.       AND String_TokenListe(Rest,T) AND !.
  581.   String_TokenListe(Str,[H|T]) :-  
  582.       BOUND(H) AND BOUND(T) AND String_TokenListe(Rest,T) AND 
  583.       fronttoken(Str,H,Rest) AND !.     
  584.        
  585.   aeussere_Klammern(["("|T],NT,Rest) IF ! AND rechte_Klammer(T,1,NT,Rest).
  586.   aeussere_Klammern(A,A,[]). 
  587.   
  588.   rechte_Klammer(X,0,[],X) IF !.
  589.   rechte_Klammer(X,0,[],Y) IF ! AND X = Y. /* Faile falls X <> Y */  
  590.   rechte_Klammer([")"|T],1,[],T) :- BOUND(T) AND !.
  591.   rechte_Klammer(["("|T],Zaehler,["("|NT],Rest) IF ! AND  
  592.       Zaehler_1 = Zaehler + 1 AND rechte_Klammer(T,Zaehler_1,NT,Rest).
  593.   rechte_Klammer([")"|T],Zaehler,[")"|NT],Rest) IF ! AND
  594.       Zaehler_1 = Zaehler - 1 AND rechte_Klammer(T,Zaehler_1,NT,Rest).
  595.   rechte_Klammer([H|T],Zaehler,[H|NT],Rest) IF ! AND
  596.       bound(H) AND rechte_Klammer(T,Zaehler,NT,Rest).
  597.     
  598.   ordne_vorne(["+"|T],T) :- !.
  599.   ordne_vorne(["-"|T],["0","-"|T]) :- !.
  600.   ordne_vorne(A,A).
  601.   
  602.   member(X,[X|_]).
  603.   member(X,[_|L]) :- member(X,L).
  604.   
  605.   
  606.       
  607.       
  608. /****************************************************************************/
  609. /**                        Das Hauptprogramm                               **/
  610. /****************************************************************************/
  611.  
  612. predicates
  613.     ableite(STRING,TokenListe,STRING)
  614.     integ(STRING,TokenListe,STRING)
  615.     start
  616.     option(CHAR)
  617.     
  618. GOAL START.
  619.     
  620. clauses
  621.    ableite(FunkStr,VarListe,Nach) :- 
  622.       nl, nl, parse(FunkStr,VarListe,FL), vereinfache(FL,FLV), 
  623.       stammf_ableit(FLV,var(Nach),AblL),  vereinfache(AblL,AblV), 
  624.       parse(Ableitung,[],AblV), nl, nl,
  625.       write("  Ableitung: "), write(Ableitung),nl,
  626.       write(">> Taste druecken <<"),readchar(_),
  627.       nl,nl,nl.
  628.    integ(FunkStr,VarListe,Nach) :- 
  629.       nl,nl, parse(FunkStr,VarListe,FL), vereinfache(FL,FLV),
  630.       stammf_ableit(SF,var(Nach),FLV),
  631.       vereinfache(SF,SFV), parse(Stammf,[],SFV),
  632.       write("   Stammfunktion: "), write(Stammf),nl,
  633.       write(">> Taste druecken <<"),readchar(_),
  634.       nl,nl,nl.   
  635.    
  636.    start :-
  637.       makewindow(1,7,112,"NEWTON - Integration und Differenzierung",0,0,25,80),
  638.       clearwindow, nl, nl ,nl,
  639.       write("  A)bleiten   I)ntegrieren   V)ereinfachen   Q)uit"), nl, nl, 
  640.       write("      Ihre Wahl : "), readchar(Wahl), nl, nl, 
  641.       option(Wahl), start.
  642.       
  643.    option('q') :- exit.        
  644.    option('Q') :- exit.
  645.    
  646.    option('a') :- 
  647.       write("  Ihr Funktionsterm ? : "), readln(Str), nl,
  648.       write("  Die gewuenschten Variablen ? (Durch Leerzeichen trennen) :"),
  649.       readln(VarStr), nl, string_tokenliste(VarStr,VarL),
  650.       write("  Nach welcher Variable ableiten ? : "), readln(DieVar), nl,
  651.       ableite(Str,VarL,DieVar) AND !.
  652.    option('A') :- option('a') AND !.
  653.    option('i') :- 
  654.       write("  Ihr Funktionsterm ? : "), readln(Str), nl,
  655.       write("  Die gewuenschten Variablen ? (Durch Leerzeichen trennen) :"),
  656.       readln(VarStr), nl, string_tokenliste(VarStr,VarL),
  657.       write("  Nach welcher Variable integrieren ? : "), readln(DieVar), nl,
  658.       integ(Str,VarL,DieVar) AND !.
  659.    option('I') :- option('i') AND !.
  660.    option('v') :- 
  661.       write("  Ihr Funktionsterm ? : "), readln(Str), nl,
  662.       parse(Str,[],Term), vereinfache(Term,Term2), parse(NStr,[],Term2),
  663.       write("  Vereinfachter Term : "), write(NStr), nl, nl,
  664.       write(">> Taste druecken <<"), readchar(_) AND !.
  665.    option('V') :- option('v') AND !.   
  666.        
  667.    option(_) :- 
  668.        write(">>>> Berechnung nicht moeglich oder Fehler bei Eingabe <<<<"),
  669.        nl, write(">> Taste druecken <<"), readchar(_)
  670.        AND !.   
  671.        
  672.        
  673.