-
Notifications
You must be signed in to change notification settings - Fork 0
/
pathManipulation.lhs
121 lines (98 loc) · 3.57 KB
/
pathManipulation.lhs
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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
This is going to be an illustration for how paths can be combined or be changed.
compile with
runhaskell pathManipulation.lhs -o pathManipulation.svg -h 500
look at it with
firefox pathManipulation.svg
> {-# LANGUAGE NoMonomorphismRestriction #-}
>
Imports for Diagrams
> import Diagrams.Prelude
> -- import Diagrams.Backend.SVG.CmdLine
> import Diagrams
Other imports
> import Data.List
> type Tour = [Int]
> type RichTour = (Int, [Int], Tour, [(Int, Int)], [(Int, Int)])
Main funktion: Try to read a List of paths and paint the Diagram of the Mutation or the crossover
> main = do
> input <- getLine
> let tourLists = ((read input) :: [[RichTour]])
> mainWith (makeTournament tourLists)
Mutation and Crossover get different funktions
A Mutation has 1 before and 1 after, A Crossover has many befores and 1 after
> makeTournament :: [[RichTour]] -> Diagram B R2
> makeTournament = (concatY) . map (concatX) . map (map tournament)
Like ||| but better (for me) and for ists
> concatX :: [Diagram B R2] -> Diagram B R2
> concatX list =
> translateX (
> ( * (1 + circleRadius + 0.5))
> . ((-) 1)
> $ listLength
> )
> . foldl1 (|||)
> . intersperse (strutX 1)
> $ list
> where
> listLength :: Double
> listLength = fromIntegral . length $ list
Like === but better (for me) and for Lists
> concatY :: [Diagram B R2] -> Diagram B R2
> concatY list =
> foldl1 (===)
> . intersperse
> (
> strutY 0.3
> ===
> hrule (listLength * 1.2 * (1 + circleRadius))
> ===
> strutY 0.5
> )
> $ list
> where
> listLength :: Double
> listLength = fromIntegral . length $ list
A circle wirh a number in it. The name is the number. The radius is the circleRadius
> node :: Bool -> Int -> Diagram B R2
> node special n = text (show n)
> # fontSize (Global 0.17) -- this numbers get really smal in pdf, but not in svg. Weired. perhaps the backend cairo is better then svg.
> # fontSizeN 0.05 -- why do I have Fontsize twice?
> # fc black
> <> circle circleRadius
> # fc white
> # lc (if special then red else black)
> # named n
>
>
> circleRadius :: Double
> circleRadius = 0.17
I don't want arrowheads or any decoration - fix this when I have Internet
>
> arrowOptsSimple = with -- & gaps .~ small
> & arrowHead .~ noHead
>
> arrowOptsDashed = with -- & gaps .~ small
> & arrowHead .~ noHead
> & shaftStyle %~ dashingG [0.04, 0.02] 0
>
> tournament :: RichTour -> Diagram B R2
> tournament (n, specialNodes, path, invisibles, dashed) =
> decorateTrail myPolygon (nodeList n specialNodes)
> -- # applyAll [connectOutside' arrowOptsSimple j k | (j,k) <- pathpairs]
> # applyAll [connectOutside' arrowOptsSimple j k | (j,k) <- pathpairs, not $ (j,k) `elem` (invisibles ++ dashed)]
> # applyAll [connectOutside' arrowOptsDashed j k | (j,k) <- dashed] -- dashed
> -- # translate (r2 (0.5, -0.5))
> # translate (fromDirection ((1/(fromIntegral n)) @@ rad))
> -- # showOrigin
> where
> pathpairs :: [(Int, Int)]
> pathpairs = zip path (tail path)
>
> nodeList :: Int -> [Int] -> [Diagram B R2]
> nodeList maxNode specialNodes = zipWith node (map (`elem` specialNodes) [1..maxNode]) [1..maxNode]
>
> --Seitenlaenge 1
> --myPolygon = regPoly n 1
> -- radius 1
> myPolygon = polygon $ PolygonOpts (PolyRegular n 1) OrientH origin
>