Define a Scheme function my-len that calculates the length of a given list. You should implement this function using a tail-recursive helper function. Your function should take one argument, which is the list for which you want to find the length.
(define (len L)
(define (tail-len L k)
(if (null? L) k
(tail-len (cdr L) (+ 1 k))))
(tail-len L 0))
Non tail-recursive version:
(define (my-len L)
(if (null? L)
0
(+ 1 (my-len (cdr L))))
)
The last operation in the tail-recursive tail-len is calling tail-len itself while in the not tail-recursive version the function my-len does and additional operation (+ 1 ...).
Non recursive version:
(define (my-len L)
(let loop ((l L) (k 0))
(if (pair? l)
(loop (cdr l) (+ k 1))
k)
))
To check whether a list is empty:
(null? '()) ; => #t
(pair? '()) ; => #f
Define a procedure prefix that generates a new list containing the first 'n' elements of a given list.
(define (prefix n L)
(define (prefix-tail pre n L)
(if (= n 0)
pre
(if (pair? L)
(prefix-tail (append pre (list (car L))) (- n 1) (cdr L))
(error "ERROR: prefix length is bigger than list lenght"))))
(prefix-tail '() n L))
cons vs appendThe append procedure takes two lists as arguments and append the second list to the first: it does not accept other types of arguments.
On the other hand cons handles more types, and can be used create pairs of heterogeneous types. Since list in Scheme are save as nested pairs, cons can create a list from an element and a list:
(define l '(1 2 3 4)); is saved as (1.(2.(3.(4.'()))))
(cons 0 l) ; => '(0 1 2 3 4)
Using cons we can prepend a value to a list.
Here we use cons instead of append to define the prefix procedure:
(define (prefix* n L)
(if (= n 0)
(list (car L))
(cons (car L) (prefix* (- n 1) (cdr L)))))
This function takes the prefix of length
Define a procedure ref that takes a number and list and the return the item whose index is equal to the number.
(define (ref k L)
(if (= k 0)
(car L)
(ref (- k 1) (cdr L))))
The function is tail-recursive.
Define a range procedure that returns a list of numbers:
s, it generates a list of integers from 0 to s - 1.(range 3) (0 1 2 3)
s and e, it generates a list of integers from s to e - 1.
(range 2 3) (2 3)
A possible tail-recursive implementation:
```scheme
(define (range s . e)
(define (tail-range-one s acc) ; one param provided: end = s
(if (= s -1)
acc
(tail-range-one (- s 1) (cons s acc))))
(define (tail-range-two s e acc) ; two parameters provided
(if (= e (- s 1))
acc
(tail-range-two s (- e 1) (cons e acc))))
(if (null? e)
(tail-range-one s '())
(tail-range-two s (car e) '())))
Here I defined two different implementations of the same recursive procedure to differentiate between the two case, but a shorter implementation is possible after noting that tail-range-one s '()' is equal to tail-range-two 0 s '():
(define (range s . e)
(define (tail-range s e acc)
(if (= e (- s 1))
acc
(tail-range s (- e 1) (cons e acc))))
(if (null? e)
(tail-range 0 s '())
(tail-range s (car e) '())))
Implement a recursive function in Scheme that simulates the behavior of a while loop. This function, named while, will take two arguments: a condition function c and a body function b. The while function should execute the body function b as long as the condition function c returns true.
(define (while condition body)
(let loop ()
(when (condition)
((lambda ()
(body)
(loop)))
)))
;; helper to test the procedure
(define (test-while)
(let ((x 0))
(while (lambda () (< x 10))
(lambda ()
(displayln x)
(set! x (+ 1 x))))))
This implementation works but there are a few issues:
let to define a named loop is not necessary in this context. The let keyword is used to bind variables to values in a local scope, but here it's used to create a recursive function, which is better accomplished just with define.lambda to create an anonymous function that wraps the body and recursive call to loopis unnecessary.A better recursive alternative:
(define (while c b)
(when (c)
(b)
(while c b)))
lambda vs begin for sequential evaluationImplement a procedure that takes a list L as argument and returns the list in reverse order.
A tail-recursive implementation:
(define (reverse-l L)
(define (reverse-l-tail L acc)
(if (null? L)
acc
(reverse-l-tail (cdr L) (cons (car L) acc))))
(reverse-l-tail L '()))
A non-tail recursive implementation:
(define (tsil L)
(if (null? L)
'()
(append (tsil (cdr L)) (list (car L)))))
Using foldl:
(define (reverse-list lst)
(foldl cons '() lst))
Implement a procedure that given any list L as argument return the flatten version of L.
(flat-l '(1 2 (3 4) 5 (6 7 (8 9))))) ;=> '(1 2 3 4 5 6 7 8 9)
(flat-l '((1 2)(3 (4) (5)) ((6) (7 8)) (((9) 10))))
; => '(1 2 3 4 5 6 7 8 9 10)
car and cdrHow to combine car and cdr:
(define nested-list
'(1 2 (3 4) 5 (6 7 (8 9))))
(car nested-list) ; returns 1
(cadr nested-list) ; returns 2
(caddr nested-list) ; returns (3 4)
(cadddr nested-list) ; returns 5
Note that (caddr x) is equivalent to:
(car (cdr (cdr x)))
A solution could be:
(define (flat-l L)
(define (flat-l* L acc)
(if (null? L)
acc
(if (pair? (car L))
(append (flat-l* (car L) acc) (flat-l* (cdr L) '()))
(flat-l* (cdr L) (append acc (list (car L)))))))
(flat-l* L '()))
Tail-recursive(?) solution using reverse instead of append:
(define (flat-l-v2 l)
(define (flat-l* l acc)
(cond ((null? l) acc)
((pair? (car l)) (flat-l* (cdr l) (flat-l* (car l) acc)))
(else (flat-l* (cdr l) (cons (car l) acc)))))
(reverse (flat-l* l '())))
reverse returns a list in reverse order.
cond evaluationThe cond form in scheme have short-cutting behavior:
(define (test x)
(cond ((= x 1) 'one)
((< x 2) (begin (display "Two") 'two))
((< x 3) 'three)
(else 'other)))
(test 1) ; => 'one
Another solution:
(define (flat L)
(if (null? L)
'()
(append (if (list? (car L))
(flat (car L))
(list (car L)))
(flat (cdr L)))))
In this exercise we create a new a binary tree type in Scheme, display it, and apply functions to it, both in a non-destructive and a destructive manner.
node-base structure and a node structure, the node-base doesn't have any children: is a leaf node that contains a mutable value. (struct node-base
((value #:mutable)))
(struct node node-base
(left
right))
struct usage examplenode-nilnode-nil object and a node-nil? function that checks if a given object is a node-nil object.(define node-nil (node-base #f))
(define (node-nil? n)
(eq? node-nil n))
(define t1
(node 1
(node 2
(node-base 4) (node 5
(node-base 6) node-nil))
(node-base 3)))
; 1
; / \
; 2 3
; / \
; 4 5
; /
; 6
;
;[1 [2 [4] [5 [6] []]] [3]]
(define t2
(node 1
(node 2
(node 4
(node-base 7)
(node 8
(node-base 9)
node-nil))
(node 5
(node-base 6)
node-nil))
(node 3
(node-base 10)
(node 11
(node-base 12)
(node-base 13)))))
leaf? functionleaf? function that checks if a given node is a leaf node. A leaf node is a node-base that is not a node.(define (leaf? n)
(and (node-base? n)
(not (node? n))))
tree-display functiontree-display function that displays a tree in a readable format.(define (tree-display tree)
(cond
((node-nil? tree) (display "[]"))
((leaf? tree) (begin
(display "[")
(display (node-base-value tree))
(display "]")))
(else
(begin
(display "[")
(display (node-base-value tree))
(display " ")
(tree-display (node-left tree))
(display " ")
(tree-display (node-right tree))
(display "]")))))
(tree-display t1)
; => [1 [2 [4] [5 [6] []]] [3]]
(tree-display t2)
; [1 [2 [4 [7] [8 [9] []]] [5 [6] []]] [3 [10] [11 [12] [13]]]]
tree-map functiontree-map function that applies a given function to each value in the tree, producing a new tree.(define (tree-map f tree)
(cond
((node-nil? tree) node-nil)
((leaf? tree) (node-base (f (node-base-value tree))))
((node? tree) (node
(f (node-base-value tree))
(tree-map f (node-left tree))
(tree-map f (node-right tree))))
(else (error "not a tree"))))
tree-map! functiontree-map! function that applies a given function to each value in the tree, modifying the original tree.(define (tree-map! f tree)
(cond
((node-nil? tree) "ah!")
((leaf? tree) (set-node-base-value! tree (f (node-base-value tree))))
((node? tree) (begin
(set-node-base-value! tree (f (node-base-value tree)))
(tree-map! f (node-left tree))
(tree-map! f (node-right tree))))
(else (error "not a tree"))))
++ increment operatorDefine a macro for the ++ operator that is equivalent to this procedure:
(define (++ x)
(set! x (+ x 1))
x)
Using define-syntax and syntax-rules:
(define-syntax ++
(syntax-rules ()
[(_ x)
(+ 1 x)]))
Since there is just one syntax rule, we can use the short hand define-syntax-rule:
(define-syntax-rule (++ x)
(+ 1 x))
Create a variadic function called proj-m that takes an integer n and a list of arguments and returns the nth argument. The function should be zero-indexed, meaning the first argument is at index 0.
The function should be defined such that it fits the following usage:
(proj-m 0 'a 'b 'c) ; Should evaluate to 'a
(proj-m 1 'a 'b 'c) ; Should evaluate to 'b
(proj-m 2 'a 'b 'c) ; Should evaluate to 'c
A wrong solution could be:
(define-syntax proj-m
(syntax-rules ()
((_ n . params)
(if (= n 0)
(car params)
(proj-m (- n 1) (cdr params))))
))
The problem is that macros don't evaluate expressions like (= n 0) or (- n 1) at runtime; they perform syntactic transformations. As a result, the if expression in the macro is not evaluated as an if at compile time, leading to infinite recursion during macro expansion.
In macros we have to leverage syntactic recursion, that means using pattern matching instead of expression evaluation:
(define-syntax proj-m
(syntax-rules ()
[(_ n v1)
v1]
[(_ n v1 v2 ...)
(if (= n 0)
v1
(proj-m (- n 1) v2 ...))]))
In this case the compiler will expand the macro until the first rule is expanded. The exact number of recursion steps does not depend on n but instead on the number of parameters passed.
Define a macro define-with-types that allows the definition of functions with type checking. The macro takes a function name f, a return type tf, a list of parameters with their types (x1 : t1) ..., and a list of expressions e1 .... It defines a function that checks the types of its parameters and its return value.
Using the function with type checking:
(define-with-types (add-to-char : integer (x : integer?) (y : char?))
(+ x (char->integer y)))
(char->integer #\y) ; => 121
(add-to-char 1 #\y) ; => 122
(add-to-char 1 121) ; => error "bad input types"
Solution:
(define-syntax define-with-types
(syntax-rules (:)
((_ (f : tf (x1 : t1) ...) e1 ...)
(define (f x1 ...)
(if (and (t1 x1) ...)
(let ((res (begin
e1 ...)))
(if (tf res)
res
(error "bad return type")))
(error "bad input types"))))))
Write a Scheme macro block that takes a series of expressions to be evaluated in two different contexts. The first context and the second context are separated by the then keyword followed by a list of expressions. After the second context follows the where keyword which specifies variables and their values for each context.
For example, the provided block macro should work as follows:
(block
((displayln (+ x y))
(displayln (* x y))
(displayln (* z z)))
then
((displayln (+ x y))
(displayln (* z x)))
where (x <- 12 3)(y <- 8 7)(z <- 3 2))
; 20
; 96
; 9
; 10
; 6
(block
((displayln "one")
(displayln "two"))
then
((displayln "three")))
; one
; two
; three
The block macro should first evaluate the expressions in the first block with x as 12, y as 8, and z as 3. Then, it should evaluate the expressions in the second block with x as 3, y as 7, and z as 2.
Solution:
(define-syntax block
(syntax-rules (where then <-)
((_ (a ...) then (b ...))
(begin
a ...
b ...))
((_ (a ...) then (b ...) where (v <- x y) ...)
(begin
(let ((v x) ...)
a ...)
(let ((v y) ...)
b ...)))))
Define a Scheme macro define-dispatcher that creates a lambda function to dispatch messages to different methods. The methods: keyword is followed by a list of method names, and the parent: keyword is followed by a parent function to call if no method matches the dispatched message.
For example, the provided define-dispatcher macro should work as follows:
;; Define example methods and parent method
(define (m1 . pars)
(begin
(display "Method 1 called with parameters: ")
(displayln pars)))
(define (m2 . pars)
(begin
(display "Method 2 called with parameters: ")
(displayln pars)))
(define (pm msg . pars)
(begin
(display "Parent method called with message: ")
(display msg)
(display " and parameters: ")
(displayln pars)))
;; Create the dispatcher
(define my-dispatcher
(define-dispatcher methods: (m1 m2) parent: pm))
;; Test the dispatcher
(my-dispatcher 'm1 'a 'b) ; > "Method 1 called with parameters: (a b)"
(my-dispatcher 'm2 'c 'd) ; > "Method 2 called with parameters: (c d)"
(my-dispatcher 'unknown 'e 'f) ; > "Parent method called with message: unknown and parameters: (e f)"
my-dispatcher is a function that dispatches its arguments to method1 or method2 depending on the first argument (the message). If neither method1 nor method2 matches the message, it dispatches the arguments to parent-method.
Solution:
(define-syntax define-dispatcher
(syntax-rules (methods: parent:)
((_ methods: (method1 method2 ...) parent: parent-method)
(lambda (msg . args)
(cond ((eq? msg 'method1) (apply method1 args))
((eq? msg 'method2) (apply method2 args))
...
(else (apply parent-method msg args)))))))
Write two Scheme functions break-negative and continue-negative that take a list of numbers as input. The break-negative function should display each number in the list until it encounters a negative number, at which point it should stop. The continue-negative function should display each non-negative number and skip any negative numbers. Use continuations to control the flow of execution.
For example, the provided break-negative function should work as follows:
(break-negative '(1 2 3 -4 5 6)) ; displays 1, 2, 3 and then stops
And the continue-negative function:
(continue-negative '(1 2 3 -4 5 6)) ; displays 1, 2, 3, 5, 6 skipping the negative number
Solution:
(define (break-negative list)
(call/cc (lambda (break)
(let loop ((l (cdr list)) (h (car list)))
(if (or (null? h) (< h 0))
(break)
((display h)
(loop (cdr l) (car l))))))))
(define (continue-negative list)
(let loop ((l (cdr list)) (h (car list)))
(call/cc (lambda (continue)
(if (or (null? h) (< h 0))
(continue)
(display h))))
(unless (null? l)
(loop (cdr l) (car l)))))
Alternative solution using for-each:
(define (break-negative l)
(call/cc (lambda (b)
(for-each (lambda (x)
(if (< x 0)
(b 'end)
(displayln x)))
l))))
(define (continue-negative l)
(for-each (lambda (x)
(call/cc (lambda (c)
(if (< x 0)
(c)
(displayln x)))))
l))
Implement a mechanism a mechanism for non-local exits using continuations, to do that:
*storage* to store continuationsret that calls the most recent continuation with a given argument.defun that defines functions using continuations stored in *storage*:call/cc function to capture the current continuation and push it onto the *storage* stackv. *storage* stack, and v is returned.As an example, we define a function g that takes two numbers as arguments and returns the smaller number using the ret function and the defun macro:
(define *storage* '()) ; continuations stack
(define (ret x)
((car *storage*) x))
(defun g (x y)
(if (< x y)
(ret x)
y))
(g 2 3) ; returns 2
(g 3 2) ; returns 2
The function g returns the smaller of its two arguments. If x is less than y, it uses the ret function to return x. Otherwise, it returns y.
defun possible implementation:
(define-syntax defun
(syntax-rules ()
((_ f (p ...) b ...)
(define (f p ...)
(let ((v (call/cc (lambda (c)
(set! *storage* (cons c *storage*))
b ...))))
(set! *storage* (cdr *storage*))
v)))))
Define a Scheme object person that has the following attributes and methods:
name and ageget-name, grow-older, and showget-name method should return the person's name, the grow-older method should take an integer argument and increase the person's age by that amount, and the show method should display the person's name and age.person objects with the new-person constructor and call the methods on them.person object (instead of using a structure type).Example usage:
(define ada (new-person "Ada" 25))
(define bob (new-person "Bob" 25))
(ada 'grow-older 10) ; => 35
(bob 'get-name) ; => "Bob"
(ada 'show) ; => "Name: Ada\nAge: 35"
(bob 'show) ; => "Name: Bob\nAge: 25"
Solution:
(define (new-person
initial-name ;; initial values / constructor
initial-age)
;; attributes
(let ([name initial-name]
[age initial-age])
;; methods
(define (get-name) ; getter for public attribute
name)
(define (grow-older years) ; a method to change age (and return it)
(set! age (+ age years))
age)
(define (show) ; another method
(display "Name: ")(displayln name)
(display "Age: ")(displayln age))
;; dispatcher (to handle calls to methods)
(λ (message . args)
(apply (case message
[(get-name) get-name]
[(grow-older) grow-older]
[(show) show]
[else (error "unknown method")])
args))))
Define a Scheme object superhero that inherits from the person object defined in the previous exercise. The superhero object should have the following additional attributes and methods:
poweruse-poweruse-power method should display the superhero's name and power when called.superhero object should inherit the name, age, get-name, grow-older, and show methods from the person object.Example:
(define superman (new-superhero "Clark Kent" 32 "Flight"))
(superman 'use-power) ; => "Clark Kent uses Flight!"
(superman 'grow-older 10) ; => 42
(superman 'show) ; => "Name: Clark Kent\nAge: 42\nPower: Flight"
Solution:
;; Inheritance
(define (new-superhero name age init-power)
(let ([parent (new-person name age)] ; inherits attrs/methods
[power init-power])
(define (use-power)
(display name)(display " uses ")(display power)(displayln "!"))
(define (show)
(parent 'show)
(display "Power: ")(displayln power))
(λ (message . args)
(case message
[(use-power) (apply use-power args)]
[(show) (apply show args)] ; overrides Person.show
[else (apply parent (cons message args))]))))