;; pouziva se funkce planuj, napriklad (planuj '((a b) (c)) '((a) (b c))) ci
;; (planuj '((a b) (c)) '((a b)(c)) :pocet-vezi 3 :vyska-vezi 3)
;; melo by to mit osetreny nalezani skutecne nejkratsich cest, ale je nutno v nejhorsim pripade projit cely stavovy prostor => nepoustet na moc vezi

;; uz toho mam dost je 0:11

(setq cena-na-zem 2)
(setq cena-na-vez 5)
(setq cena-ze-zeme 2)

;;operator prida prvek ke vsem zbylym vezim
(defun pridej-cenu (pre-stav cena)
  (list (list pre-stav) cena))

(defun poloz-na-veze (distribucni-vez zbyle-veze)
  (let* ((pridej (lambda (vez)
		   (let ;; vyradi vez, na kterou se dava prvek 
		       ((ostatni-veze (mapcan (lambda (jina-vez)
						(if (not (equal vez jina-vez)) (list jina-vez))) zbyle-veze))
			;; nasadi prvek na vez
			(nova-vez (list (append (list (car distribucni-vez)) vez)))
			(zbytek-veze (cdr distribucni-vez)))
		     ;; spoji predchozi dohromady
		     (append ostatni-veze nova-vez (if zbytek-veze (list zbytek-veze))))))
	 (naslednici (mapcar pridej zbyle-veze)))
    (mapcar (lambda (naslednik) 
	      (if (cdr distribucni-vez)
		  (pridej-cenu naslednik cena-na-vez)
		(pridej-cenu naslednik cena-ze-zeme))) naslednici)))


(defun poloz-na-zem (distribucni-vez zbyle-veze)
  (let* ((zbytek-veze (cdr distribucni-vez))
	 (naslednik (append zbyle-veze (if zbytek-veze (list zbytek-veze)) (list (list (car distribucni-vez))))))
    (list (pridej-cenu naslednik cena-na-zem))))

(defun pridej-stav (co k-cemu)
  (let ((nova-cesta (append (car co) (car k-cemu)))
	(nova-hodnota (+ (cadr co) (cadr k-cemu))))
    (list nova-cesta nova-hodnota)))

;; vygeneruje dalsi stavy z daneho
(defun dalsi-stavy (stav)
  (let* ((aktualni-stav (caar stav))
	 (presun-prvek (lambda (vez)
			 (let* (;; vyradi vez, na ktere je odebirany prvek
				(zbyle-veze (mapcan (lambda (jina-vez)
						      (if (not (equal vez jina-vez)) (list jina-vez))) aktualni-stav))
				;; vsechny kombinace prvku a vezi
				(na-vez (poloz-na-veze vez zbyle-veze))
				(na-zem (poloz-na-zem vez zbyle-veze)))
			   ;; spoji obohacene veze se stavem, kde je prvek na zemi
			   (append na-vez na-zem))))
	 (naslednici (mapcan presun-prvek aktualni-stav)))
    (mapcar (lambda (nasledny-stav) (pridej-stav nasledny-stav stav)) naslednici)))

(defun stejne-stavy? (stav-1 stav-2)
  (let ((st-1 (caar stav-1))
	(st-2 (caar stav-2)))
    (if (eq (length st-1) (length st-2))
	(every (lambda (vez-1) (some (lambda (vez-2) (equal vez-1 vez-2)) st-2)) st-1))))


(defun vyber-rozdilne-stavy (ktere z-kterych)
  (let ((rozdilny (lambda (co)
		    (if (not (some (lambda (z-ceho)
				     (stejne-stavy? co z-ceho))
				   z-kterych)) (list co)))))
    (mapcan rozdilny ktere)))

(defun existuje-v-seznamu? (stav seznam-stavu)
  (some (lambda (v-seznamu) (stejne-stavy? stav v-seznamu)) seznam-stavu))

(defun pripustny-stav (stav pocet-vezi vyska-vezi) ;;operator vraci stav, pokud je pripustny
  ;;pocet vezi
  (let ((cisty-stav (caar stav)))
    (if (and pocet-vezi stav)
	(setq stav (if (<= (length cisty-stav) pocet-vezi) stav)))
    ;;vyska vezi
    (if (and vyska-vezi stav)
	(setq stav (if (every (lambda (vez) (<= (length vez) vyska-vezi)) cisty-stav) stav)))
    stav))

(defun vyber-nasledujici-stav (udelat cil)  ;misto pro heuristiku
;  (car udelat)) ;; do sirky
  (vyber-vysledek udelat))

(defun odeber-stav (stav seznam)	
  (mapcan (lambda (hledany-stav)
	    (if (not (equal hledany-stav stav)) (list hledany-stav)))
	  seznam))

(defun orez-delsi-a-stejne-cesty (seznam-cest uroven)
  (mapcan (lambda (cesta)
	    (if (< (cadr cesta) (cadr uroven)) (list cesta)))
	  seznam-cest))

(defun vyber-vysledek (vysledky)
  (do ((nejlepsi (car vysledky))
       (seznam-vysledku vysledky (cdr seznam-vysledku)))
      ((not seznam-vysledku) nejlepsi)
      (if (< (cadar seznam-vysledku) (cadr nejlepsi))
	  (setq nejlepsi (car  seznam-vysledku)))))

(defun citelny-vysledek (vysledek)
  (if vysledek (list (reverse (car vysledek)) (cadr vysledek))))

(defun hledej (udelat udelano cil zatim-nejlepsi pocet-vezi vyska-vezi)
  (let ((aktualni-stav (vyber-nasledujici-stav udelat cil))) ;;vybira se nejlevnejsi
    (if (not udelat) ;;prohledano vse
	zatim-nejlepsi
      (let* ((close (append (list (list (list (caar aktualni-stav)))) udelano))
	     (naslednici (vyber-rozdilne-stavy (dalsi-stavy aktualni-stav) close))
	     (pripustne (mapcan (lambda (reseni)
				  (let ((pripustne (pripustny-stav reseni pocet-vezi vyska-vezi)))
				    (if pripustne (list pripustne))))
				naslednici))
	     (open (append (odeber-stav aktualni-stav udelat) pripustne)))
	(setq udelat open)
	(setq udelano close)
	(if (stejne-stavy? cil aktualni-stav)
	    (let* ((novy-zatim-nejlepsi (vyber-vysledek (append zatim-nejlepsi (list aktualni-stav))))
		   (novy-open (orez-delsi-a-stejne-cesty open novy-zatim-nejlepsi)))
	      (setq zatim-nejlepsi novy-zatim-nejlepsi)
	      (setq udelat novy-open)))
	(hledej udelat udelano cil zatim-nejlepsi pocet-vezi vyska-vezi)))))

(defun planuj (start cil &key (pocet-vezi '()) (vyska-vezi '()))
  (let ((udelat (list (list (list start) 0)))
	(udelano '())
	(konec (list (list cil))))
    (citelny-vysledek (hledej udelat udelano konec '() pocet-vezi vyska-vezi))))