Compare commits

...

2 Commits

Author SHA1 Message Date
loooph dd12124644 Add patterns for visualization 2023-03-01 00:12:57 +01:00
loooph ed655076ef Add edge type data type 2023-03-01 00:12:44 +01:00
1 changed files with 21 additions and 9 deletions

View File

@ -8,6 +8,9 @@ import Data.List
import qualified Data.Array as A import qualified Data.Array as A
-- Tree, Forward, Back, Cross, Loop, No Edge
data EdgeType = T | F | B | X | L | NE deriving Show
--
tabulate :: Bounds -> [Vertex] -> Table Int tabulate :: Bounds -> [Vertex] -> Table Int
tabulate bnds vs = A.array bnds (zip vs [1..]) tabulate bnds vs = A.array bnds (zip vs [1..])
-- --
@ -51,15 +54,24 @@ pairfastcat = (\(u,v) -> fastcat $ pure <$> [u,v])
nodeEdgePairs :: Graph -> [(Vertex,[Edge])] nodeEdgePairs :: Graph -> [(Vertex,[Edge])]
nodeEdgePairs g = map (\u -> (u,[(u,v)| v <- g ! u])) $ preorderF $ dff g nodeEdgePairs g = map (\u -> (u,[(u,v)| v <- g ! u])) $ preorderF $ dff g
-- --
instrument :: Graph -> Edge -> [Char] edgeType :: Graph -> Edge -> EdgeType
instrument g e edgeType g e@(x,y)
| p treeG = "clubkick" | p treeG = T
| p forwardG = "superpwm" | p forwardG = F
| p backG = "casio" | p backG = B
| p crossG = "amencutup" | p crossG = X
| otherwise = "sn" -- edge is (x,x) | x == y = L
| otherwise = NE
where p f = e `elem` (f g) where p f = e `elem` (f g)
-- --
instrument :: Graph -> Edge -> [Char]
instrument g e = case edgeType g e of
T -> "clubkick"
F -> "superpwm"
B -> "casio"
X -> "amencutup"
L -> "sn"
NE -> " " -- let super collider deal with it
-- complete graph -- complete graph
k n = buildG (1,n) [(u,v)|u <- [1..n],v <- [1..n]] k n = buildG (1,n) [(u,v)|u <- [1..n],v <- [1..n]]
-- path -- path
@ -79,9 +91,9 @@ t1 = buildG (1,15) [(1,4),(1,12),(4,2),(4,6),(2,8),(2,3),(6,5),(6,7),(12,10),(12
-- --
nubbeKG = buildG (0,89) [(0,1),(0,2),(0,3),(0,4),(0,5),(0,6),(0,52),(0,53),(0,54),(1,68),(1,69),(1,70),(2,71),(2,72),(2,73),(2,74),(3,75),(3,76),(3,77),(3,78),(3,79),(3,80),(3,81),(3,82),(3,83),(3,84),(3,85),(3,86),(3,87),(3,88),(3,89),(4,7),(4,8),(4,9),(4,10),(4,11),(4,12),(4,13),(4,14),(4,15),(5,60),(5,61),(5,62),(5,63),(5,64),(5,65),(5,66),(5,67),(6,55),(6,56),(6,57),(6,58),(6,59),(7,16),(7,17),(7,18),(7,19),(8,48),(8,49),(8,50),(8,51),(9,44),(9,45),(9,46),(9,47),(10,40),(10,41),(10,42),(10,43),(11,36),(11,37),(11,38),(11,39),(12,32),(12,33),(12,34),(12,35),(13,28),(13,29),(13,30),(13,31),(14,24),(14,25),(14,26),(14,27),(15,20),(15,21),(15,22),(15,23)] nubbeKG = buildG (0,89) [(0,1),(0,2),(0,3),(0,4),(0,5),(0,6),(0,52),(0,53),(0,54),(1,68),(1,69),(1,70),(2,71),(2,72),(2,73),(2,74),(3,75),(3,76),(3,77),(3,78),(3,79),(3,80),(3,81),(3,82),(3,83),(3,84),(3,85),(3,86),(3,87),(3,88),(3,89),(4,7),(4,8),(4,9),(4,10),(4,11),(4,12),(4,13),(4,14),(4,15),(5,60),(5,61),(5,62),(5,63),(5,64),(5,65),(5,66),(5,67),(6,55),(6,56),(6,57),(6,58),(6,59),(7,16),(7,17),(7,18),(7,19),(8,48),(8,49),(8,50),(8,51),(9,44),(9,45),(9,46),(9,47),(10,40),(10,41),(10,42),(10,43),(11,36),(11,37),(11,38),(11,39),(12,32),(12,33),(12,34),(12,35),(13,28),(13,29),(13,30),(13,31),(14,24),(14,25),(14,26),(14,27),(15,20),(15,21),(15,22),(15,23)]
let edgePattern g e = (n $ pure $ toEnum $ (snd e) `mod` 31) # (s $ pure $ instrument g e) let edgePattern g e = (n $ pure $ toEnum $ (snd e) `mod` 31) # (s $ pure $ instrument g e) # pI "w" (pure $ snd e) # pS "edge_type" (pure $ show $ edgeType g e)
# gain 1 # gain 1
vertexPattern g v = (scale "ritusen" $ pure $ toEnum $ (v `mod` 31) - 10) # s "supersquare" vertexPattern g v = (scale "ritusen" $ pure $ toEnum $ (v `mod` 31) - 10) # s "supersquare" # pI "vertex" (pure v)
# rate 0.1 # rate 0.1
# resonance 0.2 # resonance 0.2
# end 0.2 # end 0.2