How to plot a matrix as an image in racket? - plot

I would like to do something similar to matplotlib.pyplot.matshow with racket. I understand this is a trivial question and maybe I'm just being stupid, but I was unsuccessful after reading the Racket plotting documentation.
An example matrix that would be translated into the image of a circle:
#lang typed/racket
(require math/array)
(require plot)
(: sq (-> Integer Integer))
(define (sq [v : Integer])
(* v v))
(: make-2d-matrix (-> Integer Integer (Array Boolean)))
(define (make-2d-matrix [s : Integer] [r : Integer])
(let ([center : Integer (exact-round (/ s 2))])
(let ([a (indexes-array ((inst vector Integer) s s))])
(let ([b (inline-array-map (λ ([i : (Vectorof Index)])
(+
(sq (- (vector-ref i 0) center))
(sq (- (vector-ref i 1) center))))
a)])
(array<= b (array (sq r)))
))))
(array-map (λ ([i : Boolean]) (if (eq? i #f) 0 1)) (make-2d-matrix 20 6))
Can someone give me a hint?

Totally not a dumb question. This is one of those areas where it's hard to compete with an army of python library programmers. Here's how I'd do it in Racket:
#lang racket
(require 2htdp/image
math/array)
;; a 10x10 array
(define a
(build-array #(10 10)
(λ (e)
(match e
[(vector x y)
(cond [(= x y) x]
[else 0])]))))
;; map a value to a color
(define (cmap v)
(color (floor (* 255 (/ v 10)))
0
(floor (* 255 (- 1 (/ v 10))))))
(apply
above
(for/list ([y (in-range 10)])
(apply
beside
(for/list ([x (in-range 10)])
(rectangle 10 10 'solid (cmap (array-ref a (vector x y))))))))

Depending on you situation, you might be interested in flomaps:
http://docs.racket-lang.org/images/flomap_title.html?q=flbitmap

I'm not sure exactly what you want to plot. The plot library is designed around plotting functions, but I don't know what function you want to express.
Here are two ways of plotting a matrix:
(plot (points (cast (array->vector* m) (Vectorof (Vectorof Real)))
(plot3d (points3d (cast (array->vector* m) (Vectorof (Vectorof Real)))
The cast is needed because the type of array->vector* is not specific enough.

Related

Racket checkerboard program that takes the size (row x column) and size of squares as args and builds a red and black checkerboard with DrRacket

Hi I'm struggling with this problem, I don't know how to add the number of square tiles and incorporate that as a user input value, I only know how to increase the size of the tiles. So I can make the squares bigger but I can't increase the number of them. The main issue is alternating the square colors red and black and having user input of the board size. If you can show me with circles or anything else how to take user input to add more I'd appreciate any help, this is due in three days and I've been working on it for a while.
Edit: In my class we haven't learned for-loops in racket so if there's an iterative/recursive way that would help me out.
Here's my code with multiple attempts:
#lang slideshow
(define (square n) (filled-rectangle n n))
(define (redblock n) (colorize(square) "red"))
(define (blackblock n) (colorize(square) "black"))
;slideshow
(define (series n)
[hc-append (* square n)]) ; contract violation, expected: number?, given: #<procedure:square>
;slideshow
(define (rb-series mk)
(vc-append
(series [lambda (sz) (colorize (mk sz) "red")])
(series [lambda (sz) (colorize (mk sz) "black")])))
(define (checker p1 p2) ;makes 2x2
(let ([p12 (hc-append p1 p2)]
[p21 (hc-append p2 p1)])
(vc-append p12 p21)))
(define (four p) ;can we get the parameter of this as any number instead of the shape?
(define two-p (hc-append p p))
(vc-append two-p two-p))
(define (checkerboard n sz)
(let* ([redblock (colorize(square sz)"red")]
[blackblock (colorize(square sz)"black")])
(define (blackred-list n)
;(define (string lst)) ;is there a way to construct an empty string to add to?
(for ([i n])
(if (even? i)
(hc-append blackblock)
(else
(hc-append (redblock)))))) ; this else part throws an error saying no hc-append
(define (redblack-list n)
(for ([i n])
(if (even? i)
(hc-append redblock)
(else (hc-append blackblock))))) ;another else with the same issue
(define (row-list n)
(for ([i n])
(if (even? i)
(vc-append blackred-list)
(else
(vc-append redblack-list)))))
(checkerboard 5 20))) ;this is just to test it, but how would I get user input?```
Let's break it down step by step:
Define function named checkerboard:
(define (checkerboard n sz) ...
With local definitions of redblock and blackblock...
(let ([redblock (colorize (filled-rectangle sz sz) "red")]
[blackblock (colorize (filled-rectangle sz sz) "black")])
With function blackred-list (I used letrec for recursive local definitions)...
(letrec ([blackred-list
(lambda (m) (cond ((zero? m) '())
((even? m) (cons blackblock (blackred-list (sub1 m))))
(else (cons redblock (blackred-list (sub1 m))))))]
With function redblack-list, which is very similar to blackred-list, so I am leaving that as work for you.
With function row-list:
[row-list (lambda (m) (map (lambda (i) (apply hc-append (reverse
(if (even? i)
(blackred-list m)
(redblack-list m)))))
(range m)))]
Then write (apply vc-append (row-list n)) inside letrec.
User input isn't mentioned in task, because you will just call (checkerboard 6 15) (or any other test) in REPL, but you surely can do this:
> (checkerboard (read) (read))
If one can confidently write and assemble small functions then the suggestions in
the exercise may be all one needs to produce a solution. But if this is a skill
that one is learning, then following a systematic design method may
help that learning process.
The design method here is HtDF (How to Design Functions): write down stub with signature and purpose, examples, and template, then edit the template to produce the required function.
(This answer uses characters to stand for blocks -- substitute eg hc-append for list->string for images)
(define redblock #\r)
(define blackblock #\b)
#;
(define (blackred-list m) ;; Natural -> ListOfBlock ; *stub* ;; *signature*
;; produce list of m alternating blocks (last one red) ; *purpose statement*
empty) ; *stub body* (valid result)
(check-expect (blackred-list 0) empty ) ; *minimal example*
#;
(define (fn n) ; *template*
(cond ;
[(zero? n) ... ] ;
[else (.... n (fn (- n 1))) ])) ;
(check-expect (blackred-list 1) (list redblock) ) ; *examples* to guide .... edit
(check-expect (blackred-list 2) (list blackblock redblock) )
(define (blackred-list m) ;; Natural -> ListOfBlock ; (edit template)
;; produce list of m alternating blocks (last one red)
(cond
[(zero? m) empty ]
[else (cons
(if (even? m)
blackblock
redblock)
(blackred-list (- m 1))) ]))
(check-expect (blackred-list 3) (list redblock blackblock redblock) )
(define (redblack-list m) ;; Natural -> ListOfBlock
;; produce list of m alternating blocks (last one black)
(cond
[(zero? m) empty ]
[else (cons
(if (even? m)
redblock
blackblock)
(redblack-list (- m 1))) ]))
(check-expect (redblack-list 3) (list blackblock redblock blackblock) )
#;
(define (row-list m) ;; Natural -> ListOfString ; *stub*
;; produce list of m alternating strings of blocks (last one ends in red)
empty)
(check-expect (row-list 0) empty) ; *examples* (same template)
(check-expect (row-list 1) (list "r") )
(check-expect (row-list 2) (list "rb" "br") )
(define (n-strings-of-length m n) ;; Natural Natural -> ListOfString
;; produce list of n alternating length m strings of blocks (last one ends in red)
(cond
[(zero? n) empty ]
[else (cons
(if (even? n)
(list->string (redblack-list m))
(list->string (blackred-list m)))
(n-strings-of-length m (- n 1))) ]))
(define (row-list m) ;; Natural -> ListOfString
;; produce list of m alternating length m strings of blocks (last one ends in red)
(n-strings-of-length m m))
(define (display-rows los) ;; ListOfString -> ; (from natural list recursion template)
;; display los, one element per line
(cond
[(empty? los) (void) ]
[else (begin
(display (car los))
(newline)
(display-rows (cdr los))) ]))
(define (checkerboard m) ;; Natural ->
;; display checkerboard with side m
(display-rows (row-list m)))
Welcome to DrRacket, version 8.4 [cs].
Language: Advanced Student.
All 8 tests passed!
>
The functions can now be reordered to produce the solution in specified local form:
(define redblock #\r)
(define blackblock #\b)
(define (checkerboard m) ;; Natural ->
;; display checkerboard with side m
(local [
(define (blackred-list m) ;; Natural -> ListOfBlock
;; produce list of m alternating blocks (last one red)
(cond
[(zero? m) empty ]
[else (cons
(if (even? m)
blackblock
redblock)
(blackred-list (- m 1))) ]))
(define (redblack-list m) ;; Natural -> ListOfBlock
;; produce list of m alternating blocks (last one black)
(cond
[(zero? m) empty ]
[else (cons
(if (even? m)
redblock
blackblock)
(redblack-list (- m 1))) ]))
(define (n-strings-of-length m n) ;; Natural Natural -> ListOfString
;; produce list of n alternating length m strings of blocks (last one ends in red)
(cond
[(zero? n) empty ]
[else (cons
(if (even? n)
(list->string (redblack-list m))
(list->string (blackred-list m)))
(n-strings-of-length m (- n 1))) ]))
(define (row-list m) ;; Natural -> ListOfString
;; produce list of m alternating length m strings of blocks (last one ends in red)
(n-strings-of-length m m))
(define (display-rows los) ;; ListOfString ->
;; display los, one element per line
(cond
[(empty? los) (void) ]
[else (begin
(display (car los))
(newline)
(display-rows (cdr los))) ])) ])
(display-rows (row-list m)))
Welcome to DrRacket, version 8.4 [cs].
Language: Advanced Student.
> (checkerboard 5)
rbrbr
brbrb
rbrbr
brbrb
rbrbr
>

Pascal's Triangle in Racket

I am trying to create Pascal's Triangle using recursion. My code is:
(define (pascal n)
(cond
( (= n 1)
list '(1))
(else (append (list (pascal (- n 1))) (list(add '1 (coresublist (last (pascal (- n 1))))))
)))) ;appends the list from pascal n-1 to the new generated list
(define (add s lst) ;adds 1 to the beginning and end of the list
(append (list s) lst (list s))
)
(define (coresublist lst) ;adds the subsequent numbers, takes in n-1 list
(cond ((= (length lst) 1) empty)
(else
(cons (+ (first lst) (second lst)) (coresublist (cdr lst)))
)))
When I try to run it with:
(display(pascal 3))
I am getting an error that says:
length: contract violation
expected: list?
given: 1
I am looking for someone to help me fix this code (not write me entirely new code that does Pascal's Triangle). Thanks in advance! The output for pascal 3 should be:
(1) (1 1) (1 2 1)
We should start with the recursive definition for a value inside Pascals' triangle, which is usually expressed in terms of two parameters (row and column):
(define (pascal x y)
(if (or (zero? y) (= x y))
1
(+ (pascal (sub1 x) y)
(pascal (sub1 x) (sub1 y)))))
There are more efficient ways to implement it (see Wikipedia), but it will work fine for small values. After that, we just have to build the sublists. In Racket, this is straightforward using iterations, but feel free to implement it with explicit recursion if you wish:
(define (pascal-triangle n)
(for/list ([x (in-range 0 n)])
(for/list ([y (in-range 0 (add1 x))])
(pascal x y))))
It'll work as expected:
(pascal-triangle 3)
=> '((1) (1 1) (1 2 1))

How to make recursion using only lambdas in Racket?

I need some help trying to figure out how to make the code below recursive using only lambdas.
(define (mklist2 bind pure args)
(define (helper bnd pr ttl lst)
(cond [(empty? lst) (pure ttl)]
[else (define (func t) (helper bnd pr (append ttl (list t)) (rest lst)))
(bind (first lst) func)])
)
(helper bind pure empty args))
Given a sample factorial program -
(define fact
(lambda (n)
(if (= n 0)
1
(* n (fact (- n 1)))))) ;; goal: remove reference to `fact`
(print (fact 7)) ; 5040
Above fact is (lambda (n) ...) and when we call fact we are asking for this lambda so we can reapply it with new arguments. lambda are nameless and if we cannot use top-level define bindings, the only way to bind a variable is using a lambda's parameter. Imagine something like -
(lambda (r)
; ...lambda body...
; call (r ...) to recur this lambda
)
We just need something to make our (lambda (r) ...) behave this way -
(something (lambda (r)
(print 1)
(r)))
; 1
; 1
; 1
; ... forever
introducing U
This something is quite close to the U combinator -
(define u
(lambda (f) (f f)))
(define fact
(lambda (r) ;; wrap in (lambda (r) ...)
(lambda (n)
(if (= n 0)
1
(* n ((r r) (- n 1))))))) ;; replace fact with (r r)
(print ((u fact) 7))
; => 5040
And now that recursion is happening thru use of a parameter, we could effectively remove all define bindings and write it using only lambda -
; ((u fact) 7)
(print (((lambda (f) (f f)) ; u
(lambda (r) ; fact
(lambda (n)
(if (= n 0)
1
(* n ((r r) (- n 1)))))))
7))
; => 5040
Why U when you can Y?
The U-combinator is simple but having to call ((r r) ...) inside the function is cumbersome. It'd be nice if you could call (r ...) to recur directly. This is exactly what the Y-combinator does -
(define y
(lambda (f)
(f (lambda (x) ((y f) x))))) ;; pass (y f) to user lambda
(define fact
(lambda (recur)
(lambda (n)
(if (= n 0)
1
(* n (recur (- n 1))))))) ;; recur directly
(print ((y fact) 7))
; => 5040
But see how y has a by-name recursive definition? We can use u to remove the by-name reference and recur using a lambda parameter instead. The same as we did above -
(define u
(lambda (f) (f f)))
(define y
(lambda (r) ;; wrap in (lambda (r) ...)
(lambda (f)
(f (lambda (x) (((r r) f) x)))))) ;; replace y with (r r)
(define fact
(lambda (recur)
(lambda (n)
(if (= n 0)
1
(* n (recur (- n 1)))))))
(print (((u y) fact) 7)) ;; replace y with (u y)
; => 5040
We can write it now using only lambda -
; (((u y) fact) 7)
(print ((((lambda (f) (f f)) ; u
(lambda (r) ; y
(lambda (f)
(f (lambda (x) (((r r) f) x))))))
(lambda (recur) ; fact
(lambda (n)
(if (= n 0)
1
(* n (recur (- n 1)))))))
7))
; => 5040
need more parameters?
By using currying, we can expand our functions to support more parameters, if needed -
(define range
(lambda (r)
(lambda (start)
(lambda (end)
(if (> start end)
null
(cons start ((r (add1 start)) end)))))))
(define map
(lambda (r)
(lambda (f)
(lambda (l)
(if (null? l)
null
(cons (f (car l))
((r f) (cdr l))))))))
(define nums
((((u y) range) 3) 9))
(define squares
((((u y) map) (lambda (x) (* x x))) nums))
(print squares)
; '(9 16 25 36 49 64 81)
And as a single lambda expression -
; ((((u y) map) (lambda (x) (* x x))) ((((u y) range) 3) 9))
(print (((((lambda (f) (f f)) ; u
(lambda (r) ; y
(lambda (f)
(f (lambda (x) (((r r) f) x))))))
(lambda (r) ; map
(lambda (f)
(lambda (l)
(if (null? l)
null
(cons (f (car l))
((r f) (cdr l))))))))
(lambda (x) (* x x))) ; square
(((((lambda (f) (f f)) ; u
(lambda (r) ; y
(lambda (f)
(f (lambda (x) (((r r) f) x))))))
(lambda (r) ; range
(lambda (start)
(lambda (end)
(if (> start end)
null
(cons start ((r (add1 start)) end)))))))
3) ; start
9))) ; end
; => '(9 16 25 36 49 64 81)
lazY
Check out these cool implementations of y using lazy
#lang lazy
(define y
(lambda (f)
(f (y f))))
#lang lazy
(define y
((lambda (f) (f f)) ; u
(lambda (r)
(lambda (f)
(f ((r r) f))))))
#lang lazy
(define y
((lambda (r)
(lambda (f)
(f ((r r) f))))
(lambda (r)
(lambda (f)
(f ((r r) f))))))
In response to #alinsoar's answer, I just wanted to show that Typed Racket's type system can express the Y combinator, if you put the proper type annotations using Rec types.
The U combinator requires a Rec type for its argument:
(: u (All (a) (-> (Rec F (-> F a)) a)))
(define u
(lambda (f) (f f)))
The Y combinator itself doesn't need a Rec in its type:
(: y (All (a b) (-> (-> (-> a b) (-> a b)) (-> a b))))
However, the definition of the Y combinator requires a Rec type annotation on one of the functions used within it:
(: y (All (a b) (-> (-> (-> a b) (-> a b)) (-> a b))))
(define y
(lambda (f)
(u (lambda ([g : (Rec G (-> G (-> a b)))])
(f (lambda (x) ((g g) x)))))))
Recursion using only lambdas can be done using fixed point combinators, the simplest one being Ω.
However, take into account that such a combinator has a type of infinite length, so if you program with types, the type is recursive and has infinite length. Not every type checker is able to compute the type for recursive types. The type checker of Racket I think it's Hindley-Miller and I remember typed racket it's not able to run fixed point combinators, but not sure. You have to disable the type checker for this to work.

Recursive call in Scheme language

I am reading sicp, there's a problem (practice 1.29), I write a scheme function to solve the the question, but it seems that the recursive call of the function get the wrong answer. Really strange to me. The code is following:
(define simpson
(lambda (f a b n)
(let ((h (/ (- b a) n))
(k 0))
(letrec
((sum (lambda (term start next end)
(if (> start end)
0
(+ (term start)
(sum term (next start) next end)))))
(next (lambda (x)
(let ()
(set! k (+ k 1))
(+ x h))))
(term (lambda (x)
(cond
((= k 0) (f a))
((= k n) (f b))
((even? k) (* 2
(f x)))
(else (* 4
(f x)))))))
(sum term a next b)))))
I didn't get the right answer.
For example, if I try to call the simpson function like this:
(simpson (lambda (x) x) 0 1 4)
I expected to get the 6, but it returned 10 to me, I am not sure where the error is.It seems to me that the function "sum" defined inside of Simpson function is not right.
If I rewrite the sum function inside of simpson using the iteration instead of recursive, I get the right answer.
You need to multiply the sum with h/3:
(* 1/3 h (sum term a next b))

(Scheme) Take a list and return new list with count of positive, negative, and zeros

I am attempting to accept a list, have it count the positive, negative, and zeros, and return a new list.
The only thing I notice as I'm debugging is that the list is iterating through, but it is not utilizing any of the conditionals. So its successfully recursively calling itself, and then it just errors once its empty.
(define (mydisplay value)
(display value)
(newline)
#t
)
(define neg 0)
(define z 0)
(define pos 0)
(define (posneg lst)
(cond
((NULL? lst))
(NEGATIVE? (car lst) (+ 1 neg))
(ZERO? (car (lst)) (+ 1 z))
(else (+ 1 pos))
)
(posneg (cdr lst))
)
(mydisplay (posneg '(1 2 3 4 2 0 -2 3 23 -3)))
(mydisplay (posneg '(-1 2 -3 4 2 0 -2 3 -23 -3 0 0)))
(mydisplay (posneg '()))
OK, my favorite technique to apply here is wishful thinking as I learned it from Gerald Jay Sussman and Hal Abelson in the Structure and Interpretation of Computer Programs (SICP) course. Particularly, video lecture 2B. Compound Data will be of interest to you.
Let's start by just pretending (wishing) with have this data container available to us that holds 3 values: one for positives, one for negatives, and one for zeros. We'll call it pnz.
The way to create one of these is simple
; construct a pnz that has 1 positive, 4 negatives, and 2 zeros
(define x (make-pnz 1 4 2))
To select the positives value
(positives x) ;=> 1
To select a negatives value
(negatives x) ;=> 4
To select the zeros value
(zeros x) ;=> 2
Forget for a moment that these procedures don't exist (yet). Instead, just wish that they did and begin writing the procedure to solve your problem.
We'll start with some pseudocode
; pseudocode
define count-pnz xs
if xs is null? return (make-pnz p n z)
if (car xs) is positive, update the positive count by one
if (car xs) is negative, update the negative count by one
if (car xs) is zero, update the zero count by one
return count-pnz (cdr xs)
OK, that's pretty straight forward actually. Well, with one little gotcha. Notice I'm saying "update the count by one"? Well we need somewhere to store that count as the procedure is iterating. Let's make a slight adjustment to the pseudocode, this time including a pnz parameter to keep track of our current count
; pseudocode v2
define count-pnz xs pnz=(0 0 0)
if xs is null? return (make-pnz p n z)
if (car xs) is positive, nextpnz = (make-pnz p+1 n z)
if (car xs) is negative, nextpnz = (make-pnz p n+1 z)
if (car xs) is zero, nextpnz = (make-pnz p n z+1)
return count-pnz (cdr xs) nextpnz
Now this procedure makes sense to me. In the simplest case where xs is an empty list, it will simply return a pnz of (0 0 0). If xs has any number of values, it will iterate through the list, one-by-one, and increment the corresponding value in the pnz container.
Translating this into scheme is a breeze
; wishful thinking
; we will define make-pnz, positives, negatives, and zeros later
(define (count-pnz xs (pnz (make-pnz 0 0 0)))
(let [(p (positives pnz))
(n (negatives pnz))
(z (zeros pnz))]
(cond [(null? xs) pnz]
[(> (car xs) 0) (count-pnz (cdr xs) (make-pnz (+ 1 p) n z))]
[(< (car xs) 0) (count-pnz (cdr xs) (make-pnz p (+ 1 n) z))]
[(= (car xs) 0) (count-pnz (cdr xs) (make-pnz p n (+ 1 z)))])))
You'll notice I used a let here to make it easier to reference the individual p, n, z values of the current iteration. That way, when we detect a positive, negative, or zero, we can easily increment the appropriate value by simply doing (+ 1 p), (+ 1 n), or (+ 1 z) accordingly. Values that are not meant to be incremented can simply be passed on untouched.
We're getting extremely close. Our procedure make logical sense but we need to define make-pnz, positives, negatives, and zeros before it can work. By the way, this methodology of defining data objects by creating constructors and selectors to isolate use from representation is called data abstraction. You'll learn more about that in the video I linked, if you're interested.
So here's the contract that we need to fulfill
; PNZ CONTRACT
; pnz *must* behave like this
(positives (make-pnz p n z)) ⇒ p
(negatives (make-pnz p n z)) ⇒ n
(zeros (make-pnz p n z)) ⇒ z
Let's implement it !
; constructor
(define (make-pnz p n z)
(list p n z))
; positives selector
(define (positives pnz)
(car pnz))
; negatives selector
(define (negatives pnz)
(cadr pnz))
; zeros selector
(define (zeros pnz)
(caddr pnz))
Pff, well that was easy as can be ! Using a list, car, cadr, and caddr made our job simple and it's easy to understand how pnz behaves.
Without further ado, let's see this thing in action now
(define answer (count-pnz '(-1 2 -3 4 2 0 -2 3 -23 -3 0 0)))
(positives answer) ; => 4
(negatives answer) ; => 5
(zeros answer) ; => 3
And there you have it. Wishful thinking and a dash of data abstraction to the rescue.
Data abstraction is a very powerful concept. You might be thinking, "Why didn't we just use list in the count-pnz procedure instead of all of this constructor/selector ceremony?" The answer may not be readily apparent, but it is a bit too much for me to get into with this post. Instead, I sincerely do hope you check out the learning resources I linked as I'm certain they will be of great benefit to you.
#DavinTryon says "#naomik's answer could be defined in something other than a list (even just functions)."
Yep, that's totally true. Let's see make-pnz, positives, negatives, and zero implemented in a different way. Remember, the contract still has to be fulfilled in order for this implementation to be considered valid.
; constructor
(define (make-pnz p n z)
(λ (f) (f p n z)))
; selectors
(define (positives pnz)
(pnz (λ (p n z) p)))
(define (negatives pnz)
(pnz (λ (p n z) n)))
(define (zeros pnz)
(pnz (λ (p n z) z)))
Pretty cool. This demonstrates the beauty of data abstraction. We were able to completely re-implement make-pnz, positives, negatives, and zeros in a different way, but because we still fulfilled the original contract, our count-pnz function does not need to change at all.
First, let me say that #naomik's answer is awesome. This is the way to deconstruct the problem and build it up step by step.
When I first read the question, what I ended up thinking was:
How can I reduce a list of integers to the defined list '(p n z)?
So reduce means perhaps using foldl or foldr.
Here is example with foldr (returning a list in the format '(p n z)):
(define (count-pnz xs)
(foldr (lambda (next prev)
(cond ((= next 0) (list (car prev) (cadr prev) (+ 1 (caddr prev))))
((< next 0) (list (car prev) (+ 1 (cadr prev)) (caddr prev)))
(else (list (+ 1 (car prev)) (cadr prev) (caddr prev)))))
'(0 0 0) xs))
The body of the solution is the lambda we are using to reduce. Essentially, this just adds 1 to the p, n or z position of the list (using car, cadr and caddr respectively).
*note, this solution is not optimized.
A better way to keep values while computing are by making a helper that has the data you want to keep as arguments. Updating the value is the same as recursing by providing a new value:
(define (pos-neg-zero lst)
(define (helper pos neg zero lst)
(cond ((null? lst) (pnz pos neg zero)) ; the result
((positive? (car lst)) (helper (+ 1 pos) neg zero (cdr lst)))
((negative? (car lst)) (helper pos (+ neg 1) zero (cdr lst)))
(else (helper pos neg (+ zero 1) (cdr lst)))))
(helper 0 0 0 lst))
I like #naomik's abstraction but unboxing/boxing for each iteration within the helper is perhaps overkill. Though having a contract is nice and both Racket and R6RS supports making your own types:
;; scheme version (r6rs)
(define-record-type (pnz-type pnz pnz?)
(fields
(immutable p pnz-p)
(immutable n pnz-n)
(immutable z pnz-z)))
;; racket
(struct pnz (p n z) #:transparent)
An alternative would be it returned the values as separate results with values or it could take a continuation:
(define (pos-neg-zero lst . lcont)
(define cont (if (null? lcont) values (car lcont)))
(define (helper pos neg zero lst)
(cond ((null? lst) (cont pos neg zero)) ; the result
((positive? (car lst)) (helper (+ 1 pos) neg zero (cdr lst)))
((negative? (car lst)) (helper pos (+ neg 1) zero (cdr lst)))
(else (helper pos neg (+ zero 1) (cdr lst)))))
(helper 0 0 0 lst))
(pos-neg-zero '(1 -3 0)) ; returns 1, 1, and 1
(pos-neg-zero '(1 -3 0) pnz) ; returns result as an object
(pos-neg-zero '(1 -3 0) list) ; returns result as a list
(pos-neg-zero '(1 -3 0) (lambda (p n z) (+ p n z))) ; does something with the results
#!racket has optional arguments so the prototype could be just without having to have the first expression to check if there was passed an extra argument or not:
(define (pos-neg-zero lst (cont values))
...)

Resources