]> gerrit.simantics Code Review - simantics/platform.git/blob - tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/Search.scl
Supply SVG text editor with element measurement context
[simantics/platform.git] / tests / org.simantics.scl.compiler.tests / src / org / simantics / scl / compiler / tests / scl / Search.scl
1 import "Prelude" hiding (findFirst)
2
3 infinity = 1e9
4
5 @inline
6 findFirst :: (a -> <e> Maybe b) -> [a] -> <e> Maybe b
7 findFirst f l = loop 0
8   where
9     len = length l
10     loop i                         
11         | i >= len  = Nothing
12         | otherwise = match f (l!i) with
13                         s @ (Just _) -> s
14                         Nothing      -> loop (i+1)
15
16 dfsFirst :: (a -> <e> Boolean) -> (a -> <e> [a]) -> [a] -> <e> (Maybe a)
17 dfsFirst acceptable successors initial = tryAll initial
18   where
19     tryAll l = findFirst loop l
20     loop p 
21         | acceptable p = Just p
22         | otherwise    = tryAll (successors p)
23
24 data Weighted a = Weighted a Double
25
26 //type SearchAlgorithm e a =
27 //    (a -> <e> Boolean) -> (a -> <e> [Weighted a]) -> [Weighted a] -> <e> Weighted (Maybe a)
28     
29 //dfs :: SearchAlgorithm e a
30 dfs :: (a -> <e> Boolean) -> (a -> <e> [Weighted a]) -> [Weighted a] -> <e> Weighted (Maybe a)
31 dfs acceptable successors initial = foldl loop (Weighted Nothing infinity) initial
32   where
33     loop best@(Weighted _ bestW) (Weighted p w)
34         | w >= bestW   = best
35         | acceptable p = Weighted (Just p) w
36         | otherwise    = foldl loop best
37                        $ map (\(Weighted p' w') -> Weighted p' (w+w'))
38                        $ successors p
39
40 /*
41 bfs :: SearchAlgorithm e a
42
43 aStar :: (a -> <e> Double) -> SearchAlgorithm e a
44 */
45 main = "Hello"
46 --
47 Hello