diff --git a/src/runtime/haskell/PGF/VisualizeTree.hs b/src/runtime/haskell/PGF/VisualizeTree.hs index d1e188495..4ba605432 100644 --- a/src/runtime/haskell/PGF/VisualizeTree.hs +++ b/src/runtime/haskell/PGF/VisualizeTree.hs @@ -500,7 +500,6 @@ data Dep = Dep { , tokens :: [(String,String)] -- word, pos (0..) , deps :: [((Int,Int),String)] -- from, to, label , root :: Int -- root word position - , pictureSize :: (Int,Int) -- width = #words*wordlength } -- some general measures @@ -515,7 +514,7 @@ wdist rwld x y = sum [wsize rwld i | i <- [min x y .. max x y - 1]] -- distan labelheight h = h + arcbase + 3 -- label just above arc; 25 would put it just below labelstart c = c - 15.0 -- label starts 15u left of arc centre arcbase = 30.0 -- arcs start and end 40u above the bottom -arcfactor r = r * 500 -- reduction of arc size from word distance +arcfactor r = r * 600 -- reduction of arc size from word distance xyratio = 3 -- width/height ratio of arcs putArc :: (Int -> Double) -> Int -> Int -> Int -> String -> String @@ -526,7 +525,7 @@ putArc frwld height x y label = unlines [oval,arrowhead,labelling] where dxy = wdist frwld x y -- distance between words, >>= 20.0 ndxy = 100 * rwld * fromIntegral height -- distance that is indep of word length hdxy = dxy / 2 -- half the distance - wdth = dxy - (arcfactor rwld)/dxy -- longer arcs are less wide in proportion + wdth = dxy - (arcfactor rwld)/dxy -- longer arcs are wider in proportion hght = ndxy / (xyratio * rwld) -- arc height is independent of word length begp = min x y -- begin position of oval ctr = wpos frwld begp + hdxy + (if x < y then 20 else 10) -- LR arcs are farther right from center of oval @@ -545,7 +544,6 @@ dep2latex d = ++ [put (wpos rwld (root d) + 20) (height - 10) (small "ROOT")] ++ ["\\end{picture}"] where - (width,height) = case pictureSize d of (w,h) -> (w, h) wld i = wordLength d i -- >= 20.0 rwld i = (wld i) / defaultWordLength -- >= 1.0 aheight x y = depth (min x y) (max x y) + 1 ---- abs (x-y) @@ -553,40 +551,8 @@ dep2latex d = depth x y = case [(u,v) | (u,v) <- arcs, (x < u && v <= y) || (x == u && v < y)] of ---- only projective arcs counted [] -> 0 uvs -> 1 + maximum [depth u v | (u,v) <- uvs] - - - -{- -dep2latex :: Dep -> [String] -dep2latex d = - comment (unwords (map fst (tokens d))) - : app "setlength{\\unitlength}" (show defaultUnit ++ "mm") - : ("\\begin{picture}(" ++ show width ++ "," ++ show height ++ ")") - : [put (wpos rwld i) 0 w | (i,w) <- zip [0..] (map fst (tokens d))] -- words - ++ [put (wpos rwld i) 15 (small w) | (i,w) <- zip [0..] (map snd (tokens d))] -- pos tags 15u above bottom - ++ [putArc rwld x y label | ((x,y),label) <- (deps d)] -- arcs and labels - ++ [put (wpos rwld (root d) + 15) height (app "vector(0,-1)" (show (fromIntegral height-arcbase)))] - ++ [put (wpos rwld (root d) + 20) (height - 10) (small "ROOT")] - ++ ["\\end{picture}"] - where - (width,height) = case pictureSize d of (w,h) -> (w, h) - wld = wordLength d -- >= 20.0 - rwld i = wld i / defaultWordLength -- >= 1.0 - -putArc :: (Int -> Double) -> Int -> Int -> String -> String -putArc rwld x y label = unlines [oval,arrowhead,labelling] where - oval = put ctr arcbase ("\\oval(" ++ show wdth ++ "," ++ show hght ++ ")[t]") - arrowhead = put endp (arcbase + 5) (app "vector(0,-1)" "5") -- downgoing arrow 5u above the arc base - labelling = put (labelstart ctr) (labelheight (hght/2)) (small label) - dxy = wdist rwld x y -- distance between words, >>= 20.0 - hdxy = dxy / 2 -- half the distance - wdth = dxy - (arcfactor wrwld)/dxy -- longer arcs are less wide in proportion - hght = dxy / (xyratio * wrwld) -- arc height is independent of word length - begp = min x y -- begin position of oval - ctr = wpos rwld begp + hdxy + (if x < y then 20 else 10) -- LR arcs are farther right from center of oval - endp = (if x < y then (+) else (-)) ctr (wdth/2) -- the point of the arrow - wrwld = wdist rwld x y / defaultWordLength --} + width = round (sum [wsize rwld w | (w,_) <- zip [0..] (tokens d)]) + round spaceLength * ((length (tokens d)) - 1) + height = 40 + 20 * round (maximum [aheight x y | ((x,y),_) <- deps d]) conll2dep :: String -> Dep conll2dep str = Dep { @@ -594,16 +560,13 @@ conll2dep str = Dep { , tokens = toks , deps = dps , root = head $ [read x-1 | x:_:_:_:_:_:"0":_ <- ls] ++ [1] - , pictureSize = (totallength, 60 + 16*maxdist) -- highest arc + 60u } where wld i = maximum [charWidth * fromIntegral (length w) | w <- let (tok,pos) = toks !! i in [tok,pos]] ls = map words (lines str) toks = [(w,c) | _:w:_:c:_ <- ls] dps = [((read y-1, read x-1),lab) | x:_:_:_:_:_:y:lab:_ <- ls, y /="0"] - rwld w = wld w / defaultWordLength maxdist = maximum [abs (x-y) | ((x,y),_) <- dps] - totallength = round (sum [wsize rwld w | (w,_) <- zip [0..] toks]) + round spaceLength * ((length toks) - 1) -- latex formatting