Search code examples
schemeracketcode-translationwescheme

Translation of Scheme code for Sierpinski carpet


I found code for generating Sierpinski carpet at http://rosettacode.org/wiki/Sierpinski_carpet#Scheme - but it won't run in the DrRacket environment or WeScheme. Could someone provide solutions for either environments?


Solution

  • I've translated the program to run under WeScheme. I've made a few changes: rather than use (display) and (newline), I use the image primitives that WeScheme provides to make a slightly nicer picture. You can view the running program and its source code. For convenience, I also include the source here:

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