is it possible to implement Scheme function (one function - its important) that gets a list and k, and retreive the permutations in size of k, for example: (1 2 3), k=2 will output { (1,1) , (1,2) , (1,3) , (2,1) , (2,2) , ..... } (9 options).?
Its possible to do anything without defining anything as long as you have lambda:
(define (fib n)
;; bad internal definition
(define (helper n a b)
(if (zero? n)
a
(helper (- n 1) b (+ a b))))
(helper n 0 1))
Using Z combinator:
(define Z
(lambda (f)
((lambda (g)
(f (lambda args (apply (g g) args))))
(lambda (g)
(f (lambda args (apply (g g) args)))))))
(define (fib n)
((Z (lambda (helper)
(lambda (n a b)
(if (zero? n)
a
(helper (- n 1) b (+ a b))))))
n 0 1))
Now we are never calling Z so we can substitute the value of Z for Z in the function and it will do the same:
(define (fib n)
(((lambda (f)
((lambda (g)
(f (lambda args (apply (g g) args))))
(lambda (g)
(f (lambda args (apply (g g) args))))))
(lambda (helper)
(lambda (n a b)
(if (zero? n)
a
(helper (- n 1) b (+ a b))))))
n 0 1))
There you go, Saved by Alonzo Church.
It is not only possible, it is easy. Just use a loop:
(define permute
(lambda (k lst)
(let loop ((result (map list lst))
(i 1))
(if (= i k)
result
(loop
;; code to add each element of the original list
;; to each element of the result list
(1+ i))))))
Related
In SICP it defines the church numerals for positive numbers as follows:
(define zero (lambda (f) (lambda (x) x)))
(define (add-1 n)
(lambda (f) (lambda (x) (f (n f) x))))
The following is my 'best attempt' to rewrite this for my own understanding, here passing explicit arguments to one function:
(define (church f x n)
(cond
((= n 0) x) ; zero case: return x
(else (f (church f x (- n 1)))))) ; otherwise f(f(f...(x))) n times
(church square 3 2)
81
And then redefining zero I would have:
(define (zero2 f)
(lambda (x) (church f x 0)))
And add-one as:
(define (add-1 n f)
(lambda (x) (church f x (+ n 1))))
Or, if we have to defer the f argument then adding a wrapper-lambda:
(define (add-1 n)
(lambda (f) (lambda (x) (church f x (+ n 1)))))
Do I have a correct understanding of this? if so, why the oh-so-complicated-syntax at the top for the add-1 or zero procedures (note: I'm guessing it's not that complicated and I'm just not fully understanding what it's doing). Any help would be greatly appreciated!
lambda calculus is a sub set of Scheme that does not allow more than one argument and lambda. With combinations of lambdas you can make any construct:
(define false (lambda (true) (lambda (false) false)))
(define true (lambda (true) (lambda (false) true)))
(define if (lambda (pred) (lambda (consequence) (lambda (alternative) ((pred consequence) alternative)))))
You might be wondering why I allow define since it isn't lambda. Well you don;t need it. It is just for convenience since with it you can try it out:
(((if true)
'result-true)
'result-false)
; ==> result-true
Instead of using the totally equal version:
((lambda (pred)
(lambda (consequence)
(lambda (alternative)
((pred consequence) alternative))))
(lambda (true) (lambda (false) true))
'result-true
'result-false)
Your function church is not lambda calculus since it does not return a church number and it takes more than one argument which is a violation. I have seen scheme functions to produce chuck numbers but any chuck number you should be able to do this to get the integer value:
((church-number add1) 0)
eg. zero:
(((lambda (f) (lambda (x) x)) add1) 0) ; ==> 0
Your version presupposes the existence of primitives like cond, 0, 1, =, and -. The point of all this is to show that you can implement such primitives starting from nothing but lambda.
SICP defines the Church numerals for positive numbers as follows:
(define zero (lambda (f) (lambda (x) x)))
(define (add-1 n)
(lambda (f) (lambda (x) (f (n f) x))))
No, it doesn't. The correct definitions are
(define zero (lambda (f) (lambda (x) x)))
(define (add-1 n)
(lambda (f) (lambda (x) (f ((n f) x)))))
f is a "successor step", and x is "zero value".
(f ((n f) x)) means, do with f and x whatever n would be doing with f and x, and then do f one more time to the result.
In other words, transform the "zero value" with the "successor step" function one more times than n would be transforming it.
Now,
> ((zero add1) 0)
0
> (((add-1 zero) add1) 0)
1
> (((add-1 (add-1 zero)) add1) 0)
2
etc. Or,
> (define plus1 (lambda (x) (cons '() x)))
> ((zero plus1) '(NIL))
'(NIL)
> (((add-1 zero) plus1) '(NIL))
'(() NIL)
> (((add-1 (add-1 zero)) plus1) '(NIL))
'(() () NIL)
Hopefully you can see how the Church numbers could be defined as binary functions as well:
(define zero (lambda (f x) x))
(define (add-1 n)
(lambda (f x) (f (n f x))))
(define plus1 (lambda (x) (cons '() x)))
(zero add1 0) ;=> 0
((add-1 zero) add1 0) ;=> 1
((add-1 (add-1 zero)) add1 0) ;=> 2
(zero plus1 '(NIL)) ;=> '(NIL)
((add-1 zero) plus1 '(NIL)) ;=> '(() NIL)
((add-1 (add-1 zero)) plus1 '(NIL)) ;=> '(() () NIL)
producing the same results as before.
I'm trying to write a code for extended Euclidian Algorithm in Scheme for an RSA implementation.
The thing about my problem is I can't write a recursive algorithm where the output of the inner step must be the input of the consecutive outer step. I want it to give the result of the most-outer step but as it can be seen, it gives the result of the most inner one. I wrote a program for this (it is a bit messy but I couldn't find time to edit.):
(define ax+by=1
(lambda (a b)
(define q (quotient a b))
(define r (remainder a b))
(define make-list (lambda (x y)
(list x y)))
(define solution-helper-x-prime (lambda (a b q r)
(if (= r 1) (- 0 q) (solution-helper-x-prime b r (quotient b r) (remainder b r)))
))
(define solution-helper-y-prime (lambda (a b q r)
(if (= r 1) (- r (* q (- 0 q) )) (solution-helper-y-prime b r (quotient b r) (remainder b r))
))
(define solution-first-step (lambda (a b q r)
(if (= r 1) (make-list r (- 0 q))
(make-list (solution-helper-x-prime b r (quotient b r) (remainder b r)) (solution-helper-y-prime b r (quotient b r) (remainder b r))))
))
(display (solution-first-step a b q r))
))
All kinds of help and advice would be greatly appreciated. (P.S. I added a scrrenshot of the instructions that was given to us but I can't see the image. If there is a problem, please let me know.)
This is a Diophantine equation and is a bit tricky to solve. I came up with an iterative solution adapted from this explanation, but had to split the problem in parts - first, obtain the list of quotients by applying the extended Euclidean algorithm:
(define (quotients a b)
(let loop ([a a] [b b] [lst '()])
(if (<= b 1)
lst
(loop b (remainder a b) (cons (quotient a b) lst)))))
Second, go back and solve the equation:
(define (solve x y lst)
(if (null? lst)
(list x y)
(solve y (+ x (* (car lst) y)) (cdr lst))))
Finally, put it all together and determine the correct signs of the solution:
(define (ax+by=1 a b)
(let* ([ans (solve 0 1 (quotients a b))]
[x (car ans)]
[y (cadr ans)])
(cond ((and (= a 0) (= b 1))
(list 0 1))
((and (= a 1) (= b 0))
(list 1 0))
((= (+ (* a (- x)) (* b y)) 1)
(list (- x) y))
((= (+ (* a x) (* b (- y))) 1)
(list x (- y)))
(else (error "Equation has no solution")))))
For example:
(ax+by=1 1027 712)
=> '(-165 238)
(ax+by=1 91 72)
=> '(19 -24)
(ax+by=1 13 13)
=> Equation has no solution
I'm currently stuck on a problem creating func and am a beginner at Scheme. In order to achieve such a result, will I have to define double inside func?
(func double 3 '(3 5 1))
would return (24 40 8) because each element is doubled 3 times.
No, double needs to be outside func because it will be passed as a parameter (bound to f) to func:
(define (double n) (* 2 n))
(define (times f e t)
(if (= t 0)
e
(times f (f e) (- t 1))))
(define (func f t lst)
(map (lambda (e) (times f e t)) lst))
then
> (func double 3 '(3 5 1))
'(24 40 8)
OTOH, in this case times could be defined inside func, but it's a reusable procedure so I'd leave it outside.
If I understand your question correctly, here's one way you can implement func:
(define (func f n lst)
(do ((n n (sub1 n))
(lst lst (map f lst)))
((zero? n) lst)))
Example usage:
> (func (lambda (x) (* x 2)) 3 '(3 5 1))
=> (24 40 8)
#lang racket
(define (repeat f x n)
(cond [(= n 0) x]
[else (f (repeat f x (- n 1)))]))
(define (func f n xs)
(map (λ(x) (repeat f x n)) xs))
(define (double x)
(* 2 x))
(func double 3 '(3 5 1))
Possibly something like this:
(define (cmap fun arg1 lst)
(map (lambda (x) (fun arg1 x)) lst))
But really you want to do this (cmap list 1 (get-some-calc x) (get-list)) but it's very difficult to make it take any curried argument and perhaps you want more than one list. You do it like this:
(let ((cval (get-come-calc x)))
(map (lambda (x) (list 1 cval x)) (get-list)))
I would like to write a simple profiler for Scheme that gives a count of the number of times each function in a program is called. I tried to redefine the define command like this (eventually I'll add the other forms of define, but for now I am just trying to write proof-of-concept code):
(define-syntax define
(syntax-rules ()
((define (name args ...) body ...)
(set! name
(lambda (args ...)
(begin
(set! *profile* (cons name *profile*))
body ...))))))
My idea was to record in a list *profile* each call to a function, then later to examine the list and determine function counts. This works, but stores the function itself (that is, the printable representation of the function name, which in Chez Scheme is #<procedure f> for a function named f), but then I can't count or sort or otherwise process the function names.
How can I write a simple profiler for Scheme?
EDIT: Here is my simple profiler (the uniq-c function that counts adjacent duplicates in a list comes from my Standard Prelude):
(define *profile* (list))
(define (reset-profile)
(set! *profile* (list)))
(define-syntax define-profiling
(syntax-rules ()
((_ (name args ...) body ...)
(define (name args ...)
(begin
(set! *profile*
(cons 'name *profile*))
body ...)))))
(define (profile)
(uniq-c string=?
(sort string<?
(map symbol->string *profile*)))))
As a simple demonstration, here is a function to identify prime numbers by trial division. Function divides? is broken out separately because the profiler only counts function calls, not individual statements.
(define-profiling (divides? d n)
(zero? (modulo n d)))
(define-profiling (prime? n)
(let loop ((d 2))
(cond ((= d n) #t)
((divides? d n) #f)
(else (loop (+ d 1))))))
(define-profiling (prime-pi n)
(let loop ((k 2) (pi 0))
(cond ((< n k) pi)
((prime? k) (loop (+ k 1) (+ pi 1)))
(else (loop (+ k 1) pi)))))
> (prime-pi 1000)
168
> (profile)
(("divides?" . 78022) ("prime-pi" . 1) ("prime?" . 999))
And here is an improved version of the function, which stops trial division at the square root of n:
(define-profiling (prime? n)
(let loop ((d 2))
(cond ((< (sqrt n) d) #t)
((divides? d n) #f)
(else (loop (+ d 1))))))
> (reset-profile)
> (prime-pi 1000)
168
> (profile)
(("divides?" . 5288) ("prime-pi" . 1) ("prime?" . 999))
I'll have more to say about profiling at my blog. Thanks to both #uselpa and #GoZoner for their answers.
Change your line that says:
(set! *profile* (cons name *profile*))
to
(set! *profile* (cons 'name *profile*))
The evaluation of name in the body of a function defining name is the procedure for name. By quoting you avoid the evaluation and are left with the symbol/identifier. As you had hoped, your *profile* variable will be a growing list with one symbol for each function call. You can count the number of occurrences of a given name.
Here's a sample way to implement it. It's written in Racket but trivial to transform to your Scheme dialect.
without syntax
Let's try without macros first.
Here's the profile procedure:
(define profile
(let ((cache (make-hash))) ; the cache memorizing call info
(lambda (cmd . pargs) ; parameters of profile procedure
(case cmd
((def) (lambda args ; the function returned for 'def
(hash-update! cache (car pargs) add1 0) ; prepend cache update
(apply (cadr pargs) args))) ; call original procedure
((dmp) (hash-ref cache (car pargs))) ; return cache info for one procedure
((all) cache) ; return all cache info
((res) (set! cache (make-hash))) ; reset cache
(else (error "wot?")))))) ; unknown parameter
and here's how to use it:
(define test1 (profile 'def 'test1 (lambda (x) (+ x 1))))
(for/list ((i 3)) (test1 i))
=> '(1 2 3)
(profile 'dmp 'test1)
=> 3
adding syntax
(define-syntax define!
(syntax-rules ()
((_ (name args ...) body ...)
(define name (profile 'def 'name (lambda (args ...) body ...))))))
(define! (test2 x) (* x 2))
(for/list ((i 4)) (test2 i))
=> '(0 2 4 6)
(profile 'dmp 'test2)
=> 4
To dump all:
(profile 'all)
=> '#hash((test2 . 4) (test1 . 3))
EDIT applied to your last example:
(define! (divides? d n) (zero? (modulo n d)))
(define! (prime? n)
(let loop ((d 2))
(cond ((< (sqrt n) d) #t)
((divides? d n) #f)
(else (loop (+ d 1))))))
(define! (prime-pi n)
(let loop ((k 2) (pi 0))
(cond ((< n k) pi)
((prime? k) (loop (+ k 1) (+ pi 1)))
(else (loop (+ k 1) pi)))))
(prime-pi 1000)
=> 168
(profile 'all)
=> '#hash((divides? . 5288) (prime-pi . 1) (prime? . 999))
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)