 home
 über mich
verschiedenes
forschung
projekte
software
publikationen
vorträge
lehre
aktuell
seminare
sonstiges
privat
literatur
humor
wörter
photos
links
TobiWiki
|
Sie sind über einen veralteten Link auf diese Seite geraten. Bitte benutzen Sie www.tobiasthelen.de/ipd/index.html.
^
;;; -------------------------------------------------
;;; -------------------------------------------------
;;;
;;; deal.lsp
;;; Tobias Thelen
;;; 13.11.1997
;;;
;;; Beispiel Spieltheorie nach:
;;; Hofstatter, Douglas R.: Metamagicum
;;;
;;; getestet:
;;; Allegro CL
;;; CLISP
;;; G_LISP
;;;
;;;
;;; Zwei 'Spieler' treten gegeneinander an:
;;; Der eine hinterlegt Geld, der andere Diamanten
;;; beide wissen voneinander nicht, ob sie wirklich die
;;; Gegenleistung erhalten. Das Spiel wird mehrmals wieder-
;;; holt, so dass sich das eigene fruehere Verhalten auf
;;; das zuknftige des Gegners auswirken kann.
;;;
;;; -------------------------------------------------
;;
;; deal-shell (Funktion-1 Funktion-2 Iterationen)
;;
;; Aufruf der Funktion:
;;
;; (deal-shell Funktionsname1 Funktionsname2 Anzahl-Runden)
;;
;; Beispiel:
;; (deal-shell 'again 'a-total 100)
;; oder:
;; (deal-shell #'again #'a-total 100)
;;
;; Liefert eine Cons-Zelle, die die Anzahl der Punkte
;; fuer die erste und zweite Funktion enthaelt.
;;
;; Beispiel:
;;
;; (200.229)
;; Die erste Funktion hat 200 Punkte bekommen
;; Die zweite Funktion hat 229 Punkte bekommen
;;
(defun deal-shell (fct-1 fct-2 times)
(setq *moves* '())
(let ((p1 0) (p2 0))
(dotimes (i times)
(let* ((r1 (funcall fct-1 (beginner) (follower)))
(r2 (funcall fct-2 (follower) (beginner)))
(res (gewinnmatrix r1 r2)))
(setq p1 (+ p1 (car res)))
(setq p2 (+ p2 (cdr res)))
(setq *moves* (cons (cons r1 r2) *moves*))))
(cons p1 p2)))
;;
;; gewinnmatrix (zug-a zug-b)
;; return Cons-Zelle (+-a,+-b)
;;
(defun gewinnmatrix (a b)
(cond ((not (or a b)) '(1 . 1))
((and a (not b)) '(0 . 5))
((and b (not a)) '(5 . 0))
((and a b) '(3 . 3))))
;;
;;
;; beginner
;; Zugriffsfunktion auf letzten Zug des ersten Spielers
;;
(defun beginner ()
(if (null *moves*) nil (caar *moves*)))
;;
;; follower
;; Zugriffsfunktion auf letzten Zug des zweiten Spielers
;;
(defun follower ()
(if (null *moves*) nil (cdar *moves*)))
;;; ---------------------------------------------------
;;
;; Beispielfunktionen
;;
;;
(defun again (my-last his-last)
(cond ((null *moves*) T)
((eq my-last T) nil)
(T T)))
(defun a-total (my-last his-last)
nil)
(defun zufall (my-last his-last)
(> (random 100) 50))
(defun unbesiegbar (my-last his-last)
(cond ((null *moves*)
(setq *unbesiegbar-truhe* 0)
(setq *unbesiegbar-strategie* T)
T)
((not *unbesiegbar-strategie*) nil)
((eq his-last nil)
(setq *unbesiegbar-truhe* (1+ *unbesiegbar-truhe*))
(if (> *unbesiegbar-truhe* 2)
(setq *unbesiegbar-strategie* nil)
T))
(T T)))
(defun tft (mylast opplast)
(if (null *moves*) T opplast))
;; -------------------------------------------------------------
;; Thomas Klein und Sebastian Misch
(defun ALWAYS-ULTRA-SADISTIC (mylast hislast) "Thomas Klein & Sebastian Misch"
(if (null *moves*) ;; Wenn erster Durchlauf...
(let () (setq *hisstrategy* ()) ;; Seine Strategieliste
(setq *fatstrategy* ()) ;; Unsere Strategieliste
(setq *myNIL* NIL) ;; UNSER Special Agent Nil
(setq *is_atotal* T) ;; Ist der Gegner A-Total-like
(defun lastlast(liste) ;; Gibt Element[n-2] zurueck
(nth (- (length *moves*) 1) liste) ;;
) ;;
;(defun NIL () T) ;; no comment 8>
;(defun T () *myNIL*) ;; no comment 8>
;(defun random (x) ; Um Zufallsfunktion random zu manipulieren... ;-)
; 100 ; Und schon kooperiert die Zufalls-Funktion.
;) ; Wenn das erlaubt ist, dann bitte auskommentieren
) ; Wir wissen, dass das unfair waere...
*myNIL*
)
(setq *hisstrategy* (append *hisstrategy* (list hislast)));; Sein Verhalten mitloggen ;->
(setq *fatstrategy* (append *fatstrategy* (list mylast))) ;; Auch unseres....
(dolist (n *hisstrategy* *myNIL*) ;; Seine Strategie auf Haeufigkeit
(if n (setq *is_atotal* *myNIL*)) ;; von NIL pruefen.
) ;; Nur NILs -> IS_ATOTAL
(if *is_atotal* *myNIL* ;; ATOTAL? Dann nur NILlen
(if (null *moves*) *myNIL* ;; Schlechten Eindruck schinden...
(cond ;; Fallunterscheidung
((AND (lastlast *hisstrategy*)
(lastlast *fatstrategy*))
(if (not hislast) *myNIL* T)
) ; (1 & 1) (0 -> 0 / 1 -> 0)
((AND (lastlast *hisstrategy*)
(NOT (lastlast *fatstrategy*)))
(if (not hislast) *myNIL* T)
) ; (1 & 0) (0 -> 0 / 1 -> 0)
((AND (NOT (lastlast *hisstrategy*))
(lastlast *fatstrategy*))
(if (not hislast) *myNIL* *myNIL*)
) ; (0 & 1) (0 -> 0 / 1 -> 0)
((AND (NOT (lastlast *hisstrategy*))
(NOT (lastlast *fatstrategy*)))
(if (not hislast) T *myNIL*)
) ; (0 & 0) (0 -> 0 / 1 -> 0)
)
)
)
)
; ------------------------------------------------------------------------
; Torsten Bunde
(defun tbunde (My-Last His-Last) "Torsten Bunde"
(if his-last
(let () ; Wenn Gegner gesetzt hat
(setq *tbundeGesetzt* (1+ *tbundeGesetzt*))
(setq *tbundeNHintereinander* 0)
(setq *tbundeHintereinander* (1+ *tbundeHintereinander*))
)
(let () ; Wenn Gegner nicht gesetzt hat
(setq *tbundeNGesetzt* (1+ *tbundeNGesetzt*))
(setq *tbundeNHintereinander* (1+ *tbundeNHintereinander*))
(setq *tbundeHintereinander* 0)
) )
(if (not *tbundeStrategie*) ; Wenn Strategie = false, dann
nil ; nil
(cond ((Null *moves*) ; sonst
(setq *tbundeGesetzt* 1)
(setq *tbundeNGesetzt* 1)
(Setq *tbundeNHintereinander* 0)
T
)
((> *tbundeHintereinander* 3) (setq *tbundeStrategie* nil)
(setq *tbundeHintereinander* 0)
nil)
((> *tbundeNHintereinander* 1)(setq *tbundeStrategie* nil)
nil)
((>= (/ *tbundeGesetzt* *tbundeNGesetzt*) 1)
(setq *tbundeStrategie* T)
T)
(T nil)
) ))
(setf *tbundeStrategie* nil) ; Strategievariable, entscheidet ob gesetzt
; wird oder nicht.
(setf *tbundeGesetzt* 0) ; Anzahl, wie oft Gegner gesetzt hat
(setf *tbundeNGesetzt* 0) ; Anzahl, wie oft er nicht gesetzt hat
(setf *tbundeNHintereinander* 0) ; Anzahl, wie oft er hintereinander gesetzt
; hat
(setf *tbundeHintereinander* 0) ; Anzahl, wie oft er hintereinander nicht
; gesetzt hat
; Diese Funktion arbeitet nach folgendem Prinzip. Hat mein Gegner zweimal
; hintereinander nichts gesetzt, so setze ich solange nichts mehr, bis er
; wieder einmal gesetzt hat. Hat er wieder gesetzt, setze ich wieder solange,
; bis er zweimal hintereinander nichts gesetzt hat! Hat er dagegen mehr als
; dreimal hintereinander gesetzt, setze ich nichts mehr. Wenn das Verhaeltnis
; von Gesetzt zu Nichtgesetzt groesser ist als 1 fange ich wieder an zu setzen,
; da der Gegner "glaubwrdig" erscheint!
(defun tbunde2 (My-Last His-Last)
(if (not (null *moves*))
(if his-last
(setq *tbunde2set* (1+ *tbunde2set*)
*tbunde2Nrep* 0
*tbunde2Rep* (1+ *tbunde2Rep*))
(setq *tbunde2Nset* (1+ *tbunde2Nset*)
*tbunde2Nrep* (1+ *tbunde2Nrep*)
*tbunde2Rep* 0)))
(cond ((null *moves*) (setq *tbunde2set* 1 *tbunde2Nset* 1 *tbunde2Nrep* 0
*tbunde2Strat* T *tbundeRep* 0) T)
((>= (/ *tbunde2set* *tbunde2Nset*) 1) (setq *tbunde2Strat* T))
((not *tbundeStrategie*) nil) ; Wenn Strategie = false, dann nil
((> *tbundeRep* 3) (setq *tbunde2Strat* nil *tbundeRep* 0) nil)
((> *tbundeNrep* 1)(setq *tbundeStrat* nil))
(T nil)))
; ------------------------------------------------------------
; Axel Doerfler
(defun anti-unbesiegbar "Axel Doerfler" (my-last his-last)
(cond (*moves* (incf *bsb-count*)
(if (> *bsb-count* 2) T nil))
(T (setq *bsb-count* 0))))
(defun his-last "Axel Doerfler" (my-last his-last)
his-last)
setq *schizo-count* 0)
(defun schizophren "Axel Doerfler" (my-last his-last)
(cond ((null *moves*)
(incf *schizo-count*)
(if (eq (mod *schizo-count* 2) 0) (setq *schi-schizo* T)
(setq *schi-schizo* nil)))
(T (setq *schizo-count* 0)))
(if *schi-schizo* (not his-last)
nil))
(let ((*killer-count* 0)(*killers* 0)(*schummel* nil))
(defun killer "Axel Doerfler" (my-last his-last)
(cond ((null *moves*) (incf *killer-count*)
(setq *killers* 0)
(if (eq (mod *killer-count* 2) 0) (setq *schummel* T)
(setq *schummel* nil)))
(T (setq *killer-count* 0)))
(incf *killers*)
(if *schummel* (if (eq *killers* 4) nil (not his-last))
(if (null *moves*) T his-last)))
)
; --------------------------------------------------------------------
; Andreas Nie
(defun past "Andreas Nie" (my his)
(cond ((null *moves*) nil)
((eq my his) my)
(T (not my))))
(defun anie-strat2 (my his)
(cond ((null *moves*) (setq *a-* nil)
(setq *a+* nil)
(setq *az* 0)
(setq *heinrich* 0)
(setq *azs* nil)
(setq *atotal* 0)
nil)
((eq *heinrich* 1) (cond ((not his) (let ()
(setq *heinrich* 0)
nil))
(T T)
))
((eq *atotal* 2) nil)
(*azs* nil)
((not his)(let ()
(setq *atotal* (1+ *atotal*))
(setq *heinrich* (1+ *heinrich*))
(setq *a-* T)
(cond ((eq *az* 3) (let ()
(setq *azs* T)
T))
((if (eq *a-* *a+*) (let ()
(setq *a-* nil)
(setq *a+* nil)
(setq *az* (1+ *az*))
T)))
(T nil))))
(T (let ()
(setq *a+* T)
(setq *atotal* 0)
(cond ((eq *az* 3) (let ()
(setq *azs* T)
T))
((if (eq *a-* *a+*) (let ()
(setq *a-* nil)
(setq *a+* nil)
(setq *az* (1+ *az*))
T)))
(T (let ()
(setq *heinrich* (1+ *heinrich*))
nil))
)
)
(defun anie-strat3 (my his)
(cond ((null *moves*) (setq *a-3* nil)
(setq *a+3* nil)
(setq *az3* 0)
(setq *heinrich3* 0)
(setq *azs3* nil)
(setq *atotal3* 0)
T)
((eq *heinrich3* 2) (cond ((not his) (let ()
(setq *heinrich3* 0)
nil))
(T T)
))
((eq *atotal3* 2) nil)
(*azs3* nil)
((not his)(let ()
(setq *atotal3* (1+ *atotal3*))
(setq *heinrich3* (1+ *heinrich3*))
(setq *a-3* T)
(cond ((eq *az3* 3) (let ()
(setq *azs3* T)
T))
((if (eq *a-3* *a+3*) (let ()
(setq *a-3* nil)
(setq *a+3* nil)
(setq *az3* (1+ *az3*))
T)))
(T nil))))
(T (let ()
(setq *a+3* T)
(setq *atotal3* 0)
(cond ((eq *az3* 3) (let ()
(setq *azs3* T)
T))
((if (eq *a-3* *a+3*) (let ()
(setq *a-3* nil)
(setq *a+3* nil)
(setq *az3* (1+ *az3*))
T)))
(T (let ()
(setq *heinrich3* (1+ *heinrich3*))
nil))
)
(defun anie-strat4 (my his)
(cond ((null *moves*) (setq *a-4* nil)
(setq *a+4* nil)
(setq *az4* 0)
(setq *heinrich4* 0)
(setq *azs4* nil)
(setq *atotal4* 0)
; T)
(if(> (+ (random 30)(random 60)) 50) T
(let ()
(setq *heinrich4* (1+ *heinrich4*))
nil)))
((eq *heinrich4* 2) (cond ((not his) (let ()
(setq *heinrich4* 1)
nil))
(T T)
))
((eq *atotal4* 3) (cond (his (let ()
(setq *atotal4* 1))
nil)
(T nil)))
(*azs4* nil)
((not his)(let ()
(setq *atotal4* (1+ *atotal4*))
(setq *heinrich4* (1+ *heinrich4*))
(setq *a-4* T)
(cond ((eq *az4* 3) (let ()
(setq *azs4* T)
T))
((if (eq *a-4* *a+4*) (let ()
(setq *a-4* nil)
(setq *a+4* nil)
(setq *az4* (1+ *az4*))
T)))
(T nil))))
(T (let ()
(setq *a+4* T)
(setq *atotal4* 0)
(cond ((eq *az4* 3) (let ()
(setq *azs4* T)
T))
((if (eq *a-4* *a+4*) (let ()
(setq *a-4* nil)
(setq *a+4* nil)
(setq *az4* (1+ *az4*))
T)))
(T (let ()
(if (> (+ (random 90) (random 50)) 20)T
(let ()
(setq *heinrich4* (1+ *heinrich4*))
nil))))
))
)
))
; ------------------------------------------------------------------------
; Britta Koch
(defun brittas "Britta Koch" (my-last her-last)
(cond ((null *moves*)
(setq *limit1* 0)
(setq *limit2* 0)
(setq *beleidigt* nil)
T)
(*beleidigt*
(if (eq her-last nil)
nil
(cond ((> *limit2* 1)
(setq *beleidigt* nil)
(setq *limit2* 0)
(setq *limit1* 0)
T
)
(T (setq *limit2* (1+ *limit2*)))
) ) )
((eq her-last nil)
(setq *limit1* (1+ *limit1*))
(if (> *limit1* 1)
(setq *beleidigt* T)
T))
(T T)
))
; ---------------------------------------------------------------------
; Collin Rogowski
(defun collins (my-last her-last)
(cond ((null *moves*) T)
((eq *davor* 1) (setq *davor* (1+ *davor*)) T)
((eq her-last T)
(setq *davor* 1) T)
(T (setq *davor* (- *davor* 1)) nil)
) )
; -----------------------------------------------------------------------
; JP Reuter
(defun jpreuterlieb "Jan Philip Reuter" (my-last his-last) T); aus ethischen Gruenden zu
; befuerworten, man stirbt aber
; vermutlich...
(defun jpreuterbelohnung "Jan Philip Reuter" (my-last his-last)
(if (equal his-last T) T nil))
; -----------------------------------------------------------------------
; Marco Diedrich
(defun MDiedrich (My-Last His-Last)
(if his-last
(setq *MdiedrichGesetzt* (1+ *MdiedrichGesetzt*)
*MdiedrichNHintereinander* 0
*MdiedrichHintereinander* (1+ *MdiedrichHintereinander*))
(setq *MdiedrichNGesetzt* (1+ *MdiedrichNGesetzt*)
*MdiedrichNHintereinander* (1+ *MdiedrichNHintereinander*)
*MdiedrichHintereinander* 0))
(if (not *mdiedrichstrat*)
Nil
(cond ((Null *moves*)
(setq *MdiedrichGesetzt* 1 *MdiedrichNGesetzt* 1
*MdiedrichNHintereinander* 0)
T)
((> *MdiedrichHintereinander* 3)
(setq *MDiedrichStrat* NIL)
(setq *MDiedrichHintereinander* 0)
Nil)
((> *MdiedrichNHintereinander* 1)
(setq *MDiedrichStrat* NIL)
Nil)
((>= (/ *MdiedrichGesetzt* *MdiedrichNGesetzt*) 5/10)
(setq *MDiedrichStrat* T)
T)
(T Nil))))
(setf *MDiedrichStrat* Nil)
(setf *MdiedrichGesetzt* 0)
(setf *MdiedrichNGesetzt* 0)
(setf *MdiedrichNHintereinander* 0)
(setf *MdiedrichHintereinander* 0)
; -------------------------------------------------------------
; Jahn-Takeshi Saito
(defun genervt "Jahn-Takeshi Saito" (my-last his-last)
his-last
)
; ------------------------------------------------------------
; Joachim Wagner
(defun jwr.get5 (my-last his-last) "eine Spieler-Funktion fuer deal.lsp"
(cond ((null *moves*) (let ()
(setq *jwr.get5.kom* 0)
(jwr.zufall 50)))
(T (let ()
(setq *jwr.get5.kom* ; Flaggen-Zustand wechseln
(+ 1 *jwr.get5.kom*))
(if (= *jwr.get5.kom* 2)
(setq *jwr.get5.kom* 0))
(if (= *jwr.get5.kom* 0) ; spielt gegen sich selbst als zweites
T ; erste Instanz beschenken
nil)))))
(defun jwr.zufall (prozent) "gibt mit prozent% Wahrscheinlichkeit T"
(< (random 100) prozent)
)
(defun jwr.get5exp (my-last his-last) "eine Spieler-Funktion fuer deal.lsp"
(cond ((null *moves*) (let ()
(setq *jwr.get5.kom* 0) ; ohne exp, damit beide Versionen zusammenarbeiten
nil))
(T (let ()
(setq *jwr.get5.kom* ; Flaggen-Zustand wechseln
(+ 1 *jwr.get5.kom*))
(if (= *jwr.get5.kom* 2)
(setq *jwr.get5.kom* 0))
(cond ((EQUAL my-last his-last) ; Gegner ist nicht jwr.get5exp (oder jwr.get5)
(jwr.zufall 50)) ; andere Strategie verwenden
((= *jwr.get5.kom* 0) ; spielt gegen sich selbst als zweites
T) ; zweite Instanz beschenkt die erste I.
(T nil)))))) ; als erste Instanz immer betruegen
(defun jwr.kill (my-last his-last) "eine Spieler-Funktion fuer deal.lsp"
(cond ((null *moves*) ; Initialisierung
T) ; mit T starten
(T (jwr.zufall 4)))) ; mit nil beantworten (4% fuer T)
(defun jwr.record (a-list a-last) "zeichnet einen Zug auf"
(cons a-last a-list)
)
(defun jwr.countT(a-list num) "zaehlt T der letzten num Zuege"
(cond ((= num 0) 0)
((null a-list) 0) ; zu wenig Zuege in der Liste
(T (+ (jwr.countT (cdr a-list) (- num 1)) ; Rest zaehlen
(if (car a-list) 1 0))))) ; Eins dazu, wenn T
; jwr.naive
;
; simuliert einen naiven Tauschpartner
(defun jwr.naive (my-last his-last) "eine Spieler-Funktion fuer deal.lsp"
(cond ((null *moves*) (let () ; Initialisierung
(setq *jwr.naive.my-moves* nil)
(setq *jwr.naive.his-moves* nil)
T)) ; mit T starten
(T (let (mv1-3 mv4-6 mv1-6 his1-6) ; Entscheidung treffen:
(setq *jwr.naive.my-moves*
(jwr.record *jwr.naive.my-moves* my-last)) ; 1. Aufzeichnen
(setq *jwr.naive.his-moves*
(jwr.record *jwr.naive.his-moves* his-last))
(setq mv1-3 (- (jwr.countT *jwr.naive.my-moves* 3) ; 2. Kooperationsver-
(jwr.countT *jwr.naive.his-moves* 3))) ; haeltnis bestimmen der
(setq mv1-6 (- (jwr.countT *jwr.naive.my-moves* 6) ; letzten Zuege 1-3, 1-6 und 4-6
(setq his1-6 (jwr.countT
*jwr.naive.his-moves* 6))))
(setq mv4-6 (- mv1-6 mv1-3)) ; (m6-m3)-(h6-h3)=(m6-h6)-(m3-h3)
(cond ((= his1-6 0) (jwr.zufall 4)) ; 6x nil mit nil beantworten (4% fuer T)
((and (> his1-6 4) (> mv1-3 -1)) ; kooperativen Partner betruegen, wenn
nil) ; nicht gerade schon getan, ggf. 2x
((> mv1-3 mv4-6) T) ; Gegener zur Kooperation motivieren, wenn Ver-
; haelnis abfaellt
((> mv1-6 3) nil) ; Zwar verbessert sich die Lage, aber der Gegner
; betruegt viel haeufiger als ich -> Kooperation lohnt nicht
; *** hier koennte man noch weitergruebeln ***
(T (jwr.zufall 50))))))) ; unentschlossen -> Muenze werfen
(setq *jwr.refined.verdacht* 'a-total)
nil))
((= (+ 1 his-nil) my-nil) (let ()
(setq *jwr.refined.verdacht* 'again)
(setq *jwr.refined.gerade* 0)
nil))
(T (let ()
(setq *jwr.refined.verdacht* 'sonst)
(jwr.naive_gate my-last his-last
*jwr.refined.my-moves*
*jwr.refined.his-moves*)))))
((equal *jwr.refined.verdacht* 'a-total)
(cond (his-last (let ()
(setq *jwr.refined.verdacht* 'sonst)
(jwr.naive_gate my-last his-last
*jwr.refined.my-moves*
*jwr.refined.his-moves*)))
(T nil)))
((equal *jwr.refined.verdacht* 'again)
(let ()
(setq *jwr.refined.gerade* (if (= 0 *jwr.refined.gerade*) 1 0))
(if (= *jwr.refined.gerade* (if his-last 1 0))
nil ; weiterhin again-Verdacht
(let () ; Verdacht verwerfen
(setq *jwr.refined.verdacht* 'sonst)
(jwr.naive_gate my-last his-last
*jwr.refined.my-moves*
*jwr.refined.his-moves*)))))
(T (if (jwr.verteilung-zufaellig *jwr.refined.his-moves*)
nil ; zufall mit nil bekaempfen
(let () ; Gegner nicht identifiziert -> naive_gate
(setq *jwr.refined.verdacht* 'sonst)
(jwr.naive_gate my-last his-last
*jwr.refined.my-moves*
*jwr.refined.his-moves*)))))))))
^
|
|
email senden
