home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 01 / newton / newton.pro < prev    next >
Encoding:
Text File  |  1987-06-23  |  11.2 KB  |  248 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. database
  30.   bekanntesIntegral(term,term,term)
  31.  
  32. include "SIMPLE.PRO"
  33.           
  34. /****************************************************************************/
  35. /*                        ABLEITER/INTEGRATOR                               */
  36. /*                                                                          */
  37. /* PREDIKAT: stammf_ableit(term,nach,term)                                  */
  38. /* VORAUSSETZUNGEN : DOMAINS term,nach                                      */
  39. /* Bildet, je nachdem in welcher Richtung es angewendet wird, die Ableitung */
  40. /* oder Stammfunktion eines terms in der Baumnotation                       */
  41. /****************************************************************************/
  42.  
  43. predicates
  44.     stammf_ableit(term,nach,term)
  45.     part_I(term,nach,term)
  46.   
  47. clauses 
  48.     /* Hier bringen wir ihm Ableitungen und Stammfunktionen bei. Die Regeln */
  49.     /* die nur geschrieben wurden, um die Richtung Ableitung --> Stamm-     */
  50.     /*  funktion abzudecken, sind mit /*****/ gekennzeichnet.               */
  51.        
  52.     /* Konstanten */
  53.     stammf_ableit(Res,var(X),Ein) :- 
  54.       bound(Ein), bekanntesIntegral(Res,var(X),Ein), !.
  55.     stammf_ableit(const(A),_,nconst(0)) IF bound(A) AND !.
  56.     stammf_ableit(const(const),_,nconst(0)) IF !. /*****/ 
  57.     stammf_ableit(nconst(A),_,nconst(0)) IF bound(A) AND !.
  58.     /* Variablen */
  59.     stammf_ableit(var(Name),var(Name),nconst(1)) IF !.
  60.     stammf_ableit(var(A),var(B),nconst(0)) IF 
  61.       bound(A) AND bound(B) AND A <> B AND !.       
  62.     stammf_ableit(mal(const(C),var(A)),var(A),const(C)) IF /*****/
  63.         bound(C) AND !.         
  64.     stammf_ableit(mal(nconst(C),var(A)),var(A),nconst(C)) IF /*****/
  65.         bound(C) AND !.        
  66.     /* Zweistellige Operatoren */
  67.     stammf_ableit(plus(U,V),Nach,plus(U_Strich,V_Strich)) IF
  68.         ! AND
  69.         stammf_ableit(U,Nach,U_Strich) AND 
  70.         stammf_ableit(V,Nach,V_Strich).
  71.     stammf_ableit(minus(U,V),Nach,minus(U_Strich,V_Strich)) IF 
  72.         ! AND
  73.         stammf_ableit(U,Nach,U_Strich) AND 
  74.         stammf_ableit(V,Nach,V_Strich).    
  75.     stammf_ableit(mal(U,V),Nach,plus(mal(U,V_Strich),mal(U_Strich,V))) IF
  76.         ! AND
  77.         stammf_ableit(U,Nach,U_Strich) AND 
  78.         stammf_ableit(V,Nach,V_Strich).        
  79.     stammf_ableit(div(U,V),Nach,div(minus(mal(U_Strich,V),
  80.                   mal(U,V_Strich)), mal(V,V))) IF
  81.         ! AND
  82.         stammf_ableit(U,Nach,U_Strich) AND 
  83.         stammf_ableit(V,Nach,V_Strich).                
  84.  
  85.     /******************************/    
  86.     /*      Fuer Integration      */
  87.     /******************************/
  88.  
  89.     stammf_ableit(mal(nconst(X),U),Nach,mal(nconst(X),U_Strich)) IF
  90.         ! AND stammf_ableit(U,Nach,U_Strich).            
  91.     stammf_ableit(mal(nconst(X),U),Nach,mal(U_Strich,nconst(X))) IF
  92.         ! AND stammf_ableit(U,Nach,U_Strich).                
  93.     stammf_ableit(mal(const(X),U),Nach,mal(const(X),U_Strich)) IF
  94.         ! AND stammf_ableit(U,Nach,U_Strich).            
  95.     stammf_ableit(mal(const(X),U),Nach,mal(U_Strich,const(X))) IF
  96.         ! AND stammf_ableit(U,Nach,U_Strich).                    
  97.     stammf_ableit(div(npot(var(X),nconst(2)),nconst(2)),var(X),var(X)) IF !.   
  98.  
  99.     /* natuerliche Potenzen */
  100.     stammf_ableit(npot(Arg,nconst(1)),Nach,Arg_Abl) 
  101.         IF FREE(Arg_Abl) AND ! AND stammf_ableit(Arg,Nach,Arg_Abl).
  102.     stammf_ableit(npot(Arg,nconst(X)),Nach,
  103.                   mal(Arg_Abl,mal(nconst(X),npot(Arg,nconst(X_minus_1))))) IF
  104.          ! AND X_minus_1 = X - 1 AND stammf_ableit(Arg,Nach,Arg_Abl).
  105.     stammf_ableit(npot(Arg,X),Nach,
  106.            mal(Arg_Abl,mal(X,npot(Arg,minus(X,nconst(1)))))) IF
  107.          ! AND stammf_ableit(Arg,Nach,Arg_Abl).
  108.     stammf_ableit(div(npot(var(X),plus(Exp,nconst(1))),Exp),var(X),
  109.                    npot(var(X),Exp)) IF !.
  110.  
  111.     /* Ableitung von Funktionen ---> innere mal aeussere Ableitung */
  112.     stammf_ableit(funk(sqr,Arg),Nach,mal(mal(nconst(2),ArgAbl),Arg)) IF 
  113.         ! AND stammf_ableit(Arg,Nach,ArgAbl).
  114.     stammf_ableit(funk(sqrt,Arg),Nach,
  115.                   mal(ArgAbl,div(nconst(0.5),funk(sqrt,Arg)))) IF 
  116.         ! AND stammf_ableit(Arg,Nach,ArgAbl).
  117.     stammf_ableit(funk(exp,Arg),Nach,mal(Arg_Abl,funk(exp,Arg))) IF
  118.         ! AND stammf_ableit(Arg,Nach,Arg_Abl).
  119.     stammf_ableit(funk(sin,Arg),Nach,mal(Arg_Abl,funk(cos,Arg))) IF
  120.         ! AND stammf_ableit(Arg,Nach,Arg_Abl).    
  121.     stammf_ableit(funk(cos,Arg),Nach,mal(Arg_Abl,mal(nconst(-1),
  122.                   funk(sin,Arg)))) IF
  123.         ! AND stammf_ableit(Arg,Nach,Arg_Abl).
  124.     stammf_ableit(funk(ln,Arg),Nach,mal(Arg_Abl,div(nconst(1),Arg))) IF
  125.         ! AND stammf_ableit(Arg,Nach,Arg_Abl).
  126.  
  127.     /******************************/
  128.     /* Und wieder die Integration */
  129.     /******************************/
  130.     stammf_ableit(mal(nconst(-1),div(funk(cos,Arg),ArgAbl)),
  131.                                          Nach,funk(sin,Arg)) IF 
  132.         stammf_ableit(Arg,Nach,ArgAbl) AND !.        
  133.     stammf_ableit(div(funk(sin,Arg),ArgAbl),Nach,funk(cos,Arg)) IF 
  134.         stammf_ableit(Arg,Nach,ArgAbl) AND !.        
  135.     stammf_ableit(div(funk(exp,Arg),ArgAbl),Nach,funk(exp,Arg)) IF 
  136.         stammf_ableit(Arg,Nach,ArgAbl) AND !.        
  137.     stammf_ableit(div(npot(Arg,nconst(1.5)),mal(nconst(2),ArgAbl)),Nach,
  138.                                                           funk(sqrt,Arg)) IF 
  139.         stammf_ableit(Arg,Nach,ArgAbl) AND !.         
  140.     stammf_ableit(div(npot(Arg,nconst(3)),mal(nconst(3),ArgAbl)),Nach,
  141.                                                            funk(sqr,Arg)) IF 
  142.         stammf_ableit(Arg,Nach,ArgAbl) AND !.        
  143.     stammf_ableit(mal(nconst(X),div(funk(ln,Arg),ArgAbl)),Nach,
  144.                                                       div(nconst(X),Arg)) IF 
  145.         stammf_ableit(Arg,Nach,ArgAbl) AND !.             
  146.     stammf_ableit(mal(const(X),div(funk(ln,Arg),ArgAbl)),Nach,
  147.                   div(const(X),Arg)) IF 
  148.         stammf_ableit(Arg,Nach,ArgAbl) AND !.                 
  149.     
  150.     /****** PARTIELLE INTEGRATION ******/    
  151.     stammf_ableit(Res,Nach,mal(A,B)) IF part_I(mal(A,B),Nach,Res) AND !.
  152.     
  153.     part_I(mal(U,V_Strich),Nach,minus(mal(U,V),I)) IF
  154.         stammf_ableit(V,Nach,V_Strich) AND stammf_ableit(U,Nach,U_Strich) AND
  155.         vereinfache(mal(V,U_Strich),Res1) AND stammf_ableit(I,Nach,Res1) AND !.
  156.     part_I(mal(V_Strich,U),Nach,minus(mal(U,V),I)) IF
  157.         stammf_ableit(V,Nach,V_Strich) AND stammf_ableit(U,Nach,U_Strich) AND
  158.         vereinfache(mal(V,U_Strich),Res1) AND stammf_ableit(I,Nach,Res1) AND !.
  159.         
  160.  
  161.  
  162.  
  163. include "PARSER.PRO"  
  164.       
  165.       
  166. /****************************************************************************/
  167. /**                        Das Hauptprogramm                               **/
  168. /****************************************************************************/
  169.  
  170. predicates
  171.     ableite(STRING,TokenListe,STRING)
  172.     integ(STRING,TokenListe,STRING)
  173.     start
  174.     start2
  175.     option(CHAR)
  176.     
  177. GOAL START.
  178.     
  179. clauses
  180.    ableite(FunkStr,VarListe,Nach) :- 
  181.       nl, nl, parse(FunkStr,VarListe,FL), vereinfache(FL,FLV), 
  182.       stammf_ableit(FLV,var(Nach),AblL),  vereinfache(AblL,AblV), 
  183.       parse(Ableitung,[],AblV), nl, nl,
  184.       write("  Ableitung: "), write(Ableitung),nl,
  185.       write(">> Taste druecken <<"),readchar(_),
  186.       nl,nl,nl.
  187.    /* Database abfragen */
  188.    integ(FunkStr,VarListe,Nach) :- 
  189.       nl,nl, parse(FunkStr,VarListe,FL), vereinfache(FL,FLV),
  190.       bekanntesIntegral(SF,var(Nach),FLV), !,
  191.       parse(Stammf,[],SF),
  192.       write("   Stammfunktion: "), write(Stammf),nl,
  193.       write(">> Taste druecken <<"),readchar(_),
  194.       nl,nl,nl.   
  195.    /* Ansonsten Database ergaenzen */
  196.    integ(FunkStr,VarListe,Nach) :- 
  197.       nl,nl, parse(FunkStr,VarListe,FL), vereinfache(FL,FLV),
  198.       stammf_ableit(SF,var(Nach),FLV),
  199.       vereinfache(SF,SFV), !, assertz(bekanntesIntegral(SFV,var(Nach),FLV)),
  200.       !,
  201.       parse(Stammf,[],SFV),
  202.       write("   Stammfunktion: "), write(Stammf),nl,
  203.       write(">> Taste druecken <<"),readchar(_),
  204.       nl,nl,nl.   
  205.    
  206.    
  207.    start :-
  208.      consult("INTEGRAL.TAB"), start2.
  209.    
  210.    start2 :-
  211.       makewindow(1,7,112,"NEWTON - Integration und Differenzierung",0,0,25,80),
  212.       clearwindow, nl, nl ,nl,
  213.       write("  A)bleiten   I)ntegrieren   V)ereinfachen   Q)uit"), nl, nl, 
  214.       write("      Ihre Wahl : "), readchar(Wahl), nl, nl, 
  215.       option(Wahl), !, start2.
  216.    start2 :-
  217.       write("## FEHLER: Integraltabelle in Datei INTEGRAL.TAB fehlt ! ##").
  218.       
  219.    option('q') :- save("INTEGRAL.TAB"), exit.        
  220.    option('Q') :- option('q'), !.
  221.    
  222.    option('a') :- 
  223.       write("  Ihr Funktionsterm ? : "), readln(Str), nl,
  224.       write("  Die gewuenschten Variablen ? (Durch Leerzeichen trennen) :"),
  225.       readln(VarStr), nl, string_tokenliste(VarStr,VarL),
  226.       write("  Nach welcher Variable ableiten ? : "), readln(DieVar), nl,
  227.       ableite(Str,VarL,DieVar) AND !.
  228.    option('A') :- option('a') AND !.
  229.    option('i') :- 
  230.       write("  Ihr Funktionsterm ? : "), readln(Str), nl,
  231.       write("  Die gewuenschten Variablen ? (Durch Leerzeichen trennen) :"),
  232.       readln(VarStr), nl, string_tokenliste(VarStr,VarL),
  233.       write("  Nach welcher Variable integrieren ? : "), readln(DieVar), nl,
  234.       integ(Str,VarL,DieVar) AND !.
  235.    option('I') :- option('i') AND !.
  236.    option('v') :- 
  237.       write("  Ihr Funktionsterm ? : "), readln(Str), nl,
  238.       parse(Str,[],Term), vereinfache(Term,Term2), parse(NStr,[],Term2),
  239.       write("  Vereinfachter Term : "), write(NStr), nl, nl,
  240.       write(">> Taste druecken <<"), readchar(_) AND !.
  241.    option('V') :- option('v') AND !.   
  242.        
  243.    option(_) :- 
  244.        write(">>>> Berechnung nicht moeglich oder Fehler bei Eingabe <<<<"),
  245.        nl, write(">> Taste druecken <<"), readchar(_)
  246.        AND !.   
  247.        
  248.