![]() |
Модераторы: Poseidon |
![]() ![]() ![]() |
|
wwall |
|
|||
Новичок Профиль Группа: Участник Сообщений: 45 Регистрация: 28.9.2006 Репутация: нет Всего: 4 |
решение задачи http://alpo.yard.ru/rivergame.html
(defun ВСписке? (x y) (cond ((null y) nil) ((not (consp y)) (equal x y)) ((equal x (car y)) 't) ('t (ВСписке? x (cdr y))))) (DEFUN ВычестьМножество (LST1 LST2) (COND ( (NULL LST1) NIL ) ( (NULL LST2) LST1 ) ( (MEMBER (CAR LST1) LST2) (ВычестьМножество (CDR LST1) LST2) ) ( 'T (CONS (CAR LST1) (ВычестьМножество (CDR LST1) LST2)) ) ) ) (defun oneIntersect (x y) (cond ((null x) nil) ((null y) nil) ((equal x y) nil) ('t (list x y)) ) ) (defun listIntersect (x y) (if (null y) nil (cons (oneIntersect x (car y)) (listIntersect x (cdr y))))) (defun intersect (x y) (if (null x) nil (cons (listIntersect (car x) y) (intersect (cdr x) y)))) (defun нет-на? (x y) (cond ((not (consp y)) (not (equal x y))) ((null (member x y)) 't) ('t nil) ) ) (defun есть? (x y) (not (нет-на? x y))) (defun ПроверитьПоПапе (x) "Функция проверяет ограничения по папе" (let((xx (есть? 'Папа x)) (y1 (есть? 'Дочь1 x)) (y2 (есть? 'Дочь0 x)) (z (есть? 'Мама x))) (or (not xx) (and xx (and (not y1) (not y2))) (and xx z) ))) (defun ПроверитьПоМаме (x) "Функция проверяет ограничения по маме " (let ((xx (есть? 'Мама x)) (y1 (есть? 'Сын1 x)) (y2 (есть? 'Сын0 x)) (z (есть? 'Папа x))) (or (not xx) (and xx (and (not y1) (not y2))) (and xx z)))) (defun ПроверитьПоПреступнику (x) "Функция проверяет ограничения по преступнику" (let ((y (есть? 'Полицейский x)) (z (есть? 'Преступник x)) (q (null (ВычестьМножество x '(Преступник))))) (or (not z) (and q z) (and y z) ))) (defun МожетЕхать (x) "Функция проверяет возможность переместить плот с данным множество людей" (let ((a (есть? 'Полицейский x)) (b (есть? 'Мама x)) (d (есть? 'Папа x))) (or a b d) ) ) (defun ПроверитьДопустимость (x) "Функция проверяет допустимость ситуации по маме папе преступнику" (and (ПроверитьПоПапе x) (ПроверитьПоМаме x) (ПроверитьПоПреступнику x)) ) (defun ПроверитьПлот (x) "Проверяет состояние плота, в отличие от задачи о козле, капусте и волке, здесь есть ограничения на состояние плота (к приимеру папа не может перевезти дочь)" (and (МожетЕхать x) (ПроверитьДопустимость x)) ) (defun Перестановки (что сЧем) "Функция возвращает все допустимые состояние плота исходя из содержимого берега" (append (mapcar #'list что) (remove-if-not #'ПроверитьПлот (remove-if #'null (apply #'append (intersect что сЧем))))) ) (defun getNextCorrect (from _to moves was) (cond ((null from) nil) ; Если неоткуда брать то nil ((null moves) nil) ; Если нечем двигать то nil ((ВСписке? (car moves) was) (getNextCorrect from _to (cdr moves) was)) ('t (let ( (tmpFrom (ВычестьМножество from (car moves))) ; новый откуда (tmpTo (append _to (car moves))) ; новый куда (tmpMove (car moves))) ; новое движение (if (and (ПроверитьДопустимость tmpfrom) (ПроверитьДопустимость tmpto) ) (list tmpFrom tmpTo (cdr moves) (car moves)) (getNextCorrect from _to (cdr moves) was) ) ) ) ) ) (defun Перевозчики (ктоНаБерегу) (Перестановки (remove-if-not #'МожетЕхать ктоНаБерегу) ктоНаБерегу ) ) (defun ПолучитьДвижение (откуда куда движения ужеБыло) (let ((res (GetNextCorrect откуда куда движения ужеБыло) )) (if (null res) (list 'error 'error 'error 'error) res) ) ) (defun подвинуть1 (откуда куда движения было) (let* ( (Res (ПолучитьДвижение откуда куда движения было)) (tmpTo (car res)) (tmpFrom (cadr res)) (tmpMoves (caddr res)) (tmpMove (cadddr res)) (tmpWas (nth 5 res)) ) (format 't "Движение с правого на левый - ~S~%" tmpMove) (cond ((equal tmpTo 'error) nil) ('t (cond ((шаг tmpFrom tmpTo (Перевозчики tmpFrom) (append было (list tmpMove nil)) 1) 't) ('t (подвинуть1 откуда куда (cdr движения) (append было (list tmpMove nil)) ))))))) (defun ШагПраво (откуда куда движения было n) (cond ((null откуда) 't) ; если пусто то мы достигли цели!!! ((null движения) nil) ; если нечем передвигать то не нашли ('t (подвинуть1 куда откуда движения было)) ) ) (defun Шаг (откуда куда движения было n) (cond ((null откуда) 't) ; если пусто то мы достигли цели!!! ((null движения) nil) ; если нечем передвигать то не нашли ('t (let ((Res (ПолучитьДвижение откуда куда движения было))) (let ( (tmpFrom (car res)) (tmpTo (cadr res)) (tmpMoves (caddr res)) (tmpMove (cadddr res)) (tmpWas (nth 5 res)) ) (format 't "Движение с левого на правый- ~S~%" tmpMove) (cond ((equal tmpFrom 'error) nil) ('t (if (шагПраво tmpFrom tmpTo (Перевозчики tmpTo) nil (+ n 1)) 't (шаг откуда куда (cdr движения) (append было (list tmpMove nil)) (+ n 1))) ))))))) (setq все (list 'Полицейский 'Преступник 'Папа 'Сын0 'Сын1 'Мама 'Дочь0 'Дочь1)) (setq МожетПлавать (list 'Полицейский 'Папа 'Мама)) (setq НеМожетПлавать (ВычестьМножество все МожетПлавать)) (шаг все () (Перевозчики Все) () 1) Закритикуйте и скажите как можно по другому |
|||
|
||||
![]() ![]() ![]() |
Правила форума "Центр помощи" | |
|
ВНИМАНИЕ! Прежде чем создавать темы, или писать сообщения в данный раздел, ознакомьтесь, пожалуйста, с Правилами форума и конкретно этого раздела.
Более подробно с правилами данного раздела Вы можете ознакомится в этой теме. Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Poseidon, Rodman |
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей) | |
0 Пользователей: | |
« Предыдущая тема | Центр помощи | Следующая тема » |
|
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности Powered by Invision Power Board(R) 1.3 © 2003 IPS, Inc. |