weaving in ascii

as seen in the mathematickal arts 2011 workshop. runs in Racket (see: http://racket-lang.org/ )


;-------------------------------------------------------
; a plain weave "kernel" looks like this, with different
; colour threads in the warp and weft:
;
;   R   G
;   ||  ||
;B =||======
;   ||  ||
;Y =====||==
;   ||  ||
; 
; resulting topmost colours would look like this:
; 
;    R   B
;     
;    Y   G

;---------------------------------------------------------
; this function prints plain weave given warp and weft 
; lists where characters represent colours.
; eg: (weave '(O O O O O O O) '(: : : : : : : : :))
; =>
; O : O : O : O
; : O : O : O :
; O : O : O : O
; : O : O : O :
; O : O : O : O
; : O : O : O :
; O : O : O : O
; : O : O : O :
; O : O : O : O
;
; or: (weave '(O O : : O O : : O O) '(O : : O O : : O O :))
; =>
; : O : : : O : : : O
; O : : : O : : : O :
; O O O : O O O : O O
; O O : O O O : O O O
; : O : : : O : : : O
; O : : : O : : : O :
; O O O : O O O : O O
; O O : O O O : O O O
; : O : : : O : : : O

(define (weave warp weft)
  (define (_ x y warp weft)
    (if (eq? (modulo x 2)
             (modulo y 2))
        warp weft))
  (for ((x (in-range 0 (length weft))))
    (for ((y (in-range 0 (length warp))))
      (display (_ x y 
                  (list-ref warp y)
                  (list-ref weft x)))
      ;(display " ")
      )
    (newline)))

;------------------------------------------------------------
; what happens if we generate the warp and weft colours 
; via formal grammar replacement?
;
; * works on lists not strings
; * given axiom and rules where a rule a=>ab is '(a (a b))
;
; eg: (replace '(x) '((x (h e l l o)))) => '(h e l l o)

(define (replace pattern rules)
  (foldl
   (lambda (item r)
     (append 
      r
      (foldl
       (lambda (rule r)
         (if (eq? item (car rule))
             (cadr rule)
             r))
       (list item)
       rules)))
   '()
   pattern))

;--------------------------------------------------------
; repeat replace multiple times:
; eg: (recurse '(a) '((a (a b)) (b (a a))) 3) 
; => 
; (a b a a a b a b)

(define (recurse pattern rules n)
  (cond
    ((zero? n) pattern)
    (else
     (recurse
      (replace pattern rules) rules (- n 1)))))

;--------------------------------------------------------
; plug formal grammars into weave:

(let ((p (recurse '(O)
                  '( 
                    (O (: O : O :))
                    )
                  4))
      (q (recurse '(O)
                  '(
                    (O (O : : O O))
                    )
                  4)))
                  
  (display "warp:")(display p)(newline)
  (display "weft:")(display q)(newline)
  (weave p q))

; some notes:

; one rule cross
; ((O (: O : O)))

;'((O (O : O))
; (: (: O : O : O)))

; complex
; '((O (: O :))
; (: (O O O)))

; wavy
; '((O (: O O :))) 4)) 
; '((O (O : : O))) 4))

; lozenge
; (O (: O : O :)) 3))
; (O (O : : : O)) 4)

; hyper lozenge
; '((O (: O : O :) 4))
;   (O (O : : O O)) 4)

  • ascii_weave.txt
  • Last modified: 2011-07-29 07:50
  • by nik