Eine Warnung vorweg: Dies ist ein sehr langes Kapitel! Hier geht es nicht darum, eine bestimmte Technik oder ähnliches vorzustellen - es ist einfach nur ein Bespiel, wie man in AutoLisp programmieren kann, und was man in AutoLisp programmieren kann. AutoCAD als Spieleplattform ist ja bisher nicht gerade als populär zu bezeichnen, aber das sollte uns nicht abhalten: Es geht also um ein Spiel, und wir fangen mal klein an und entscheiden uns für Tic Tac Toe.

Wenn man ein solches Brettspiel, bei dem ein Mensch gegen den Rechner antritt, programmieren will, muss man zunächst eine Vorstellung von der Strategie haben, die der Rechner bei seinen Zügen anwenden soll. Diese herauszufinden, ist aber oft recht schwierig - meist wird diejenige angewandt, bei der der Rechner möglichst viele Züge im Voraus durchrechnet und sich dann für den Zug mit der besten Gewinnchance entscheidet.

Ich möchte hier aber eine ganz andere Vorgehensweise vorstellen: Der Rechner plant überhaupt nichts, er zieht irgendwie und verliert dann auch fast immer. Aber: Er lernt aus Fehlern! Nach und nach wird er diese dummen Züge nicht mehr machen, sondern sich bessere einfallen lassen! Keine komplizierte Strategie also - das Programm wird wie ein Pawlowscher Hund mit Belohnung und Strafe konditioniert!

Den meisten Leuten wird bekannt sein, dass man bei Tic Tac Toe nicht wirklich gewinnen kann. Wenn beide Spieler keine Fehler machen, bleibt es immer bei einem Unentschieden! Um das Programm kurz und übersichtlich zu halten, habe ich es erst einmal so implementiert, dass der menschliche Spieler (im Programm immer durch H wie Human gekennzeichnet) immer den ersten Zug macht und der Rechner (M wie Machine) antwortet.

In diesem Kapitel werde ich das Programm in einer Form darstellen, bei der es seine 'Erfahrungen' in einer globalen Variable ablegt. Bei einem Neustart in einer neuen Zeichnung ist es also wieder strohdumm und muss von vorne anfangen zu lernen. Im nächsten Kapitel werde ich dann aber eine Variante vorstellen, bei der sich der Programmcode selber modifiziert und dann auf der Platte abspeichert: Ein Programm, das durch Benutzung wächst und immer schlauer wird.

Allerdings entsteht in diesem Zusammenhang ein kleines, aber lösbares Problem: Seit Einführung des neuen (Visual-) Interpreters werden benutzderdefinierte Funktionen nicht mehr als Listen, sondern als ein eigener Datentyp im Speicher abgelegt. Das bedeutet, dass man an den Code von mit (defun ...) erzeugten Funktionen nicht mehr herankommt und ihn natürlich erst recht nicht mehr modifizieren kann.

Die Implementation verzichtet daher vollständig auf die Verwendung von (defun ...), alle Programmteile werden mit (setq ...) als Datenlisten erzeugt. Dabei liegt folgende Äquivalenz zu Grunde:

(defun funktion1 (arg1 arg2 / var1 var2)
  ... ; macht irgendetwas
)

(setq funktion2 '((arg1 arg2 / var1 var2)
  ... ; macht auch irgendetwas
))
                  

Funktion 2 lässt sich genauso verwenden und ausführen wie Funktion 1, nur eben mit dem Unterschied, dass auf der AutoCAD-Kommandozeile mit !funktion2 der Lisp-Code ausgegeben wird und wir ihn natürlich auch im Programm verwenden oder modifizieren können. Dies ist sozusagen als Vorgriff auf das Folgekapitel schon eingebaut. Das Programm ist übrigens so angelegt, dass es nur eine einzige Funktion namens (play-game) gibt, alle anderen Funktionen sind als lokale Variablen darin 'versteckt'.

Allerdings brauchen wir einige solcher Unterfunktionen: (play-game) deckt nur die Rahmenhandlung ab, den Ablauf des Spiels mit dem Wechsel zwischen H und M, und es wird nach jedem Zug ein Test aufgerufen, ob einer der Spieler gewonnen hat oder das Spiel unentschieden ausgegangen ist. Die einzelnen Tests usw. finden aber in den Unterfunktionen statt, so dass die Hauptfunktion eigentlich für jedes beliebige ähnliche Spiel zu verwenden ist.

Ich werde jetzt das gesamte Programm Funktion für Funktion mit einigen Erläuterungen hier vorstellen. Am Ende des Kapitels findet sich das Programm dann noch einmal am Stück zum Kopieren und Ausprobieren. Und wie gesagt: es ist etwas länger!

(setq play-game '(( / size graphics gameover moves history
                      tmp draw-grid clear-grid draw-h-move
                      draw-m-move get-h-move win-test
                      h-only m-only tied? h-won? m-won?
                      ask-for-end find-m-move)

  ; Zeichnet das Gitter
  (setq draw-grid '((size / i ents)
    (setq i 0)
    (repeat (1+ size)
      (command"_line"(list i 0)(list i size)"")
      (setq ents(cons(entlast)ents))
      (command"_line"(list 0 i)(list size i)"")
      (setq ents(cons(entlast)ents))
      (setq i(1+ i))
    )
    (command"_zoom"
      (list(- size)(- size))
      (list(* 2 size)(* 2 size))
    )
    ents
  ))
                  

Wie gesagt, alle Unterfunktionen sind als lokale Variablen in der Hauptfunktion eingebettet. (draw-grid ...) zeichnet ein Gitter der Größe size, die Funktion kann also auch für andere Spiele verwendet werden, bei denen die Größe mehr als 3 beträgt. Die erzeugten Geometrieelemente werden zurückgegeben, damit sie nach dem Spiel gelöscht werden können. Die Variable graphics enthält immer die durch das laufende Spiel entstandenen Elemente.

  ; Löscht das letzte Spiel vom Bildschirm
  (setq clear-grid '((ents / )
    (foreach ent ents(entdel ent))
    nil
  ))
                  

Dieser Funktion wird nach einem Spiel der Inhalt von graphics zum Löschen übergeben.

  ; Zeichnet einen H-Zug
  (setq draw-h-move '((pos s / row col)
    (setq row(/ pos s)col(rem pos s))
    (command"_circle"(list(+ col 0.5)(+ row 0.5))0.35)
    (entlast)
  ))

  ; Zeichnet einen M-Zug
  (setq draw-m-move '((pos s / row col ents)
    (setq row(/ pos s)col(rem pos s))
    (command"_line"(list(+ col 0.8)(+ row 0.8))
            (list(+ col 0.2)(+ row 0.2))"")
    (setq ents(list(entlast)))
    (command"_line"(list(+ col 0.8)(+ row 0.2))
            (list(+ col 0.2)(+ row 0.8))"")
    (setq ents(cons(entlast)ents))
  ))
                  

Die beiden Funktionen zeichnen die Spielerzüge auf dem Bildschirm, für H einen Kreis, für M ein Kreuz. Auch diese Elemente werden zurückgegeben und von der Hauptfunktion in graphics gespeichert.

  (setq get-h-move '((moves s / tmp ok get-click)
    (setq get-click '((s / p row col)
      (setq p(getpoint "Click a field: \n"))
      (+(*(min(max(fix(cadr p))0)(1- s))s)
        (min(max(fix(car p))0)(1- s))
      )
    ))
    ;*******************
    (while(not ok)
      (initget 1)
      (setq tmp(get-click s))
        (if(member tmp moves)(princ "Invalid. ")(setq ok 1))
      )
      tmp
    )
  )
                  

Diese Funktion stellt sozusagen das 'Human Interface' dar - der Zug des menschlichen Spielers wird angefordert. In dieser Unterfunktion eingebettet findet man die Unter-Unterfunktion (get-click), die ermittelt, in welches Feld der Mensch geklickt hat. Auch diese Funktion ist wieder so ausgelegt, dass sie mit jedem quadratischen Spielfeld der Größe s umgehen kann.

  (setq win-test '((pl / )
    (apply'or
      (mapcar
      '(lambda(l)
         (apply'and(mapcar'(lambda(p)(member p pl))l))
       )
      '((0 1 2)(3 4 5)(6 7 8)(0 3 6)(1 4 7)
                        (2 5 8)(0 4 8)(2 4 6))
      )
    )
  ))
                  

Diese Funktion testet, ob einer der beiden Spieler eine Mühle zugemacht hat. Sie mag schon so etwas undurchsichtig aussehen - deshalb habe ich hier auf eine Funktion für beliebige Spielbretter verzichtet - hier wird nur Tic Tac Toe getestet! Die Zahlentripel sind natürlich die Gewinnkombinationen auf dem von 0 bis 8 durchnummerierten Spielfeld. Da ich hier auf die Riesenschüssel 'mapcar-lambda-Salat' verzichten wollte, habe ich sie fest verdrahtet!

  (setq h-only '((pl / )
    (setq pl(reverse pl))
    (if(null pl)
      nil
      (append(list(car pl))(h-only(cddr pl)))
    )
  ))
                  

Ein Spiel wird im Programm immer als Liste in der Form (0 4 7 5 ...) aufgezeichnet. Da H immer anfängt, hat H also zuerst 0 besetzt, dann antwortete M mit 4 usw. Der Korrektheit halber sollte allerdings noch erwähnt werden, dass die Listen tatsächlich auch noch rückwärts vorliegen, da sie mit (cons ...) erzeugt werden, also (... 5 7 4 0). Diese Hilfsfunktion extrahiert schlicht und einfach die H-Züge, d.h. jedes zweite Element, von hinten angefangen!

  (setq m-only '((pl / )
    (h-only(reverse(cdr(reverse pl))))
  ))
                  

Und diese Funktion extrahiert die M-Züge - das letze Element (das ja immer der Eröffnungszug von H ist, wird einfach abgeschnitten, und dann wird (h-only) im Sinnes des Code-Recycling verwendet!

  (setq tied? '((pl s / )
    (if(=(length pl)(* s s))
      (progn
        (princ "Game tied.\n")
        (princ)
      )
    )
  ))
                  

Diese Funktion testet, ob ein Unentschieden vorliegt. Der Test selbst ist einfach: Wenn soviel Züge gemacht wurden, wie das Spielfeld Felder hat, und keiner bisher gewonnen hat (das wird hier nicht mehr getestet!), dann muss es wohl so sein. Schwieriger ist wohl zu sehen, dass es sich hier um eine Prädikatfunktion handelt (deshalb auch das Fragezeichen im Namen). Dass (princ) als T gewertet wird, kann man durch die Eingabe von (not(not(princ))) verifizieren!

  (setq h-won? '((pl / )
    (if(win-test(h-only pl))
      (progn
        (princ"H is winner! Game over.\n")
        (princ)
      )
    )
  ))

  (setq m-won? '((pl / )
    (if(win-test(m-only pl))
      (progn
        (princ"M is winner! Game over.\n")
        (princ)
      )
    )
  ))

  (setq ask-for-end '(( / tmp)
    (initget 0 "Yes No")
    (=(getkword "Play again? <Yes>/No: ")"No")
  ))
                  

Diese beiden Funktion sind absolut simpel. Beide bedienen sich des selben Mechanismus: Die entsprechende H- oder M-Teilliste wird auf Sieg getestet, falls ja, wir eine entsprechende Meldung ausgegeben. Die dritte Funktion schliesslich fragt nur bei H an, ob er weiterspielen möchte.

  (setq reward '((amt his memory / )
    (foreach item his
      (setq memory
        (if(assoc item memory)
          (subst
            (cons item(+ amt(cdr(assoc item memory))))
            (assoc item memory)
            memory
          )
          (cons(cons item amt)memory)
        )
      )
    )
    memory
  ))
                  

Jetzt geht es ans Eingemachte: Die reward-Funktion führt die Pawlowsche Konditionierung durch! Zunächst die Erläuterung der Argumente: amt ist der Betrag (amount), für verlorene Spiele gibt es Abzug (-1), für Patt-Spiele und gewonnene Spiele einen Bonus (1 bzw. 2). Der Spielverlauf wird in der Variablen memory abgelegt und bewertet. memory ist eine Assoziationsliste in der Form ( ((1 0) . -4) ((4 0) . 3) ...).

Das Beispiel sagt uns: M hat mit der Antwort 4 auf die Eröffnung 0 bereits dreimal unentschieden gespielt (es kann aber auch ein Sieg und ein Unentschieden gewesen sein) - mit der Antwort 1 auf die Eröffnung 0 aber schon viermal verloren. Die reward-Funktion ist also der Buchhalter, der nach einem Spiel die Kontierung durchführt. Das Argument his bekommt hier den gesamten Spielverlauf in der Form ((... 2 7 4 0)(7 4 0)(4 0)...), und jeder dieser zwischenzeitlichen Spielstände erhält die Bewertung.

Ist ein Spielstand noch nicht in der Liste enthalten, wird er also mit amt bewertet eingetragen. Falls er in der Liste vorgefunden wird, kann er aktualisiert und mit verändertem Wert abgespeichert werden. Noch ein kleiner Hinweis: Eine Liste wie (7 4 0) kann durchaus als Schlüssel einer Assoziationsliste verwendet werden. Es müssen nicht immer Strings oder Zahlen sein!

Die Übergabe der Spiel-History könnte eigentlich einfach vonstatten gehen: Jeder vorhergehende Spielstand kann natürlich mit mapcdr aus dem letzten vorliegenden Stand abgeleitet werden. Ich möchte in diesem Kapitel aber auf das Einbinden anderer Funktionen völlig verzichten und habe daher diesen etwas primitiven Weg gewählt.

Ebenso verzichten wollte ich auf den Zugriff auf Variablen in übergeordneten Namensräumen, um keine irgendwie gearteten Undurchsichtigkeiten zu schaffen. Deshalb wird die globale Variable memory hier nicht dirket verwendet, sondern (etwas mühsam) als Argument übergeben, modifiziert und an den Aufrufer zurückgegeben. Dies hat den Vorteil, dass der Code unabhängig von den Namensraum-Verhältnissen bleibt (im Hinblick auf das Folgekapitel).

  (setq find-m-move'( (pl s memory / j rl mvs mn)
    (setq j 0)
    (repeat (* s s)
      (if(not(member j pl))
        (progn
          (if(not(assoc(cons j pl)memory))
            (progn
              (setq memory(cons(cons(cons j pl)0)memory))
              (setq mvs(cons(cons(cons j pl)0)mvs))
            )
            (setq mvs(cons(assoc(cons j pl)memory)mvs))
          )
        )
      )
      (setq j(1+ j))
    )
    (foreach item mvs
      (if
        (or
          (m-won?(car item))
          (h-won?(cons(caar item)(cons'x(cdar item))))
        )
        (setq mn item)
      )
    )
    (if(null mn)
      (progn
        (setq mn '((-1) . -1000000))
        (foreach item(reverse mvs)
          (if(>(cdr item)(cdr mn))
            (setq mn item)
          )
        )
      )
    )
    (list(caar mn)memory)
  ))
                  

Und nun zur letzten Unterfunktion - hier wird der nächste M-Zug festgelegt. In der hier vorliegenden Version wird folgendermassen vorgegangen: Zunächst wird eine Liste mvs mit allen möglichen Antworten erzeugt (je voller das Brett ist, umso kürzer fällt sie aus). Falls diese potenziellen Züge noch nicht in memory vorhanden sind, werden sie mit 0-Bewertung eingetragen.

Im zweiten Teil wird getestet, ob a) eine Mühle zugemacht werden kann, oder ob b) ein H-Sieg direkt verhindert werden kann. Falls es eine von diesen Möglichkeiten gibt, wird sie wahrgenommen. Dazu ist zu sagen: Dieser Teil ist verzichtbar! Er beschleunigt nur den Lernprozess - nimmt man das erste (foreach ...) aus dem Code heraus, wird der Rechner trotzdem seine Erfahrungen machen, nur eben etwas langsamer. Statt 'strohdumm' wird er eben 'saudumm' anfangen, aber trotzdem lernen.

Und hier beginnt nun das eigentliche Hauptprogramm (die Deklaration war schon ganz oben!):

  (setq size 3 stop nil)
  (while(not stop)
    (setq graphics(clear-grid graphics))
    (setq graphics(append graphics(draw-grid size)))
    (setq gameover nil moves nil history nil)
    (while(not gameover)
      (setq moves(cons(get-h-move moves size)moves))
      (setq graphics
        (cons(draw-h-move(car moves)size)graphics)
      )
      (if(h-won? moves)
        (progn
          (setq memory(reward -1 history memory))
          (setq gameover 1)
        )
        (progn
          (if(tied? moves size)
            (progn
              (setq memory(reward 1 history memory))
              (setq gameover 1)
            )
            (progn
              (setq tmp(find-m-move moves size memory))
              (setq moves(cons(car tmp)moves))
              (setq memory(cadr tmp))
              (setq history(append history(list moves)))
              (setq graphics
                (append graphics
                  (draw-m-move(car moves)size)
                )
              )
              (if(m-won? moves)
                (progn
                  (setq memory(reward 2 history memory))
                  (setq gameover 1)
                )
              )
            )
          )
        )
      )
    )
    (if(ask-for-end)(setq stop 'T))
  )
))

                  

Die Hauptfunktion selbst ist übersichtlich und in keinster Weise aufregend. Zwei ineinander geschachtelte Schleifen steuern zum einen (aussen) den Ablauf mehrerer Spiele nacheinander und zum anderen (innen) den Ablauf des jeweiligen aktuellen Spiels. In der Variablen moves ist der jeweils aktuelle Spielstand abgelegt, in history noch einmal der Verlauf (darauf wurde weiter oben bereits eingegangen).

Hier noch einmal der komplette Code zum Kopieren und ausprobieren (es sind keine zusätzlichen Funktionen nötig). Als Datei speichern, mit (load ...) und mit (play-game) starten. Ein Errorhandling ist nicht eingebaut, und der Ofang sollte vor dem Start ausgeschaltet werden!

(setq play-game '(( / size graphics gameover moves history
                      tmp draw-grid clear-grid draw-h-move
                      draw-m-move get-h-move win-test
                      h-only m-only tied? h-won? m-won?
                      ask-for-end find-m-move)

  ; Zeichnet das Gitter
  (setq draw-grid '((size / i x1 y1 ents)
    (setq i 0)
    (repeat (1+ size)
      (command"_line"(list i 0)(list i size)"")
      (setq ents(cons(entlast)ents))
      (command"_line"(list 0 i)(list size i)"")
      (setq ents(cons(entlast)ents))
      (setq i(1+ i))
    )
    (command"_zoom"
      (list(- size)(- size))
      (list(* 2 size)(* 2 size))
    )
    ents
  ))
  ;**************************************
  ; Löscht das letzte Spiel vom Bildschirm
  (setq clear-grid '((ents / )
    (foreach ent ents(entdel ent))
    nil
  ))
  ;**************************************
  ; Zeichnet einen H-Zug
  (setq draw-h-move '((pos s / row col)
    (setq row(/ pos s)col(rem pos s))
    (command"_circle"(list(+ col 0.5)(+ row 0.5))0.35)
    (entlast)
  ))
  ;**************************************
  ; Zeichnet einen M-Zug
  (setq draw-m-move '((pos s / row col ents)
    (setq row(/ pos s)col(rem pos s))
    (command"_line"(list(+ col 0.8)(+ row 0.8))
            (list(+ col 0.2)(+ row 0.2))"")
    (setq ents(list(entlast)))
    (command"_line"(list(+ col 0.8)(+ row 0.2))
            (list(+ col 0.2)(+ row 0.8))"")
    (setq ents(cons(entlast)ents))
  ))
  ;**************************************
  ; Fordert H zum Ziehen auf und ermittelt das Feld
  (setq get-h-move '((moves s / tmp ok get-click)
    ; Ermittelt das geklickte Feld
    (setq get-click '((s / p row col)
      (setq p(getpoint "Click a field: \n"))
      (+(*(min(max(fix(cadr p))0)(1- s))s)
        (min(max(fix(car p))0)(1- s))
      )
    ))
    ;*******************
    (while(not ok)
      (initget 1)
      (setq tmp(get-click s))
        (if(member tmp moves)(princ "Invalid. ")(setq ok 1))
      )
      tmp
    )
  )
  ;**************************************
  ; Testet, ob das Spiel gewonnen wurde
  (setq win-test '((pl / )
    (apply'or
      (mapcar
      '(lambda(l)
         (apply'and(mapcar'(lambda(p)(member p pl))l))
       )
      '((0 1 2)(3 4 5)(6 7 8)(0 3 6)(1 4 7)
                              (2 5 8)(0 4 8)(2 4 6))
      )
    )
  ))
  ;**************************************
  ; Extrahiert die H-Züge aus einem Spielverlauf
  (setq h-only '((pl / )
    (if(null pl)
      nil
      (append(list(car pl))(h-only(cddr pl)))
    )
  ))
  ;**************************************
  ; Extrahiert die M-Züge aus einem Spielverlauf
  (setq m-only '((pl / )
    (h-only(reverse(cdr(reverse pl))))
  ))
  ;**************************************
  ; Testet, ob ein Unentschieden vorliegt
  (setq tied? '((pl s / )
    (if(=(length pl)(* s s))
      (progn
        (princ "Game tied.\n")
        (princ)
      )
    )
  ))
  ;**************************************
  ; Testet, ob H gewonnen hat
  (setq h-won? '((pl / )
    (if(win-test(h-only pl))
      (progn
        (princ"H is winner! Game over.\n")
        (princ)
      )
    )
  ))
  ;**************************************
  ; Testet, ob M gewonnen hat
  (setq m-won? '((pl / )
    (if(win-test(m-only pl))
      (progn
        (princ"M is winner! Game over.\n")
        (princ)
      )
    )
  ))
  ;**************************************
  ; Fragt beim Benutzer an, ob weiteres Spiel
  (setq ask-for-end '(( / tmp)
    (initget 0 "Yes No")
    (=(getkword "Play again? <Yes>/No: ")"No")
  ))
  ;**************************************
  ; Trägt die Bewertung des Spielverlaufs ein
  (setq reward '((amt his memory / )
    (foreach item his
      (setq memory
        (if(assoc item memory)
          (subst
            (cons item(+ amt(cdr(assoc item memory))))
            (assoc item memory)
            memory
          )
          (cons(cons item amt)memory)
        )
      )
    )
    memory
  ))
  ;**************************************
  ; Ermittelt den nächsten M-Zug
  (setq find-m-move'( (pl s memory / j rl mvs mn)
    (setq j 0)
    (repeat (* s s)
      (if(not(member j pl))
        (progn
          (if(not(assoc(cons j pl)memory))
            (progn
              (setq memory(cons(cons(cons j pl)0)memory))
              (setq mvs(cons(cons(cons j pl)0)mvs))
            )
            (setq mvs(cons(assoc(cons j pl)memory)mvs))
          )
        )
      )
      (setq j(1+ j))
    )
    (foreach item mvs
      (if
        (or
          (m-won?(car item))
          (h-won?(cons(caar item)(cons'x(cdar item))))
        )
        (setq mn item)
      )
    )
    (if(null mn)
      (progn
        (setq mn '((-1) . -1000000))
        (foreach item(reverse mvs)
          (if(>(cdr item)(cdr mn))
            (setq mn item)
          )
        )
      )
    )
    (list(caar mn)memory)
  ))
  ;**************************************
  ; Hauptfunktion - Spielverlauf
  (setq size 3 stop nil)
  (while(not stop)
    (setq graphics(clear-grid graphics))
    (setq graphics(append graphics(draw-grid size)))
    (setq gameover nil moves nil history nil)
    (while(not gameover)
      (setq moves(cons(get-h-move moves size)moves))
      (setq graphics
        (cons(draw-h-move(car moves)size)graphics)
      )
      (if(h-won? moves)
        (progn
          (setq memory(reward -1 history memory))
          (setq gameover 1)
        )
        (progn
          (if(tied? moves size)
            (progn
              (setq memory(reward 1 history memory))
              (setq gameover 1)
            )
            (progn
              (setq tmp(find-m-move moves size memory))
              (setq moves(cons(car tmp)moves))
              (setq memory(cadr tmp))
              (setq history(append history(list moves)))
              (setq graphics
                (append graphics(draw-m-move(car moves)size))
              )
              (if(m-won? moves)
                (progn
                  (setq memory(reward 2 history memory))
                  (setq gameover 1)
                )
              )
            )
          )
        )
      )
    )
    (if(ask-for-end)(setq stop 'T))
  )
))