home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / prolog / library / diverses / raetsel.pro < prev    next >
Text File  |  1991-10-19  |  12KB  |  290 lines
  1. /* Das folgende PROLOG-Programm ist entnommen aus: Bundeswettbewerb */
  2. /* Informatik, Aufgaben und Lösungen, Band 3 , S. 47 ff. Die        */
  3. /* zugrundeliegende Aufgabe (s. Programmtext) wurde in der zweiten  */
  4. /* Runde des 6. Wettbewerbs gestellt.                               */
  5. /* Neben dieser Lösung (in MPROLOG) ist noch eine in ELAN           */
  6. /* abgedruckt, die ich z.T. bereits nach PASCAL portiert habe.      */
  7. /* Problem: Wer kennt MPROLOG und kann das untenstehende Programm   */
  8. /* testen?                                                          */
  9. /* Testdaten:   kiha  :  f   =  ige      1230    :   5  =  246      */
  10. /*                 :     +        -         :        +       -      */
  11. /*                ka  + fg   =   eg        10    +  54  =   64      */
  12. /*              ===================      =====================      */
  13. /*              kih   + fb   =  kci       123    +  59  =  182      */
  14. /*                                                                  */
  15. /* Infos bitte an: Rainer Fischer, Quellenstr. 12, Tel. 07183/8660  */
  16.  
  17. /* RAETSEL.PRO  */
  18.  
  19. module mengen.
  20.  
  21. body.
  22.  
  23. element (X, [X|_])
  24. element (X, [_|R]) :- element (X,R) .
  25.  
  26. paare ([], [], []) .
  27. paare ([K1|R1], [K2|R2], [(K1, K2)|R3]) :- paare (R1, R2, R3) .
  28.  
  29. teilmenge (O, _, [])      :- ! .
  30. teilmenge (N, [K|R], [K|R1] :- N > O, N1 is N-1, teilmenge (N1, R, R1) .
  31. teilmenge (N, [K|R], T)    :- teilmenge (N, R, T) .
  32.  
  33. append ([], L, L) .
  34. append ([K|R1], L, [K|R2]) :- append (R1, L, R2) .
  35.  
  36. anzahl_elemente ([], O) .
  37. anzahl_elemente ([K|R], A) :- anzahl_elemente (R, RA), A is 1+RA .
  38.  
  39. restmenge (T, [], []) .
  40. restmenge (T, [K|R], REST) :- element (K, T), !, restmenge (T,R,REST) .
  41. restmenge (T, [K|R, [K|REST]) :- !, restmenge (T, R, REST) .
  42.  
  43. endmod /* mengen */
  44.  
  45. module eingabe.
  46. /*****************************************************************/
  47. /* Dieses Modul ermöglicht die Eingabe der Symbolmatrix in der   */
  48. /* folgenden Form:                                               */
  49. /*       XXXX O XXXX = XXXX       ZEILE_1                        */
  50. /*          O      O      O       O-ZEILE                        */
  51. /*       XXXX O XXXX = XXXX       ZEILE_2                        */
  52. /*       ==================                                      */
  53. /*       XXXX O XXXX = XXXX       ZEILE_3                        */
  54. /* X steht für ein Ziffernsymbol [a,b,c,d,e,f,g,h,i,k] oder      */
  55. /* ein Leerzeichen für fehlende Stellen am Anfang einer Zahl.    */
  56. /* O steht für ein Operatorsymbol [+,-,*,:].                     */
  57. /* Die Eingaben werden zeichenweise auf syntaktische Richtig-    */
  58. /* keit überprüft. Fehlerhafte Eingaben werden nicht angenom-    */
  59. /* men. Der Benutzer muß in diesem Fall die Eingabe solange      */
  60. /* wiederholen, bis er eines der erwarteten Zeichen eingegeben   */
  61. /* hat.                                                          */
  62. /*                                                               */
  63. /* Datenstrukturen:                                              */
  64. /*     Symbolmatrix (Zeile, Operatorzeile, Zeile, Zeile)         */
  65. /*     Zeile        (Zahl, Operator, Zahl, Zahl)                 */
  66. /*     Operatorzeile(Operator, Operator, Operator)               */
  67. /*     Zahl         (Z-Symbol, Z-Symbol, Z-Symbol, Z-Symbol)     */
  68. /*****************************************************************/
  69.  
  70. body.
  71.  
  72. symbolmatrix_angefordert :-
  73.   write ('Geben Sie jetzt bitte die Symbolmatrix '),
  74.   write (' in der folgenden Form ein:'), nl,
  75.   write ('   xxxx O xxxx = xxxx'), nl,
  76.   write ('      O      O      O'), nl,
  77.   write ('   xxxx O xxxx = xxxx'), nl,
  78.   write ('   =================='), nl,
  79.   write ('   xxxx O xxxx = xxxx'), nl, nl,
  80.   write ('x ist ein Element aus [a,b,c,d,e,f,g,h,i,k]'),
  81.   write (' oder ein Leerzeichen für'), nl,
  82.   write ('fehlende Stellen am Anfang einer Zahl.'), nl, nl,
  83.   write ('O ist ein Element aus [+-*:].'), nl ,nl,
  84.   write ('Bitte:'), nl.
  85.  
  86. gelesen (sybolmatrix, (ZEILE_1, O_ZEILE, ZEILE_2, ZEILE_3) :-
  87.      symbolmatrix_angefordert,
  88.      gelesen (zeile, ZEILE_1),
  89.      gelesen (o_zeile, O_ZEILE),
  90.      gelesen (zeile, ZEILE_2),
  91.      write (==================), nl,
  92.      gelesen (zeile, ZEILE_3) .
  93. gelesen (zeile, (ZAHL_1, OPERATOR, ZAHL_2, ZAHL_3)) :-
  94.      gelesen (zahl, ZAHL_1, display_string(' '),
  95.      gelesen (o_symbol, OPERATOR), display_string(' '),
  96.      gelesen (zahl, ZAHL_2, display_string (' = '),
  97.      gelesen (zahl, ZAHL_3), nl.
  98. gelesen (o_zeile, (O1,O2,O3)) :-
  99.      display_string ('   '), gelesen (o_symbol, O1),
  100.      display_string ('     '), gelesen (o_symbol, O2),
  101.      display_string ('     '), gelesen (o_symbol, O3), nl .
  102. gelesen (zahl, (Z1, Z2, Z3, Z4)) :-
  103.      gelesen (xb_symbol, Z1),
  104.      ((Z1=' ', gelesen (xb_symbol, Z2), (/); gelsen (x_symbol, Z2))),
  105.      ((Z2=' ', gelesen (xb_symbol, Z3), (/); gelsen (x_symbol, Z3))),
  106.      gelesen (x_symbol, Z4) .
  107. gelesen (o_symbol, O)  :- eingegeben ([+,-,*,:],O) .
  108. gelesen (x_symbol, X)  :- eingegeben ([a,b,c,d,e,f,g,h,i,k], X) .
  109. gelesen (xb_symbol, XB)  :- eingegeben ([' ',a,b,c,d,e,f,g,h,i,k], XB) .
  110.  
  111. transponiert (SM, (Z1, OZ, Z2, Z3)) :-
  112.      spalte (1,SM,Z1), spalte (2,SM,Z2), spalte (3,SM,Z3),
  113.      spalte (o,SM,OZ) .
  114.  
  115. belegung (matrix, PAARE, (SZ1,OZ,SZ2,SZ3), (WZ1,OZ,WZ2,WZ3)) :-
  116.      belegung (zeile, PAARE, SZ1, WZ1),
  117.      belegung (zeile, PAARE, SZ2, WZ2),
  118.      belegung (zeile, PAARE, SZ3, WZ3) .
  119. belegung (zeile, PAARE, (Z1,O,Z2,Z3), (W1,O,W2,W3)) :-
  120.      belegung (zahl, PAARE, S1, W1),
  121.      belegung (zahl, PAARE, S2, W2),
  122.      belegung (zahl, PAARE, S3, W3) .
  123. belegung (zahl, PAARE, (S1,S2,S3,Z4),W) :-
  124.      belegung (zeile, PAARE, SZ3, WZ3) .
  125.      element (((Z1,W1), PAARE), element ((Z2,W2), PAARE),
  126.      element ((Z3,W3), PAARE), element ((Z4,W4), PAARE),
  127.      W is W4+10*W3+100*W2+1000*W1 .
  128.  
  129. erfüllt (matrix, (ZEILE_1, O_ZEILE, ZEILE_2, ZEILE_3)) :-
  130.      erfüllt (zeile,ZEILE_1), erfüllt(zeile,ZEILE_2),
  131.              erfüllt (zeile,ZEILE_3) .
  132. erfüllt (zeile, (Z1, (+), Z2, Z3)) :-           Z3 =:= Z1  +  Z2 .
  133. erfüllt (zeile, (Z1, (-), Z2, Z3)) :-  Z2<=Z1,  Z3 =:= Z1  -  Z2 .
  134. erfüllt (zeile, (Z1, (*), Z2, Z3)) :-           Z3 =:= Z1  *  Z2 .
  135. erfüllt (zeile, (Z1, (:), Z2, Z3)) :-  Z2>0,    Z3 =:= Z1  :  Z2 .
  136.  
  137. spalte (1, ((Z1,_,_,_), (O,_,_), (Z2,_,_,_),Z3,_,_,_), (Z1,O,Z2,Z3)) .
  138. spalte (2, ((_,_,Z1,_), (_,O,_), (_,_,Z2,_),_,_,Z3,_), (Z1,O,Z2,Z3)) .
  139. spalte (3, ((_,_,_,Z1), (_,_,O), (_,_,_,Z2),_,_,_,Z3), (Z1,O,Z2,Z3)) .
  140. spalte (o, ((_,O1,_,_),_, (_,O2,_,_),_,O3,_,_), (O1,O2,O3)) .
  141.  
  142. eingegeben (ZEICHENVORRAT,ZEICHEN) :-
  143.  repeat, current_key (KEY), accept_key,convert_char (ZEICHEN, KEY),
  144.          element (ZEICHEN, ZEICHENVORRAT), !,
  145.  display_string (ZEICHEN) .
  146.  
  147. endmod /* eingabe */ .
  148.  
  149. module primitiv_lösung.
  150.  
  151. /****************************************************************/
  152. /* Dieses Modul ermittelt die Lösung durch Ausprobieren aller    */
  153. /* Permutationen von [0,1,2,3,4,5,6,7,8,9].                      */
  154. /* Im Extremfall (unlösbares System) dauert es Stunden, bis eine */
  155. /* Ausgabe erfolgt.                                              */
  156. /*****************************************************************/
  157.  
  158. body.
  159.  
  160. primitiv (SYMBOLMATRIX, WERTEMATRIX) :-
  161.   permutation ([0,1,2,3,4,5,6,7,8,9], PERMUTATION),
  162.   paare ([a,b,c,d,e,f,g,h,i,k], PERMUTATION, PAARE),
  163.   belegung (matrix, [(' ',O)|PAARE], SYMBOLMATRIX, WERTEMATRIX) .
  164.   erfüllt (matrix (WERTEMATRIX),
  165.   transponiert (WERTEMATRIX, TMATRIX), erfüllt (matrix, TMATRIX) .
  166.  
  167. permutation ([], []) .
  168. permutation ([K|R], P) :- permutation (R,P1), verteilung (K,P1,P).
  169.  
  170. verteilung (K, P1, [K|P1]) .
  171. verteilung (K, [K1|R1], [K1|R2]) :- verteilung (K, R1, R2) .
  172.  
  173. endmod /* primitiv_lösung */ .
  174.  
  175. module zeilenpermutation.
  176.  
  177. /*****************************************************************/
  178. /* Dieses Modul geht zeilenweise vor und permutiert zunächst nur */
  179. /* die Belegung der Buchstabensymbole mit Ziffern für eine Zeile.*/
  180. /* Dabei werden viele unlösbare Systeme frühzeitig entdeckt.     */
  181. /* Dennoch kann es über eine Stunde dauern, bis es zu einer      */
  182. /* Ausgabe kommt. Das Beispiel wurde in etwa 34 Minuten gelöst.  */
  183. /*****************************************************************/
  184.  
  185. body.
  186.  
  187. neue_symbole (zeile, ALTE, (Z1,O,Z2,Z3), NEUE) :_
  188.   neue_symbole (zahl, ALTE, Z1, N1),
  189.   neue_symbole (zahl, N1, Z2, N2),
  190.   neue_symbole (zahl, N2, Z3, NEUE) .
  191. neue_symbole (zahl, ALTE, (A,B,C,D), NEUE) :-
  192.   neues_symbol (A, ALTE, NA), neues_symbol (B, NA, NB),
  193.   neues_symbol (C. NB, NC), neues_symbol (D, NC, NEUE) .
  194.  
  195. neues_symbol (X. ALTE, ALTE)   :- element (X, ALTE), ! .
  196. neues_symbol (' ',ALTE,ALTE)   :- ! .
  197. neues_symbol (X, ALTE, [X|ALTE] .
  198.  
  199. permutation (WERTE, ALTE, ZEILE, PERMUTATION, RESTWERTE, NEUE,
  200.              NEU) :-
  201.       neue_symbole (zeile, ALTE, ZEILE, NEUE),
  202.       restmenge (ALTE, NEUE, NEU),
  203.       anzahl_elemente (NEU, ANZ),
  204.       teilmenge (ANZ, WERTE, T),
  205.       permutation (T, PERMUTATION),
  206.       restmenge (T, WERTE, RESTWERTE) .
  207.  
  208. zpermut ((Z1, OZ, Z2, Z3), (W1, OZ, W2, W3)) :-
  209.       permutation ([0,1,2,3,4,5,6,7,8,9], [],Z1,P1,RW1,ALT1,NEU1),
  210.         paare (NEU1, P1, PAARE1);
  211.         belegung (zeile, [(' ',O)|PAARE1], Z1, W1),
  212.         erfüllt (zeile, W1) .
  213.       permutation (RW1, ALT1, Z2, P2, RW2, ALT2, NEU2),
  214.         paare (NEU2, P2, TPAARE2),
  215.         append (PAARE1, TPAARE2, PAARE2),
  216.         belegung (zeile, [(' ',O|PAARE2], Z2, W2),
  217.         erfüllt (zeile, W2) .
  218.       permutation (RW2, ALT2, Z3, P3, RW3, ALT3, NEU3),
  219.         paare (NEU3, P3, TPAARE3),
  220.         append (PAARE2, TPAARE3, PAARE3),
  221.         belegung (zeile, [(' ',O|PAARE3], Z3, W3),
  222.         erfüllt (zeile, W3),
  223.       transponiert ((W1, OZ, W2, W3), TMATRIX),
  224.         erfüllt (matrix, TMATRIX) .
  225.  
  226. endmod /* zeilenpermutation */ .
  227.  
  228. module raetsel.
  229.  
  230. /******************************************************************/
  231. /* Dieses Modul ermittelt die Lösung nach dem angegebenen Verfah- */
  232. /* ren und gibt sie dann aus. Außerdem wird die verbrauchte Zeit  */
  233. /* ermittelt und ausgegeben.                                      */
  234. /******************************************************************/
  235.  
  236. body.
  237.  
  238. lösung (VERFAHREN) :-
  239.   set_state (evaluation_limit, 8000000),
  240.   gelesen (symbolmatrix, SM), nl,
  241.   write ('Danke, ich mache mich jetzt an die Arbeit nach dem '),
  242.    write ('$"'), write (VERFAHREN), write ('$"-Verfahren. '), nl,
  243.   write ('Das kann '), write_zeit (VERFAHREN), write (' dauern.'),
  244.   nl,
  245.   write (Haben Sie bitte Geduld!'), nl, nl,
  246.   structure (LOESUNG, list, [VERFAHREN, SM, WERTEMATRIX]),
  247.     state (system_time, T1),
  248.   ((LOESUNG, ausgegeben (matrix, WERTEMATRIX);
  249.     write ('Es gibt keine Lösung.'), nl)), nl,
  250.    state (system_time, T2), write_dauer (T1, T2), nl.
  251.  
  252. write_zeit (primitiv) :- write ('einige Stunden') .
  253. write_zeit (zpermut)  :- write ('wer weiß wie lange') .
  254.  
  255. write_dauer (T1, T2) :-
  256.  H1 is T1 div 10000, M1 is T1 mod 10000 div 100, S1 is T1 mod 100,
  257.  H2 is T2 div 10000, M2 is T2 mod 10000 div 100, S2 is T2 mod 100,
  258.  ((S2>=S1, S is S2-S1,  US is 0; S2   <S1, S is S2-S1+60, US is -1)),
  259.  ((M2+US>=M1, M is M2+US-M1,  UM is 0; M2+US<M1, M is M2+Us+60-M1,
  260.    UM is -1)),
  261.  H is H2+UM-H1, write ('Zeitbedarf: '),
  262.   write (H), ((H=1, write (' Stunde '),(/); write (' Stunden '))),
  263.   write (M), ((M=1, write (' Minute '),(/); write (' Minuten '))),
  264.   write (S), ((S=1, write (' Sekunde '),(/);write (` Sekunden'))),
  265.   nl .
  266.  
  267. ausgeben (matrix, (ZEILE_1, O_ZEILE, ZEILE_2, ZEILE_3)) :-
  268.  nl, write ('Es gibt die folgende Lösung:'), nl, nl,
  269.  ausgegeben (zeile, ZEILE_1),
  270.  ausgegeben (o_zeile, O_ZEILE),
  271.  ausgegeben (zeile, ZEILE_2),
  272.  write (==================), nl,
  273.  ausgegeben (zeile, ZEILE3) .
  274. ausgegeben (zeile, (ZAHL1, OPERATOR, ZAHL2, ZAHL3)) :_
  275.  ausgegeben (zahl, ZAHL1), write (' '),
  276.  write (OPERATOR), write (' '),
  277.  ausgegeben (zahl, ZAHL2), write (' '),
  278.  ausgegeben (zahl, ZAHL3), nl.
  279. ausgegeben (o_zeile, (O1, O2, O3)) :-
  280.  write ('   '),   write (O1),
  281.  write ('     '), write (O2),
  282.  write ('     '), write (=3), nl.
  283. ausgegeben (zahl, Z) :_
  284.  ((Z >=1000,            (/);
  285.   Z>=100 , write (' '), (/);
  286.   Z>=10,   write (' '), (/);
  287.   Z< 10,   write ('  '),(/))), write (Z) .
  288.  
  289. endmod /* raetsel */  .
  290.