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 

線表明該代碼後運行正常寫在球拍。如果這還不夠，我可以提供更多細節。