Решение упражнения 2.20 из SICP

26 January, 2008 (19:29) | Решения упражнений

Довольно интересное упражнение с учетом того, что пока мы не рассматривали вопросы обобщенного отображения и фильтрации списков (очевидно, нас подводят к этим важным понятиям).

Итак, с помощью точечной записи мы выделим первое значение из переданных и список остальных значений. Далее просто пройдем по списку остальных значений и отфильтруем его, составив список чисел той же четности, что и первое переданное значение. В конце просто добавим первое значение в начало списка-результата:

(define (same-parity first-value . other-values) 
  (define (accept-parity? value) 
    (equal? (even? first-value) (even? value))) 
  (define (filter-parity values) 
    (cond ((null? values) null) 
          ((accept-parity? (car values)) (cons (car values) 
                                               (filter-parity (cdr values)))) 
          (else (filter-parity (cdr values))))) 
  (cons first-value (filter-parity other-values)))

Проверку того, совпадает ли четность первого значения и некоторого другого значения можно записать несколько короче, воспользовавшись тем, что сумма чисел одинаковой четности четна, а сумма чисел разной четности нечетна:

(define (accept-parity? value) 
  (even? (+ first-value value)))

Будет ли этот способ записи более эффективным, сказать сложно.

Comments

Comment from thror
Date: February 8, 2008, 2:19 pm

Здесь на самом деле появляется очень интересная абстракция, фильтрация списка, которую можно выразить более общей идееей вот так (в рекурсивном, и итеративном виде):

(define (filter-list filter items)
  (cond ((null? items) '())
        ((filter (car items)) (cons (car items) (filter-list filter (cdr items))))
        (else (filter-list filter (cdr items)))))

Обратите внимание на этот вид рекурсии, о котором вы вообще не упоминаете, так называемая continuation-passing recursion, представляющая собой очень важный момент для изучения течения процессов. Подробнее о том, что это, и как работает, и почему полезно, можно почитать здесь MIT AI Memo 353–LAMBDA: The Ultimate Imperative.

(define (filter-list filter items c)
  (cond ((null? items) (c '()))
        ((filter (car items)) (filter-list filter
                                           (cdr items)
                                           (lambda (a) (c (cons (car items) a)))))
        (else (filter-list filter
                           (cdr items)
                           (lambda (a) (c a))))))

[ Вообще, вот определение факториала в том же стиле, оно более понятно:

(define (factorial n c)
  (if (= n 0)
      (c 1)
      (factorial (- n 1) (lambda (a) (c (* n a))))))

Вообще можно дополнить уражнения подобными определениями, просто для полноты. Странно что авторы даже не упоминают о таком виде рекурсии.]

(define (filter-list filter items)
  (define (iter l r)
    (cond ((null? r) l)
          ((filter (car r)) (iter (append l (list (car r))) (cdr r)))
          (else (iter l (cdr r)))))
  (iter '() items))

(define (same-parity n . w)
  (cons n (filter-list (lambda (x) (even? (+ n x))) w)))

--thror

Comment from Sergey Khenkin
Date: February 8, 2008, 3:19 pm

Совершенно верно.
В разделе 2.2.3, который идет в книге после упражнения 2.20, вводится обобщенная процедура фильтрации filter, аналогичная приведенной вами filter-list с двумя аргументами. Имея эту процедуру в арсенале, действительно можно записать same-parity как

(define (same-parity first-value . other-values)
  (cons first-value 
        (filter (lambda (value) (even? (+ first-value value)))
                other-values)))

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

Что касается continuation-passing recursion, то из приведенных примеров можно понять, как такая рекурсия работает, но неясен практический выигрыш от ее использовния.

Comment from thror
Date: February 8, 2008, 7:17 pm

На самом деле подобный вид рекурсии подводит нас вплотную к одной из важнейших концепций функционального программирования–Continuation Passing Style (CPS).

Число работ по данной теме очень велико, и найти их не трудно. Вот к примеру из классических Lambda-papers: MIT AITR 474–Rabbit: A Compiler for Scheme.

–thror

Comment from Sergey Khenkin
Date: February 9, 2008, 12:43 am

В английской Википедии есть неплохая вводная информация по Continuation Passing Style. Все же это слишком фундаментальная вещь для того, чтобы рассматривать ее серьезно на этом этапе. Как я понимаю, практически она используется при построении компиляторов. Подозреваю, что с continuations мы еще встретимся в четвертой главе книги.

Comment from thror
Date: February 11, 2008, 4:29 pm

Все же, если кто-нибудь окажется заинтересован в изучении этого интересного явления–CPS, то начать можно с классических статей отсюда http://library.readscheme.org/page6.html

–thror

Comment from JessicaFletcher
Date: March 7, 2009, 3:35 pm

еще простое решение –
(define (some-parity i . list)
(cons i (
(cond (= (cdr list) nill) nill)
(= (average i 2) (average (car list) 2)
(cons (car list) (some-parity (cdr list)))
(some-parity (cdr list))))))

Comment from domr
Date: November 25, 2010, 7:05 pm

Сразу хотел бы выразить огромную благодарность автору за этот замечательный ресурс, очень помогает новичку в lisp!
Что касается этого упражнения, то именно с него я, что называется, въехал в lisp! =) До него всё было инопланетно. Спасибо автору и комментаторам!
Ну и другим новичкам, может быть, будет интересен мой вариант решения:

(define (same-parity first . other)
  (define (filter predicate lst)
    (cond ((null? lst) lst)
             ((predicate (car lst)) (cons (car lst) (filter predicate (cdr lst))))
             (else (filter predicate (cdr lst)))))
  
  (if (even? first)
      (cons first (filter even? other))
      (cons first (filter odd? other))))

Comment from Spok
Date: February 5, 2014, 11:18 am

У меня получилось нечто компактное:

(define (same-parity first . others)
  (define (parser checker result leftovers)
    (if (null? leftovers)
        result
        (if (checker (car leftovers))
            (parser checker
                    (append result (list (car leftovers)))
                    (cdr leftovers))
            (parser checker result (cdr leftovers)))))
  
  (if (even? first)
      (parser (lambda (x) (even? x)) (list first) others)
      (parser (lambda (x) (not (even? x))) (list first) others)))

Comment from Rokker Ruslan
Date: February 7, 2014, 1:24 pm

Еще решение

(define (return f items)
    (cond ((null? items)
              null)
          ((f (car items))
              ;(append (list (car items)) (return (cdr items) f)))
              (cons (car items) (return f (cdr items))))
          (else (return f (cdr items)))))

(define (same-parity . items)
    (if (even? (car items))
        (return even? items)
        (return odd?  items)))

Comment from alexk
Date: August 9, 2014, 11:35 am

(define (same-parity . l)
  (define (iter li pred? res)
    (if (null? li)
        res
        (iter (cdr li) pred? (if (pred? (car li)) (append res (list (car li))) res)))
    )
  (cond ((even? (car l)) (iter l even? (list)))
        (else (iter l odd? (list))))
  )

Comment from hi-artem
Date: November 12, 2014, 9:03 pm

Должен сказать спасибо thror за Сontinuation-passing
Такой стиль программирования оказался новым и интересным для меня.

Всем кто сомневается – не сомневайтесь: читать вики + Lambda-papers и за несколько вечеров в голове это уложится.
Кстати lambda papers написаны на удивление понятным языком.
Видно, что тогда эти концепции только развивались и Sussman хотел их донести максимально понятно.

Comment from Максим
Date: November 24, 2014, 4:13 pm

С использованием higher-order procedure и т.н. pattern of computation.

(define (same-parity-1 x y . z)
    (define (parity-rec predicate y z)
      (cond ((null? z) (cons y))
            ((predicate y) (cons y (parity-rec predicate (car z) (cdr z))))
            (else (parity-rec predicate (car z) (cdr z)))))
    (cons x
          (if (even? x) 
              (parity-rec even? y z)
              (parity-rec odd? y z))))





Comment from Максим
Date: November 24, 2014, 6:57 pm

Пришлось переписать, так как код не годный.
При тесте вбил (same-parity), который уже зарезервирован в окружении правильным вариантом проги.
Пришлось “вылечить” таким образом:

(define (same-parity-1 x y . z)
    (define (parity-rec predicate y z)
      (cond ((null? z) (if (predicate y)
                           (cons y null)
                           null))
            ((predicate y) (cons y (parity-rec predicate (car z) (cdr z))))
            (else (parity-rec predicate (car z) (cdr z)))))
    (cons x
          (if (even? x) 
              (parity-rec even? y z)
              (parity-rec odd? y z))))





Comment from Sergk
Date: February 19, 2015, 11:16 am

Мой вариант, он не идеален, но за-то работает)))

(define (same-parity x . l)
  (define (even items)
    (define (iter-even items n)
      (cond ((= n (length items)) '())
            ((even? (list-ref items n))
             (append (list (list-ref items n))
                     (iter-even items (+ n 1))))
            (else (iter-even items (+ n 1)))))
    (iter-even items 0))
  (define (uneven items)
    (define (iter-even items n)
      (cond ((= n (length items)) '())
            ((even? (list-ref items n)) (iter-even items (+ n 1)))
            (else (append (list (list-ref items n))
                  (iter-even items (+ n 1))))))
    (iter-even items 0))
  (if (even? x)
      (append (list x) (even l)) 
      (append (list x) (uneven l))))

Comment from knagaev
Date: June 1, 2015, 11:21 am

Мой вариант

(define (same-parity sample . ls)
    (define (same-parity-iter ls acc-ls)
        (if (null? ls)
            acc-ls
            (same-parity-iter (cdr ls) 
                                (if (eq? (even? sample) (even? (car ls)))
                                    (cons acc-ls (car ls))
                                    acc-ls))))
    (same-parity-iter ls nil)
)

Comment from Irv
Date: January 29, 2016, 11:18 am

вариант решения в итеративном стиле

(define (same-parity x . z)
  (define (iter source target)
    (if (null? source)
        (reverse target)
        (let ((sign (remainder x 2))
              (i (car source))
              (tail (cdr source)))
          (if (= sign (remainder i 2))
              (iter tail (cons i target))
              (iter tail target)))))
  (cons x (iter z (list))))

(same-parity 3 4 5 6 7 8 9 10 3 7)

Write a comment