1. Куча / Говнокод #12476

    +124

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    buildTree sentence graph =
        (M.lookup (0, length sentence - 1, DirLeft) finalGraph, finalGraph)
        where finalGraph = execState runEisner (M.fromList elementaryPathes)
              elementaryPathes =
                 map (\(i, word) -> ((i, i, DirLeft), elementaryPath DirLeft word)) indexed ++
                 map (\(i, word) -> ((i, i, DirRight), elementaryPath DirRight word)) indexed
              indexed = zip [0..] sentence
    
              runEisner = do
                  let len = length sentence
                  forM_ [1 .. len - 1] $ \l -> do
                      forM [0 .. len - 1 - l] $ \i -> do
                          matrix <- get
                          let j = i + l
                          let w1 = sentence !! i
                          let w2 = sentence !! j
    
                          let buildConcat dir = (catMaybes $ (zipWith (\p1 p2 -> join $ (liftM2 concatenatePath) p1 p2)
                                                [M.lookup (i, k, dir) matrix | k <- [i + 1 .. j - 1]]
                                                [M.lookup (k, j, dir) matrix | k <- [i + 1 .. j - 1]])) :: [Path]
    
                          let buildJoin dir key = fromMaybe [] $ M.lookup key graph >>= \link ->
                                                  return (catMaybes (zipWith (\p1 p2 -> join $ (liftM2 (\f c -> joinPath f c link)) p1 p2)
                                                  [M.lookup (i, k, dir) matrix | k <- [i .. j - 1]]
                                                  [M.lookup (k, j, rev dir) matrix | k <- [i + 1 .. j]]))
    
                          let posR = (buildConcat DirRight ++ buildJoin DirRight (w1, w2)) :: [Path]
    
                          let newMatrix = if (not . null) posR
                                              then M.insert (i, j, DirRight) (minimumBy compWeight posR) matrix
                                              else matrix
    
                          let posL = buildConcat DirLeft ++ buildJoin DirRight (w2, w1)
    
                          let newMatrix' = if (not . null) posL
                                               then M.insert (i, j, DirLeft) (minimumBy compWeight posL) matrix
                                               else newMatrix
    
                          put newMatrix'

    Кусок из диплома по NLP. Yuuri неделю как познал монаду State и сделал двумерный императивный цыкл.

    Запостил: Yuuri, 25 Января 2013

    Комментарии (5) RSS

    • >NLP
      Neuro linguistic programming?
      Ответить
      • NeedLess Programming
        а вообще Natural Language
        Ответить
        • Все просто заходят в раздел Хацкеля, видят, что код на хацкеле, а значит априори говнокд и плюсуют.
          Ответить
          • Ну в общем, на то и расчёт! Хотя этот конкретный кусок правда говнокод.
            Ответить
      • >Neuro
        Necro
        Ответить

    Добавить комментарий