谢尔宾斯基地毯方案代码翻译答案

【问题标题】：Translation of Scheme code for Sierpinski carpet谢尔宾斯基地毯方案代码翻译
【发布时间】：2012-01-30 09:37:06
【问题描述】：

我在http://rosettacode.org/wiki/Sierpinski_carpet#Scheme 找到了生成 Sierpinski 地毯的代码 - 但它不会在 DrRacket 环境或 WeScheme 中运行。有人可以为这两种环境提供解决方案吗？

【问题讨论】：

标签： scheme racket code-translation wescheme

【解决方案1】：

看起来这段代码在添加了

之后在 DrRacket 中运行良好

#lang racket

表示代码是用 Racket 编写的行。如果这还不够，我可以提供更多细节。

【讨论】：

【解决方案2】：

我已将程序翻译为在 WeScheme 下运行。我做了一些更改：我没有使用 (display) 和 (newline)，而是使用 WeScheme 提供的图像原语来制作更好的图片。你可以view the running program and its source code。为方便起见，我还在这里包括了来源：

;; Sierpenski carpet.
;; http://rosettacode.org/wiki/Sierpinski_carpet#Scheme

(define SQUARE (square 10 "solid" "red"))
(define SPACE (square 10 "solid" "white"))

(define (carpet n)
  (local [(define (in-carpet? x y)
           (cond ((or (zero? x) (zero? y))
                  #t)
                 ((and (= 1 (remainder x 3)) (= 1 (remainder y 3)))
                  #f)
                 (else
                  (in-carpet? (quotient x 3) (quotient y 3)))))]

  (letrec ([outer (lambda (i)
                    (cond
                      [(< i (expt 3 n))                       
                       (local ([define a-row
                                 (letrec ([inner 
                                           (lambda (j)
                                             (cond [(< j (expt 3 n))
                                                    (cons (if (in-carpet? i j)
                                                              SQUARE
                                                              SPACE)
                                                          (inner (add1 j)))]
                                                   [else
                                                    empty]))])
                                   (inner 0))])
                         (cons (apply beside a-row)
                               (outer (add1 i))))]
                      [else
                       empty]))])
    (apply above (outer 0)))))


(carpet 3)

【讨论】：

非常感谢。像魅力一样工作，代码非常易读。问候，

【解决方案3】：

这是 WeScheme 的修改代码。 WeScheme 不支持 do-loop 语法，所以我改用 srfi-1 的展开

(define (unfold p f g seed)
  (if (p seed) '()
    (cons (f seed)
          (unfold p f g (g seed)))))

(define (1- n) (- n 1))

(define (carpet n)
  (letrec ((in-carpet?
             (lambda (x y)
               (cond ((or (zero? x) (zero? y))
                      #t)
                     ((and (= 1 (remainder x 3)) (= 1 (remainder y 3)))
                      #f)
                     (else
                       (in-carpet? (quotient x 3) (quotient y 3)))))))
    (let ((result
            (unfold negative?
                    (lambda (i)
                      (unfold negative?
                              (lambda (j) (in-carpet? i j))
                              1-
                              (1- (expt 3 n))))
                    1-
                    (1- (expt 3 n)))))
      (for-each (lambda (line)
                         (begin
                           (for-each (lambda (char) (display (if char #\# #\space))) line)
                           (newline)))
                result))))

【讨论】：

这似乎没有生成所需的图形图片。
您可以在此处查看output。问题似乎出在 (for-each (lambda (char) (display (if char #\# #\space))。我用 (for-each (lambda (char) (display (if char "#" " ") 并且它起作用了。但是，显示是锯齿状的，因为字体不固定。我不知道如何在 Wescheme 的“显示”功能中使用固定字体。