> 1 <

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

Kirzum

Members


Статус

4 сообщений

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

#1823   2010-04-08 11:13 GMT+3 часа(ов)      
Помогите решить задачку.
Пытаюсь начать разбираться в лиспе. Половина задачи решил, осталась небольшая часть, вроде и просто, но мозг сломал, кружусь вокруг да около.

Осталось выкинуть из списка все отрицательные элементы. Может кто-нибудь поможет?

Михаил

Members


Статус

120 сообщений

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

#1824   2010-04-08 17:53 GMT+3 часа(ов)      
(define (remove-negative L)
(if (null? L)
'()
(if (negative? (car L))
(remove-negative (cdr L))
(cons (car L) (remove-negative (cdr L))))))

;> (remove-negative '(0 1 -1 3 -4 -5 6 76 9))
;(0 1 3 6 76 9)

ander-skirnir

Members


Статус

227 сообщений
http://lisper.ru
Где: Ukraine
Род занятий: `'`,`',`',
Возраст: 30

#1828   2010-04-08 19:40 GMT+3 часа(ов)      
Михаил, Вы не удалили отрицательные элементы, а построили новый список, состоящий из всех неотрицательных элементов исходного. Поставленную же задачу решить можно далеко не на всех схемах, ибо в них стандартные списки иммутабельны, и не везде присутствует mcons.

На common-lisp задача решается так:

(defun delete-negatives (lst)
(let ((iter-ptr lst))
(tagbody start
(when (and (car iter-ptr) (< (car iter-ptr) 0))
(rplaca iter-ptr (cadr iter-ptr))
(rplacd iter-ptr (cddr iter-ptr))
(go start))
(if (cdr iter-ptr)
(setf iter-ptr (cdr iter-ptr))
(return-from delete-negatives lst))
(go start))))


> (defvar *x* '(-1 2 -3 4 5))
(-1 2 -3 4 5)
 
> (delete-negatives *x*)
(2 4 5)
 
> *x*
(2 4 5)
 
> (defvar *x* '(-1 -2 -3 -4 -5))
(-1 -2 -3 -4 -5)
 
> (delete-negatives *x*)
(nil)
 
> *x*
(nil)

отредактировал(а) ander-skirnir: 2010-04-08 20:08 GMT+3 часа(ов)

Михаил

Members


Статус

120 сообщений

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

#1829   2010-04-08 20:08 GMT+3 часа(ов)      
> Вы не удалили отрицательные элементы, а построили новый список
Функционально программирование у нас или где? Если же надо изменить состояние, то можно добавить
(define-syntax-rule (remove-negative! L) 
(set! L (remove-negative L)))

ander-skirnir

Members


Статус

227 сообщений
http://lisper.ru
Где: Ukraine
Род занятий: `'`,`',`',
Возраст: 30

#1830   2010-04-08 20:13 GMT+3 часа(ов)      
> Функционально программирование у нас или где?
Это в схеме у Вас функциональное, в лиспах, вообще говоря, мультипарадигменное.

Цитата

(define-syntax-rule (remove-negative! L)
(set! L (remove-negative L)))


Вы всё-равно присваиваете переменной новый список, а не меняете старый, на который она указывала.

Вообще, у меня вариант не лучший. Быстрее всего будет не замещать отрицательные символы в начале списка следующими за ними неотрицательными, а просто двигать указатель до первого подходящего.

(defun delete-negatives (lst)
(loop (if (and (car lst) (< (car lst) 0))
(setf lst (cdr lst))
(return)))
(let ((iter-ptr lst))
(loop (when (null (cdr iter-ptr))
(return lst))
(if (< (cadr iter-ptr) 0)
(rplacd iter-ptr (cddr iter-ptr))
(setf iter-ptr (cdr iter-ptr))))))


Причём в CL есть стандартный функционал, так работающий - delete-if (и его иммутабельный вариант для функциональщиков - remove-if). То есть, чтобы совсем без заморочек, можно просто объявить макрос:

(defmacro delete-negatives (ls)
(if (symbolp ls)
`(setf ,ls (delete-if (lambda (x) (< x 0)) ,ls))
`(delete-if (lambda (x) (< x 0)) ,ls)))

отредактировал(а) ander-skirnir: 2010-04-08 21:00 GMT+3 часа(ов)

Михаил

Members


Статус

120 сообщений

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

#1832   2010-04-08 23:02 GMT+3 часа(ов)      
Вот еще очень красивое решение:
(define (remove-negative L)
(foldr (lambda (x y) (if (negative? x) y (cons x y))) '() L))

Михаил

Members


Статус

120 сообщений

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

#1833   2010-04-09 02:51 GMT+3 часа(ов)      
> delete-if
> remove-if

У наc тоже есть такая штука, только без if, просто remove и remove!.

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#1834   2010-04-09 03:18 GMT+3 часа(ов)      
ander-skirnir
Поставленную же задачу решить можно далеко не на всех схемах, ибо в них стандартные списки иммутабельны, и не везде присутствует mcons.
Вы не правы. mcons присутствует в каждой реализации. Просто создавайте список с помощью list, т.е. так (list 1 2 3), а не '(1 2 3).
ander-skirnir
Это в схеме у Вас функциональное, в лиспах, вообще говоря, мультипарадигменное.
А чем собственно лисп отличается от схемы?

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#1836   2010-04-09 04:02 GMT+3 часа(ов)      
ander-skirnir
Вообще, у меня вариант не лучший. Быстрее всего будет не замещать отрицательные символы в начале списка следующими за ними неотрицательными, а просто двигать указатель до первого подходящего.
У вас довольно много вычислений, а создание cons-ячеек (pair) довольно быстрый процесс. На мой взгляд алгоритм Михаила прост, не имеет побочных эффектов и он достаточно эффективен.
Вы не справились с поставленной Вами же задачей. Функция delete-negatives работает неверно, точнее не так как Вы хотели.

ander-skirnir

Members


Статус

227 сообщений
http://lisper.ru
Где: Ukraine
Род занятий: `'`,`',`',
Возраст: 30

#1837   2010-04-09 06:34 GMT+3 часа(ов)      
Цитата
У вас довольно много вычислений, а создание cons-ячеек (pair) довольно быстрый процесс. На мой взгляд алгоритм Михаила прост, не имеет побочных эффектов и он достаточно эффективен.


(defun delete-negatives-a (lst)
(loop (if (and (car lst) (< (car lst) 0))
(setf lst (cdr lst))
(return)))
(let ((iter-ptr lst))
(loop (when (null (cdr iter-ptr))
(return lst))
(if (< (cadr iter-ptr) 0)
(rplacd iter-ptr (cddr iter-ptr))
(setf iter-ptr (cdr iter-ptr))))))
 
(defun delete-negatives-b (lst)
(if (null lst)
nil
(if (< (car lst) 0)
(delete-negatives-b (cdr lst))
(cons (car lst) (delete-negatives-b (cdr lst))))))
 
(defun make-random-list (length)
(let ((lst nil))
(loop (push (* (random 10)
(if (= (random 2) 1) 1 -1))
lst)
(decf length)
(when (= length 0)
(return lst)))))
 
(defvar *a* (make-random-list 1000000))
(defvar *b* (make-random-list 1000000))


* (time (progn (delete-negatives-a *a*) nil))

Evaluation took:
0.207 seconds of real time
0.202802 seconds of total run time (0.046801 user, 0.156001 system)
98.07% CPU
412,344,400 processor cycles
0 bytes consed

NIL
* (time (progn (delete-negatives-b *b*) nil))

debugger invoked on a SB-KERNEL::CONTROL-STACK-EXHAUSTED:
Control stack exhausted (no more space for function call frames).
This is probably due to heavily nested or infinitely recursive functio
calls, or a tail call that SBCL cannot or has not optimized away.

PROCEED WITH CAUTION.

Type HELP for debugger help, or (SB-EXT:QUIT) to exit from SBCL.

restarts (invokable by number or by possibly-abbreviated name):
0: [ABORT] Exit debugger, returning to top level.

(DELETE-NEGATIVES-B (2 -1 0 -5 -3 8 5 4 -4 -1 -3 -6 ...))

Цитата
Функция delete-negatives работает неверно, точнее не так как Вы хотели.


Ответственно заявляю, что она работает и верно, и так как я хотел.

Цитата
А чем собственно лисп отличается от схемы?


Тем, что схема - конкретный язык, а лисп - семейство языков, к коим относится и схема, и коммон-лисп.

Цитата
Вы не правы. mcons присутствует в каждой реализации. Просто создавайте список с помощью list, т.е. так (list 1 2 3), а не '(1 2 3).


MzScheme:

> (require scheme/mpair)
> (define x (list 1 2 3))
> (mlist? x)
#f

> (define y (mlist 1 2 3))
> (mlist? y)
#t

отредактировал(а) ander-skirnir: 2010-04-09 06:45 GMT+3 часа(ов)

ander-skirnir

Members


Статус

227 сообщений
http://lisper.ru
Где: Ukraine
Род занятий: `'`,`',`',
Возраст: 30

#1838   2010-04-09 09:10 GMT+3 часа(ов)      
Решение с foldr'ом прикольное, но тоже медленноватое.

На списке из 1млн положительных чисел:
- delete-negatives-a : 0.013
- delete-negatives-b : stack-overflow
- delete-negatives-c : 0.417

На рандомном списке из 1млн чисел:
- delete-negatives-a : 0.120
- delete-negatives-b : stack-overflow
- delete-negatives-c : 0.202

На списке из 1млн отрицательных чисел:
- delete-negatives-a : 0.007
- delete-negatives-b : stack-overflow
- delete-negatives-c : 0.185

напоминаю:
delete-negatives-a - итерация, структуроразрушающая
delete-negatives-b - рекурсия, иммутабельная
delete-negatives-c - свёртка, иммутабельная


Ну и, понятно, у структуроразрушающего варианта, кроме выигрыша в производительности, присутствует огромный выигрыш в памяти.

;;если сомневаетесь, что правильно свёртку делал, вот:
(defun delete-negatives-c (lst)
(reduce (lambda (x y) (if (< x 0) y (cons x y))) lst
:from-end t
:initial-value '()))

Михаил

Members


Статус

120 сообщений

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

#1839   2010-04-09 10:54 GMT+3 часа(ов)      
Я голосую за свертку (вообще я люблю ее). Интересные результаты. Вот Вам за это еще одно решение:
(define (remove-negative! L)
(let ((r L))
(for-each (lambda (x)
(if (>= x 0)
(begin (set-car! r x)
(set! r (cdr r))))) L)
(if (not (null? r)) (set-cdr! r '()))))

Михаил

Members


Статус

120 сообщений

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

#1840   2010-04-09 11:05 GMT+3 часа(ов)      
Кстати, у меня в PLT Scheme на Вашем тесте delete-negatives-b не вылытает в stack-overflow, а время вычисления занимает в среднем пять секунд. Может у Вас хвостовая рекурсия не поддерживается?

asbest

Members


Статус

64 сообщений

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

#1841   2010-04-09 12:43 GMT+3 часа(ов)      
Надо же, какая дискуссия :-)

Я бы рекомендовал (на CL)

(delete 0 '(1 -2 3 -4 5 -6 7 -8) :test #'>)
 

здесь не используется самописный код, то бишь lambda и т.д. что в интерпретаторах важно. В native code компиляторах, наверное неважно. C reduce :from-end решение интересное.

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#1842   2010-04-09 12:44 GMT+3 часа(ов)      
>Ответственно заявляю, что она работает и верно, и так как я хотел.
> (setq l '(-1 -2 3 -7 8 -9))
(-1 -2 3 -7 8 -9)
> (delete-negatives-a l)
(3 8)
> l
(-1 -2 3 8)
Вы этого добивались?

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#1843   2010-04-09 12:47 GMT+3 часа(ов)      
> (require scheme/mpair)
Вы сами изменили работу интерпретатора. Где тут по умолчанию?
Все реализации схемы поддерживающие хотя бы r4rs содержат mcons.

отредактировал(а) misha: 2010-04-09 12:55 GMT+3 часа(ов)

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#1844   2010-04-09 13:04 GMT+3 часа(ов)      
>>>Это в схеме у Вас функциональное, в лиспах, вообще говоря, мультипарадигменное.
>>А чем собственно лисп отличается от схемы?
>Тем, что схема - конкретный язык, а лисп - семейство языков, к коим относится и схема, и коммон-лисп.
>Поставленную же задачу решить можно далеко не на всех схемах, ибо в них стандартные списки иммутабельны, и не везде присутствует mcons.

Вы наверное запутались. Т.к. Вы сами подтверждаете как существование нескольких диалектов схемы, так и то, что схема поддерживает мультипарадигменное программирование.

Fallen_s4e

Members


Статус

114 сообщений
http://lisper.ru
Где: Zimbabwe lisper.ru
Род занятий: fallen_s4e
Возраст: 8

#1845   2010-04-09 13:16 GMT+3 часа(ов)      
asbest, красиво, но похоже на грязный хак). Оттуда же:
(delete -1 '(1 -2 3 -4 5 -6 7 - :key #'signum)
И самое напрашивающиеся:
(delete-if #'minusp '(1 -2 3 -4 5 -6 7 -)

ander-skirnir

Members


Статус

227 сообщений
http://lisper.ru
Где: Ukraine
Род занятий: `'`,`',`',
Возраст: 30

#1846   2010-04-09 14:05 GMT+3 часа(ов)      
misha
нескольких диалектов схемы

У схемы нет диалектов, схема сама - диалект, как и CL. Есть реализации этого диалекта, а есть стандарты, декларирующие требования к реализациям.

misha
схема поддерживает мультипарадигменное программирование

Так же поддерживает, как си - логическое программирование. Схема заточена под ФП, CL - под мультипарадигменность.

misha
Все реализации схемы поддерживающие хотя бы r4rs содержат mcons.

Ну я не особо интересовался, насколько это оговаривается в стандартах, но мне хватило того, что в такой популярной реализации, как plt-scheme, для того, чтобы заюзать mcons, нужно подключать дополнительный модуль.

Цитата
misha :
>Ответственно заявляю, что она работает и верно, и так как я хотел.
> (setq l '(-1 -2 3 -7 8 -9))
(-1 -2 3 -7 8 -9)
> (delete-negatives-a l)
(3 8)
> l
(-1 -2 3 8)
Вы этого добивались?



(setf l (delete-negatives-a l))

Я добивался не строить новые списочные ячейки.

Михаил

Кстати, у меня в PLT Scheme на Вашем тесте delete-negatives-b не вылытает в stack-overflow, а время вычисления занимает в среднем пять секунд. Может у Вас хвостовая рекурсия не поддерживается?


Суть в том, что это таки не хвостовая рекурсия. Знающий человек на соседнем форуме говорит, что это просто в некоторых реализациях схемы есть оптимизация случаев вроде такого вызова cons.

отредактировал(а) ander-skirnir: 2010-04-09 14:16 GMT+3 часа(ов)

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#1847   2010-04-09 14:37 GMT+3 часа(ов)      
>Поставленную же задачу решить можно далеко не на всех схемах, ибо в них стандартные списки иммутабельны, и не везде присутствует mcons.
>У схемы нет диалектов, схема сама - диалект, как и CL. Есть реализации этого диалекта, а есть стандарты, декларирующие требования к реализациям.
Как я писал: "Все реализации схемы поддерживающие хотя бы r4rs содержат mcons". А иначе это не схема.
Все отклонения от стандарта четко указываются:
Цитата
Kawa is a featureful dialect in its own right, and additionally provides very useful integration with Java.


>Схема заточена под ФП, CL - под мультипарадигменность.
Схема поддерживает: метапрограммирование, функциональное и процедурное программирование. А с помощью библиотек и ООП. Вам этого что мало?

отредактировал(а) misha: 2010-04-09 16:18 GMT+3 часа(ов)

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#1848   2010-04-09 15:27 GMT+3 часа(ов)      
Решил я протестировать свой ToyScheme написанный на C# за пару дней. Конечно об оптимизации речи быть не может.
> (define (rn L)
(if (null? L)
'()
(if (< (car L) 0)
(rn (cdr L))
(cons (car L) (rn (cdr L))))))
#<void>
>
(define (ml n r)
(if (> r n)
'()
(cons r (ml n (+ r 1)))))
#<void>
>
(define l '(1 2 3 -8 9 8 -9))
#<void>
> (set! l (rn l))
#<void>
> l
(1 2 3 9 8)
>
(set! l (ml 1000000 1))
#<void>
> (set-car! (cddddr l) -89)
#<void>
> (length l)
1000000
> (set! l (rn l))
#<void>
> (length l)
999999
Забавно, что никакого переполнения стека не произошло. И время потраченное на вычисление составляет от 12-14 сек.(зависит от работы сборщика мусора).
Тестировал на P4 2.4 с 1 Гб оперативной памяти, т.е. на древнем старье.

ander-skirnir

Members


Статус

227 сообщений
http://lisper.ru
Где: Ukraine
Род занятий: `'`,`',`',
Возраст: 30

#1849   2010-04-09 16:59 GMT+3 часа(ов)      
> свой ToyScheme написанный на C# за пару дней
> Забавно, что никакого переполнения стека не произошло.

Ну Вы, скорее всего, сами не управляете в своей реализации стеком вызовов функций, а если так - тогда об этом заботится CLR, которая умеет разруливать подобные ситуации.

> 12-14 сек

Лучше уж переполнение стека Щас протестил на пне втором (233 мгц, 320 мб оп) - вариант delete-negatives-a с рандомным списком миллионной длины отработал за 160 мс против 120 мс на мощном компе - на самом деле те результаты, что я раньше приводил не совсем объективны (и истинный результат будет гораздо круче), потому что надо разобраться как sbcl на 64 разрядных многоядерных процах нормально юзать.

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#1850   2010-04-09 17:23 GMT+3 часа(ов)      
>Ну Вы, скорее всего, сами не управляете в своей реализации стеком вызовов функций, а если так - тогда об этом заботится CLR, которая умеет разруливать подобные ситуации.

А о какой оптимизации идет речь?)) Вы довольно неопытны в этом вопросе. Беда в том, что аппаратный стек возвратов слишком мал. Поэтому все пришлось реализовывать самому.

>> 12-14 сек
>Лучше уж переполнение стека
Для не компилирующего интерпретатора это достаточно хороший результат. Сможете за пару дней сделать лучше? Тогда и поговорим.

asbest

Members


Статус

64 сообщений

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

#1851   2010-04-09 17:41 GMT+3 часа(ов)      
Цитата
Fallen_s4e :
(delete-if #'minusp '(1 -2 3 -4 5 -6 7 -8 ))



А, ну да, есть же minusp!

ander-skirnir

Members


Статус

227 сообщений
http://lisper.ru
Где: Ukraine
Род занятий: `'`,`',`',
Возраст: 30

#1852   2010-04-09 18:34 GMT+3 часа(ов)      
>> А о какой оптимизации идет речь?

Я не имел ввиду какие-либо оптимизации. Я хотел сказать, что если Вы сами не моделируете вызовы функций со всеми проистекающими отсюда стеками, окружениями, связываниями, а реализовываете базисные функции built-in'ами, тогда вся забота перекладывается на clr, который может уметь разруливать переполнения стеков в определённых ситуациях.

>> Беда в том, что аппаратный стек возвратов слишком мал. Поэтому все пришлось реализовывать самому.
>> Для не компилирующего интерпретатора это достаточно хороший результат. Сможете за пару дней сделать лучше? Тогда и поговорим.

Нет, ну я ни в коем случае не хотел Вас обидеть, я думал это clr так избегает переполнения, что функция отрабатывает 12+ секунд. Понятно, что в такие короткие сроки никому не под силу реализовать это оптимально.
> 1 <


Онлайн :

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