I defined a simple lazy list of all integers from zero:
(define integers-from
(lambda (n)
(cons n
(lambda () (integers-from (+ 1 n))))))
(define lz (integers-from 0))
I also coded an accumaltor that gets a lazy list as a parameter
(define lz-lst-accumulate
(lambda (op initial lz)
(if (null? lz)
initial
(cons (op (head lz) initial)
(lambda () (lz-lst-accumulate op (op initial (head lz)) (tail lz)))))))
Does this accumaltor answer the format of lazy lists?
Here is a simple test of the accumulator:
(define acc (lz-lst-accumulate * 1 lz))
(take acc 4)
=> '(1 2 6 24)
take is a helper function that creates a list from the first n elements of a lazy list:
(define head car)
(define tail
(lambda (lz-lst)
((cdr lz-lst)) ))
(define take
(lambda (lz-lst n)
(if (= n 0)
(list)
(cons (car lz-lst)
(take (tail lz-lst) (sub1 n)))) ))
In your lz-lst-accumulate you calculate once (op (head lz) initial) and then also (op initial (head lz)). This is inconsistent; both should be the same and actually calculated only once, since it's the same value:
(define lz-lst-accumulate
(lambda (op initial lz)
(if (lz-lst-empty? lz)
initial
(let ((val (op (head lz) initial)))
(cons val
(lambda () (lz-lst-accumulate op val (tail lz))))))))
It works in your example with numbers only because you use the type-symmetrical operation *. With cons it wouldn't work.
Other than that it's OK. lz-lst-accumulate is usually known as left fold (scanl in Haskell, actually, since you produce the progression of "accumulated" values, foldl f z xs = last (scanl f z xs)).
re: your version of take, it is forcing one too many elements of a stream. Better make it
(define take
(lambda (lz n)
(if (or (<= n 0) (lz-lst-empty? lz))
(list)
(if (= n 1)
(list (car lz)) ; already forced
(cons (car lz)
(take (tail lz) (sub1 n)))))))
so that it only forces as many elements as it has to produce, and not one more (which might be e.g. divergent, like (/ 1 0), invalidating the whole calculation for no reason).
That way, the counter-example in SRFI 41 (of (take 4 (stream-map 1/ (ints-from-by 4 -1)))) will just work (it calculates (1/4 1/3 1/2 1/1) without forcing 1/0, which the usual version of take, like the one you're using, would do).
Related
I'm trying to write a function in Scheme that returns the first n elements in a list. I'm want to do that without loops, just with this basic structure below.
What I've tried is:
(define n-first
(lambda (lst n)
(if (or(empty? lst) (= n 0))
(list)
(append (car lst) (n-first (cdr lst) (- n 1))))))
But I'm getting an error:
append: contract violation
expected: list?
given: 'in
I've tried to debug it and it looks that the tail of the recursion crashes it, meaning, just after returning the empty list the program crashes.
When replacing "append" operator with "list" I get:
Input: (n-first '(the cat in the hat) 3)
Output:
'(the (cat (in ())))
But I want to get an appended list.
A list that looks like (1 2 3) i constructed like (1 . (2 . (3 . ()))) or if you're more familiar with cons (cons 1 (cons 2 (cons 3 '()))). Thus (list 1 2 3)) does exactly that under the hood. This is crucial information in order to be good at procedures that works on them. Notice that the first cons cannot be applied before the (cons 2 (cons 3 '())) is finished so a list is always created from end to beginning. Also a list is iterated from beginning to end.
So you want:
(define lst '(1 2 3 4 5))
(n-first lst 0) ; == '()
(n-first lst 1) ; == (cons (car lst) (n-first (- 1 1) (cdr lst)))
(n-first lst 2) ; == (cons (car lst) (n-first (- 2 1) (cdr lst)))
append works like this:
(define (append lst1 lst2)
(if (null? lst1)
lst2
(cons (car lst1)
(append (cdr lst1) lst2))))
append is O(n) time complexity so if you use that each iteration of n parts of a list then you get O(n^2). For small lists you won't notice it but even a medium sized lists of a hundred thousand elements you'll notice append uses about 50 times longer to complete than the cons one and for large lists you don't want to wait for the result since it grows exponentially.
try so
(define first-n
(lambda (l)
(lambda (n)
((lambda (s)
(s s l n (lambda (x) x)))
(lambda (s l n k)
(if (or (zero? n)
(null? l))
(k '())
(s s (cdr l) (- n 1)
(lambda (rest)
(k (cons (car l) rest))))))))))
(display ((first-n '(a b c d e f)) 4))
(display ((first-n '(a b)) 4))
In scheme you must compute mentally the types of each expression, as it does not have a type checker/ type inference included.
So I have an example list of elements like this
(define A (list 'a 'c 'd 'e 'f 'e 'a))
Now I want to make a ranking from this sample
(define (scan lst)
(foldl (lambda (element a-hash) (hash-update a-hash element add1 0))
(hash)
lst))
The result should be like this:
> #(('a . 2) ('f . 1) ('e . 2) ....)
Because `scan function will make a hash table containing unique keys and the number of repetitions of that key (if it catches an unindexed key it will create a new place for that new key, counting from 0).
Then I'd like to sort that hash-table because it's unsorted:
(define (rank A)
(define ranking (scan A))
(sort ranking > #:key cdr)))
So the result would look like this:
#(('a . 2) ('e . 2) ('f . 1) ...)
Now I'd like to truncate the hash-table and throw away the bottom at the threshold of n = 1 (aka only take the elements with more than 2 repetitions).
(define (truncate lst n)
(define l (length lst))
(define how-many-to-take
(for/list
([i l]
#:when (> (cdr (list-ref lst i))
n))
i))
(take lst (length how-many-to-take)))
So the result might look like this:
(('a . 2) ('e . 2))
However, at the big scale, this procedure is not very efficient, it takes too long. Would you have any suggestion to improve the performance?
Thank you very much,
Part 2:
I have this data structure:
(automaton x
(vector (state y (vector a b c))
(state y (vector a b c)) ...))
Then i generate randomly a population of 1000 of them. Then i scan and rank them using the above functions. If i just scan them as is, it already takes long time. If i try to flatten them into a list like this
(list x y a b c y a b c...)
it'd take even more time. Here is the flatten function:
(define (flatten-au au)
(match-define (automaton x states) au)
(define l (vector-length states))
(define body
(for/list ([i (in-range l)])
(match-define (state y z) (vector-ref states i))
(list y (vector->list z))))
(flatten (list x body)))
The scan function will look a bit different:
(define (scan population)
(foldl (lambda (auto a-hash) (hash-update a-hash (flatten-automaton auto) add1 0))
(hash)
population))
Yep, I believe I see the problem. Your algorithm has O(n^2) ("n-squared") running time. This is because you're counting from one to the length of the list, then for each index, performing a list-ref, which takes time proportional to the size of the index.
This is super-easy to fix.
In fact, there's really no reason to sort it or convert it to a list if this is what you want; just filter the hash table directly. Like this...
#lang racket
(define A (build-list 1000000 (λ (idx) (random 50))))
(define (scan lst)
(foldl (lambda (element a-hash) (hash-update a-hash element add1 0))
(hash)
lst))
(define ht (scan A))
(define only-repeated
(time
(for/hash ([(k v) (in-hash ht)]
#:when (< 1 v))
(values k v))))
I added the call to time to see how long it takes. For a list of size one million, on my computer this takes a measured time of 1 millisecond.
Asymptotic complexity is important!
I wanted to write a code in Scheme that writes the square odd elements in list.For example (list 1 2 3 4 5) for this list it should write 225.For this purpose i write this code:
(define (square x)(* x x))
(define (product-of-square-of-odd-elements sequence)
(cond[(odd? (car sequence)) '() (product-of-square-of-odd-elements (cdr sequence))]
[else ((square (car sequence)) (product-of-square-of-odd-elements (cdr sequence)))]))
For run i write this (product-of-square-of-odd-elements (list 1 2 3 4 5))
and i get error like this:
car: contract violation
expected: pair?
given: '()
What should i do to make this code to run properly? Thank you for your answers.
First of all, you need to do proper formatting:
(define (square x) (* x x))
(define (product-of-square-of-odd-elements sequence)
(cond
[(odd? (car sequence))
'() (product-of-square-of-odd-elements (cdr sequence))]
[else
((square (car sequence)) (product-of-square-of-odd-elements (cdr sequence)))]))
Now there are multiple issues with your code:
You are trying to work recursively on a sequence, but you are missing a termination case: What happens when you pass '() - the empty sequence? This is the source of your error: You cannot access the first element of an empty sequence.
You need to build up your result somehow: Currently you're sending a '() into nirvana in the first branch of your cond and put a value into function call position in the second.
So let's start from scratch:
You process a sequence recursively, so you need to handle two cases:
(define (fn seq)
(if (null? seq)
;; termination case
;; recursive case
))
Let's take the recursive case first: You need to compute the square and multiply it with the rest of the squares (that you'll compute next).
(* (if (odd? (car seq)
(square (car seq))
1)
(fn (cdr seq)))
In the termination case you have no value to square. So you just use the unit value of multiplication: 1
This is not a good solution, as you can transform it into a tail recursive form and use higher order functions to abstract the recursion altogether. But I think that's enough for a start.
With transducers:
(define prod-square-odds
(let ((prod-square-odds
((compose (filtering odd?)
(mapping square)) *)))
(lambda (lst)
(foldl prod-square-odds 1 lst))))
(prod-square-odds '(1 2 3 4 5))
; ==> 225
It uses reusable transducers:
(define (mapping procedure)
(lambda (kons)
(lambda (e acc)
(kons (procedure e) acc))))
(define (filtering predicate?)
(lambda (kons)
(lambda (e acc)
(if (predicate? e)
(kons e acc)
acc))))
You can decompose the problem into, for example:
Skip the even elements
Square each element
take the product of the elements
With this, an implementation is naturally expressed using simpler functions (most of which exist in Scheme) as:
(define product-of-square-of-odd-elements (l)
(reduce * 1 (map square (skip-every-n 1 l))))
and then you implement a helper function or two, like skip-every-n.
I'm trying to find an implementation which flattens a lazy list of lazy lists using interleave and lz-lst-accumulate which are procedures that I wrote. This is the code so far:
(define lz-lst-accumulate
(lambda (op initial lz)
(if (empty? lz)
initial
(op (head lz)
(lambda() (lz-lst-accumulate op initial (tail lz)))))))
(define interleave
(lambda (lz1 lz2)
(if (empty? lz1)
(lz2)
(cons (head lz1)
(interleave (lz2) (lambda() (tail lz1)))))))
(define all-div-from-flattened
(lambda (lower)
(lz-lst-accumulate interleave '() (all-div-from lower))))
(define take
(lambda (lz-lst n)
(if (= n 0)
(list)
(cons (car lz-lst)
(take (tail lz-lst) (sub1 n))))))
(define head
(lambda (lz)
(car lz)))
(define tail
(lambda (lz-lst)
((cdr lz-lst))))
(define lz-lst-map
(lambda (f lz)
(if (empty? lz)
lz
(cons (f (head lz))
(lambda () (lz-lst-map f (tail lz)))))))
; Signature: all-div-from (low)
; Type: [Number -> Lazy-list]
; Purpose: return a lazy-list of lazy-lists. The nested lazy-lists
; correspond to the integers greater than lower in an
; increasing order. Each nested lazy-list is the list of
; all integers divisible by i for some i>=lower.
; Pre-conditions: low is an integer
; Tests: > (define lz3 (all-div-from 7))
; > (take lz3 3)
; '((7 . #<procedure>) (8 . #<procedure>) (9 . #<procedure>))
; > (take (head lz3) 3)
; '(7 14 21)
; > (take (head (tail lz3)) 3)
; '(8 16 24)
(define all-div-from
(lambda(lower)
(cons (lz-lst-map (lambda(x) (* x lower)) (div-from 1 1))
(lambda() (all-div-from (add1 lower))))))
; Signature: div-from (low int)
; Type: [[Number*Number]-> Lazy-list]
; Purpose: return the lazy-list of all integers that
; are larger than low and divisible by int
; Pre-conditions: int > low
; Tests: > (define lz1 (div-from 5 12))
; > (take lz1 3)
; '(12 24 36)
; > (define lz2 (div-from 7 10))
; > (take lz2 4)
; '(10 20 30 40)
(define div-from
(lambda (lower int)
(lz-lst-filter (lambda(x) (> x (- lower 1)))
(lz-lst-map (lambda(x) (* x int)) (integers-from 1)))))
(define integers-from
(lambda (n) (cons n
(lambda () (integers-from (+ 1 n))))))
(define lz-lst-filter
(lambda (p lz)
(cond ((empty? lz) lz)
((p (head lz))
(cons (head lz)
(lambda () (lz-lst-filter p (tail lz)))))
(else (lz-lst-filter p (tail lz))))))
The procedure all-div-from receives a lower bound low and returns a lazy-list of lazy-lists. Each lazy list in it is made by div-from which receives a lower bound low and an integer int > low, and
returns the lazy-list of all integers that are larger than low and divisible by int.
An example of input and the correct output:
> (take (all-div-from-flattened 7) 10)
'(7 8 14 9 21 16 28 10 35 24)
But when I try this line in the interpreter:
> (take (all-div-from-flattened 3) 3)
it gets into an infinite loop.
My implementation must use lz-lst-accumulate, interleave and all-div-from-flattend procedures.
Any suggestions on how to make it work?
Your interleave does not produce a lazy list; it produces an ordinary list: it uses cons with two arguments, with the second argument not wrapped in a lambda. So the cons forces the 2nd argument through, causing the run-away evaluation:
(define interleave
(lambda (lz1 dlz2) ; "delayed" lz2
(if (empty? lz1)
(dlz2)
(cons (head lz1)
; here:
(interleave (dlz2) (lambda () (tail lz1)))))))
(define lz-lst-accumulate
(lambda (op initial lz)
(if (empty? lz)
initial
(op (head lz)
(lambda () (lz-lst-accumulate op initial (tail lz)))))))
(all-div-from lower) produces correct output, ( (lower . <proc1>) . <proc2> ), but the call to (lz-lst-accumulate interleave '() (all-div-from lower)) reduces as
(interleave [lower . <proc1>]
(lambda () (lz-lst-accumulate interleave '() (<proc2>))))
and that reduces as
(cons lower
(interleave (lz-lst-accumulate interleave '() (<proc2>))
(lambda () (<proc1>))))
while it has to reduce as
(cons lower
(lambda () (interleave ....)))
to produce a lazy list.
The obvious (now) solution is to add that missing lambda:
(define interleave
(lambda (lz1 lz2)
(if (empty? lz1)
(lz2)
(cons (head lz1)
(lambda () (interleave (lz2) (lambda() (tail lz1))))))))
Now it runs correctly:
(take (all-div-from-flattened 7) 10)
;Value 12: (7 8 14 9 21 16 28 10 35 24)
You could much simplify your code by introducing
(define integers-from-by
(lambda (n d) (cons n
(lambda () (integers-from (+ n d) d)))))
then,
;(define div-from
; (lambda (lower int)
; (lz-lst-filter (lambda(x) (> x (- lower 1)))
; (lz-lst-map (lambda(x) (* x int)) (integers-from 1)))))
(define mults-from-of ; n in [int, 2*int ..], n >= lower
(lambda (lower int)
(let ((x (* (quotient (+ lower (- int 1)) int) int)))
(integers-from-by x int))))
You could also have
(define mults-above-of ; n in [int, 2*int ..], n > lower
(lambda (lower int)
(let ((x (* (+ (quotient lower int) 1) int)))
(integers-from-by x int))))
Next,
; (define all-div-from
; (lambda(lower)
; (cons (lz-lst-map (lambda(x) (* x lower)) (div-from 1 1))
; (lambda() (all-div-from (add1 lower))))))
(define all-mults-from
(lambda (lower)
(lz-lst-map (lambda (n) (mults-from-of n n))
; or just (integers-from-by n n)
(integers-from-by lower 1))))
If you change your interleave to combine the streams in order, and switch to mults-above-of in the all-mults-from definition, then (lz-lst-accumulate interleave-ordered '() (all-mults-from-above 2)) will define the lazy list of all composite numbers, in order, by means of counting up as in the sieve of Eratosthenes.
From this, it's just one more step to getting yourself your own lazy unbounded incremental sieve of Eratosthenes (search for "SiCp" on that page).
Another remark: take should be tweaked to not force an extra element of a stream. More here.
I can't seem to figure out how to write this function. What I am trying to write is a function expand that takes a list lst as a parameter of the form '(a (2 b) (3 c)) and is evaluated to '(a b b c c c)
This looks like homework, so I'm not giving you a straight answer. Instead, I'll give you some pointers in the right direction. The most useful hint, is that you should split the problem in two procedures, one for processing the "outer" list and the other for generating the repetitions encoded in the inner sublists.
Notice that both procedures are mutually recursive (e.g., they call each other). The expand procedure recurs over the list, whereas the repeat procedure recurs over the number of repetitions. This is the general structure of the proposed solution, fill-in the blanks:
; input: lst - list to be processed
; output: list in the format requested
(define (expand lst)
(cond ((null? lst) ; if the list is null
'()) ; then return null
((not (pair? (car lst))) ; if the first element of the list is an atom
(cons <???> <???>)) ; cons the atom and advance the recursion
(else ; if the first element of the list is a list
<???>))) ; call `repeat` with the right params
; input: n - number of repetitions for the first element in the list
; lst - list, its first element is of the form (number atom)
; output: n repetitions of the atom in the first element of lst
(define (repeat n lst)
(if (zero? n) ; if the number of repetitions is zero
(expand (cdr lst)) ; continue with expand's recursion
(cons <???> ; else cons the atom in the first element and
<???>))) ; advance the recursion with one less repetition
As this was answered three years ago, I don't think that I am helping with homework. Would just like to point out that the two functions really don't need to be mutually recursive. As replicate is a fairly common function, I would propose:
(define (replicate what n)
(if (zero? n)
(list)
(cons what (replicate what (- n 1)))))
(define (my-expand xs)
(if (empty? xs)
(list)
(let ((x (first xs)))
(if (list? x)
(let ((the-number (first x))
(the-symbol (cadr x)))
(flatten (cons (replicate the-symbol the-number)
(my-expand (rest xs)))))
(cons x (my-expand (rest xs)))))))
Of course it is better to use two lists and perform the flatten at the end, something like this:
(define (my-expand xs)
(define (inner-expander xs ys)
(if (empty? xs) (flatten (reverse ys))
(let ((x (first xs)))
(if (list? x)
(let ((the-number (first x))
(the-symbol (cadr x)))
(inner-expander (rest xs) (cons (replicate the-symbol the-number) ys)))
(inner-expander (rest xs) (cons x ys))))))
(inner-expander xs (list)))