Home

PureScript experiments - spiral

2017-Apr-02 21:26
purescript-experimentspurescript

A small demo of using the modules from the previous post to create spiral matrices.

The imports we will use:

1
2
3
4
5
6
7
8
module Ex.Spiral where
 
import Prelude
import Data.Array (zip, (..))
import Data.Maybe (Maybe, fromJust)
import Partial.Unsafe (unsafePartial)
 
import Ex.Mat (Dim(..), Pt(..), Mat, makeMat, putMany)

Types for Corner and Rot, with Show instances:

1
2
3
4
5
6
7
8
9
10
11
12
13
data Corner = TL | TR | BL | BR
 
instance showCorner :: Show Corner where
  show TL = "TL"
  show TR = "TR"
  show BL = "BL"
  show BR = "BR"
 
data Rot = CC | CCW
 
instance showRot :: Show Rot where
  show CC  = "CC"
  show CCW = "CCW"

Functions for finding the next corner, length of the line to the next corner and the position on the line:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
nextCorner :: Corner -> Rot -> Corner
nextCorner TL CC  = TR
nextCorner TR CC  = BR
nextCorner BR CC  = BL
nextCorner BL CC  = TL
 
nextCorner TL CCW = BL
nextCorner BL CCW = BR
nextCorner BR CCW = TR
nextCorner TR CCW = TL
 
lineLen :: Corner -> Rot -> Dim -> Int
lineLen TL CC  (Dim {w, h}) = w - 1
lineLen TR CC  (Dim {w, h}) = h - 1
lineLen BR CC  (Dim {w, h}) = w - 1
lineLen BL CC  (Dim {w, h}) = h - 1
 
lineLen TL CCW (Dim {w, h}) = h - 1
lineLen BL CCW (Dim {w, h}) = w - 1
lineLen BR CCW (Dim {w, h}) = h - 1
lineLen TR CCW (Dim {w, h}) = w - 1
 
fposLine :: Corner -> Rot -> Pt -> Int -> Pt
fposLine TL CC  (Pt {x,y}) n = Pt {x: x + n, y: y    }
fposLine TR CC  (Pt {x,y}) n = Pt {x: x    , y: y + n}
fposLine BR CC  (Pt {x,y}) n = Pt {x: x - n, y: y    }
fposLine BL CC  (Pt {x,y}) n = Pt {x: x    , y: y - n}
 
fposLine TL CCW (Pt {x,y}) n = Pt {x: x    , y: y + n}
fposLine BL CCW (Pt {x,y}) n = Pt {x: x + n, y: y    }
fposLine BR CCW (Pt {x,y}) n = Pt {x: x    , y: y - n}
fposLine TR CCW (Pt {x,y}) n = Pt {x: x - n, y: y    }

Functions for finding the position on the ring and its length:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
fposRing :: Corner -> Rot -> Pt -> Dim -> Int -> Pt
fposRing sc r sp d sn = go sc sp sn
  where go _ p 0 = p
        go c p n =
          let ll = lineLen c r d
          in if n < ll
             then fposLine c r p n
             else go (nextCorner c r) (fposLine c r p ll) (n - ll)
 
ringLen :: Dim -> Int
ringLen (Dim {w, h})
  | w == 1    = 1
  | h == 1    = 1
  | otherwise = 2 * (w + h - 2)

Functions for finding the start position and dimension after peeling one ring off, finding the position in the whole matrix and finally the spiral function itself:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
start :: Corner -> Dim -> Int -> Pt
start TL (Dim {w, h}) n = Pt {x: n        , y: n        }
start TR (Dim {w, h}) n = Pt {x: w - n - 1, y: n        }
start BL (Dim {w, h}) n = Pt {x: n        , y: h - n - 1}
start BR (Dim {w, h}) n = Pt {x: w - n - 1, y: h - n - 1}
 
peel :: Dim -> Dim
peel (Dim {w, h}) = Dim {w: w - 2, h: h - 2}
 
fpos :: Corner -> Rot -> Dim -> Int -> Pt
fpos c r sd sn = go 0 sd sn
  where go l d n =
          let rl = ringLen d
          in if n < rl
             then fposRing c r (start c sd l) d n
             else go (l + 1) (peel d) (n - rl)
 
spiral :: Corner -> Rot -> Dim -> Maybe (Mat Int)
spiral c r d@(Dim {w, h}) = putMany (zip ps vs) (makeMat d 0)
  where len = w * h
        ps = map (fpos c r d) (0..(len - 1))
        vs = 1..len

A couple of examples:

1
2
3
4
5
6
7
8
unsafeSpiral :: Corner -> Rot -> Dim -> Mat Int
unsafeSpiral c r d = unsafePartial fromJust (spiral c r d)
 
p1 :: Mat Int
p1 = unsafeSpiral TL CC (Dim {w: 7, h: 4})
 
p2 :: Mat Int
p2 = unsafeSpiral BR CCW (Dim {w: 2, h: 5})

7x4 matrix starting from top-left corner and going clockwise:

1
2
3
4
5
6
> import Ex.Spiral
> p1
  1   2   3   4   5   6   7
 18  19  20  21  22  23   8
 17  28  27  26  25  24   9
 16  15  14  13  12  11  10

2x5 matrix starting from bottom-right corner and going counter-clockwise:

1
2
3
4
5
6
7
> import Ex.Spiral
> p2
  6   5
  7   4
  8   3
  9   2
 10   1