Модераторы: Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Закритикуйте 
:(
    Опции темы
wwall
Дата 25.10.2006, 10:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 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)



Закритикуйте и скажите как можно по другому
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Центр помощи"

ВНИМАНИЕ! Прежде чем создавать темы, или писать сообщения в данный раздел, ознакомьтесь, пожалуйста, с Правилами форума и конкретно этого раздела.
Несоблюдение правил может повлечь за собой самые строгие меры от закрытия/удаления темы до бана пользователя!


  • Название темы должно отражать её суть! (Не следует добавлять туда слова "помогите", "срочно" и т.п.)
  • При создании темы, первым делом в квадратных скобках укажите область, из которой исходит вопрос (язык, дисциплина, диплом). Пример: [C++].
  • В названии темы не нужно указывать происхождение задачи (например "школьная задача", "задача из учебника" и т.п.), не нужно указывать ее сложность ("простая задача", "легкий вопрос" и т.п.). Все это можно писать в тексте самой задачи.
  • Если Вы ошиблись при вводе названия темы, отправьте письмо любому из модераторов раздела (через личные сообщения или report).
  • Для подсветки кода пользуйтесь тегами [code][/code] (выделяйте код и нажимаете на кнопку "Код"). Не забывайте выбирать при этом соответствующий язык.
  • Помните: один топик - один вопрос!
  • В данном разделе запрещено поднимать темы, т.е. при отсутствии ответов на Ваш вопрос добавлять новые ответы к теме, тем самым поднимая тему на верх списка.
  • Если вы хотите, чтобы вашу проблему решили при помощи определенного алгоритма, то не забудьте описать его!
  • Если вопрос решён, то воспользуйтесь ссылкой "Пометить как решённый", которая находится под кнопками создания темы или специальным флажком при ответе.

Более подробно с правилами данного раздела Вы можете ознакомится в этой теме.

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Poseidon, Rodman

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Центр помощи | Следующая тема »


 




[ Время генерации скрипта: 0.0692 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.