Ryan
Ryan

Reputation: 119

Turn list of list into image

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: picture (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)))

Upvotes: 2

Views: 711

Answers (3)

molbdnilo
molbdnilo

Reputation: 66459

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.

Upvotes: 1

Alexis King
Alexis King

Reputation: 43872

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?

Upvotes: 2

C. K. Young
C. K. Young

Reputation: 223143

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))

Upvotes: 1

Related Questions