Следующая страница > 1 < [2]

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

joba

Members


Статус

157 сообщений

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

#4864   2011-10-22 13:57 GMT+3 часа(ов)      
Как разумнее всего реализовать сабж?
Я вижу несколько вариантов решения.

1. (define (add lst elem) `(,@lst ,elem))
2. (define (add lst elem) (fold-right cons (list elem) lst))
3. (define (add lst elem) (append lst (list elem)))

Какой лучше?

UPD. Все. Я сам нашел ответ. В racket, например, `(,@lst ,elem) раскроется в (#%app append (#%top . lst) (#%app list (#%top .elem))), т.е. в то же самое, что и (append lst (list elem)). А вот как реализован append в racket:
Scheme_Object *
scheme_append(Scheme_Object *l1, Scheme_Object *l2)
{
Scheme_Object *first, *last, *orig1, *v;
 
orig1 = l1;
 
first = last = NULL;
while (SCHEME_PAIRP(l1)) {
v = cons(SCHEME_CAR(l1), scheme_null);
if (!first)
first = v;
else
SCHEME_CDR(last) = v;
last = v;
l1 = SCHEME_CDR(l1);
 
SCHEME_USE_FUEL(1);
}
 
if (!SCHEME_NULLP(l1))
scheme_wrong_type("append", "proper list", -1, 0, &orig1);
 
if (!last)
return l2;
 
SCHEME_CDR(last) = l2;
 
return first;
}
Т.о. они делают копию l1 и по ходу получают указатель last на последнюю ячейку списка, в cdr которой потом записываю l2. Т.е. это то же самое, что следующий код:
 
(require racket/mpair)
(define (append2 orig1 l2)
(define first '())
(let recur ((last '()) (l1 orig1))
(if (mpair? l1)
(let ((v (mcons (mcar l1) '())))
(if (null? first) (set! first v)
(set-mcdr! last v))
(recur v (mcdr l1)))
(begin (set-mcdr! last l2) first))))
 

В итоге, первый вариант эквивалентен третьему, ну а второй самый медленный, очевидно, потому что не хвостовая рекурсия.

отредактировал(а) joba: 2011-10-22 14:40 GMT+3 часа(ов)

misha

Moderators


Статус

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

#4866   2011-10-22 16:49 GMT+3 часа(ов)      
joba
В итоге, первый вариант эквивалентен третьему, ну а второй самый медленный, очевидно, потому что не хвостовая рекурсия.

Второй самый быстрый, хотя нет - они равны
#!r6rs
(import [rnrs base]
[rnrs control (6)]
[rnrs lists (6)])
#|
(define (append1 . lists)
(cond
[(null? lists) '()]
[(null? (cdr lists)) (car lists)]
[(null? (cddr lists))
(let loop ([l (car lists)])
(if (null? l)
(cadr lists)
(cons (append(car l) (loop (cdr l))))))]
[else
(append1 (car lists) (apply append1 (cdr lists)))]))
 
(define append2
(case-lambda
[() '()]
[(l) l]
[(ls1 ls2)
(let loop ([l ls1])
(if (null? l)
ls2
(cons (car l) (loop (cdr l)))))]
[(l . ls) (append2 l (apply append2 ls))]))
 
(define (fold-right fun start lst . lsts)
(if (null? lsts)
(let foldr-lst ((l lst))
(if (null? l)
start
(fun (car l) (foldr-lst (cdr l)))))
(let foldr-lsts ((l (cons lst lsts)))
(if (do ((l l (cdr l)))
((or (null? (car l))
(null? (cdr l))) (null? (car l))))
start
(apply fun
(append (map car l)
(list (foldr-lsts (map cdr l)))))))))
|#
(define (add lst elem) (fold-right cons (list elem) lst))

отредактировал(а) misha: 2011-10-22 16:59 GMT+3 часа(ов)

joba

Members


Статус

157 сообщений

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

#4867   2011-10-22 17:15 GMT+3 часа(ов)      
>(define (append1 . lists) [...]
>(define append2 [...]

Это откуда вообще?

Вот fold-right из racket-5.1.3/collects/rnrs/lists-6.rkt
(define (fold-right combine nil the-list . the-lists)
(assert-procedure 'fold-right combine)
(if (null? the-lists)
(fold-right1 combine nil the-list)
(let recur ((list the-list) (lists the-lists))
(if (null? list)
(begin
(check-nulls 'fold-right the-list the-lists lists)
nil)
(apply combine
(car list)
(append (map car lists)
(cons (recur (cdr list) (map cdr lists))
'())))))))
 
(define (fold-right1 combine nil list)
(let recur ((list list))
(if (null? list)
nil
(combine (car list) (recur (cdr list))))))

>они равны

Приведенные тобой append и fold-right -- да, они оба медленные, а в racket -- нет, там вариант с append будет быстрее чем с fold-right.

отредактировал(а) joba: 2011-10-22 17:38 GMT+3 часа(ов)

misha

Moderators


Статус

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

#4868   2011-10-22 18:05 GMT+3 часа(ов)      
joba
Приведенные тобой append и fold-right -- да, они оба медленные, а в racket -- нет, там вариант с append будет быстрее чем с fold-right.
Обратите внимание, функция
Scheme_Object * scheme_append(Scheme_Object *l1, Scheme_Object *l2)
не является структуроразрушающей, т.е. она возвращает новый список.

joba

Members


Статус

157 сообщений

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

#4869   2011-10-22 18:10 GMT+3 часа(ов)      
>не является структуроразрушающей, т.е. она возвращает новый список.

Я знаю. Неужели не видно, что там while (итерация), а в fold-right не хвостовая рекурсия? Надеюсь не надо объяснять почему второе медленнее первого?

misha

Moderators


Статус

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

#4870   2011-10-22 18:18 GMT+3 часа(ов)      
> Неужели не видно, что там while (хвостовая рекурсия), а в fold-right не хвостовая рекурсия?
while - цикл Вам написать с циклом?

joba

Members


Статус

157 сообщений

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

#4871   2011-10-22 18:32 GMT+3 часа(ов)      
Да, напиши мне не структуроразрушающий (т.е. возвращающий новый список) fold-right (вариант с одним списком) через хвостовую рекурсию (или циклами, как больше нравится), такой, чтобы (fold-right cons (list elem) lst) работал не медленнее моего (append2 lst (list elem)), где append2 имеется в виду который в первом моем посте.

joba

Members


Статус

157 сообщений

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

#4872   2011-10-22 18:58 GMT+3 часа(ов)      
Подсказка: такой fold-right написать невозможно. Теперь тебе только осталось понять почему так.

misha

Moderators


Статус

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

#4874   2011-10-22 19:39 GMT+3 часа(ов)      
Цитата
joba :
Да, напиши мне не структуроразрушающий (т.е. возвращающий новый список) fold-right (вариант с одним списком) через хвостовую рекурсию (или циклами, как больше нравится), такой, чтобы (fold-right cons (list elem) lst) работал не медленнее моего (append2 lst (list elem)), где append2 имеется в виду который в первом моем посте.

Я имел в виду add. И кто сказал, что твой append будет быстрее работать? Ты хоть слышал об оптимизации хвостовых cons?
Цитата
joba :
Подсказка: такой fold-right написать невозможно. Теперь тебе только осталось понять почему так.

Ты всех за идиотов держишь? Тогда понятно, почему на тебя жалуются.

joba

Members


Статус

157 сообщений

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

#4875   2011-10-22 19:41 GMT+3 часа(ов)      
Цитата
misha :
joba
Приведенные тобой append и fold-right -- да, они оба медленные, а в racket -- нет, там вариант с append будет быстрее чем с fold-right.
Обратите внимание, функция
Scheme_Object * scheme_append(Scheme_Object *l1, Scheme_Object *l2)
не является структуроразрушающей, т.е. она возвращает новый список.


Вообще-то, этот будет так, только если список l2 никто не сможет "затереть". Кстати, именно поэтому в racket нету схемовских set-cdr! set-car!, а set! не удаляет ничего из памяти.
Смотри
;;r5rs
(define a '(1 2))
(define b '(3))
(define c (append a b))
(set-car! b 5)
> с
(1 2 5)

joba

Members


Статус

157 сообщений

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

#4876   2011-10-22 19:51 GMT+3 часа(ов)      
>Я имел в виду add.

А речь шла о fold-right, а точнее, о твоей наглой, ничем не обоснованной заяве: "Второй самый быстрый, хотя нет - они равны". Признай свою ошибку.

>Ты всех за идиотов держишь? Тогда понятно, почему на тебя жалуются.

Не всех. Жалуются на меня потому что действительно идиоты.

misha

Moderators


Статус

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

#4877   2011-10-22 20:01 GMT+3 часа(ов)      
joba
Вообще-то, этот будет так, только если список l2 никто не сможет "затереть". Кстати, именно поэтому в racket нету схемовских set-cdr! set-car!, а set! не удаляет ничего из памяти.
Что значит "затереть"? Сборщик мусора не позволит.
set-cdr! и set-car! - отсутствуют и в r6rs, но они доступны из библиотеки.

joba

Members


Статус

157 сообщений

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

#4878   2011-10-22 20:05 GMT+3 часа(ов)      
>Что значит "затереть"?

Я же привел пример. Читай внимательней.

>Сборщик мусора не позволит.

Сборщик мусора тут ни при чем.

>set-cdr! и set-car! - отсутствуют и в r6rs, но они доступны из библиотеки.

Не знаю насчет r6rs. В r5rs зато есть.

misha

Moderators


Статус

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

#4879   2011-10-22 20:24 GMT+3 часа(ов)      
joba
А речь шла о fold-right, а точнее, о твоей наглой, ничем не обоснованной заяве: "Второй самый быстрый, хотя нет - они равны". Признай свою ошибку.

Ты меня наглым назвал?
;; file:///home/misha/racket/collects/racket/mpair.rkt
(define mappend
(case-lambda
[() null]
[(a) a]
[(a b) (let loop ([a a])
(if (null? a)
b
(mcons (mcar a) (loop (mcdr a)))))]
[(a . l) (mappend a (apply mappend l))]))
Что ребятишки вдруг отупели?
joba
Не всех. Жалуются на меня потому что действительно идиоты.
ЧСВ зашкаливает.
joba
Я же привел пример. Читай внимательней.
"Scheme_Object *" считай передача аргументов по ссылке. Поэтому твоя фраза "set! не удаляет ничего из памяти." звучит по-детски.

misha

Moderators


Статус

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

#4884   2011-10-22 22:04 GMT+3 часа(ов)      
#lang racket
 
(require racket/mpair)
 
(define (append2 orig1 l2)
(define first '())
(let recur ((last '()) (l1 orig1))
(if (mpair? l1)
(let ((v (mcons (mcar l1) '())))
(if (null? first) (set! first v)
(set-mcdr! last v))
(recur v (mcdr l1)))
(begin (set-mcdr! last l2) first))))
 
(define (mappend-fast lst1 lst2)
(if (null? lst1)
lst2
(let ([result (mcons (mcar lst1) '())])
(let loop ([ls (mcdr lst1)][last result])
(if (null? ls)
(set-mcdr! last lst2)
(let ([v (mcons (mcar ls) '())])
(set-mcdr! last v)
(loop (mcdr ls) v))))
result)))
 
(define l (build-list 1000000 values))
(define ml (list->mlist l))
 
(collect-garbage)
(time (begin (append2 ml (mlist 1000000)) #f))
; => cpu time: 172 real time: 187 gc time: 0
(collect-garbage)
(time (begin (mappend-fast ml (mlist 1000000)) #f))
; => cpu time: 144 real time: 156 gc time: 0

joba

Members


Статус

157 сообщений

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

#4886   2011-10-22 23:18 GMT+3 часа(ов)      
>И кто сказал, что твой append будет быстрее работать?

Я сказал.

>Ты хоть слышал об оптимизации хвостовых cons?

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

Кстати, вот cons и mcons из racket.
 
Scheme_Object *
scheme_make_pair(Scheme_Object *car, Scheme_Object *cdr)
{
#ifdef MZ_PRECISE_GC
return GC_malloc_pair(car, cdr);
#else
Scheme_Object *cons;
cons = scheme_alloc_object();
cons->type = scheme_pair_type;
SCHEME_CAR(cons) = car;
SCHEME_CDR(cons) = cdr;
return cons;
#endif
}
 
Scheme_Object *
scheme_make_mutable_pair(Scheme_Object *car, Scheme_Object *cdr)
{
Scheme_Object *cons;
cons = scheme_alloc_object();
cons->type = scheme_mutable_pair_type;
SCHEME_CAR(cons) = car;
SCHEME_CDR(cons) = cdr;
return cons;
}
 


Цитата

Ты меня наглым назвал?
 
;; file:///home/misha/racket/collects/racket/mpair.rkt
 
(define mappend
(case-lambda
[() null]
[(a) a]
[(a b) (let loop ([a a])
(if (null? a)
b
(mcons (mcar a) (loop (mcdr a)))))]
[(a . l) (mappend a (apply mappend l))]))
 

Что ребятишки вдруг отупели?

И что ты этим хотел сказать? Что этот mappend не медленнее моего append2?
 
#lang racket
(require racket/mpair)
;(require racket/trace)
 
(define mappend2
(case-lambda
[() null]
[(a) a]
[(a b) (let loop ([a a])
(if (null? a)
b
(mcons (mcar a) (loop (mcdr a)))))]
[(a . l) (mappend2 a (apply mappend2 l))]))
 
(define (append2 orig1 l2)
(define first '())
(let recur ((last '()) (l1 orig1))
(if (mpair? l1)
(let ((v (mcons (mcar l1) '())))
(if (null? first) (set! first v)
(set-mcdr! last v))
(recur v (mcdr l1)))
(begin (set-mcdr! last l2) first))))
 
(define (make-mlist n)
(let recur ((ml '()) (n n))
(if (zero? n) ml
(recur (mcons 1 ml) (- n 1)))))
 
(define test-mlist (make-mlist 500000))
 
(collect-garbage)(time (begin (append2 test-mlist (mlist 0)) 1))
(collect-garbage)
(time (begin (mappend2 test-mlist (mlist 0)) 1))
 
cpu time: 116 real time: 133 gc time: 0
cpu time: 2513 real time: 2601 gc time: 1464
 
cpu time: 116 real time: 132 gc time: 0
cpu time: 2436 real time: 2522 gc time: 1388
 


>ЧСВ зашкаливает.

Обоснуй.

> "Scheme_Object *" считай передача аргументов по ссылке. Поэтому твоя фраза "set! не удаляет ничего из памяти." звучит по-детски.

Да ты вообще не догоняешь что я говорю. Пусть a и b ссылаются на один и тот же участок памяти. Если сделать (set! a <val>), то выделится новый участок памяти (set! не затронет старый участок), на который будет ссылаться a, что никак не затронет b.

отредактировал(а) joba: 2011-10-22 23:39 GMT+3 часа(ов)

joba

Members


Статус

157 сообщений

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

#4887   2011-10-23 00:15 GMT+3 часа(ов)      
>Что ребятишки вдруг отупели?

Там на самом деле какой-то другой по умолчанию mappend вызывается, который gc time: 0 показывает. Потом я попробовал изменить mappend (просто добавил (display "hello") на выходе) в файле mpair.rkt. После этого этот mappend выводил "hello", но стал работать так же медленно, как и вышеприведенный mappend2. Потом я откатил все изменения в mpair.rkt, но mappend все равно остался работать медленно. Короче, вот так вот, что-то тут не чисто. Я честно пока не понял почему так происходит.

joba

Members


Статус

157 сообщений

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

#4888   2011-10-23 00:42 GMT+3 часа(ов)      
>Сообщение #4884

Да, так лучше, согласен, не нужно будет этот (if (null? first) ... сто раз вызывать.

misha

Moderators


Статус

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

#4889   2011-10-23 02:32 GMT+3 часа(ов)      
joba
>Ты хоть слышал об оптимизации хвостовых cons?
Нет, расскажи. Как это, интересно, можно выполнить cons до того, как будет известен один из ее аргументов?

Существует хитрое преобразование - Tail recursion modulo cons. Видимо разработчики racket до него еще пока не дошли.
joba
> "Scheme_Object *" считай передача аргументов по ссылке. Поэтому твоя фраза "set! не удаляет ничего из памяти." звучит по-детски.

Да ты вообще не догоняешь что я говорю. Пусть a и b ссылаются на один и тот же участок памяти. Если сделать (set! a <val>), то выделится новый участок памяти (set! не затронет старый участок), на который будет ссылаться a, что никак не затронет b.
set! присваивает переменной "а" новое значение <val>. Зачем ты вообще начал этот разговор? Конечно, если ты новичок, тогда понятно

misha

Moderators


Статус

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

#4890   2011-10-23 02:36 GMT+3 часа(ов)      
joba
Там на самом деле какой-то другой по умолчанию mappend вызывается, который gc time: 0 показывает. Потом я попробовал изменить mappend (просто добавил (display "hello") на выходе) в файле mpair.rkt. После этого этот mappend выводил "hello", но стал работать так же медленно, как и вышеприведенный mappend2. Потом я откатил все изменения в mpair.rkt, но mappend все равно остался работать медленно. Короче, вот так вот, что-то тут не чисто. Я честно пока не понял почему так происходит.
Функции взятые из скомпилированного модуля лучше оптимизированы. Поэтому откомпилируй модуль, и будет тебе счастье

joba

Members


Статус

157 сообщений

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

#4897   2011-10-24 09:40 GMT+3 часа(ов)      
>Существует хитрое преобразование - Tail recursion modulo cons.

Ok. Я тормознул, мой append2 по сути и есть результат подобного преобразования обычного mappend, который через cons'ы написан. Но я все равно не согласен с твоим утверждением о том, что третий (c append) и второй вариант (c fold-right) равны. Потому что у fold-right параметр - произвольная функция от двух аргументов. Хочешь сказать, что fold-right преобразуется после оптимизации в какой-то дикий код с проверкой является ли его параметр-функция функцией cons?

UPD
Хотя, сейчас попробовал потестить скомпилированный fold-right, и он, скотина, действительно для cons очень быстро выполняется. Значит он таки оптимизируется.

>Видимо разработчики racket до него еще пока не дошли.

Дошли. Иначе бы их скомпилированные mappend и fold-right не были бы такими быстрыми.

отредактировал(а) joba: 2011-10-24 11:47 GMT+3 часа(ов)

joba

Members


Статус

157 сообщений

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

#4899   2011-10-24 10:42 GMT+3 часа(ов)      
Все равно мой append2 быстрее:
(define test-mlist (make-mlist 500000))
(define test-list (mlist->list test-mlist))
 
(collect-garbage)(time (begin (append2 test-mlist (mlist 0)) 1))
(collect-garbage)(time (begin (mappend test-mlist (mlist 0)) 1))
(collect-garbage)(time (begin (fold-right cons (list 0) test-list) 1))
 
;скомпилированный append2 => cpu time: 32 real time: 47 gc time: 0
;скомпилированный mappend => cpu time: 60 real time: 82 gc time: 0
;скомпилированный fold-right => cpu time: 104 real time: 142 gc time: 0


Видимо потому, что внутри кода проверок меньше.

joba

Members


Статус

157 сообщений

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

#4900   2011-10-24 10:57 GMT+3 часа(ов)      
> set! присваивает переменной "а" новое значение <val>.

Спасибо, я знаю.

>Зачем ты вообще начал этот разговор? Конечно, если ты новичок, тогда понятно

Это ты его начал, когда сказал, что scheme_append "не является структуроразрушающей, т.е. она возвращает новый список". Она была бы действительно таковой, если бы еще помимо копии списка l1 создавала и копию списка l2. Но, с другой стороны, ты тоже прав, потому что мы никак и не сможем потом "испортить" тот участок памяти, на который ссылался l2, потому что нету разрушающих set-cdr! и set-car!, а set! ничего не разрушает. Если и сейчас непонятно о чем я говорю, то я уже тогда не знаю как тебе объяснить.

joba

Members


Статус

157 сообщений

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

#4901   2011-10-24 11:01 GMT+3 часа(ов)      
>Функции взятые из скомпилированного модуля лучше оптимизированы. Поэтому откомпилируй модуль, и будет тебе счастье

Да это понятно. Просто я до последнего не верил, что racket при компиляции оптимизирует хвостовые cons, поэтому и подумал, что может они там мутят чего-нибудь нечистое.

joba

Members


Статус

157 сообщений

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

#4902   2011-10-24 11:18 GMT+3 часа(ов)      
Кстати, смотри:
 
(define (cons2 a b) (cons a b))
(collect-garbage)(time (begin (fold-right cons2 (list 0) test-list) 1))
 
cpu time: 2008 real time: 2177 gc time: 1492


Видишь, все именно так как я и говорил происходит: проверяется, является ли параметр-функция функцией cons, и если не является, то облом.

misha

Moderators


Статус

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

#4908   2011-10-24 13:25 GMT+3 часа(ов)      
Добавление элемента в конец списка является довольно ресурсоемкой операцией, поэтому лучше реализовать либо структуроразрушающий вариант, либо использовать массив (когда не требуется удалять элементы, добавлять их в начало).

joba

Members


Статус

157 сообщений

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

#4915   2011-10-24 15:12 GMT+3 часа(ов)      
>структуроразрушающий вариант

Тогда мы выйдем за рамки функциональной парадигмы, что не есть тру. Возможно стоит использовать какие-нибудь другие структуры данных, а не список. Есть какие-то V-списки, например, но я пока толком не разбирался (а надо бы, но потом, сейчас у меня времени нет), что они из себя представляют и могут ли они вообще помочь при решении обсуждаемой здесь задачи, просто знаю, что есть такая фигня.

joba

Members


Статус

157 сообщений

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

#4916   2011-10-24 15:12 GMT+3 часа(ов)      
Кстати, массивы не сильно помогут, realloc же придется делать при каждом добавлении, а это вообще жопа. Хотя, если это будет массив ссылок, то не такая уж и жопа, но все равно будет медленнее чем mappend!.

отредактировал(а) joba: 2011-10-24 15:21 GMT+3 часа(ов)

misha

Moderators


Статус

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

#4918   2011-10-24 15:35 GMT+3 часа(ов)      
>Тогда мы выйдем за рамки функциональной парадигмы, что не есть тру.
Использование set-car! и set-cdr! не является функциональным подходом.

>Есть какие-то V-списки
По сути список векторов.

>realloc же придется делать при каждом добавлении, а это вообще жопа.
Создай структуру ArrayList, состоящую из массива и указателя(счетчик) на его фиктивный конец. Короче, действуй как на Сях.

joba

Members


Статус

157 сообщений

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

#4919   2011-10-24 15:39 GMT+3 часа(ов)      
>Использование set-car! и set-cdr! не является функциональным подходом.

Спасибо, я знаю. Только к чему ты это сказал?


Онлайн :

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




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