> 1 <

Автор Сообщение

nekhor

Members


Статус

4 сообщений

Где: Russia Йошкар-Ола
Род занятий:
Возраст: 37

#134   2008-11-02 00:47 GMT+3 часа(ов)      
Уважаемые, сможет ли кто дать подсказку? Требуется функция, осуществляющая в списке W замену элементов списка X на элементы списка Y. Звучит малопонятно, поясню примером:
список X: (a b)
список Y: (1 2)
список W: ((a b) a (c (a (a d))))
Найти в списке W элементы, имеющиеся в списке X и заменить их соответствующими элементами списка Y, другие элементы оставить без изменения. Список W, например, после такого преобразования должен принять вид: ((1 2) 1 (c (1 (1 d)))) .

Кто сможет дать подсказку? Необязательно весь текст, хоть алгоритм подскажите, а дальше я сам.

Спасибо.

dmitry_vk

Members


Статус

33 сообщений
http://dmitry-vk.livejournal.com/
Где: Russia Казань
Род занятий:
Возраст: 30

#135   2008-11-02 01:25 GMT+3 часа(ов)      
Например,
 
(defun subst-lists (x y w)
(let ((n (position w x)))
(if n
(nth n y)
w)))
 
(defun rec-subst (x y w)
(typecase w
(list (mapcar (lambda (w) (rec-subst x y w)) w))
(t (subst-lists x y w))))
 
(rec-subst '(a b) '(1 2) '((a b) a (c (a (a d)))))
=>
((1 2) 1 (C (1 (1 D))))
 

nekhor

Members


Статус

4 сообщений

Где: Russia Йошкар-Ола
Род занятий:
Возраст: 37

#136   2008-11-02 20:12 GMT+3 часа(ов)      
Ага, спасибище огромное! Говорила мне мама - изучай лямбда-исчисление, пригодится :-)

nekhor

Members


Статус

4 сообщений

Где: Russia Йошкар-Ола
Род занятий:
Возраст: 37

#137   2008-11-02 21:10 GMT+3 часа(ов)      
Совсем забыл сказать что используется XLISP, а в нем, как выяснилось, нет typecase и position, придется их тоже реализовывать.
typecase w заменил на case (type-of w) - функциональность от этого, по-моему, не изменилась.
Насчет реализации в XLISP функционала position - первой в голову пришла такая реализация:
(defun position (c l)
(- (length l) (length (member c l)))
)


Итоговый код:
(defun position (c l)
(- (length l) (length (member c l)))
)
(defun subst-lists (x y w)
(let ((n (position w x)))
(if n
(nth n y)
w)
)
)
(defun rec-subst (x y w)
(case (type-of w)
(list (mapcar (lambda (w) (rec-subst x y w)) w))
(t (subst-lists x y w))
)
)


Не работает :-(
Привел бы данные трассировки, да XLISP-PLUS 2.1d, в которой работаю, не позволяет ни выделить ни скопировать кусок текста из окна транслятора.

Сдается мне, ошибка кроется в неверной реализации position. Сможете подсказать?

Спасибо.

отредактировал(а) nekhor: 2008-11-02 23:37 GMT+3 часа(ов)

nekhor

Members


Статус

4 сообщений

Где: Russia Йошкар-Ола
Род занятий:
Возраст: 37

#138   2008-11-03 00:25 GMT+3 часа(ов)      
Кажется, нащупал такое решение:

(defun position (_elem _list)
(if _list
(if (equal (car _list) _elem) 0
((lambda (result)
(if result (1+ result)))
(position _elem (cdr _list))
)
)
)
)
 
(defun subst-lists (x y w)
(let ((n (position w x))) (if n (nth n y) w)
)
)
 
(defun rec-subst (x y w)
(if (typep w 'list)
(mapcar (lambda (w) (rec-subst x y w)) w)
(subst-lists x y w)
)
)
 


Что скажете об этом, уважаемые?

Надо попроверять, погонять на разных списках, но кажется решение верное.

dmitry_vk

Members


Статус

33 сообщений
http://dmitry-vk.livejournal.com/
Где: Russia Казань
Род занятий:
Возраст: 30

#139   2008-11-03 14:38 GMT+3 часа(ов)      
Вообще, использование двух списков для задания замены кажется нелогичным. Гораздо лучше использовать списки замен вот такой структуры: ((a 1) (b 2) (c 3)). Тогда не нужно будет position'ов, и вообще код будет проще.
Вместо использования position и nth можно сделать функцию, которая будет параллельно идти по двум спискам и искать в первом списке заменяемый объект, и при нахождении будет возвращать объект из второго списка. Например, так:
 
(defun subst-lists (x y w)
(if y
(if (eq (car y) x)
(car w)
(subst-lists x (cdr y) (cdr w)))
x))
 

juna

Members


Статус

23 сообщений

Где: Russia
Род занятий:
Возраст:

#201   2008-12-29 23:37 GMT+3 часа(ов)      
Думаю утратила статус актуальной, поэтому вот решение извращенцев типа меня
(defun repl (x y w)
(defun it (x y w)
(cond
((null w) nil)
((and (atom (car w)) (equal (car w) (car x )))
(cons (car y) (it x y (cdr w))))
((and (atom (car w)) (not (equal (car w) (car x ))))
(cons (car w) (it x y (cdr w))))
(t (cons (it x y (car w)) (it x y (cdr w))))))
(cond
((or (null x) (null y)) w)
(t (repl (cdr x) (cdr y) (it x y w)))))

чистая рекурсия и ничего более.

отредактировал(а) juna: 2008-12-30 00:54 GMT+3 часа(ов)
> 1 <


Онлайн :

0 пользователь(ей), 29 гость(ей) :




Реклама на сайте: