Sierpinskiカーペットのスキームコードの翻訳

Question

http://rosettacode.org/wiki/Sierpinski_carpet#SchemeにSierpinskiカーペットを生成するコードが見つかりましたが、DrRacket環境またはWeSchemeでは実行されません。誰かがどちらの環境にもソリューションを提供できますか？

Answer 1

私はWeSchemeで動作するようにプログラムを翻訳しました。私はいくつかの変更を加えました.WindSchemeが提供する画像プリミティブを使用して、（表示）と（改行）を使用するのではなく、やや良い画像を作成します。あなたは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がdo-ループ構文をサポートしていないので、私は、このコードは、そのコードを示す

#lang racket 

ラインを付加した後DrRacketで正常に動作ように見え代わり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

を使用しますラケットに書かれています。これが十分でない場合は、より詳細な情報を提供することができます。