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))

joba

---

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

---

Scheme_Object * scheme_append(Scheme_Object *l1, Scheme_Object *l2)

Цитата

---

misha :

joba

---

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

---

Обратите внимание, функция

Scheme_Object * scheme_append(Scheme_Object *l1, Scheme_Object *l2)

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

---

;;r5rs

(define a '(1 2))

(define b '(3))

(define c (append a b))

(set-car! b 5)

> с

(1 2 5)

joba

---

Вообще-то, этот будет так, только если список l2 никто не сможет "затереть". Кстати, именно поэтому в racket нету схемовских set-cdr! set-car!, а set! не удаляет ничего из памяти.

---

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 *

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))]))

 

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

---

 

#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

 

joba

---

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

---

(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