Zvire.el

Z Wikiverzity

zvire.el je program pro demonstraci:

  • učících se programů
  • implemantace struktury binárního rozhodovacího stromu
  • programování v lispu, konkrétně v jeho klonu elisp, použité v editoru emacs

Ilustrace toho, jak se program vyvíjel od jednoduchého ke komplikovanějšímu:


; Zvire
; =====
; Copyleft Kychot 1997

(setq zverinec1 '("chlupaté" ("domácí" "kočka" . "tygr") . "ryba"))
(setq zverinec2 '
("chlupaté" ("domácí" ("věrné" "pes" "víc chlupaté" "ovečka" "rohaté" ("více dojivé" "kravička" . "koza") . "kočka") "s velkýma ušima" "medvěd" . "tygr") "slizské" ("dlouhé" "had" "červené" "beruška" . "žába") "pernaté" "slepice" . "ryba")
)

(setq zver-file "zverinec")
(setq minibuf 't)      ; Bavime se pres minibuffer?

(defun zvire ()
  "Hra na hadani zvirat."
  (interactive)
  (setq minibuf (ano-ne "Budeme se bavit přes minibuffer?"))
  (let ((zver-file "zverinec") (zver-buffer))
    (switch-to-buffer "zvire")
    (if (file-readable-p zver-file)
	(progn
	  (setq zver-buffer (find-file-noselect zver-file))
	  (save-excursion
	    (set-buffer zver-buffer)
	    (goto-char (point-min)))
	  (setq zverinec (read zver-buffer)))
      (progn
	(setq zver-buffer (find-file-noselect zver-file))
	(setq zverinec '("chlupaté" "kočka" . "ryba"))))
    (while (and (ano-ne "Myslíš si nějaké zvíře? ") (hadej zverinec)))
    (if (ano-ne 
	 "Tak si do příště nejaké vymysli. Mám uložit zvířata do zvěřince? ")
	(save-excursion
	  (print zverinec zver-buffer) 
	  (set-buffer zver-buffer)
	  (save-buffer)))
;   (kill-buffer zver-buffer)))

(defun hadej (zvirata)
    "Hada podle seznamu zvirata."
    (let  ((vlastnost (car zvirata))
	   (takovi-onaci (cdr zvirata))
	   (prvni-druha)
	   (vybrany)
	   (nove-zvire)
	   (nova-vlastnost)
	  )
	(setq prvni-druha (zeptej-se vlastnost))
	(setq vybrany (if prvni-druha (car takovi-onaci)(cdr takovi-onaci)))
	(if (consp vybrany)
		(hadej vybrany)			; rekurse
	    (if (odpovez vybrany)		; konec rekurse - pokrac.?
		    (ano-ne "Hurá, uhádnul jsem. Budeme hádat další zvíře? ")
		(progn				; nove zvire do seznamu
		    (setq nove-zvire (read-string
			"Jiné takové zvíře neznám. Jak se jmenuje? "))
		    (setq nova-vlastnost (read-string (format
			"A jaké je %s zvíře na rozdíl od zvířete zvaného %s? "
			nove-zvire vybrany)))
		    (if (ano-ne (format
		    "Platí, že %s je zvíře %s a %s není zvíře %s? "
			nove-zvire nova-vlastnost vybrany nova-vlastnost))
			(if prvni-druha
			    (setcar takovi-onaci
			    (cons nova-vlastnost (cons nove-zvire vybrany)))
			  (setcdr takovi-onaci
			  (cons nova-vlastnost (cons nove-zvire vybrany)))
		    )	)
		    (ano-ne "Děkuji za poučení. Mám zase hádat? ")
)   )   )   )   )
; (hadej zverinec1)

; (zeptej-se 'šedivé)
(defun zeptej-se (vlastnost)
	"Zepta se na vlastnost zvirete."
	(ano-ne (format "Je to zvíře %s? " vlastnost)))

; (odpovez 'myš)
(defun odpovez (zvire)
	"Odpovi uhadnute zvire."
	(ano-ne (format "Je to %s! Že mám pravdu? " zvire)))

(defun ano-ne (otazka)
  "Zepta se a chce odpoved a/n."
  (let ((odpoved))
    (insert-string otazka)
    (catch 'loop
      (while 't
	(setq odpoved (read-char))
	(if (eq odpoved ?a) (progn (_output " ano\n") (throw 'loop 't))
        (if (eq odpoved ?A) (progn (_output " Ano\n") (throw 'loop 't))
        (if (eq odpoved ?y) (progn (_output " yes\n") (throw 'loop 't))
        (if (eq odpoved ?Y) (progn (_output " Yes\n") (throw 'loop 't))
        (if (eq odpoved ?j) (progn (_output " jo\n") (throw 'loop 't))
        (if (eq odpoved ?J) (progn (_output " Jo\n") (throw 'loop 't))
        (if (eq odpoved ?n) (progn (_output " ne\n") (throw 'loop nil))
        (if (eq odpoved ?N) (progn (_output " Ne\n") (throw 'loop nil))
      ))))))))))))

; (ano-ne "Zkouška?")Zkouška? Yes

(defun _output (mess)
  "Vystup do minibufferu nebo do bufferu."
  (interactive)
  (if minibuf
      (message mess)
    (insert-string mess)))

(defun _input-string(mess)
  "Vstup stringu pres minibuffer nebo pres buffer."
  (interactive)
  (if minibuf
      (read-string mess)
    (let ((beg))
      (insert-string (concat mess "  "))
      (set beg (point))