Схема - суммирование квадратов четных элементов в списке

Ответ 1

Есть две возможности: либо реализовать рекурсию с нуля:

(define (sum elemList)
  (cond ((null? elemList) 0)
        ((even? (car elemList))
         (+ (* (car elemList) (car elemList))
            (sum (cdr elemList))))
        (else (sum (cdr elemList)))))

Или мы используем встроенные процедуры, определяя помощники по мере необходимости. Эта стратегия известна как использование "последовательностей как обычных интерфейсов" :

(define (square x)
  (* x x))

(define (sum elemList)
  (apply +
         (map square
              (filter even? elemList))))

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

(sum '(1 2 3 4 5 6 7 8 9 10))
=> 220

Ответ 2

С левой функцией сгиба,

(define (foldl cons z ls) 
  (if (null? ls) 
    z 
    (foldl cons (cons (car ls) z)           ; NB! args order
                (cdr ls))))   

мы можем легко реализовать суммирование списка ((foldl + 0 xs)) или захват квадратов или фильтрацию отдельно.

Также легко вложить их, так что один работает с результатами другого (как показано в других ответах), но это означает, что выполняются три отдельных прохода списка,

(define (sqr x) (* x x)) 

(define (foo-3 xs)
  (foldl  +  0 
    (foldl  (lambda (x acc) (cons (sqr x) acc))  '() 
      (foldl  (lambda (x acc) (if (even? x) (cons x acc) acc))  '() 
        xs))))

Но на самом деле свертывание (или "сокращение" ) списка с помощью функции редуктора (например, +) заменяет список cons этим приложением во всяком случае, так почему бы не просто пойти и использовать этот редуктор в первую очередь? Это означает, что вложенные складки могут быть слиты вместе как

(define (foo-2 xs)
    (foldl  (lambda (x acc) (+  (sqr x) acc))  0 
      (foldl  (lambda (x acc) (if (even? x) (cons x acc) acc))  '() 
        xs)))

и, далее, как

(define (foo-1 xs)   ; one traversal, tail-recursive, iterative!
      (foldl  (lambda (x acc) (if (even? x) (+ (sqr x) acc) acc))  0 
        xs))

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

Мы видим необходимость абстрактного cons здесь, чтобы его можно было легко манипулировать, заменить. Другими словами, мы хотим

  (lambda (x acc) (cons (sqr x) acc))               ==:  ((mapping  sqr) cons)
  (lambda (x acc) (if (even? x) (cons x acc) acc))  ==:  ((filtering even?) cons)

таким образом, достигая того, что известно как "преобразователи", то есть модификаторы функций редуктора:

(define (((mapping  f) kons) x acc) (kons (f x) acc))           ; "mapping" transducer
(define (((filtering p) kons) x acc) (if (p x) (kons x acc) acc))    ; "filtering" one

(define (foo xs)

  (foldl + 0 
    (foldl ((mapping sqr) cons) '() 
      (foldl ((filtering even?) cons) '() 
        xs)))
  =
    (foldl ((mapping sqr) +) 0                 ; replace the constructor!
      (foldl ((filtering even?) cons) '()      ;   and the sentinel value
        xs))
  =
      (foldl ((filtering even?) ((mapping sqr) +)) 0    ; and again!
           ; (lambda (x acc) (if  (even? x)  (+ (sqr x) acc)  acc)) ; look, ma, no cons!
        xs)
  )

Шаблон (f (g x)) абстрагируется как функциональная композиция,

(define ((compose1 f g) x)
    (f (g x)))

так что (f (g x)) ((compose1 f g) x). С более общим compose, принимающим любое количество функций для компоновки,

(define ((compose . fs) x)
  (if (null? fs)
    x
    ((car fs) ((apply compose (cdr fs)) x))))

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

(define (transduce-list tducr op z xs)
  (foldl                            ; lists are reduced with foldl
         (tducr op)                 ; the full reducer is created by applying
         z xs))                     ;   the transducer to the final reducer

(define (foo xs)                    ; sum the squares of evens in a list
  (transduce-list                   ; by transducing the list
       (compose                     ;   with the transducer composed from
           (filtering even?)        ;     a filtering step and
           (mapping sqr))           ;     a mapping step
       + 0 xs))                     ;   with + as the final reducer

и что это!

Итак, мы имеем

(define (sqr1 x) (+ 1 (* x x)))     ; for clearer testing results

> (foldl ((mapping sqr1) cons) '() '(1 2 3 4))
'(17 10 5 2)
> (foldl ((mapping sqr1) +) 0 '(1 2 3 4))
> 34

((mapping sqr1) cons), как и сам cons, является функцией двух аргументов, поэтому его можно использовать в качестве аргумента функции редуктора для foldl.

Если (define g ((mapping sqr1) cons)) совпадает с

(define (g x acc)
      (cons (sqr1 x) acc)) 

И с filtering имеем

> (foldl ((filtering even?) +) 0 '(1 2 3 4))
> 6
> (foldl ((mapping sqr1) ((filtering even?) cons)) '() '(1 2 3 4))
> '(10 2)
> (foldl ((filtering even?) ((mapping sqr1) cons)) 0 '(1 2 3 4))
> '(17 5 . 0)

Итак, ((mapping sqr1) ((filtering even?) cons)) является редуктором, где (mapping sqr1) использует ((filtering even?) cons) в качестве своего редуктора. И это (filtering even?), используя cons как его – окончательный в цепи – функция редуктора:

(define g
  ((mapping sqr1) ((filtering even?) cons)))
=
(define (g x acc)
  (let ((f ((filtering even?) cons)))
    (f (sqr1 x) acc)))                          ; by definition of mapping
= 
(define (g x acc)
  (define (f y acc)
    (if (even? y)  (cons y acc)  acc))          ; by definition of filtering
  (f (sqr1 x) acc))
= 
(define (g x acc)
  (let ((y (sqr1 x)))
    (if (even? y)  (cons y acc)  acc)))          ; by application rule

Mmm, отображение, фильтрация и consing все автоматизированы в одну редукторную функцию для нас, как если бы мы сами ее написали! Еще лучше, foldl является хвостовым рекурсивным, общая функция является итеративной и выполняет только один просмотр списка – потому что три функции редуктора были объединены в один.

Еще несколько тестов:

(define (bar xs)
  (foldl ((compose
                (filtering even?)    ; filtering is done first
                (mapping sqr1))
           cons)
          0 xs))

(define (baz xs)
  (foldl ((compose
                (mapping sqr1)       ; mapping is done first
                (filtering even?))
           cons)
         '() xs))

так что

> (bar '(1 2 3 4 5))
'(17 5 . 0)
> (baz '(1 2 3 4 5))
'(26 10 2)

Ответ 3

(define (sum ls)
  (if (null? ls)
      0
      (if (even? (car ls))
          (+ (square (car ls)) (sum (cdr ls)))
          (sum (cdr ls)))))

где

(define (square x)
  (* x x))

суммируют квадраты четных элементов. Если вы суммируете элементы списка без каких-либо действий, конечно, ответ не может быть ответом на ваш вопрос.

Что еще, можно реализовать эту процедуру следующим образом:

(define (sum ls)
  (reduce +
          0
          (map square
               (filter even?
                       ls))))

где map, filter и reduce - общие значения (вы можете попробовать это в мит-схеме). Это делает то же самое, однако это более читаемо, и такие вещи, как рекурсия cdr, оптимизируются. Вторая глава в SICP (Структура и интерпретация компьютерных программ) внедрила эту методологию программирования.

Ответ 4

или с потоками стилей SICP!

если это вас интересует, см. раздел 3.5 структуры и интерпретации компьютерных программ (Суссман, Абельсон)

функции потока здесь работают так же, как преобразователи, описанные в ответе @WillNess, т.е. потоки не требуют нескольких итераций через данные

все процедуры потока здесь рекурсивные, но эволюционируют линейный итеративный процесс

Стоит отметить, что cons-stream - это особый вид, который не сразу оценивает его второй аргумент

#lang sicp

(define (square x)
  (* x x))

(define stream-car car)

(define (stream-cdr s)
  (force (cdr s)))

(define (integers x)
  (cons-stream x (integers (inc x))))

(define (stream-filter f s)
  (cond ((stream-null? s) the-empty-stream)
        ((f (stream-car s)) (cons-stream (stream-car s) (stream-filter f (stream-cdr s))))
        (else (stream-filter f (stream-cdr s)))))

(define (stream-map f s)
  (if (stream-null? s)
      the-empty-stream
      (cons-stream (f (stream-car s)) (stream-map f (stream-cdr s)))))

(define (stream-take n s)
  (cond ((stream-null? s) the-empty-stream)
        ((> n 0) (cons-stream (stream-car s) (stream-take (dec n) (stream-cdr s))))
        (else the-empty-stream)))

(define (stream-reduce f acc s)
  (if (stream-null? s)
      acc
      (stream-reduce f (f acc (stream-car s)) (stream-cdr s))))

(stream-reduce + 0
  (stream-map square
    (stream-filter even?
      (stream-take 10
        (integers 1)))))
;; => 220

преобразователи

с огромной привязанностью я представляю эту часть ответа для @WillNess

i был представленный преобразователям через человека, у которого есть умение перегонять подавляющее сложность вплоть до чудесного простого - как труд love, я адаптировал некоторые из представленных кода/идей (первоначально в javascript) к схеме

каждый ;; [section] определяет барьер абстракции

изменить: удалить специальные формы для cons-cont и cons-trans - макрос не критически улучшил читаемость кода

#lang sicp

;; [procedure]
(define (compose f g)
  (lambda (x) (f (g x))))

;; [list]
(define (foldl f acc xs)
  (if (null? xs)
      acc
      (foldl f (f acc (car xs)) (cdr xs))))

;; [continuation]
(define cons-cont
  identity)

(define the-empty-cont
  identity)

(define cont-concat
  compose)

(define (cont-concat-all cs)
  (foldl cont-concat the-empty-cont cs))

;; [trans]
(define (cons-trans f)
  (cons-cont (lambda (cont) (lambda (acc x) (f cont acc x)))))

(define the-empty-trans
  the-empty-cont) ;; unused in this program, but completes implementation

(define trans-concat
  cont-concat)    ;; unused in this program, but completes implementation

(define trans-concat-all
  cont-concat-all)

;; [transducer]
(define (cons-transducer . ts)
  (lambda (f acc xs)
    (foldl ((trans-concat-all ts) f) acc xs)))

(define (mapper f)
  (cons-trans (lambda (next acc x) (next acc (f x)))))

(define (filterer f)
  (cons-trans (lambda (next acc x) (if (f x) (next acc x) acc))))

(define (effector f)
  (cons-trans (lambda (next acc x) (f x) (next acc x))))

(define (logger s)
  (effector (lambda (x) (display s) (display " ") (display x) (display "\n"))))

;; [main]
(define (square x)
  (* x x))

(define (main xs)
  ((cons-transducer (logger "input")
                    (filterer even?)
                    (logger "filtered")
                    (mapper square)
                    (logger "squared"))
   + 0 xs))

(main '(1 2 3 4 5 6 7 8 9 10))

Выход

input 1
input 2
filtered 2
squared 4
input 3
input 4
filtered 4
squared 16
input 5
input 6
filtered 6
squared 36
input 7
input 8
filtered 8
squared 64
input 9
input 10
filtered 10
squared 100
=> 220