Scheme 将列表列表转换为图像

好的，我试着把一个数字列表转换成一个图像，其中每个数字代表一个块，并为该数字指定颜色。例如：

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

我想把它变成这样：

（用调色板10绘制图片）

其中10是组成图像的正方形的大小，调色板是分配给每个数字的颜色（即图中1是“蓝色”），allig是数字列表

到目前为止，我已经有了一种方法来获取颜色，制作第一列，并反复重复该列，以使图片的x列变大。我的问题是，我不知道如何获得每个连续的列，只有第一列

我已经差不多完成了，我只是停留在最后一部分，所以任何帮助都将是巨大的

以下是我所拥有的：

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

这适用于

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

（请注意，我在

pal

的前面添加了

Transparent

，这样就不必将索引移动1。）

它也适用于

#lang htdp/isl+

（但出于某种原因，它显示结构而不是直接显示图像）。当然，Alexis King询问您是否使用ISL+vs plain ISL的原因是我上面使用的

lambda

表达式在plain ISL中是被禁止的

以下是一个在纯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))

---

下面是一组函数，它们实现了您在无全局状态的纯ISL中所需的功能

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

---

棘手的一点是

partial

函数，它在纯ISL中实现二进制函数（即具有arity 2的函数）的部分函数应用。我不确定这是否应该在ISL中起作用，但它确实起作用。也许这是一个bug，哈哈？

一个简单的版本，没有任何更高阶的函数或任何铃铛和口哨-非常初级，我希望：

最常见的是在列表的结构上递归，而不是在列表的大小上递归，因此我们将这样做。
如果你习惯于写循环，一开始这看起来会让人不舒服，但大多数时候列表的确切长度在Racket中是不相关的——你只关心它是否为空

首先，可读性助手：

(define nothing (square 0 "solid" "red"))

逐行查看“图片”，我们要么有空列表，要么没有空列表。
如果是空的，什么也不要画。
否则，在图片其余部分上方绘制第一行：

(define (paint-picture painting)
  (if (empty? painting)
      nothing
      (above (paint-row (first painting)) 
             (paint-picture (rest painting)))))

接下来，我们需要画一行。
这也有两种情况：
如果是空列表，则不绘制任何内容。
否则，绘制行其余部分旁边的第一个像素：

(define (paint-row row)
  (if (empty? row)
      nothing
      (beside (square 30 "solid" (get-color (first row) pal)) 
              (paint-row (rest row)))))

---

就这样。

你在用什么图书馆做这个？HtDP？如果是，使用哪种语言（BSL/ISL/ASL）？或者类似Pict的东西？我正在使用（需要2htdp/image）在ISLIs it ISL和lambdas中，或者只是简单的ISL？@Ryan关于堆栈溢出，我们在解决问题时不会删除任何问题。我们把它留在网站上是为了帮助其他有同样问题的人。事实上，如果你删除（或污损）了太多的问题，.Hehe，我有一个黑客版本，可以在ISL w/o lambdas中工作。但这是一个没有任意限制的好答案，哈哈。我最初也尝试过类似的方法，但我认为部分任务是调色板必须传递给

绘制图像

，这会让事情变得烦人。那么，只需将

生成像素

和

生成行

提升到内部定义中即可。这是ISL允许的，对吗？；-）不，也不允许使用内部定义：我们今天学习了地图，所以我很抱歉之前没有使用它，我正试图提前解决这个问题。非常感谢你！我们还没有学习scale、matrix或let函数，但我看到你在上面的评论中提到了local，有没有办法用它来解决这个问题。我只需要能够删除列表列表中每个元素的下一项。@Ryan Matrix没有什么特别之处，我只是用它来引用列表。使用

let

主要是风格上的，它只是引入了一些新的绑定以在let块体中使用。最后，

scale

只是缩放一个图像，所以我不认为使用它是非常不合理的。@AlexisKing我也是，我通常更喜欢用“专业”的实现来回答问题。哈哈，我也不喜欢这样做，我更希望能够使用我可以支配的一切，但在这一点上，我无法理解是什么迫使你跳出框框思考。我相信很多程序在使用主程序中的每一个可能的函数时都会容易得多，没有任何限制，但这不会让你思考，也不会挑战你，这就是本文的目的。我真的非常感谢您的演示！非常感谢。