From: Marko Kreuzer
Subject: Bitte um Hilfe!!
Date: Thu, 09 Sep 1999 00:00:00 +0000
Message-ID: <37D7D4F3.CDCE6459@dive.informatik.fh-schmalkalden.de> --------------91C81915070BAD38D1088661
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: 8bit
Hallo zusammen !!!
Im Rahmen eines KI-Projektes an der Fachhochschule Schmalkalden sollen
wir folgende Aufgabenstellung realisieren.
Entwicklung eines Prolog-Interpreters mit Hilfe der Programmiersprache
Golden Common LISP.
Der Interpreter kann bisher leider nur normale Anfragen l�sen.
Bei folgenden Problem sind wir h�ngengeblieben.
Bsp.:
Datenbasis:
(vater hugo lars)
(mutter mary peter)
Anfrage:
(anfrage '(not vater hugo lars))
gew�nschtes Ergebnis:
�berpr�fung der Datenbasis auf Vorkommen der Anfrage.
Wenn Anfrage gefunden werden konnte, soll die Funktion "nil" liefern.
Kann die Anfrage nicht gel�st werden, d.h die Datenbasis enth�lt keine
entsprechenden Daten soll die L�sung "T" sein.
Wir ben�tigen unbedingt eine L�sung(ansatz) f�r die Umsetzung des
"not"-Problems.
Sind f�r jeden L�sungshinweis dankbar.
Im voraus vielen Dank
Anlage:
; PROLOG-Interpreter
; ===================
; allgem. Struktur einer Variable (? <name> <level>)
(defun var-p (s)
(and (listp s)
(equal (car s) '?)))
(defun var-name (s)
(if (var-p s) (car(cdr s)) (print "Fehler !!!")))
; Variablenliste zum Testen
(setq VL '(((? x)3)((? y)5)((? z)7)*end*))
(setq VL2 '(((? x) 3)
((? y)(? x))
((? z)(? y))
((? u) 7)end*))
(defun var-assoc (v l)
(cond ((null l)nil)
((equal l '(*end*))nil)
((equal v (car(car l)))(car l))
(t(var-assoc v (cdr l)))))
; Aufruf durch (ultimate-assoc '(? z) vl2 vl2)
;(defun ultimate-assoc (v l l1)
; (cond ((null l)nil)
; ((equal l '(*end*))nil)
; ((equal v (caar l))
; (if (var-p (cadar l))
; (ultimate-assoc v l1 l1)
; (cadar l)))
; (t(ultimate-assoc v (cdr l) l1))))
(defun ultimate-assoc (v l)
(cond ((var-p v) (let((binding (var-assoc v l)))
(if (null binding) v (ultimate-assoc (cadr binding)
l))))
(t v)))
(defun unify (x y vl)
(let ((x1 (ultimate-assoc x vl))
(y1 (ultimate-assoc y vl)))
(cond
((equal x1 y1) vl)
((var-p x1)(cons (list x1 y1) vl))
((var-p y1)(cons (list y1 x1) vl))
((or (atom x1)(atom y1)) nil)
(t (let ((car-erg (unify (car x1)(car y1) vl)))
(if (null car-erg)
nil
(unify (cdr x1)(cdr y1) car-erg)))))))
;DATENBASIS
;====================================================
; kleines Prolog-Programm zum Testen (PrologProgram 1)
(setq pp1 '(((vater herbert mark))
((vater gustav herbert))
((mutter mary herbert))
((mutter karin mark))
((mutter marie karin))
((vater otto karin))
((mutter karin mark2))
((vater herbert mark2))
((elternt (? x) (? y)) (vater (? x) (? y)))
((elternt (? x) (? y)) (mutter (? x) (? y)))
((opa (? x) (? y)) (vater (? x) (? z))
(elternt (? z) (? y)))
((oma (? x) (? y)) (mutter (? x) (? z))
(elternt (? z) (? y)))
((geschw (? x) (? y)) (vater (? v) (? x))
(mutter (? u) (? x))
(vater (? v) (? y))
(mutter (? u) (? y)))
))
; (? x) -> (? x <level>)
(defun rename-vars (s l)
(cond ((null s)nil)
((atom s)s)
((var-p s)(list '? (cadr s) l))
(t(cons (rename-vars (car s) l)(rename-vars (cdr s) l)))))
; prove ... Konjunktion von Zielen / try-each ... or-Funktion
(defun prove(goals bl level)
(cond ((null goals)(print-top-bindings bl bl)
(cond ((y-or-n-p "Weitere L�sungen ? ")nil)
(t t)))
(t(try-each (car goals) *pp* (cdr goals) bl level))))
(defun try-each(goal db-left goals-left bl level)
(cond ((null db-left)nil)
(t (let ((klausel (rename-vars (car db-left) level)))
(let ((new-bl (unify goal (car klausel) bl)))
(cond ((null new-bl)(try-each goal (cdr db-left)
goals-left bl level))
((prove (append (cdr klausel) goals-left) new-bl (+ level 1)))
(t (try-each goal (cdr db-left) goals-left
bl level))))))))
; Benutzeranfragen bekommen Level 0
(defun anfrage(goal)
(let ((option (car goal)))
(cond ((equal option 'normal) (prove (rename-vars (list (cdr
goal))0)'(*end*)1))
((equal option 'not) (print "not"))
(T (print "FEHLERHAFTE EINGABE")))))
; PP1 auf *pp* kopieren
(setq *pp* pp1)
; Ausgabe leserlicher machen
(defun print-top-bindings(bl vbl)
(cond ((null bl)nil)
((equal bl '(*end*))nil)
((equal (caddr (caar bl))0)
(print (caar bl))(princ " = ")(prin1 (ultimate-assoc
(cadar bl) vbl))(terpri)
(print-top-bindings (cdr bl) vbl))
(t(print-top-bindings (cdr bl) vbl))))
; Benutzerabfrage
(defun y-or-n-p (message)
(print message)
(let ((antwort (read)))
(cond ((equal antwort 'y)t)
((equal antwort 'n)nil)
((equal antwort 'j)t)
(t(y-or-n-p message)))))
--------------91C81915070BAD38D1088661
Content-Type: text/html; charset=us-ascii
Content-Transfer-Encoding: 7bit
<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<html>
Hallo zusammen !!!
<p>Im Rahmen eines KI-Projektes an der Fachhochschule Schmalkalden sollen
wir folgende Aufgabenstellung realisieren.
<p>Entwicklung eines Prolog-Interpreters mit Hilfe der Programmiersprache
Golden Common LISP.
<br>Der Interpreter kann bisher leider nur normale Anfragen lösen.
<br>Bei folgenden Problem sind wir hängengeblieben.
<p>Bsp.:
<p>Datenbasis:
<p>(vater hugo lars)
<br>(mutter mary peter)
<p>Anfrage:
<p>(anfrage '(not vater hugo lars))
<p>gewünschtes Ergebnis:
<p>Überprüfung der Datenbasis auf Vorkommen der Anfrage.
<br>Wenn Anfrage gefunden werden konnte, soll die Funktion "nil" liefern.
<br>Kann die Anfrage nicht gelöst werden, d.h die Datenbasis enthält
keine
<br>entsprechenden Daten soll die Lösung "T" sein.
<p>Wir benötigen unbedingt eine Lösung(ansatz) für die Umsetzung
des "not"-Problems.
<br>
<p>Sind für jeden Lösungshinweis dankbar.
<br>Im voraus vielen Dank
<p>Anlage:
<p><tt>; PROLOG-Interpreter</tt>
<br><tt>; ===================</tt>
<br><tt>; allgem. Struktur einer Variable (? <name> <level>)</tt><tt></tt>
<p><tt>(defun var-p (s)</tt>
<br><tt> (and (listp s)</tt>
<br><tt> (equal (car s)
'?)))</tt><tt></tt>
<p><tt>(defun var-name (s)</tt>
<br><tt> (if (var-p s) (car(cdr s)) (print "Fehler !!!")))</tt><tt></tt>
<p><tt>; Variablenliste zum Testen</tt>
<br><tt>(setq VL '(((? x)3)((? y)5)((? z)7)*end*))</tt>
<br><tt>(setq VL2 '(((? x) 3)</tt>
<br><tt>
((? y)(? x))</tt>
<br><tt>
((? z)(? y))</tt>
<br><tt>
((? u) 7)end*))</tt><tt></tt>
<p><tt>(defun var-assoc (v l)</tt>
<br><tt> (cond ((null l)nil)</tt>
<br><tt> ((equal
l '(*end*))nil)</tt>
<br><tt> ((equal
v (car(car l)))(car l))</tt>
<br><tt> (t(var-assoc
v (cdr l)))))</tt><tt></tt>
<p><tt>; Aufruf durch (ultimate-assoc '(? z) vl2 vl2)</tt>
<br><tt>;(defun ultimate-assoc (v l l1)</tt>
<br><tt>; (cond ((null l)nil)</tt>
<br><tt>; ((equal
l '(*end*))nil)</tt>
<br><tt>; ((equal
v (caar l))</tt>
<br><tt>;
(if (var-p (cadar l))</tt>
<br><tt>;
(ultimate-assoc v l1 l1)</tt>
<br><tt>;
(cadar l)))</tt>
<br><tt>; (t(ultimate-assoc
v (cdr l) l1))))</tt><tt></tt>
<p><tt>(defun ultimate-assoc (v l)</tt>
<br><tt> (cond ((var-p v) (let((binding (var-assoc v
l)))</tt>
<br><tt>
(if (null binding) v (ultimate-assoc (cadr binding) l))))</tt>
<br><tt> (t v)))</tt><tt></tt>
<p><tt>(defun unify (x y vl)</tt>
<br><tt> (let ((x1 (ultimate-assoc x vl))</tt>
<br><tt> (y1 (ultimate-assoc
y vl)))</tt>
<br><tt> (cond</tt>
<br><tt>
((equal x1 y1) vl)</tt>
<br><tt>
((var-p x1)(cons (list x1 y1) vl))</tt>
<br><tt>
((var-p y1)(cons (list y1 x1) vl))</tt>
<br><tt>
((or (atom x1)(atom y1)) nil)</tt>
<br><tt>
(t (let ((car-erg (unify (car x1)(car y1) vl)))</tt>
<br><tt>
(if (null car-erg)</tt>
<br><tt>
nil</tt>
<br><tt>
(unify (cdr x1)(cdr y1) car-erg)))))))</tt><tt></tt>
<p><tt>;DATENBASIS</tt>
<br><tt>;====================================================</tt>
<br><tt>; kleines Prolog-Programm zum Testen (PrologProgram 1)</tt>
<br><tt>(setq pp1 '(((vater herbert mark))</tt>
<br><tt> ((vater gustav herbert))</tt>
<br><tt> ((mutter mary herbert))</tt>
<br><tt> ((mutter karin mark))</tt>
<br><tt> ((mutter marie karin))</tt>
<br><tt> ((vater otto karin))</tt>
<br><tt> ((mutter karin mark2))</tt>
<br><tt> ((vater herbert mark2))</tt>
<br><tt> ((elternt (? x) (? y)) (vater (? x) (?
y)))</tt>
<br><tt> ((elternt (? x) (? y)) (mutter (? x) (?
y)))</tt>
<br><tt> ((opa (? x) (? y)) (vater (? x) (? z))</tt>
<br><tt>
(elternt (? z) (? y)))</tt>
<br><tt> ((oma (? x) (? y)) (mutter (? x) (? z))</tt>
<br><tt>
(elternt (? z) (? y)))</tt>
<br><tt> ((geschw (? x) (? y)) (vater (? v) (?
x))</tt>
<br><tt> (mutter
(? u) (? x))</tt>
<br><tt> (vater
(? v) (? y))</tt>
<br><tt> (mutter (? u) (? y)))</tt>
<br><tt> ))</tt><tt></tt>
<p><tt>; (? x) -> (? x <level>)</tt>
<br><tt>(defun rename-vars (s l)</tt>
<br><tt> (cond ((null s)nil)</tt>
<br><tt> ((atom s)s)</tt>
<br><tt> ((var-p
s)(list '? (cadr s) l))</tt>
<br><tt> (t(cons
(rename-vars (car s) l)(rename-vars (cdr s) l)))))</tt><tt></tt>
<p><tt>; prove ... Konjunktion von Zielen / try-each ... or-Funktion</tt>
<br><tt>(defun prove(goals bl level)</tt>
<br><tt> (cond ((null goals)(print-top-bindings bl bl)</tt>
<br><tt>
(cond ((y-or-n-p "Weitere Lösungen ? ")nil)</tt>
<br><tt>
(t t)))</tt>
<br><tt> (t(try-each (car
goals) *pp* (cdr goals) bl level))))</tt><tt></tt>
<p><tt>(defun try-each(goal db-left goals-left bl level)</tt>
<br><tt> (cond ((null db-left)nil)</tt>
<br><tt> (t (let ((klausel
(rename-vars (car db-left) level)))</tt>
<br><tt>
(let ((new-bl (unify goal (car klausel) bl)))</tt>
<br><tt>
(cond ((null new-bl)(try-each goal (cdr db-left) goals-left bl level))</tt>
<br><tt> ((prove (append (cdr klausel)
goals-left) new-bl (+ level 1)))</tt>
<br><tt>
(t (try-each goal (cdr db-left) goals-left bl level))))))))</tt><tt></tt>
<p><tt>; Benutzeranfragen bekommen Level 0</tt>
<br><tt>(defun anfrage(goal)</tt>
<br><tt> (let ((option (car goal)))</tt>
<br><tt> (cond ((equal option
'normal) (prove (rename-vars (list (cdr goal))0)'(*end*)1))</tt>
<br><tt>
((equal option 'not) (print "not"))</tt>
<br><tt> (T (print "FEHLERHAFTE EINGABE")))))</tt><tt></tt>
<p><tt>; PP1 auf *pp* kopieren</tt>
<br><tt>(setq *pp* pp1)</tt><tt></tt>
<p><tt>; Ausgabe leserlicher machen</tt>
<br><tt>(defun print-top-bindings(bl vbl)</tt>
<br><tt> (cond ((null bl)nil)</tt>
<br><tt> ((equal bl '(*end*))nil)</tt>
<br><tt> ((equal (caddr
(caar bl))0)</tt>
<br><tt>
(print (caar bl))(princ " = ")(prin1 (ultimate-assoc (cadar bl) vbl))(terpri)</tt>
<br><tt>
(print-top-bindings (cdr bl) vbl))</tt>
<br><tt> (t(print-top-bindings
(cdr bl) vbl))))</tt><tt></tt>
<p><tt>; Benutzerabfrage</tt>
<br><tt>(defun y-or-n-p (message)</tt>
<br><tt> (print message)</tt>
<br><tt> (let ((antwort (read)))</tt>
<br><tt> (cond ((equal antwort
'y)t)</tt>
<br><tt>
((equal antwort 'n)nil)</tt>
<br><tt>
((equal antwort 'j)t)</tt>
<br><tt>
(t(y-or-n-p message)))))</tt></html>
--------------91C81915070BAD38D1088661-- From: Thomas A. Russ
Subject: Re: Bitte um Hilfe!!
Date: Fri, 10 Sep 1999 00:00:00 +0000
Message-ID: <ymid7vqg13r.fsf@sevak.isi.edu> Marko Kreuzer <·············@dive.informatik.fh-schmalkalden.de> writes:
> Im Rahmen eines KI-Projektes an der Fachhochschule Schmalkalden sollen
> wir folgende Aufgabenstellung realisieren.
>
> Entwicklung eines Prolog-Interpreters mit Hilfe der Programmiersprache
> Golden Common LISP.
> Der Interpreter kann bisher leider nur normale Anfragen l�sen.
> Bei folgenden Problem sind wir h�ngengeblieben.
>
> Bsp.:
>
> Datenbasis:
>
> (vater hugo lars)
> (mutter mary peter)
>
> Anfrage:
>
> (anfrage '(not vater hugo lars))
Erstens, werde ich die Anfrage anders darstellen, n�mlich
(anfrage '(not (vater hugo lars)))
Diese syntaktische Umwandelung wird die Erstellung einer Funktion, die
dem Algorithmus enspricht, einfacher. Es bleibt nur den Einbau der
Semantik von "not" in der Funktion "Anfrage" bzw. "Prove". Ich habe
nicht die Zeit, es genauer zu untersuchen -- ausserdem werde es Ihnen
gut tun, die Details der L�sung selber auszut�fteln.
> gew�nschtes Ergebnis:
>
> �berpr�fung der Datenbasis auf Vorkommen der Anfrage.
> Wenn Anfrage gefunden werden konnte, soll die Funktion "nil" liefern.
> Kann die Anfrage nicht gel�st werden, d.h die Datenbasis enth�lt keine
> entsprechenden Daten soll die L�sung "T" sein.
[I suggest changing the input notation to represent NOT as an explicit
operator and then modify the ANFRAGE or PROVE functions to handle the
semantics outlined in the desired result section.]
--
Thomas A. Russ, USC/Information Sciences Institute ···@isi.edu From: Rolf-Thomas Happe
Subject: Re: Bitte um Hilfe!!
Date: Sat, 11 Sep 1999 00:00:00 +0000
Message-ID: <r54sh1waas.fsf@bonnie.mathematik.uni-freiburg.de> Marko Kreuzer writes:
> (anfrage '(not vater hugo lars))
>
> gew�nschtes Ergebnis:
>
> �berpr�fung der Datenbasis auf Vorkommen der Anfrage.
> Wenn Anfrage gefunden werden konnte, soll die Funktion "nil" liefern.
> Kann die Anfrage nicht gel�st werden, d.h die Datenbasis enth�lt keine
> entsprechenden Daten soll die L�sung "T" sein.
(Ich habe mir den beigef"ugten Code kaum angesehen.)
Beschr"anken wir uns auf Anfragen bzw. Goals der folgenden Form:
<goal0> : atomare Formel ohne freie Variablen
<goal1> : <goal0> | (not . <goal0>)
Definiere die Funktion PROVE: <goal1> --> NIL | T
(PROVE <goal0>)
wenn <goal0> aus der Datenbank ableitbar ist, so = T
andernfalls = NIL
(PROVE (not . <goal0>)) = (NOT (PROVE <goal0>)
Dann liefert (ANFRAGE (not . <goal0>)) = (PROVE (not . <goal0>))
das gew"unschte Ergebnis. Da dieser ,,Ansatz'' nicht viel mehr
tut, als die (partielle) Spezifikation von ANFRAGE neu zu drapieren,
erwarte ich keinen "uberschwenglichen Dank. Offensichtlich muss
man etwas mehr M"uhe ansetzen, um auch komplexe Formeln zu PROVEn
bzw. die m"oglichen L"osungen (Variablenbelegungen) auszurechnen.
Diese M"uhe werde ich mir nicht machen, aber die folgenden B"ucher
helfen gerne weiter:
Perter Norvig: Paradigms of Artificial Intelligence Programming.
Abelson/Sussman: Structure & Interpretation of Computer Programs.
rthappe
PS: Die seltsam exotische, weil deutsche Sprache dieses Hilferufs
schlie3t viele der potentiellen Helfer vom Verst"andnis aus.
Comp.lang.lisp ist offensichtlich ein internationales Forum.