Subscribed unsubscribe Subscribe Subscribe

Haskellで近傍探索

プログラミング
import List
import Ratio

data Tree a = Leaf [[Bool]]
            | Node ([Bool],Ratio Int) (Tree a) (Tree a) deriving Show

(<->) :: [Bool] -> [Bool] -> [Bool]
x <-> y = zipWith (==) x y

truthValue :: [Bool] -> Ratio Int
truthValue [] = 0
truthValue x = (length . elemIndices True) x % length x

dist :: [Bool] -> [Bool] -> Ratio Int
dist x y = 1 - truthValue (x <-> y)

sortByDist :: [Bool] -> [[Bool]] -> [[Bool]]
sortByDist _ []     = []
sortByDist t (x:xs) = sortByDist t [y | y <- xs, dist t y < dist t x]
                    ++ [x]
                    ++ sortByDist t [y | y <- xs, dist t y >= dist t x]

buildTree :: [[Bool]] -> Tree a
buildTree x = if length x == 1
              then Leaf x
              else Node (t,d) (buildTree l) (buildTree r)
    where sorted = sortByDist (head x) x
          (l,r) = splitAt (length sorted `div` 2) sorted
          t = head l
          d = dist t (last l)

-- テストデータ
e = [[False,True,False,True,False,True],
     [True,True,False,True,False,True],
     [False,True,False,False,True,False],
     [True,True,True,False,True,False],
     [True,False,False,True,False,False],
     [False,False,True,False,True,True],
     [False,True,False,False,True,False],
     [False,False,False,False,True,False],
     [False,True,False,False,False,True],
     [False,True,False,False,True,False]]

tree = buildTree e -- 探索木

main :: IO ()
main = do
  putStrLn $ show tree

とりあえず探索木の構築まで.続きは明日やる.