2

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?

lifebalance
  • 1,846
  • 3
  • 25
  • 57

3 Answers3

4

It looks like this code runs fine in DrRacket after prepending a 

#lang racket

line indicating that the code is written in Racket. I can provide more detail if this is not sufficient.

John Clements
  • 16,895
  • 3
  • 37
  • 52
2

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)
dyoo
  • 11,795
  • 1
  • 34
  • 44
1

Here is the modified code for WeScheme. WeScheme don't support do-loop syntax, so I use unfold from srfi-1 instead

(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))))
Zang MingJie
  • 5,164
  • 1
  • 14
  • 27
  • This did not seem to generate the desired graphical picture. – lifebalance Feb 01 '12 at 19:41
  • You can view the [output](http://www.wescheme.org/view?publicId=bathe-pesky-cover-lunar-clock) here. The problem seems to be with (for-each (lambda (char) (display (if char #\# #\space). I replaced it with (for-each (lambda (char) (display (if char "#" " ") and it worked. However, the display was jagged, because the font was not fixed. I can't figure out how to use fixed font in the Wescheme "display" function. – lifebalance Feb 25 '12 at 18:36