In response to the following exercise from the SICP,
Exercise 1.3. Define a procedure that takes three numbers as arguments
and returns the sum of the squares of the two larger numbers.
I wrote the following (correct) function:
(define (square-sum-larger a b c)
(cond ((or (and (> a b) (> b c)) (and (> b a) (> a c))) (+ (* a a) (* b b)))
((or (and (> a c) (> c b)) (and (> c a) (> a b))) (+ (* a a) (* c c)))
((or (and (> b c) (> c a)) (and (> c b) (> b a))) (+ (* b b) (* c c)))))
Unfortunately, that is one of the ugliest functions I've written in my life. How do I
(a) Make it elegant, and
(b) Make it work for an arbitrary number of inputs?
I found an elegant solution (though it only works for 3 inputs):
(define (square-sum-larger a b c)
(+
(square (max a b))
(square (max (min a b) c))))
If you're willing to use your library's sort function, this becomes easy and elegant.
(define (square-sum-larger . nums)
(define sorted (sort nums >))
(let ((a (car sorted))
(b (cadr sorted)))
(+ (* a a) (* b b))))
In the above function, nums is a "rest" argument, containing a list of all arguments passed to the function. We just sort that list in descending order using >, then square the first two elements of the result.
I don't know if it's elegant enough but for a 3 argument version you can use procedure abstraction to reduce repetition:
(define (square-sum-larger a b c)
(define (square x)
(* x x))
(define (max x y)
(if (< x y) y x))
(if (< a b)
(+ (square b) (square (max a c)))
(+ (square a) (square (max b c)))))
Make it work for an arbitrary number of inputs.
(define (square-sum-larger a b . rest)
(let loop ((a (if (> a b) a b)) ;; a becomes largest of a and b
(b (if (> a b) b a)) ;; b becomes smallest of a and b
(rest rest))
(cond ((null? rest) (+ (* a a) (* b b)))
((> (car rest) a) (loop (car rest) a (cdr rest)))
((> (car rest) b) (loop a (car rest) (cdr rest)))
(else (loop a b (cdr rest))))))
A R6RS-version using sort and take:
#!r6rs
(import (rnrs)
(only (srfi :1) take))
(define (square-sum-larger . rest)
(apply +
(map (lambda (x) (* x x))
(take (list-sort > rest) 2))))
You don't need to bother sorting you just need the find the greatest two.
(define (max-fold L)
(if (null? L)
#f
(reduce (lambda (x y)
(if (> x y) x y))
(car L)
L)))
(define (remove-num-once x L)
(cond ((null? L) #f)
((= x (car L)) (cdr L))
(else (cons (car L) (remove-once x (cdr L))))))
(define (square-sum-larger . nums)
(let ((max (max-fold nums)))
(+ (square max)
(square (max-fold (remove-num-once max nums))))))
(square-sum-larger 1 8 7 4 5 6 9 2)
;Value: 145
Related
I used the following code to solve Sum by Factors:
#lang racket
(provide sum-of-divided)
(define (sum-of-divided lst)
(define (go ps n l)
(define ((exhaust d) x)
(define q (/ x d))
(if (integer? q)
((exhaust d) q)
(if (> x 1) `(,x) '())))
(if (null? l)
ps
(if
(for/or
([p ps])
#:break (< n (sqr p))
(= 0 (modulo n p)))
(go ps (+ n 1) l)
(go
(append ps `(,n))
(+ n 1)
(append-map (exhaust n) l)))))
(for*/list
([m (go '() 2 (map abs lst))]
[s `(,(for/fold
([a '(0 #f)])
([x lst])
(if (= 0 (modulo x m))
`(,(+ (car a) x) #t)
a)))]
#:when (cadr s))
`(,m ,(car s))))
To my surprise, it passed the tests, which have a time limit of 12 s, only after I changed sequence-append in L20 to append. The documentation for sequence-append says:
The new sequence is constructed lazily.
But, as it turns out, it apparently means that the subsequent sequences aren't concatenated unless needed. But when their elements are needed, i.e. the sequence resulting from sequence-append is consumed far enough, the time cost linear in the sum of lengths of all previous sequences is incurred. Right? Is that why it was slow?
If so, how to work around it? (In this case append was performant enough, but suppose I really needed a structure which is at least a FIFO queue with the usual complexities.) Is there a good alternative within the racket language, without requireing additional packages (which may be unavailable, as is the case on Codewars)? Difference lists maybe (quite easy to implement from scratch)?
I ended up using the obvious, hitherto purposely avoided: mutable lists:
#lang racket
(provide sum-of-divided)
(define (sum-of-divided lst)
(define ps (mcons 0 '()))
(define t ps)
(for*/list
([m
(let go ([n 2] [l (map abs lst)])
(if (null? l)
(mcdr ps)
(go
(+ n 1)
(if
(for/or
([p (mcdr ps)])
#:break (< n (sqr p))
(= 0 (modulo n p)))
l
(begin
(set-mcdr! t (mcons n '()))
(set! t (mcdr t))
(remq*
'(1)
(map
(λ (x)
(let exhaust ([s x])
(define q (/ s n))
(if (integer? q)
(exhaust q)
s)))
l)))))))]
[s `(,(for/fold
([a '(0 #f)])
([x lst])
(if (= 0 (modulo x m))
`(,(+ (car a) x) #t)
a)))]
#:when (cadr s))
`(,m ,(car s))))
I also tried a purely functional approach with streams:
#lang racket
(provide sum-of-divided)
(define primes
(letrec
([ps
(stream*
2
(for*/stream
([i (in-naturals 3)]
#:unless
(for/or
([p ps])
#:break (< i (sqr p))
(= 0 (modulo i p))))
i))])
ps))
(define (sum-of-divided lst)
(for/fold
([l lst]
[r '()]
#:result (reverse r))
([d primes])
#:break (null? l)
(values
(remq*
'(1)
(map
(λ (x)
(let exhaust ([s x])
(define q (/ s d))
(if (integer? q)
(exhaust q)
s)))
l))
`(,#(for/fold
([a 0]
[f #f]
#:result
(if f
`((,d ,a))
'()))
([n lst])
(if (= 0 (modulo n d))
(values (+ a n) #t)
(values a f)))
,#r))))
Surprisingly, it consistently times out, whereas the imperative one above never does. Having believed Racket implementors cared at least equally for performance with functional style, I'm disappointed.
Here is my code:
(define (squares 1st)
(let loop([1st 1st] [acc 0])
(if (null? 1st)
acc
(loop (rest 1st) (* (first 1st) (first 1st) acc)))))
My test is:
(test (sum-squares '(1 2 3)) => 14 )
and it's failed.
The function input is a list of number [1 2 3] for example, and I need to square each number and sum them all together, output - number.
The test will return #t, if the correct answer was typed in.
This is rather similar to your previous question, but with a twist: here we add, instead of multiplying. And each element gets squared before adding it:
(define (sum-squares lst)
(if (empty? lst)
0
(+ (* (first lst) (first lst))
(sum-squares (rest lst)))))
As before, the procedure can also be written using tail recursion:
(define (sum-squares lst)
(let loop ([lst lst] [acc 0])
(if (empty? lst)
acc
(loop (rest lst) (+ (* (first lst) (first lst)) acc)))))
You must realize that both solutions share the same structure, what changes is:
We use + to combine the answers, instead of *
We square the current element (first lst) before adding it
The base case for adding a list is 0 (it was 1 for multiplication)
As a final comment, in a real application you shouldn't use explicit recursion, instead we would use higher-order procedures for composing our solution:
(define (square x)
(* x x))
(define (sum-squares lst)
(apply + (map square lst)))
Or even shorter, as a one-liner (but it's useful to have a square procedure around, so I prefer the previous solution):
(define (sum-squares lst)
(apply + (map (lambda (x) (* x x)) lst)))
Of course, any of the above solutions works as expected:
(sum-squares '())
=> 0
(sum-squares '(1 2 3))
=> 14
A more functional way would be to combine simple functions (sum and square) with high-order functions (map):
(define (square x) (* x x))
(define (sum lst) (foldl + 0 lst))
(define (sum-squares lst)
(sum (map square lst)))
I like Benesh's answer, just modifying it slightly so you don't have to traverse the list twice. (One fold vs a map and fold)
(define (square x) (* x x))
(define (square-y-and-addto-x x y) (+ x (square y)))
(define (sum-squares lst) (foldl square-y-and-addto-x 0 lst))
Or you can just define map-reduce
(define (map-reduce map-f reduce-f nil-value lst)
(if (null? lst)
nil-value
(map-reduce map-f reduce-f (reduce-f nil-value (map-f (car lst))))))
(define (sum-squares lst) (map-reduce square + 0 lst))
racket#> (define (f xs) (foldl (lambda (x b) (+ (* x x) b)) 0 xs))
racket#> (f '(1 2 3))
14
Without the use of loops or lamdas, cond can be used to solve this problem as follows ( printf is added just to make my exercises distinct. This is an exercise from SICP : exercise 1.3):
;; Takes three numbers and returns the sum of squares of two larger number
;; a,b,c -> int
;; returns -> int
(define (sum_sqr_two_large a b c)
(cond
((and (< a b) (< a c)) (sum-of-squares b c))
((and (< b c) (< b a)) (sum-of-squares a c))
((and (< c a) (< c b)) (sum-of-squares a b))
)
)
;; Sum of squares of numbers given
;; a,b -> int
;; returns -> int
(define (sum-of-squares a b)
(printf "ex. 1.3: ~a \n" (+ (square a)(square b)))
)
;; square of any integer
;; a -> int
;; returns -> int
(define (square a)
(* a a)
)
;; Sample invocation
(sum_sqr_two_large 1 2 6)
A little help, guys.
How do you sort a list according to a certain pattern
An example would be sorting a list of R,W,B where R comes first then W then B.
Something like (sortf '(W R W B R W B B)) to (R R W W W B B B)
Any answer is greatly appreciated.
This is a functional version of the Dutch national flag problem. Here are my two cents - using the sort procedure with O(n log n) complexity:
(define sortf
(let ((map '#hash((R . 0) (W . 1) (B . 2))))
(lambda (lst)
(sort lst
(lambda (x y) (<= (hash-ref map x) (hash-ref map y)))))))
Using filter with O(4n) complexity:
(define (sortf lst)
(append (filter (lambda (x) (eq? x 'R)) lst)
(filter (lambda (x) (eq? x 'W)) lst)
(filter (lambda (x) (eq? x 'B)) lst)))
Using partition with O(3n) complexity::
(define (sortf lst)
(let-values (((reds others)
(partition (lambda (x) (eq? x 'R)) lst)))
(let-values (((whites blues)
(partition (lambda (x) (eq? x 'W)) others)))
(append reds whites blues))))
The above solutions are written in a functional programming style, creating a new list with the answer. An optimal O(n), single-pass imperative solution can be constructed if we represent the input as a vector, which allows referencing elements by index. In fact, this is how the original formulation of the problem was intended to be solved:
(define (swap! vec i j)
(let ((tmp (vector-ref vec i)))
(vector-set! vec i (vector-ref vec j))
(vector-set! vec j tmp)))
(define (sortf vec)
(let loop ([i 0]
[p 0]
[k (sub1 (vector-length vec))])
(cond [(> i k) vec]
[(eq? (vector-ref vec i) 'R)
(swap! vec i p)
(loop (add1 i) (add1 p) k)]
[(eq? (vector-ref vec i) 'B)
(swap! vec i k)
(loop i p (sub1 k))]
[else (loop (add1 i) p k)])))
Be aware that the previous solution mutates the input vector in-place. It's quite elegant, and works as expected:
(sortf (vector 'W 'R 'W 'B 'R 'W 'B 'B 'R))
=> '#(R R R W W W B B B)
This is a solution without using sort or higher order functions. (I.e. no fun at all)
This doesn't really sort but it solves your problem without using sort. named let and case are the most exotic forms in this solution.
I wouldn't have done it like this unless it's required not to use sort. I think lepple's answer is both elegant and easy to understand.
This solution is O(n) so it's probably faster than the others with very large number of balls.
#!r6rs
(import (rnrs base))
(define (sort-flag lst)
;; count iterates over lst and counts Rs, Ws, and Bs
(let count ((lst lst) (rs 0) (ws 0) (bs 0))
(if (null? lst)
;; When counting is done build makes a list of
;; Rs, Ws, and Bs using the frequency of the elements
;; The building is done in reverse making the loop a tail call
(let build ((symbols '(B W R))
(cnts (list bs ws rs))
(tail '()))
(if (null? symbols)
tail ;; result is done
(let ((element (car symbols)))
(let build-element ((cnt (car cnts))
(tail tail))
(if (= cnt 0)
(build (cdr symbols)
(cdr cnts)
tail)
(build-element (- cnt 1)
(cons element tail)))))))
(case (car lst)
((R) (count (cdr lst) (+ 1 rs) ws bs))
((W) (count (cdr lst) rs (+ 1 ws) bs))
((B) (count (cdr lst) rs ws (+ 1 bs)))))))
Make a lookup eg
(define sort-lookup '((R . 1)(W . 2)(B . 3)))
(define (sort-proc a b)
(< (cdr (assq a sort-lookup))
(cdr (assq b sort-lookup))))
(list-sort sort-proc '(W R W B R W B B))
Runnable R6RS (IronScheme) solution here: http://eval.ironscheme.net/?id=110
You just use the built-in sort or the sort you already have and use a custom predicate.
(define (follow-order lst)
(lambda (x y)
(let loop ((inner lst))
(cond ((null? inner) #f)
((equal? x (car inner)) #t)
((equal? y (car inner)) #f)
(else (loop (cdr inner)))))))
(sort '(W R W B R W B) (follow-order '(R W B)))
;Value 50: (r r w w w b b)
What is the most transparent and elegant string to decimal number procedure you can create in Scheme?
It should produce correct results with "+42", "-6", "-.28", and "496.8128", among others.
This is inspired by the previously posted list to integer problem: how to convert a list to num in scheme?
I scragged my first attempt since it went ugly fast and realized others might like to play with it as well.
Much shorter, also makes the result inexact with a decimal point, and deal with any +- prefix. The regexp thing is only used to assume a valid syntax later on.
#lang racket/base
(require racket/match)
(define (str->num s)
;; makes it possible to assume a correct format later
(unless (regexp-match? #rx"^[+-]*[0-9]*([.][0-9]*)?$" s)
(error 'str->num "bad input ~e" s))
(define (num l a)
(match l
['() a]
[(cons #\. l) (+ a (/ (num l 0.0) (expt 10 (length l))))]
[(cons c l) (num l (+ (* 10 a) (- (char->integer c) 48)))]))
(define (sign l)
(match l
[(cons #\- l) (- (sign l))]
[(cons #\+ l) (sign l)]
[_ (num l 0)]))
(sign (string->list s)))
Here is a first shot. Not ugly, not beautiful, just longer than I'd like. Tuning another day. I will gladly pass the solution to someone's better creation.
((define (string->number S)
(define (split L c)
(let f ((left '()) (right L))
(cond ((or (not (list? L)) (empty? right)) (values L #f))
((eq? c (car right)) (values (reverse left) (cdr right)))
(else (f (cons (car right) left) (cdr right))))))
(define (mkint L)
(let f ((sum 0) (L (map (lambda (c) (- (char->integer c) (char->integer #\0))) L)))
(if (empty? L) sum (f (+ (car L) (* 10 sum)) (cdr L)))))
(define list->num
(case-lambda
((L) (cond ((empty? L) 0)
((eq? (car L) #\+) (list->num 1 (cdr L)))
((eq? (car L) #\-) (list->num -1 (cdr L)))
(else (list->num 1 L))))
((S L) (let*-values (((num E) (split L #\E)) ((W F) (split num #\.)))
(cond (E (* (list->num S num) (expt 10 (list->num E))))
(F (* S (+ (mkint W) (/ (mkint F) (expt 10 (length F))))))
(else (* S (mkint W))))))))
(list->num (string->list S)))
I'm trying to learn scheme via SICP. Exercise 1.3 reads as follow: Define a procedure that takes three numbers as arguments and returns the sum of the squares of the two larger numbers. Please comment on how I can improve my solution.
(define (big x y)
(if (> x y) x y))
(define (p a b c)
(cond ((> a b) (+ (square a) (square (big b c))))
(else (+ (square b) (square (big a c))))))
Using only the concepts presented at that point of the book, I would do it:
(define (square x) (* x x))
(define (sum-of-squares x y) (+ (square x) (square y)))
(define (min x y) (if (< x y) x y))
(define (max x y) (if (> x y) x y))
(define (sum-squares-2-biggest x y z)
(sum-of-squares (max x y) (max z (min x y))))
big is called max. Use standard library functionality when it's there.
My approach is different. Rather than lots of tests, I simply add the squares of all three, then subtract the square of the smallest one.
(define (exercise1.3 a b c)
(let ((smallest (min a b c))
(square (lambda (x) (* x x))))
(+ (square a) (square b) (square c) (- (square smallest)))))
Whether you prefer this approach, or a bunch of if tests, is up to you, of course.
Alternative implementation using SRFI 95:
(define (exercise1.3 . args)
(let ((sorted (sort! args >))
(square (lambda (x) (* x x))))
(+ (square (car sorted)) (square (cadr sorted)))))
As above, but as a one-liner (thanks synx # freenode #scheme); also requires SRFI 1 and SRFI 26:
(define (exercise1.3 . args)
(apply + (map! (cut expt <> 2) (take! (sort! args >) 2))))
What about something like this?
(define (p a b c)
(if (> a b)
(if (> b c)
(+ (square a) (square b))
(+ (square a) (square c)))
(if (> a c)
(+ (square a) (square b))
(+ (square b) (square c)))))
I did it with the following code, which uses the built-in min, max, and square procedures. They're simple enough to implement using only what's been introduced in the text up to that point.
(define (sum-of-highest-squares x y z)
(+ (square (max x y))
(square (max (min x y) z))))
Using only the concepts introduced up to that point of the text, which I think is rather important, here is a different solution:
(define (smallest-of-three a b c)
(if (< a b)
(if (< a c) a c)
(if (< b c) b c)))
(define (square a)
(* a a))
(define (sum-of-squares-largest a b c)
(+ (square a)
(square b)
(square c)
(- (square (smallest-of-three a b c)))))
(define (sum-sqr x y)
(+ (square x) (square y)))
(define (sum-squares-2-of-3 x y z)
(cond ((and (<= x y) (<= x z)) (sum-sqr y z))
((and (<= y x) (<= y z)) (sum-sqr x z))
((and (<= z x) (<= z y)) (sum-sqr x y))))
(define (f a b c)
(if (= a (min a b c))
(+ (* b b) (* c c))
(f b c a)))
Looks ok to me, is there anything specific you want to improve on?
You could do something like:
(define (max2 . l)
(lambda ()
(let ((a (apply max l)))
(values a (apply max (remv a l))))))
(define (q a b c)
(call-with-values (max2 a b c)
(lambda (a b)
(+ (* a a) (* b b)))))
(define (skip-min . l)
(lambda ()
(apply values (remv (apply min l) l))))
(define (p a b c)
(call-with-values (skip-min a b c)
(lambda (a b)
(+ (* a a) (* b b)))))
And this (proc p) can be easily converted to handle any number of arguments.
With Scott Hoffman's and some irc help I corrected my faulty code, here it is
(define (p a b c)
(cond ((> a b)
(cond ((> b c)
(+ (square a) (square b)))
(else (+ (square a) (square c)))))
(else
(cond ((> a c)
(+ (square b) (square a))))
(+ (square b) (square c)))))
You can also sort the list and add the squares of the first and second element of the sorted list:
(require (lib "list.ss")) ;; I use PLT Scheme
(define (exercise-1-3 a b c)
(let* [(sorted-list (sort (list a b c) >))
(x (first sorted-list))
(y (second sorted-list))]
(+ (* x x) (* y y))))
Here's yet another way to do it:
#!/usr/bin/env mzscheme
#lang scheme/load
(module ex-1.3 scheme/base
(define (ex-1.3 a b c)
(let* ((square (lambda (x) (* x x)))
(p (lambda (a b c) (+ (square a) (square (if (> b c) b c))))))
(if (> a b) (p a b c) (p b a c))))
(require scheme/contract)
(provide/contract [ex-1.3 (-> number? number? number? number?)]))
;; tests
(module ex-1.3/test scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(planet "text-ui.ss" ("schematics" "schemeunit.plt" 2)))
(require 'ex-1.3)
(test/text-ui
(test-suite
"ex-1.3"
(test-equal? "1 2 3" (ex-1.3 1 2 3) 13)
(test-equal? "2 1 3" (ex-1.3 2 1 3) 13)
(test-equal? "2 1. 3.5" (ex-1.3 2 1. 3.5) 16.25)
(test-equal? "-2 -10. 3.5" (ex-1.3 -2 -10. 3.5) 16.25)
(test-exn "2+1i 0 0" exn:fail:contract? (lambda () (ex-1.3 2+1i 0 0)))
(test-equal? "all equal" (ex-1.3 3 3 3) 18))))
(require 'ex-1.3/test)
Example:
$ mzscheme ex-1.3.ss
6 success(es) 0 failure(s) 0 error(s) 6 test(s) run
0
It's nice to see how other people have solved this problem. This was my solution:
(define (isGreater? x y z)
(if (and (> x z) (> y z))
(+ (square x) (square y))
0))
(define (sumLarger x y z)
(if (= (isGreater? x y z) 0)
(sumLarger y z x)
(isGreater? x y z)))
I solved it by iteration, but I like ashitaka's and the (+ (square (max x y)) (square (max (min x y) z))) solutions better, since in my version, if z is the smallest number, isGreater? is called twice, creating an unnecessarily slow and circuitous procedure.
(define (sum a b) (+ a b))
(define (square a) (* a a))
(define (greater a b )
( if (< a b) b a))
(define (smaller a b )
( if (< a b) a b))
(define (sumOfSquare a b)
(sum (square a) (square b)))
(define (sumOfSquareOfGreaterNumbers a b c)
(sumOfSquare (greater a b) (greater (smaller a b) c)))
I've had a go:
(define (procedure a b c)
(let ((y (sort (list a b c) >)) (square (lambda (x) (* x x))))
(+ (square (first y)) (square(second y)))))
;exercise 1.3
(define (sum-square-of-max a b c)
(+ (if (> a b) (* a a) (* b b))
(if (> b c) (* b b) (* c c))))
I think this is the smallest and most efficient way:
(define (square-sum-larger a b c)
(+
(square (max a b))
(square (max (min a b) c))))
Below is the solution that I came up with. I find it easier to reason about a solution when the code is decomposed into small functions.
; Exercise 1.3
(define (sum-square-largest a b c)
(+ (square (greatest a b))
(square (greatest (least a b) c))))
(define (greatest a b)
(cond (( > a b) a)
(( < a b) b)))
(define (least a b)
(cond ((> a b) b)
((< a b) a)))
(define (square a)
(* a a))