```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 ``` ```------------------------------------------------------------------------------ --- Implements additional traversals on search trees. --- --- @author Sebastian Fischer --- @version February 2016 --- @category algorithm ------------------------------------------------------------------------------ module SearchTreeTraversal ( depthDiag, rndDepthDiag, levelDiag, rndLevelDiag, rndLevelDiagFlat ) where import List ( diagonal ) import Random ( nextInt, nextIntRange, shuffle ) import SearchTree --- Splits a random seeds into new seeds. --- The range avoids large negative seeds (which cause problems with PAKCS). split :: Int -> [Int] split n = nextIntRange n 2147483648 --- diagonalized depth first search. --- --- @param t search tree --- @return enumeration of values in given search tree --- depthDiag :: SearchTree a -> [a] depthDiag t = [ x | Value x <- dfsDiag t ] dfsDiag :: SearchTree a -> [SearchTree a] -- dfsDiag Suspend = [] dfsDiag (Fail _) = [] dfsDiag t@(Value _) = [t] dfsDiag (Or t1 t2) = diagonal (map dfsDiag [t1,t2]) --- randomized variant of diagonalized depth first search. --- --- @param t search tree --- @return enumeration of values in given search tree --- rndDepthDiag :: Int -> SearchTree a -> [a] rndDepthDiag rnd t = [ x | Value x <- rndDfsDiag rnd t ] rndDfsDiag :: Int -> SearchTree a -> [SearchTree a] -- rndDfsDiag _ Suspend = [] rndDfsDiag _ (Fail _) = [] rndDfsDiag _ t@(Value _) = [t] rndDfsDiag rnd (Or t1 t2) = diagonal (zipWith rndDfsDiag rs (shuffle r [t1,t2])) where r:rs = split rnd --- diagonalization of devels. --- --- @param t search tree --- @return enumeration of values in given search tree --- levelDiag :: SearchTree a -> [a] levelDiag t = [ x | Value x <- diagonal (levels [t]) ] levels :: [SearchTree a] -> [[SearchTree a]] levels ts | null ts = [] | otherwise = ts : levels [ u | Or u1 u2 <- ts, u <- [u1,u2] ] --- randomized diagonalization of levels. --- --- @param t search tree --- @return enumeration of values in given search tree --- rndLevelDiag :: Int -> SearchTree a -> [a] rndLevelDiag rnd t = [ x | Value x <- diagonal (rndLevels rnd [t]) ] rndLevels :: Int -> [SearchTree a] -> [[SearchTree a]] rndLevels rnd ts | null ts = [] | otherwise = ts : rndLevels r (concat (zipWith shuffle rs [ [u1,u2] | Or u1 u2 <- ts ])) where r:rs = split rnd --- randomized diagonalization of levels with flattening. rndLevelDiagFlat :: Int -> Int -> SearchTree a -> [a] rndLevelDiagFlat d rnd t = concat \$ transpose (zipWith rndLevelDiag rs (flatRep d [t])) where rs = split rnd flat :: SearchTree a -> [SearchTree a] flat t@(Value _) = [t] flat (Fail _) = [] -- pretend Fail ~ Or [] flat (Or t1 t2) = [t1,t2] flatRep :: Int -> [SearchTree a] -> [SearchTree a] flatRep n ts | n==0 = ts | otherwise = flatRep (n-1) (concatMap flat ts) -- auxiliary functions transpose :: [[a]] -> [[a]] transpose [] = [] transpose ([] : xss) = transpose xss transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [t | (_:t) <- xss]) ```