Turn list of list into image - scheme

Okay, so I am trying to turn a list of a list of numbers into an image where each number represents a block with a color assigned to that number. For example:
(define allig
'((1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(1 1 1 1 1 1 1 2 2 2 2 1 1 1 1 1 1 1 1)
(1 1 1 1 1 1 2 4 5 5 5 2 1 1 1 2 2 1 1)
(1 1 1 1 2 2 2 5 5 3 2 5 2 2 2 5 5 2 1)
(1 1 2 2 5 5 5 5 5 5 5 5 5 5 5 5 5 5 2)
(2 2 5 5 2 5 4 5 5 2 3 2 3 2 3 2 3 2 1)
(5 5 5 5 5 5 5 5 2 1 2 1 2 1 2 1 2 1 1)
(4 5 2 5 4 5 2 5 2 1 1 1 1 1 1 1 1 1 1)
(5 5 5 5 5 5 5 5 2 1 1 1 1 1 1 1 1 1 1)
(2 5 4 5 2 5 4 5 5 2 1 2 1 2 1 2 1 2 1)
(5 5 5 5 5 5 5 5 5 5 2 3 2 3 2 3 2 3 2)
(5 5 2 2 2 2 2 2 5 5 5 5 5 5 5 5 5 5 2)
(5 5 2 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 1)
(5 5 5 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(2 5 5 5 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(1 2 5 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
))
I want to turn it into this:
(paint-picture allig palette 10)
where 10 is the size of the squares that make up the image, palette is the color assigned to each number (ie 1 is "blue" in this picture), and allig is the list of list of numbers.
So far I have a way to get the colors, make the first column, and repeat the column over and over to make a picture Col x Row big. My problem is that I don't know how to get each consecutive column, only the first.
I'm pretty much done with this, I'm just stuck on this last part so any help would be great.
Here's what I have:
(define (make-column painting)
(cond
[(zero? (length painting)) (square 0 "solid" "red")]
[else (above (square 30 "solid"
(get-color (first (first painting)) pal))
(make-column (rest painting)))]))
;puts images side by side to make a row
(define (make-row n img1 img2)
(cond
[(zero? n ) (square 0 "solid" "red")]
[else (beside img1 (make-row (sub1 n) img2 img1))]))
;makes a row of columns, I'm stuck as to how to make it recursive
; to get the next column since it is a list of a list
(define (paint-picture painting)
(cond
[(zero? (length painting) ) (square 0 "solid" "red")]
[else (make-row (length (first painting))
(make-column painting)
; this should be the recursive next col part (paint-picture painting))]))
(define pal (list "blue" "dark gray" "white" "green" "dark green"))
(define (get-color n colors) (list-ref colors (- n 1)))

Here is a set of functions that implement what you're looking for in plain ISL with no global state whatsoever.
; (a b -> c) a -> (b -> c)
(define (partial f x)
(let ([g (lambda (y) (f x y))])
g))
; (listof string?) integer? -> image?
(define (pixel palette c)
(let ([color (list-ref palette (sub1 c))])
(square 1 "solid" color)))
; (listof string?) (listof integer?) -> image?
(define (row->image palette lst)
(let* ([pixel/palette (partial pixel palette)]
[pixels (map pixel/palette lst)])
(apply beside pixels)))
; (listof string?) (listof (listof integer?)) -> image?
(define (matrix->image palette lst)
(let* ([row/palette->image (partial row->image palette)]
[rows (map row/palette->image lst)])
(apply above rows)))
; (listof (listof integer?)) (listof string?) integer? -> image?
(define (paint-picture matrix palette size)
(scale size (matrix->image palette matrix)))
The tricky bit is the partial function, which implements partial function application for binary functions (i.e. functions with arity 2) in plain ISL. I'm not sure if this is supposed to work in ISL, but it does. Maybe it's a bug, haha?

A straight-forward version without any higher order functions or any bells and whistles at all - very beginner-level, I hope:
It's most common to recurse on the lists' structure, not their size, so we'll do that.
This can seem uncomfortable at first if you're used to writing for-loops, but most of the time the exact length of a list is irrelevant in Racket - you only care about whether it's empty or not.
First, a readability helper:
(define nothing (square 0 "solid" "red"))
Going through the "picture" row by row, we either have the empty list or we don't.
If it's empty, paint nothing.
Otherwise, paint the first row above the rest of the picture:
(define (paint-picture painting)
(if (empty? painting)
nothing
(above (paint-row (first painting))
(paint-picture (rest painting)))))
Next, we need to paint a row.
This also has two cases:
If it's the empty list, paint nothing.
Otherwise, paint the first pixel beside the rest of the row:
(define (paint-row row)
(if (empty? row)
nothing
(beside (square 30 "solid" (get-color (first row) pal))
(paint-row (rest row)))))
And that's it.

This works in #lang racket.
(define pal '(Transparent Blue DarkGray White Green DarkGreen))
(apply above (map (lambda (row)
(apply beside (map (lambda (col)
(square 4 'solid (list-ref pal col)))
row)))
allig))
(Notice that I added Transparent to the front of pal so that I don't have to shift the index by 1.)
It also works for #lang htdp/isl+ (but for some reason, it shows the struct instead of displaying the image directly). Of course, the reason why Alexis King was asking whether you were using ISL+ vs plain ISL is that the lambda expressions I used above are forbidden in plain ISL.
Here's a version that works in plain ISL:
(define pal '(Transparent Blue DarkGray White Green DarkGreen))
(define (make-pixel col)
(square 4 'solid (list-ref pal col)))
(define (make-row row)
(apply beside (map make-pixel row)))
(apply above (map make-row allig))

Related

Scheme - Secuence of numbers that sum 0 in a list

I'm trying to implement a recursive function (sums cero) that given a list of integers, it prints all possible secuences of consecutive numbers that sum up 0
Example 1:
(sum-zero ‘(4 2 -3 -1 0 4))
=> (-3 -1 0 4)
(0)
Example 2:
(sum-zero ‘(3 4 -7 3 1 3 1 -4 -2 -2))
=> (3 4 -7)
(4 -7 3)
(-7 3 1 3)
(3 1 -4)
(3 1 3 1 -4 -2 -2)
(3 4 -7 3 1 3 1 -4 -2 -2)
You function needs to have a helper that has arguments for 1. the list of available numbers, 2. the current numbers, 3. the list of results of combination that sum to zero so far. Here is how I would have done it, with some parts left out to keep us from doing your homework:
(define (sum-zero lst)
;; insert e such that the resulting list i ssorted
;; (insert 3 '(1 3 4)) ; ==> (1 3 3 4)
(define (insert e lst)
<implement>)
;; main logic
(define (helper lst acc res)
(if (null? lst)
res
(let* ((new-acc (insert (car lst) acc))
(res (if <should add new-acc to res>
(cons new-acc res)
res)))
;; call the helper skipping the current element in the result
;; and use that as the result on the secon call the includes it
(helper (cdr lst)
new-acc
(helper (cdr lst) acc res)))))
;; notice () is already in the results
(helper lst '() '(())))
Testing it is straightforward. I got some more results than you though but I believe it is correct:
(sum-zero '(3 4 -7 3 1 3 1 -4 -2 -2))
; ==> ((-7 -4 -2 -2 1 1 3 3 3 4)
; (-7 -4 -2 3 3 3 4)
; (-7 -2 -2 1 1 3 3 3)
; (-7 -4 1 1 3 3 3)
; (-7 -2 3 3 3)
; (-7 -2 -2 1 3 3 4)
; (-7 -4 1 3 3 4)
; (-7 -2 1 1 3 4)
; (-7 3 4)
; (-4 -2 1 1 4)
; (-4 -2 -2 1 3 4)
; (-2 -2 4)
; (-4 4)
; (-7 1 3 3)
; (-4 -2 -2 1 1 3 3)
; (-4 -2 3 3)
; (-2 1 1)
; (-2 -2 1 3)
; (-4 1 3)
; ())

Kadane's Algorithm in Scheme (Racket)

I understand the logic behind how Kadane's Algorithm (maximum sum of all sequential sub-arrays in an array) works in "pseudo-code," and I'm sure I could implement it as a function in C or C++. However, I'm trying to implement it using lists in Scheme (Racket; the file extension is .rkt), which I have no experience with.
The end result I'm looking for is...
Input: (maxsum `(1 4 -2 1))
Output: 5
So far I've developed two helper functions I may be able to use within the maxsum function.
(1) size: returns the number of elements in a list.
(define size
(lambda (list)
(cond
[(not (list? list)) 0]
[(null? list) 0]
[else (+ 1 (size (cdr list)))]
)
)
)
(2) sum: returns the sum of all elements in a list.
(define sum
(lambda (list)
(cond
[(not (list? list)) 0]
[(null? list) 0]
[else (+ (car list) (sum (cdr list)))]
)
)
)
How would I go about defining/designing the maxsum function?
Here is a version patterned after the Phyton code on wikipedia:
(define (maxsum lst)
(define (aux lst max-ending-here max-so-far)
(if (null? lst)
max-so-far
(let ((new-max-ending-here (max 0 (+ (car lst) max-ending-here))))
(aux (cdr lst) new-max-ending-here (max max-so-far new-max-ending-here)))))
(aux lst 0 0))
(maxsum '(1 4 -2 1)) ; => 5
(maxsum '(-2 1 -3 4 -1 2 1 -5 4)) ; => 6
It is tail recursive, so it will be compiled into an efficient iterative program.
Almost literal translation of [Python code][1] to Racket:
(define (max_subarray A)
(define-values (max_ending_here max_so_far) (values 0 0))
(for ((x (in-list A)))
(set! max_ending_here (max 0 (+ max_ending_here x)))
(set! max_so_far (max max_so_far max_ending_here)))
max_so_far)
Testing:
(max_subarray `(1 4 -2 1))
(max_subarray '(-2 1 -3 4 -1 2 1 -5 4))
Output:
5
6
Please note that recursive functions are generally preferred over iterative ones in Racket and use of "set!" is discouraged here.
Following uses higher functions like apply and map for different steps:
(define (maxsum lst)
(define subarrays
(for*/list ((start (length lst))
(len (range 1 (- (add1(length lst)) start))))
(take (drop lst start) len)))
(define sumlist (map (λ (x) (apply + x)) subarrays))
(apply max sumlist))
Following is more verbose form:
(define (maxsum lst)
(define subarrays
(for*/list ((start (length lst))
(len (range 1 (- (add1(length lst)) start))))
(take (drop lst start) len)))
(displayln "\n----- SUBARRAYS ---------")
(displayln subarrays)
(define sumlist (map (λ (x) (apply + x)) subarrays))
(displayln "----- SUMS OF SUBARRAYS ---------")
(displayln sumlist)
(display "MAX SUM:")
(apply max sumlist))
Testing:
(maxsum `(1 4 -2 1))
(maxsum '(-2 1 -3 4 -1 2 1 -5 4))
Output:
----- SUBARRAYS ---------
((1) (1 4) (1 4 -2) (1 4 -2 1) (4) (4 -2) (4 -2 1) (-2) (-2 1) (1))
----- SUMS OF SUBARRAYS ---------
(1 5 3 4 4 2 3 -2 -1 1)
MAX SUM:5
----- SUBARRAYS ---------
((-2) (-2 1) (-2 1 -3) (-2 1 -3 4) (-2 1 -3 4 -1) (-2 1 -3 4 -1 2) (-2 1 -3 4 -1 2 1) (-2 1 -3 4 -1 2 1 -5) (-2 1 -3 4 -1 2 1 -5 4) (1) (1 -3) (1 -3 4) (1 -3 4 -1) (1 -3 4 -1 2) (1 -3 4 -1 2 1) (1 -3 4 -1 2 1 -5) (1 -3 4 -1 2 1 -5 4) (-3) (-3 4) (-3 4 -1) (-3 4 -1 2) (-3 4 -1 2 1) (-3 4 -1 2 1 -5) (-3 4 -1 2 1 -5 4) (4) (4 -1) (4 -1 2) (4 -1 2 1) (4 -1 2 1 -5) (4 -1 2 1 -5 4) (-1) (-1 2) (-1 2 1) (-1 2 1 -5) (-1 2 1 -5 4) (2) (2 1) (2 1 -5) (2 1 -5 4) (1) (1 -5) (1 -5 4) (-5) (-5 4) (4))
----- SUMS OF SUBARRAYS ---------
(-2 -1 -4 0 -1 1 2 -3 1 1 -2 2 1 3 4 -1 3 -3 1 0 2 3 -2 2 4 3 5 6 1 5 -1 1 2 -3 1 2 3 -2 2 1 -4 0 -5 -1 4)
MAX SUM:6

Foldr and Foldl in DrRacket

I can see how it does it on
(foldl * 1 '(1 2 3 4 5)) == 120
(foldr * 1 '(1 2 3 4 5)) == 120
but I can't figure out how it gets 2 for
(foldl - 1 '(1 2 3 4 5)) == 2
I would've thought (foldl - 1 '(1 2 3 4 5)) would be ((((1-1)-2)-3)-4)-5), a negative number. What did I miss?
I can tho see why
(foldl + 1 '(1 2 3 4 5)) == 16
(foldl - 1 '(1 2 3 4 5)) is actually equivalent to (- 5 (- 4 (- 3 (- 2 (- 1 1))))), or, in infix, 5 - (4 - (3 - (2 - (1 - 1)))).
Likewise, (foldr - 1 '(1 2 3 4 5)) is actually equivalent to (- 1 (- 2 (- 3 (- 4 (- 5 1))))), or, in infix, 1 - (2 - (3 - (4 - (5 - 1)))).

in Scheme, is there syntactical sugar for an ordinary, unquoted list?

In Scheme, if I wanted a list, say (1 2 3), I would just write '(1 2 3). Usually, this is fine, but it is actually equivalent to (quote (1 2 3)), which is not exactly the same as (list 1 2 3). An example of when this would give different results:
'(1 2 (+ 0 3)) -> (1 2 (+ 0 3))
(list 1 2 (+ 0 3)) -> (1 2 3)
Is there a syntactical sugar for the second line here? For vectors there is. For example:
#(1 2 (+ 0 3)) -> #(1 2 3)
(vector 1 2 (+ 0 3)) -> #(1 2 3)
If there is no such sugar for list, that would be pretty ironic, because lists are used way more often than vectors in Scheme!
If you need to evaluate a part of the list, you can use quasiquoting and unquoting, like this:
`(1 2 ,(+ 0 3))
=> '(1 2 3)

Pascal's Triangle with a Twist

Say we want to generate Pascal's Triangle within Scheme, but with a twist. For the function (pascal left right depth), where left is the number on the left side of the triangle and right is the number on the right. For example a call of (pascal 1 1 5) would return
1
1 1
1 2 1
1 3 3 1
1 4 6 4 1
1 5 10 10 5 1
and a call to (pascal 1 2 5) would return
1
1 2
1 3 2
1 4 5 2
1 5 9 7 2
1 6 14 16 9 2
How would you print the triangle out so that it is spaced like the examples?
My code so far is as follows but all this does is return which number should be at which location within the standard triangle.
(define (pascal x y)
(cond ((or (<= x 0) (<= y 0) (< x y)) 0)
((or (= 1 y) (= x y)) 1)
(else (+ (pascal (- x 1) y) (pascal (- x 1) (- y 1))))))
Add a decreasing number of spaces to the start of each line. Determine the number from the length of the last line and the length of the current line to be printed.

Resources