Stream of all pairs of elements of infinite stream - scheme

How to define a procedure return all pairs of elements in an infinite stream s?
s = {1,2,3,4,5,6,...}
=> {(2,1), (3,2), (3,1), (4,3), (4,2), (4,1), ......}
Here is my code, however it didn't work like a stream, it keep running infinitely and ran out of memory.
(define (stream-pairs s)
(define (iter s save)
(stream-append (stream-map (lambda (x) (stream-cons (stream-first s) x))
save)
(iter (stream-rest s) (stream-cons save (stream-first s)))))
(iter s empty-stream))
(define A (stream-cons 1 (scale-stream 2 A)))
(define C (stream-pairs A))
A = {1,2,4,8,16,......}

Turns out, Racket's stream-append does not delay its last (at least) argument, so iter calls stream-append which calls iter ... thus the loop.
One way is to reimplement the stream-append fused with the stream-map as used here, as a simple recursive function. That way the tail will be properly under the guard of the delaying stream-cons.
Another is to take a stream-rest1 of a fake stream-cons:
(require racket/stream)
(define (stream-pairs s)
(define (iter s save)
(stream-append (stream-map (lambda (x) (list (stream-first s) x))
save) ;^^^^
(stream-rest
(stream-cons 'fake ;<<-----------------
(iter (stream-rest s)
(stream-cons (stream-first s) save))))))
(iter s empty-stream))
(define A (stream-cons 1 (stream-map add1 A))) ; easier to follow
(define C (stream-pairs A))
Also, there was another error in your code where stream-cons was used instead of plain list, to pair up the elements of save with a current element of the input stream. Now we have
> (for ((i (in-range 0 12))) (display (stream-ref C i)))
(2 1)(3 2)(3 1)(4 3)(4 2)(4 1)(5 4)(5 3)(5 2)(5 1)(6 5)(6 4)
1 cf.,
> (stream-rest (stream-cons 1 (/ 1 0)))
#<stream>

Since the question specified that the given stream is infinite:
(define (stream-pairs strm)
(stream-cons (cons (stream-first strm)
(stream-first (stream-rest strm)))
(stream-pairs (stream-rest (stream-rest strm)))))
(If the stream is not infinite, you need to add an emptiness guard to the front of the function.)
Note: If you're using SRFI 41 streams instead of Racket streams, change define to define-stream.

I'm unclear as what you mean by 'pairs of a stream', but assuming you want something like this:
> (stream-subset-pairs (in-naturals) 5)
'((0 . 1) (1 . 2) (2 . 3) (3 . 4))
With that as the expected output, here is a solution:
(define (stream-subset-pairs stream i)
(define subset ; collect all elements up to i by iterating over the list and all #'s in sequence
(for/list ([element stream]
[position (in-naturals)]
#:break (= position i)) ; break when we have reached the # of elements we want to collect
element))
(let-values ([(ignore result) ; wrapper because we want for/fold to produce one result (last-element is just a state variable)
(for/fold ([last-element null]
[result empty])
([element subset]) ; iterate through the subset
(values element (if (null? last-element) ; if we are on the first loop
result ; ignore it
(cons (last-element element) result))))]) ; else add a pair of the last result and this result
result))

Related

Scheme - returning first n-elements of an array

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.

Accumulator for infinite streams

I'm trying to implement an accumulator for an infinite stream. I've written the following code but it's running into an infinite loop and failing to terminate
(define (stream-first stream) (car stream))
(define (stream-second stream) (car ((cdr stream))))
(define (stream-third stream) (car ((cdr ((cdr stream))))))
(define (stream-next stream) ((cdr stream)))
(define (stream-foldl func accum stream)
(cond
[(empty? stream) accum]
[else (stream-foldl func (func (stream-first stream) accum) (stream-next stream))] ))
I've written up a few tests to demonstrate what I'm trying to implement
(define (natural-nums)
(define (natural-nums-iter n)
(thunk
(cons n (natural-nums-iter (+ n 1)))))
((natural-nums-iter 0)))
(define x (stream-foldl cons empty (natural-nums)))
(check-equal? (stream-first x) empty)
(check-equal? (stream-second x) (list 0))
(check-equal? (stream-third x) (list 1 0))
(define y (stream-foldl (curry + 1) 10 (naturals)))
(check-equal? (stream-first y) 10)
(check-equal? (stream-second y) 11)
(check-equal? (stream-third y) 13)
Here's a trace of my stream-foldl function
>(stream-foldl
#<procedure:cons>
'()
'(0 . #<procedure:...9/saccum.rkt:25:0>))
()>(stream-foldl
#<procedure:cons>
'(0)
'(1 . #<procedure:...9/saccum.rkt:25:0>))
(0)>(stream-foldl
#<procedure:cons>
'(1 0)
'(2 . #<procedure:...9/saccum.rkt:25:0>))
(1 0)>....
I believe I'm failing to properly set a base case, thus never terminating from the recursion call
Fold is supposed to look at every element in the stream, then produce a result based on those elements. With an infinite stream, it is no surprise that the fold does not terminate (how would you be able to look at every single element in an infinite stream?).
What you can do:
Produce a finite stream out of the infinite stream. stream-take can be used for that. Example implementation of stream-take:
;; Returns a stream containing the first n elements of stream s.
(define (stream-take n s)
(cond ((zero? n) empty-stream)
((empty? s) (error "Stream is shorter than n")
(else
(delay (stream-first s)
(stream-take (- n 1) (stream-rest s)))))))
; Note: 'delay' is the same as the 'thunk' in your code.
Then, fold the finite stream either using your implementation of fold, or stream-fold.

Compare a list of numbers with a variable

The function below is intended to compare every number in a list (2nd parameter) with the first parameter and for every num in the list that is greater than the second param, count it and return the total amount of elements in the list that were greater than the 'threshold'
The code I have doesn't run because I have tried to learn how recursion in Dr. Racket works, but I can't seem to understand. I am just frustrated so just know the code below isn't supposed to be close to working; functional programming isn't my thing, haha.
(define (comp-list threshold list-nums)
(cond [(empty? list-nums) 0]
[(cons? list-nums) (let {[my-var 0]}
(map (if (> threshold (first list-nums))
threshold 2) list-nums ))]))
The following doesn't use lambda of foldl (and is recursive) - can you understand how it works?
(define (comp-list threshold list-nums)
(cond [(empty? list-nums) 0]
[else
(cond [(> (car list-nums) threshold) (+ 1 (comp-list threshold (cdr list-nums)))]
[else (comp-list threshold (cdr list-nums))])]))
Tested:
> (comp-list 1 '(1 1 2 2 3 3))
4
> (comp-list 2 '(1 1 2 2 3 3))
2
> (comp-list 3 '(1 1 2 2 3 3))
0
map takes a procedure as first argument and applied that to every element in the given list(s). Since you are counting something making a list would be wrong.
foldl takes a procedure as first argument, the starting value as second and one or more lists. It applies the procedure with the elements and the starting value (or the intermediate value) and the procedure get to decide the next intermediate value. eg. you can use it to count a list:
(define (my-length lst)
(foldl (lambda (x acc) (+ acc 1))
0
lst))
(my-length '(a b c)) ; ==> 3
You can easily change this to only count when x is greater than some threshold, just evaluate to acc to keep it unchanged when you are not increasing the value.
UPDATE
A recursive solution of my-length:
(define (my-length lst)
;; auxiliary procedure since we need
;; an extra argument for counting
(define (aux lst count)
(if (null? lst)
count
(aux (cdr lst)
(+ count 1))))
;; call auxiliary procedure
(aux lst 0))
The same alteration to the procedure to foldl have to be done with this to only count in some circumstances.
(define (comp-list threshold list-nums)
(cond
[(empty? list-nums) ; there are 0 elements over the threshold in an empty list
0]
[(cons? list-nums) ; in a constructed list, we look at the the first number
(cond
[(< threshold (first list-nums))
(+ 1 ; the first number is over
(comp-list threshold (rest list-nums))] ; add the rest
[else
(comp-list threshold (rest list-nums))])])) ; the first number is lower
A simple functional start
#lang racket
(define (comp-list threshold list-nums)
(define (my-filter-function num)
(< num threshold))
(length (filter my-filter-function list-nums)))
Replacing define with lambda
#lang racket
(define (comp-list threshold list-nums)
(length (filter (lambda (num) (< num threshold))
list-nums)))
Racket's implementation of filter
In DrRacket highlighting the name of a procedure and right clicking and selecting "jump to definition in other file" will allow review of the source code. The source code for filter is instructive:
(define (filter f list)
(unless (and (procedure? f)
(procedure-arity-includes? f 1))
(raise-argument-error 'filter "(any/c . -> . any/c)" f))
(unless (list? list)
(raise-argument-error 'filter "list?" list))
;; accumulating the result and reversing it is currently slightly
;; faster than a plain loop
(let loop ([l list] [result null])
(if (null? l)
(reverse result)
(loop (cdr l) (if (f (car l)) (cons (car l) result) result)))))

Product of squares of odd elements in list in Scheme

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.

"application: not a procedure" while generating prime numbers

I am trying to output the first 100 prime numbers and keep getting the error:
application: not a procedure;
expected a procedure that can be applied to arguments
given: (#)
arguments...: [none]
The error is shown in my take$ procedure here:
(if (or (= m 0) (null? st))
'()
(cons (car st) (take$ (- m 1) ((cdr st)))))))
Here it all my code:
(define int-builder$
(lambda (x)
(list x (lambda () (int-builder$ (+ 1 x ))))))
(define take$
(lambda (m st)
(if (or (= m 0) (null? st))
'()
(cons (car st) (take$ (- m 1) ((cdr st)))))))
(define filter-out-mults$
(lambda (num st)
(cond
(( = (remainder (car st) num) 0)
(filter-out-mults$ num ((cadr st))))
(else
(list (car st) (lambda () (filter-out-mults$ num ((cadr st)))))))))
(define sieve$
(lambda (st)
(list (car st)
(lambda() (sieve$ (filter-out-mults$ (car st) ((cadr st))))))))
(define stol$
(lambda (n)
(take$ n (sieve$ (int-builder$ 2)))))
Thanks for any help you can provide.
Your problem is that you have not been consistent in how you have been using your abstract Sieve.
Is a sieve defined like this:
;; A Sieve is a (cons n p), where
;; n is a Natural Number
;; p is a Procedure that takes no arguments and returns a Sieve
or is it defined like this
;; A Sieve is a (list n p), where
;; n is a Natural Number
;; p is a Procedure that takes no arguments and returns a Sieve
In some places in your code, you are extracting the p and invoking it like this:
((cdr st)); in other places, like this: ((cadr st))
The reason that the commenters on your question were looking askance at each of those individually is that you have not given a high-level definition for what the rules are for forming Sieves and extracting subparts from Sieves. A data definition like the one above would help this.
For me, after I added data-definitions, contracts, and then started testing your functions individually, I quickly found the problem. (Hint: It has something to do with the inconsistency between ((cdr st)) and ((cadr st)) noted above.)
Here is my version of your code. It localizes the choice of Sieve representation by hiding it behind an abstract interface; I used a macro to do this since the stream constructor wants to delay evaluation of the expression it receives (though one could work around this by changing the interface so the Sieve constructor was required to take a sieve-producing procedure rather than a direct expression).
Exercise for reader: With the current api, and if someone follows the data definition I have given in this code, stream-empty? can never return true; how could you prove this?
;; A Stream is a (list Nat (-> () Stream))
;; but this knowledge should not be used anywhere but in the
;; procedures (and special form) stream-rest, stream-first, stream,
;; and stream-empty?.
;; stream-rest: Stream -> Stream
(define (stream-rest st) ((cadr st)))
;; stream-first: Stream -> Nat
(define (stream-first st) (car st))
;; Special Form: (stream <natural-number> <stream-expr>) is a Stream
(define-syntax stream
(syntax-rules ()
((stream n expr) (list n (lambda () expr)))))
;; Stream -> Boolean
(define (stream-empty? st) (null? st))
;; Nat -> Stream
(define (int-builder$ x)
(stream x (int-builder$ (+ 1 x))))
;; Nat Stream -> [Listof Nat]
(define (take$ m st)
(if (or (= m 0) (stream-empty? st))
'()
(cons (stream-first st) (take$ (- m 1) (stream-rest st)))))
;; Nat Stream -> Stream
(define (filter-out-mults$ num st)
(cond
(( = (remainder (stream-first st) num) 0)
(filter-out-mults$ num (stream-rest st)))
(else
(stream (stream-first st) (filter-out-mults$ num (stream-rest st))))))
;; Stream -> Stream
(define (sieve$ st)
(stream (stream-first st)
(sieve$ (filter-out-mults$ (stream-first st) (stream-rest st)))))
;; Nat -> [Listof Nat]
(define (stol$ n)
(take$ n (sieve$ (int-builder$ 2))))

Resources