Expanded form of fold in Racket - scheme

Example from http://www.cse.unsw.edu.au/~en1000/haskell/hof.html :
(foldr / 7 (list 34 56 12 4 23))
(foldl / 7 (list 34 56 12 4 23))
Output in Racket:
5 193/196
5 193/196
What would be the full (expanded) form of foldl and foldr in this case? It is not the following:
> (/ (/ (/ (/ (/ 7 34) 56) 12) 4) 23)
1/300288
Edit: I have modified above question since implementation of fold in Racket vs Haskell has been explained in another question Why is foldl defined in a strange way in Racket?.
Edit: If I understand the answers clearly, the expanded form can be shown very clearly using "threading" module, where statements appear in order of execution (_ indicates output of previous statement):
foldl:
(require threading)
; expanded form of (foldl / 7 (list 34 56 12 4 23))
; FROM LEFT TO RIGHT:
(~> 7
(/ 34 _)
(/ 56 _)
(/ 12 _)
(/ 4 _)
(/ 23 _) )
foldr:
; expanded form of (foldr / 7 (list 34 56 12 4 23))
; FROM RIGHT TO LEFT:
(~> 7
(/ 23 _)
(/ 4 _)
(/ 12 _)
(/ 56 _)
(/ 34 _) )
The output in both cases is same:
5 193/196
5 193/196
It gives correct answers (which are different for foldl and foldr) in following example also:
; FROM LEFT TO RIGHT:
(foldl - 0 '(1 2 3 4))
(~> 0
(- 1 _) ; 1-0=1
(- 2 _) ; 2-1=1
(- 3 _) ; 3-1=2
(- 4 _)) ; 4-2=2
; FROM RIGHT TO LEFT:
(foldr - 0 '(1 2 3 4))
(~> 0
(- 4 _) ; 4-0=4
(- 3 _) ; 3-4=-1
(- 2 _) ; 2-(-1)=3
(- 1 _)) ; 1-3=-2
Output:
2
2
-2
-2
In common language, it seems:
The sent function takes 2 arguments,
the first argument is from the list, one after the other
(left to right or right to left depending on foldl and foldr),
the second argument is init first and
then the output of previous calculation.

In DrRacket, press the right mouse button on foldl and choose "Open defining file" In the provide list right click again and choose "Jump to the next bound occurance". You'll see this:
(define foldl
(case-lambda
[(f init l)
(check-fold 'foldl f init l null)
(let loop ([init init] [l l])
(if (null? l) init (loop (f (car l) init) (cdr l))))]
[(f init l . ls)
(check-fold 'foldl f init l ls)
(let loop ([init init] [ls (cons l ls)])
(if (pair? (car ls)) ; `check-fold' ensures all lists have equal length
(loop (apply f (mapadd car ls init)) (map cdr ls))
init))]))
However since you only have one list it's the first term in case lambda that is the current and the fist line checks arguments and throw exceptions. You can simplify it to:
(define (foldl f init l)
(let loop ([init init] [l l])
(if (null? l)
init
(loop (f (car l) init) (cdr l))))
Using substitution rules:
(foldl / 7 '(34 56 12 4 23)) ;==>
(loop 7 '(34 56 12 4 23)) ;==>
(loop (/ (car '(34 56 12 4 23)) 7) (cdr '(34 56 12 4 23))) ;==>
(loop (/ (car '(56 12 4 23)) (/ (car '(34 56 12 4 23)) 7)) (cdr '(56 12 4 23))) ;==>
(loop (/ (car '(12 4 23)) (/ (car '(56 12 4 23)) (/ (car '(34 56 12 4 23)) 7))) (cdr '(12 4 23))) ;==>
(loop (/ (car '(4 23)) (/ (car '(12 4 23)) (/ (car '(56 12 4 23)) (/ (car '(34 56 12 4 23)) 7)))) (cdr '(4 23))) ;==>
(loop (/ (car '(23)) (/ (car '(4 23)) (/ (car '(12 4 23)) (/ (car '(56 12 4 23)) (/ (car '(34 56 12 4 23)) 7))))) (cdr '(23))) ;==>
(/ (car '(23)) (/ (car '(4 23)) (/ (car '(12 4 23)) (/ (car '(56 12 4 23)) (/ (car '(34 56 12 4 23)) 7))))) ;==>
(/ 23 (/ 4 (/ 12 (/ 56 (/ 34 7))))) ;==>
5 193/196
I'll leave the foldr one as an exercise.
About folds and standards
The folds in #!racket are racket specific. In Scheme, more precisely #!r6rs you have fold-left and fold-right and unlike #!racket the argument order from a left to a right changes making it more similar to the *new Haskell version.
SRFI-1 list library uses the names fold and foldr and expect the same argument order for both, just like #!racket. SRFI-1 also supports different length lists and stops at the shortest one so it is the one with most features. SRFI-1 can be included in both #!racket with (require srfi/1)and with #!r6rs. (import (rnrs :1))

Haskell's foldr and foldl are not exactly equivalent to Racket's. Also, div is integer division, so you should use quotient in Racket. But even then,
(foldr quotient 7 (list 34 56 12 4 23)) => 8
(foldl quotient 7 (list 34 56 12 4 23)) => quotient: undefined for 0
You could read the documentation carefully on how foldl and foldr work, but I like to refer to the docs for the teaching languages:
(foldr f base (list x-1 ... x-n)) = (f x-1 ... (f x-n base))
(foldl f base (list x-1 ... x-n)) = (f x-n ... (f x-1 base))
So it becomes
(quotient 34 (quotient 56 (quotient 12 (quotient 4 (quotient 23 7)))))
(quotient 23 (quotient 4 (quotient 12 (quotient 56 (quotient 34 7)))))

Related

Racket: sliding window over a vector

What are some good ways to perform a sliding window over a finite sequence in Racket, such as finding the highest sum of any sub-sequence of 4 numbers?
(define example #(3 1 4 5 10 23 1 50 0 12 40 12 43 20))
First find prefix sums:
#lang racket
(define example #(3 1 4 5 10 23 1 50 0 12 40 12 43 20))
(define-values (sums sum)
(for/fold ([sums '()] [sum 0]) ([x example])
(values (cons sum sums) (+ sum x))))
(list->vector (cons sum sums))
Result:
'#(224 204 161 149 109 97 97 47 46 23 13 8 4 3 0)
Then ... profit.
Where profit could be this:
#lang racket
(define example #(3 1 4 5 10 23 1 50 0 12 40 12 43 20))
(define (prefix-sums xs)
(define-values (sums sum)
(for/fold ([sums '()] [sum 0]) ([x xs])
(values (cons sum sums) (+ sum x))))
(list->vector (reverse (cons sum sums))))
(define (sum4 xs i)
(- (vector-ref xs (+ i 4))
(vector-ref xs i)))
(define (sum4s xs)
(for/list ([i (- (vector-length xs) 4)])
(sum4 (prefix-sums xs) i)))
(apply max (sum4s example))
For a more generic approach, here's a sequence constructor that returns a sliding window of len elements from a vector, len values at a time, which can then be used with for comprehensions:
(define (in-vector-window v len)
(make-do-sequence
(lambda ()
(values
(lambda (i) (vector->values v i (+ i len)))
add1
0
(lambda (i) (<= (+ i len) (vector-length v)))
#f
#f))))
And some example usages:
> (for/list ([(a b c d) (in-vector-window example 4)]) (list a b c d))
'((3 1 4 5) (1 4 5 10) (4 5 10 23) (5 10 23 1) (10 23 1 50) (23 1 50 0) (1 50 0 12) (50 0 12 40) (0 12 40 12) (12 40 12 43) (40 12 43 20))
> (define sums (for/list ([(a b c d) (in-vector-window example 4)]) (+ a b c d)))
> (foldl max (car sums) (cdr sums))
115

Splitting list into lists of a maximal length

For instance
I want to make a list which has 20 numbers showed below. separate
(list 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20)
into list of list which contains 10 numbers in each list. just like below
(list (list 1 2 3 4 5 6 7 8 9 10)
(list 11 12 13 14 15 16 17 18 19 20))
what is the best way to do this?
//Sorry for my poor English.
(define (take n xs)
(if (or (= n 0)
(null? xs) )
'()
(cons (car xs)
(take (- n 1)
(cdr xs) ))))
(define (drop n xs)
(if (or (= n 0)
(null? xs) )
xs
(drop (- n 1)
(cdr xs) )))
(define (split n xs)
(if (null? xs) '()
(cons (take n xs)
(split n (drop n xs)) )))
(display
(split 3 (list 1 2 3 4 5)) ) ; `((1 2 3) (4 5))`
Alternative split definition, elimination of wrapper recursion using named let:
(define (split n xs)
(let spl ((xs' xs)) ; Named let
(if (null? xs') '()
(cons (take n xs')
(spl (drop n xs')) ))))

How do foldl and foldr work, broken down in an example?

Okay, I am new with scheme/racket/lisp. I am practicing creating my own functions, syntax, and recursion, so I want to make my own foldl and foldr functions that do exactly what the predefined versions do. I can't do it because I just don't understand how these functions work. I have seen similar questions on here but I still don't get it. Some examples broken down would help! Here is my (incorrect) process:
(foldl - 0 '(1 2 3 4)) I do 0 -(4-3-2-1) and get 2 which is the right answer
(foldl - 0 '(4 3 2 1)) I do 0-(1-2-3-4) and get 8 but it should be -2.
(foldr - 0 '(1 2 3 4)) I do 0-(1-2-3-4) and get 8 again, but it should be -2.
(foldr - 0 '(4 3 2 1)) I do 0-(4-3-2-1) and get 2 which is the right answer.
What am I doing wrong?
Let's look at: (foldr - 0 '(1 2 3 4)).
Here the literal '(1 2 3 4) constructs a list whose elements are the numbers 1, 2, 3, and, 4. Let's make the construction of the list explicit:
(cons 1 (cons 2 (cons 3 (cons 4 empty))))
One can think of foldr as a function that replaces cons with a function f and empty with a value v.
Therefore
(foldr f 0 (cons 1 (cons 2 (cons 3 (cons 4 empty)))))
becomes
(f 1 (f 2 (f 3 (f 4 v)))))
If the function f is - and the value v is 0, you will get:
(- 1 (- 2 (- 3 (- 4 0)))))
And we can calculate the result:
(- 1 (- 2 (- 3 (- 4 0))))
= (- 1 (- 2 (- 3 4)))
= (- 1 (- 2 -1))
= (- 1 3)
= -2
Note that (foldr cons empty a-list) produces a copy of a-list.
The function foldl on the other hand uses the values from the other side:
> (foldl cons empty '(1 2 3 4))
'(4 3 2 1)
In other words:
(foldl f v '(1 2 3 4))
becomes
(f 4 (f 3 (f 2 (f 1 v)))).
If f is the function - and the value is 0, then we get:
(- 4 (- 3 (- 2 (- 1 0))))
= (- 4 (- 3 (- 2 1)))
= (- 4 (- 3 1))
= (- 4 2)
= 2
Note that (foldl cons empty a-list) produces the reverse of a-list.
You can illustrate what is going on in fold, if you create a procedure, which does the same like cons but reverses the arguments. I have called it snoc in the following example.
(define fldl
(lambda (proc a lst)
(if (pair? lst)
(fldl proc
(proc (car lst)
a)
(cdr lst))
a)))
(define fldr
(lambda (proc a lst)
(if (pair? lst)
(proc (car lst)
(fldr proc
a
(cdr lst)))
a)))
(define lst (list 1 2 3 4))
(fldl + 0 lst) ;; => 10
(fldl * 1 lst) ;; => 24
(fldl cons '() lst) ;; => (4 3 2 1)
(fldr + 0 lst) ;; => 10
(fldr * 1 lst) ;; => 24
(fldr cons '() lst) ;; => (1 2 3 4)
(define snoc (lambda (a b) (cons b a)))
(fldl snoc '() lst) ;; => ((((() . 1) . 2) . 3) . 4)
(fldr snoc '() lst) ;; => ((((() . 4) . 3) . 2) . 1)

Josephus in Scheme

Where does this implementation of the Josephus problem fall short? For those who are unfamiliar with the Josephus Problem, the goal is to delete every 3rd entry from a circularly linked list until only one remains. In this example I am deleting every "mth" value.
(define (joseph lst)
(let ((m (+ 1 (random (length lst)))))
(define (joseph-h i xlst mlst)
(cond ((<= (length xlst) 1) xlst)
((null? (cdr mlst))
(joseph-h i xlst xlst))
((= i m)
(joseph-h 1 (delete (car mlst) xlst) (cdr mlst)))
(else
(joseph-h (+ i 1) xlst (cdr mlst)))))
(joseph-h 0 lst lst)))
(joseph (list 1 2 3 4 5 6 7))
(define (delete v lst)
(cond ((= v (car lst))
(cdr lst))
(else
(cons (car lst) (delete v (cdr lst))))))
I always end up with the last number of the list as the answer. I know that this is not right.
You're taking the algorithm too literally, by creating a list and deleting elements ("killing" people) from it. A simpler solution would be to use arithmetic operations to model the problem, here's a possible implementation, adapted from my own previous answer:
(define (joseph n k)
(let loop ([i 1]
[acc 0])
(if (> i n)
(add1 acc)
(loop (add1 i)
(modulo (+ acc k) i)))))
For example, to see which position survives in the list '(1 2 3 4 5 6 7) after killing every third person, do this:
(joseph 7 3)
=> 4
Wikipedia provides an interesting discussion regarding the possible solutions for this problem, my solution adapts the simple python function shown, after converting it to tail recursion.
I give three solutions at my blog. The most literal version deletes from a list of n items in steps of m, representing the list as a cyclic list:
(define (cycle xs)
(set-cdr! (last-pair xs) xs) xs)
(define (josephus3 n m)
(let loop ((k (- m 1)) (alive (cycle (range 0 n))) (dead '()))
(cond ((= (car alive) (cadr alive))
(reverse (cons (car alive) dead)))
((= k 1)
(let ((dead (cons (cadr alive) dead)))
(set-cdr! alive (cddr alive))
(loop (- m 1) (cdr alive) dead)))
This does the deletions by actually removing the killed elements from the alive list and placing them on the dead list. The range function is from my Standard Prelude; it returns the integers from 0 to n-1:
(define (range first past . step)
(let* ((xs '()) (f first) (p past)
(s (cond ((pair? step) (car step))
((< f p) 1) (else -1)))
(le? (if (< 0 s) <= >=)))
(do ((x f (+ x s))) ((le? p x) (reverse xs))
(set! xs (cons x xs)))))
The original Josephus problem killed 41 men in steps of 3, leaving the 31st man as the survivor, counting from 1:
(josephus3 41 3)
(2 5 8 11 14 17 20 23 26 29 32 35 38 0 4 9 13 18 22 27 31 36
40 6 12 19 25 33 39 7 16 28 37 10 24 1 21 3 34 15 30)
You might also enjoy the other two versions at my blog.

Scheme problem (using a function as a parameter)

I'm a Scheme newbie and trying to make sense of my homework.
I've a function I made earlier called duplicate, and it looks like this:
( DEFINE ( duplicate lis )
(IF (NULL? lis) '())
((CONS (CAR lis) (CONS (CAR lis) (duplicate (CDR lis))))
))
A typical i/o from this would be i: (duplicate '(1 2 3 4)) o: (1 1 2 2 3 3 4 4), so basicly it duplicates everything in the list.
Moving on:
Now I'm supposed to make a function that's called comp.
It's supposed to be built like this:
(DEFINE (comp f g) (lambda (x) (f (g (x))))
Where I could input '(1 2 3 4) and it would return (1 1 4 4 9 9 16 16)
so f = duplicate and g = lambda.
I know lambda should probably look like this:
(lambda (x) (* x x))
But here's where the problem starts, I've already spent several hours on this, and as you can see not made much progress.
Any help would be appreciated.
Best regards.
Use map:
> (map (lambda (x) (* x x)) (duplicate '(1 2 3 4)))
=> (1 1 4 4 9 9 16 16)
or, modify duplicate to take a procedure as its second argument and apply it to each element of the list:
(define (duplicate lst p)
(if (null? lst) ()
(append (list (p (car lst)) (p (car lst))) (duplicate (cdr lst) p))))
> (duplicate '(1 2 3 4) (lambda (x) (* x x)))
=> (1 1 4 4 9 9 16 16)
One way to do is as follows:
(define (comp f g) (lambda (x) (f (g x))))
(define (square x) (* x x))
(define (dup x) (list x x))
(define (duplicate-square lst)
(foldr append '() (map (comp dup square) lst)))
Now at the repl, do:
> (duplicate-square '(1 2 3 4))
'(1 1 4 4 9 9 16 16)

Resources