Changeset 1388


Ignore:
Timestamp:
Oct 30, 2011, 12:06:37 PM (6 years ago)
Author:
joerg
Message:
 
File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/scripting/haskell/Trees.hs

    r1387 r1388  
    6060  | otherwise      = 1 + minimum (999 : map (depth n) (subterms term))
    6161
     62depth_lr :: String -> Term -> Int
     63depth_lr n term
     64  | n == ""        = 0
     65  | n == name term = 0
     66  | otherwise      =
     67      minimum (999 : map (\(i,t) -> depth_lr n t + (2*i - 1 - (length $ subterms term))) (zip [1..] (subterms term)))
     68
    6269occurs n term
    6370  | n == name term = True
     
    7077  | otherwise      = or $ map (nested n m) (subterms term)   
    7178
    72 data Direction = Up | Eq | Down
     79data Direction = Dec | Eq | Inc
    7380
    7481directions :: [Int] -> [Direction]
    7582directions (a:b:xs)
    76   | a < b = Down : directions (b:xs)
    77   | a > b = Up : directions (b:xs)
     83  | a < b = Inc : directions (b:xs)
     84  | a > b = Dec : directions (b:xs)
    7885  | otherwise = Eq : directions (b:xs)
    7986directions _ = []
    8087
    81 up_down :: Term -> [String] -> [(Direction,(String,(Direction,String)))]
     88up_down :: Term -> [String] -> [(String,Direction,String,Direction,String)]
    8289up_down term nodes =
    8390  let depths = map (\n -> depth n term) nodes
    84   in zip (directions $ (-1):depths) $ zip nodes $ zip (directions $ depths ++ [-1]) $ (tail nodes ++ [head nodes])
     91      zip5 (a:as) (b:bs) (c:cs) (d:ds) (e:es) = (a,b,c,d,e) : zip5 as bs cs ds es
     92      zip5 _ _ _ _ _ = []
     93  in zip5
     94      ("" : nodes)
     95      (directions $ (-1):depths)
     96      nodes
     97      (directions $ depths ++ [-1])
     98      (tail nodes ++ [head nodes])
    8599
    86100north_east n = "($(" ++ n ++ ".north east) + (.7mm,-.7mm)$)"
     
    90104south n = "($(" ++ n ++ ".south) + (0mm,-1mm)$)"
    91105north n = "($(" ++ n ++ ".north) + (0mm,1mm)$)"
     106west n = "($(" ++ n ++ ".west) + (-1mm,0mm)$)"
     107east n = "($(" ++ n ++ ".east) + (1mm,0mm)$)"
    92108on_way_left p n = "($(" ++ p ++ ") !.15! 270:(" ++ n ++ ") !.4! (" ++ n ++ ")$)"
    93109on_way_right p n = "($(" ++ p ++ ") !.15! 90:(" ++ n ++ ") !.4! (" ++ n ++ ")$)"
     
    96112renderHighlight tree highlight =
    97113  let root = head $ nodes highlight
     114      lst = last $ nodes highlight
    98115  in
    99116  "\\draw [rounded corners=1.5mm] " ++ style highlight ++ " " ++
    100117  -- root
    101   south_east root ++ " -- " ++ north_east root ++ " -- " ++ north root ++ " -- " ++
     118  (if depth_lr lst tree <= depth_lr root tree
     119   then south_east root ++ " -- "
     120   else east root ++ " -- ") ++
     121  north_east root ++ " -- " ++ north root ++ " -- " ++
    102122  -- remaining path
    103123  renderHighlight_ tree (up_down tree $ nodes highlight)
    104124
    105125renderHighlight_ tree [] = "cycle;"
    106 --south p ++ " -- " ++ south_east p ++ " -- " ++ north_east p ++ " -- cycle;"
    107 renderHighlight_ tree ((d1,(n,(d2,nn))):ns) =
     126renderHighlight_ tree ((pn,d1,n,d2,nn):ns) =
    108127  (case d1 of
    109      Down -> north_west n ++ " -- " ++ south_west n ++ " -- " ++
     128     Inc ->  (if depth_lr pn tree >= depth_lr n tree
     129               then north_west n ++ " -- "
     130               else west n ++ " -- ") ++
    110131             case d2 of
    111                Down -> ""
     132               Inc -> if depth_lr nn tree >= depth_lr n tree
     133                      then south_west n ++ " -- "
     134                      else if depth_lr pn tree >= depth_lr n tree
     135                           then west n ++ " -- "
     136                           else ""
     137               Eq   -> south_west n ++ " -- " ++ south n ++ " -- " ++ south_east n ++ " -- "
     138               Dec   -> south_west n ++ " -- " ++ south n ++ " -- " ++ south_east n ++ " -- " ++
     139                        if depth_lr n tree >= depth_lr nn tree
     140                        then north_east n ++ " -- "
     141                        else ""
     142             ++ on_way_left n nn ++ " -- " ++ on_way_right nn n ++ " -- "
     143     Eq  ->  south_west n ++ " -- " ++
     144             case d2 of
     145               Inc -> ""
    112146               Eq   -> south n ++ " -- " ++ south_east n ++ " -- "
    113                Up   -> south n ++ " -- " ++ south_east n ++ " -- " ++ north_east n ++ " -- "
     147               Dec   -> south n ++ " -- " ++ south_east n ++ " -- " ++ north_east n ++ " -- "
    114148             ++ on_way_left n nn ++ " -- " ++ on_way_right nn n ++ " -- "
    115      Eq   -> south_west n ++ " -- " ++
    116              case d2 of
    117                Down -> ""
    118                Eq   -> south n ++ " -- " ++ south_east n ++ " -- "
    119                Up   -> south n ++ " -- " ++ south_east n ++ " -- " ++ north_east n ++ " -- "
    120              ++ on_way_left n nn ++ " -- " ++ on_way_right nn n ++ " -- "
    121      Up   -> case d2 of
    122                Down -> ""
    123                Eq   -> south_east n ++ " -- "
    124                Up   -> south_east n ++ " -- " ++ north_east n ++ " -- "
     149     Dec ->  case d2 of
     150               Inc -> ""
     151               Eq  -> south_east n ++ " -- "
     152               Dec -> if depth_lr pn tree <= depth_lr n tree
     153                      then south_east n ++ " -- "
     154                      else east n ++ " -- " ++
     155                           if depth_lr n tree >= depth_lr nn tree
     156                           then north_east n ++ " -- "
     157                           else ""
    125158             ++ on_way_left n nn ++ " -- " ++ on_way_right nn n ++ " -- "
    126159  ) ++ renderHighlight_ tree ns
Note: See TracChangeset for help on using the changeset viewer.