Tag: geometry

Moiré Patterns: Square and Hexagon

thequietlearnerLeave a comment

Overlaid hexagon grids with moderate rotational offset

A square grid with a slight rotational offset gives a square or diamond zig-zag grid:

With smaller squares, the checkerboard pattern is more interesting:

Hexagonal grids give an interesting variety of overlap patterns in one image:

The new code is below:

;; Copyright 2021 Christopher Howard

;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at

;;     http://www.apache.org/licenses/LICENSE-2.0

;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(define* (draw-square-block r orig-x orig-y base-l
                         #:key (rotr 0))
  (let* ((lrot (if (zero? rotr) (lambda (x) x)
                   (lambda (c) (rot rotr c))))
         (ccomp (lambda (c) (cex (lrot c)))))
    (render-draw-lines
     r
     (map ccomp (list (list orig-x orig-y)
                      (list (+ orig-x base-l) orig-y)
                      (list (+ orig-x base-l) (+ orig-y base-l)))))))

(define* (draw-square-pattern r offset-x offset-y #:key (rotr 0))
  (let* ((base-l 10))
    (do ((j 0 (1+ j)))
        ((> j 80))
        (do ((i 0 (1+ i)))
            ((> i 80))
          (draw-square-block
           r
           (+ (* i base-l) offset-x)
           (+ (* j base-l) offset-y)
           base-l
           #:rotr rotr)))))

(define* (draw-hexagon-block r orig-x orig-y base-l
                         #:key (rotr 0))
  (let* ((base-hl (* 0.5 base-l))
         (base-h (* (* base-l (sqrt 3)) 0.5))
         (lrot (if (zero? rotr) (lambda (x) x)
                   (lambda (c) (rot rotr c))))
         (ccomp (lambda (c) (cex (lrot c)))))
    (render-draw-lines
     r
     (map ccomp (list (list orig-x orig-y)
                      (list (- orig-x base-hl)
                            (+ orig-y base-h))
                      (list orig-x
                            (+ orig-y (* 2 base-h)))
                      (list (+ orig-x base-l)
                            (+ orig-y (* 2 base-h)))
                      (list (+ orig-x base-l base-hl)
                            (+ orig-y base-h))
                      (list (+ orig-x base-l)
                            orig-y))))
    (render-draw-lines
     r
     (map ccomp (list (list (- orig-x base-hl)
                            (+ orig-y base-h))
                      (list (- orig-x base-hl base-l)
                            (+ orig-y base-h)))))))

(define* (draw-hexagon-pattern r offset-x offset-y #:key (rotr 0))
  (let* ((base-l 20)
         (base-h (* (* base-l (sqrt 3)) 0.5))
         (base-hl (* 0.5 base-l)))
    (do ((j 0 (1+ j)))
        ((> j 40))
        (do ((i 0 (1+ i)))
            ((> i 40))
          (draw-hexagon-block
           r
           (+ offset-x
              (* i 3 base-l))
           (+ offset-y (* j 2 base-h))
           base-l
           #:rotr rotr)))))
Advertisement

Moiré Patterns

thequietlearner1 Comment
Moiré pattern with two overlaid triangle tilings with a slight rotation offset

An interesting thing to play around with is Moiré patterns, which are new patterns you get when you overlay two identical patterns but with some slight displacement. The above and below images are using two triangle tilings. My code displays the tilings and allows rotational and translation adjustment using some keyboard keys. The pattern for the overlaid triangle tilings seems to be generally some number of hexagons at various sizes.

Pattern with less hexagons.

This was the most interesting, however, was this dodecagon-like shape when around a 30 degree rotation offset or so.

Pattern with dodecagon-like shapes.
;; Copyright 2021 Christopher Howard

;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at

;;     http://www.apache.org/licenses/LICENSE-2.0

;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(use-modules (sdl2)
             (sdl2 video)
             (sdl2 rect)
             (sdl2 surface)
             (sdl2 render)
             (sdl2 input keyboard)
             (sdl2 events))

(define (cex coord) (list (inexact->exact (round (car coord)))
                          (inexact->exact (round (cadr coord)))))

(define (rot rad coords)
  (let* ((x (car coords))
         (y (cadr coords))
         (cpx (make-rectangular x y))
         (fact (exp (* rad 0+i)))
         (ncpx (* cpx fact)))
    (list (real-part ncpx) (imag-part ncpx))))

(define* (draw-tri-block r orig-x orig-y base-l
                         #:key (rotr 0))
  (let* ((base-hl (* 0.5 base-l))
         (base-h (* (* base-l (sqrt 3)) 0.5))
         (lrot (if (zero? rotr) (lambda (x) x)
                   (lambda (c) (rot rotr c))))
         (ccomp (lambda (c) (cex (lrot c)))))
    (render-draw-lines
     r
     (map ccomp (list (list (+ orig-x base-l) orig-y)
                      (list (+ orig-x base-hl)
                            (+ orig-y base-h))
                      (list (+ orig-x base-hl base-l)
                            (+ orig-y base-h))
                      (list (+ orig-x base-l) (ex orig-y)))))))

(define* (draw-tri-pattern r offset-x offset-y #:key (rotr 0))
  (let* ((base-l 20)
         (base-h (* (* base-l (sqrt 3)) 0.5))
         (base-hl (* 0.5 base-l)))
    (do ((j 0 (1+ j)))
        ((> j 40))
        (do ((i 0 (1+ i)))
            ((> i 40))
          (draw-tri-block
           r
           (+ (* i base-l)
              (if (zero? (floor-remainder j 2)) 0 base-hl)
              offset-x)
           (+ (* j base-h) offset-y)
           base-l
           #:rotr rotr)))))

(define rot-radius 0)

(define rot-inc (/ 3.1415 5096))

(define trans-x 0)

(define trans-y 0)

(define trans-inc 1)

(define (main)
  (sdl-init)
  (let* ((mywindow (make-window
                  #:title "Super Awesome Window"
                  #:opengl? #t
                  #:size '(1024 768)))
         (glc (make-gl-context mywindow))
         (myrect (make-rect 100 100 200 100))
         (mysurface (make-rgb-surface 300 300 32))
         (myrenderer (make-renderer mywindow)))
    (set-gl-swap-interval! 'vsync)
    (while (not (key-pressed? 'q))
      (usleep 100)
      (poll-event)
      (if (key-pressed? 'r)
          (set! rot-radius (+ rot-inc rot-radius)))
      (if (key-pressed? 't)
          (set! rot-radius (- rot-radius rot-inc)))
      (if (key-pressed? 'j)
          (set! trans-x (- trans-x trans-inc)))
      (if (key-pressed? 'k)
          (set! trans-x (+ trans-x trans-inc)))
      (if (key-pressed? 'i)
          (set! trans-y (- trans-y trans-inc)))
      (if (key-pressed? 'm)
          (set! trans-y (+ trans-y trans-inc)))
      (set-render-draw-color myrenderer 0 0 0 255)
      (clear-renderer myrenderer)
      (set-render-draw-color myrenderer 0 255 255 255)
      (draw-tri-pattern myrenderer 0 0)
      (draw-tri-pattern myrenderer trans-x trans-y #:rotr rot-radius)
      (present-renderer myrenderer))
    (close-window! mywindow)
  (sdl-quit)))

Geometric Tilings with Guile-SDL2

thequietlearner1 Comment
Equilateral triangle tiling using Guile SDL2

I am trying to get back to the fun of being able to draw things on the screen using lisp. The Guile SDL2 module proved a handy tool. The code below was run using guile and guile-sdl from Guix commit 62942992831249d6d1c047c0a11c41d2ecccc4fc.

;; Copyright 2021 Christopher Howard

;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at

;;     http://www.apache.org/licenses/LICENSE-2.0

;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(use-modules (sdl2)
             (sdl2 video)
             (sdl2 rect)
             (sdl2 surface)
             (sdl2 render)
             (sdl2 input keyboard)
             (sdl2 events))

(define (ex x) (inexact->exact (round x)))

(define (draw-tri-block r orig-x orig-y base-l)
  (let* ((base-hl (* 0.5 base-l))
         (base-h (* (* base-l (sqrt 3)) 0.5)))
    (render-draw-lines
     r
     (list (list (ex (+ orig-x base-l)) (ex orig-y))
           (list (ex (+ orig-x base-hl))
                 (ex (+ orig-y base-h)))
           (list (ex (+ orig-x base-hl base-l))
                 (ex (+ orig-y base-h)))
           (list (ex (+ orig-x base-l)) (ex orig-y))))))

(define (draw-tri-pattern r)
  (let* ((base-l 20)
         (base-h (* (* base-l (sqrt 3)) 0.5))
         (base-hl (* 0.5 base-l)))
    (do ((j -4 (1+ j)))
        ((> j 40))
        (do ((i -4 (1+ i)))
            ((> i 40))
          (draw-tri-block
           r
           (+ (* i base-l) (if (zero? (floor-remainder j 2)) 0 base-hl))
           (* j base-h) base-l)))))

(define (main)
  (sdl-init)
  (display (sdl-version))
  (display "\r\n")
  (display (sdl-ticks))
  (display "\r\n")
  (let* ((mywindow (make-window
                  #:title "Super Awesome Window"
                  #:opengl? #t))
         (glc (make-gl-context mywindow))
         (myrect (make-rect 100 100 200 100))
         (mysurface (make-rgb-surface 300 300 32))
         (myrenderer (make-renderer mywindow)))
    (set-gl-swap-interval! 'vsync)
    (set-render-draw-color myrenderer 0 0 0 255)
    (clear-renderer myrenderer)
    (set-render-draw-color myrenderer 0 255 255 255)
    (draw-tri-pattern myrenderer)
    (present-renderer myrenderer)
    (while (not (key-pressed? 'q)) (usleep 100) (poll-event))
    (close-window! mywindow)
  (sdl-quit)))

Elliptic Pencil

thequietlearnerLeave a comment

I wanted to play around with generating an “elliptic pencil of circles” starting with the Hermatian matrices. An elliptic pencil of circles are all the circles (or some of them) which all intersect at two specific points. Here is a simple one, where the points of intersection are at (0,1) and (0,-1), or ±i in the complex plane.

You see there is the unit circle, plus the other circles branching off to each side:

The Hermatian matrix template for this particular pencil is elegant:

\begin{bmatrix} 1 & -n \\ -n & -1 \end{bmatrix}

where n is the x coordinate of the center of each circle (or the complex number center, not having an imaginary component).

Here is Racket code used to generate the plot:

(require math/array)
(require math/matrix)
(require plot)

(define (matrix-circle-radius M)
  (let ([A (array-ref M #[0 0])]
        [d (matrix-determinant M)])
    (sqrt (/ d (* -1 (* A A))))))

(define (matrix-circle-center M)
  (let ([C (array-ref M #[1 0])]
        [A (array-ref M #[0 0])])
    (/ C (* -1 A))))

(define (circle-isoline x y r c)
  (isoline
   (lambda (x_ y_) (sqrt (+ (sqr (- x_ x)) (sqr (- y_ y))))) r
   #:color c
   #:width 2))

(define (elipt-plot-demo)
  (plot
   (map (lambda (C)
          (circle-isoline (real-part (first C))
                          (imag-part (first C))
                          (second C)
                          (list 30 160 210)
                          ))
        (map (lambda (M)
               (list (matrix-circle-center M)
                     (matrix-circle-radius M)))
             (map (lambda (n)
                    (matrix+
                     (matrix-scale (array #[#[0 1] #[1 0]]) n)
                     (array #[#[1 0] #[0 -1]])))
                  (range 2.5 -3 -0.5))))
                    
   #:x-min -5
   #:x-max 5
   #:y-min -5
   #:y-max 5
   #:width 400
   #:height 400))

Circles Common Invariant

thequietlearnerLeave a comment

Schwerdteger describes an interesting “invariant” relationship between any two circles:

\frac{\Delta_{12}}{\sqrt{\Delta_1} \sqrt{\Delta_2}}

where

\Delta_1 = | \mathfrak{C}_1 |, \Delta_2 = | \mathfrak{C}_2 |, and 2 \Delta_{12} = A_1 D_2 + A_2 D_1 - B_1 C_2 - B_2 C_1

with the circles represented as Hermitian matrices \begin{bmatrix} A & B \\ C & D \end{bmatrix}.

The point is, in the end you come up with this single number which represents whether the smaller circle is inside the first, overlapping the first, just touching the first, or outside the first. Here are the cases:

common invariant > 1 : smaller circle contained withing the greater circle

common invariant = 1 : touching from the inside

-1 > common invariant > 1 : overlapping at two points

common invariant = -1 : touching from the outside

common invariant < -1 : completely outside

Here is Racket code used for calculations and plotting:

(require math/array)
(require math/matrix)
(require plot)

(define (circle-to-matrix zC r)
  (let ([B (* -1 (conjugate zC))]
        [mzC (magnitude zC)])
    (matrix [[ 1             B                       ]
             [ (conjugate B) (- (* mzC mzC) (* r r)) ]])))

;; gothic C - 212d
;; delta - 394
(define (invariant ℭ1 ℭ2)
  (let* ([Δ1 (matrix-determinant ℭ1)]
         [Δ2 (matrix-determinant ℭ2)]
         [A1 (array-ref ℭ1 #[0 0])]
         [B1 (array-ref ℭ1 #[0 1])]
         [C1 (array-ref ℭ1 #[1 0])]
         [D1 (array-ref ℭ1 #[1 1])]
         [A2 (array-ref ℭ2 #[0 0])]
         [B2 (array-ref ℭ2 #[0 1])]
         [C2 (array-ref ℭ2 #[1 0])]
         [D2 (array-ref ℭ2 #[1 1])]
         [Δ12 (* 0.5 (+ (* A1 D2)
                        (* A2 D1)
                        (* -1 B1 C2)
                        (* -1 B2 C1)))])
    (/ Δ12 (* (sqrt Δ1) (sqrt Δ2)))))

(define (circle-isoline x y r)
  (isoline
   (lambda (x_ y_) (sqrt (+ (sqr (- x_ x)) (sqr (- y_ y))))) r))

(define (circles-invariant-plot x1 y1 r1 x2 y2 r2 min max)
  (let ([C1 (circle-to-matrix (make-rectangular x1 y1) r1)]
        [C2 (circle-to-matrix (make-rectangular x2 y2) r2)])
    (plot-file
     (list
      (circle-isoline x1 y1 r1)
      (circle-isoline x2 y2 r2)
      (point-label (vector (+ min (* (- max min) 0.1))
                           (+ min (* (- max min) 0.9)))
                   (number->string (invariant C1 C2)) #:point-size 0))
     "out.png"
     #:x-min min
     #:x-max max
     #:y-min min
     #:y-max max
     #:width 400
     #:height 400)))