Scheme - sum the squares of even-valued elements in a list

Question

I want to be able to sum the squares of the even elements in the list, however my current code only sums the elements, not the squares. Does anyone know of any modifications that can be made to make this to sum the squares of the even-valued elements in the list?

(define (sum elemList)
  (if
    (null? elemList)
    0
    (+ (car elemList) (sum (cdr elemList)))
  )
)

My input would be:

(sum-evens (list 1 2 3 4))

Output would be:

20

Which is (2*2) + (4*4) .

If possible, it would be good to see both a recursive and iterative solution. Any ideas?

Answer 1

With Racket's left fold function,

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

we can easily implement the summing of a list ( (foldl + 0 xs) ), or the taking of the squares, or the filtering, separately.

It is also easy to nest them, so that one works with the results of the other (as is shown in the other answers), but that means three separate list traversals are performed,

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

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

But actually, folding (or, "reducing" ) a list with a reducer function (like + ) replaces the list's cons with that function's application anyway, so why not just go ahead and use that reducer in the first place? This means that the nested folds can be fused together as

(define (foo-2 xs)
    (foldl   
      (foldl  (lambda (x acc) (if (even? x) ( x acc) acc))   
        xs)))

and, further, as

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

thus deriving the iterative one-traversal function, which could otherwise be hand-coded relatively easily, but as a recursive variant (seen in the other answers).

We see the need to abstract the cons here, so that it can be easily manipulated, replaced. In other words, we want

  (lambda (x acc) ( ( x) acc))               ==:  ((mapping  ) )
  (lambda (x acc) (if ( x) ( x acc) acc))  ==:  ((filtering ) )

thus arriving at what's known as "transducers" , ie reducer functions' modifiers:

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

(define (foo xs)

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

The (f (gx)) pattern is abstracted as the functional composition ,

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

so that (f (gx)) is ((compose1 fg) x) . With more general compose accepting any number of functions to compose,

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

we can code it in the more general fashion, composing however many transducers we might need into one combined transducer performing the combined operation for each argument it is fed (taken from an input sequence; here, a list):

(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

and that's that!

---

So we have

(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) , just like cons itself, is a function of two arguments, so can be used as the reducer function argument to foldl .

Having (define g ((mapping sqr1) cons)) is the same as

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

And with filtering we have

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

So, ((mapping sqr1) ((filtering even?) cons)) is a reducer, where (mapping sqr1) uses ((filtering even?) cons) as its reducer. And that is (filtering even?) using cons as its – final in the chain – reducer function:

(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, mapping, filtering, and consing are all automagically rolled up into one reducer function for us as if we've written it ourselves! Better yet, foldl being tail-recursive, the overall function is iterative and performs just one list traversal – because the three reducer functions were combined into one.

Some more testing:

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

so that

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

Answer 2

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

where

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

sum the squares of the even elements. If you sum the elements of the list without doing anything, of course the answer cannot be the answer to your question.

What's more, one may implement this procedure in this way:

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

where map , filter and reduce are the common meanings(you can try it in mit-scheme). This do the same thing, however this is more readable, and things like cdr recursion are optimized. The second chapter in SICP(Structure and Interpretation of Computer Programs) introduced this methodology of programming.

Answer 3

There are two possibilities, either we implement the recursion from scratch:

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

Or we use built-in procedures, defining helpers as needed. This strategy is known as using "sequences as conventional interfaces" :

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

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

In Scheme, the preferred way is the second one, because we must not reinvent the wheel when we have procedures that already do the job for us. Either way, it works as expected:

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

Answer 4

or with SICP style streams !

if this interests you, see section 3.5 of Structure and Interpretation of Computer Programs (Sussman, Abelson)

the stream functions here work much like the transducers described in @WillNess's answer – ie, streams do not require multiple iterations thru the data

all stream procedures here are recursive but evolve a linear iterative process

it's worth noting that cons-stream is a special form that does not immediately evaluate it's second argument

#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

---

transducers

it is with immense affection i present this portion of the answer for @WillNess

i was introduced to transducers thru a person who has a knack for distilling the overwhelmingly complex down to the miraculously simple – as a labour of love, i've adapted some of the code/ideas presented (originally in javascript) to scheme

each ;; [section] ;; [section] defines an abstraction barrier

edit: removed special forms for cons-cont and cons-trans – macro didn't critically improve code readability

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

output

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