Sierpinski地毯的方案代码翻译

Question

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

Answer 1

我已经翻译了程序在WeScheme下运行。我做了一些改变：我使用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) 

Answer 2

这是WeScheme的修改代码。 WeScheme不支持这样做，循环语法，所以我用从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)))) 

Answer 3

它看起来像这样的代码在DrRacket前面加上一个

#lang racket 

线表明该代码后运行正常写在球拍。如果这还不够，我可以提供更多细节。