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

    • ava LispGovno 25.01.2013 15:29 # +4

      >NLP
      Neuro linguistic programming?
      Ответить

      • ava Yuuri 25.01.2013 15:42 # +4

        NeedLess Programming
        а вообще Natural Language
        Ответить

        • ava LispGovno 25.01.2013 16:17 # 0

          Все просто заходят в раздел Хацкеля, видят, что код на хацкеле, а значит априори говнокд и плюсуют.
          Ответить

          • ava Yuuri 25.01.2013 16:23 # 0

            Ну в общем, на то и расчёт! Хотя этот конкретный кусок правда говнокод.
            Ответить

      • ava absolut 25.01.2013 16:52 # 0

        >Neuro
        Necro
        Ответить

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