Commit ab5eb83e47d638a7223baf38208e45545f691f22

classification stuff
l10-moments.hs
(10 / 8)
  
9494margin = 5
9595-- plot x scale
9696
97knear kd p = map fst $ KD.kNearestNeighbors kd 15 p
97knear kd k p = map fst $ KD.kNearestNeighbors kd k p
9898
9999readData :: FilePath -> IO [HuFeature]
100100readData p = do
166166 qps = signalToPixel (100,100) 2 (4,4) (-2) $ map (randomProject b) qran
167167 tps = signalToPixel (100,100) 2 (4,4) (-2) $ map (randomProject b) tran
168168
169replaceClass c (_,f) = (c,f)
170
169171main = do
170172 (nbins,inv,inputImage, outputImage) <- readArgs
171173 cf <- readData "circles.dat"
190190 thist = accBoundedVectorHistogram (xmins,xmaxs) 300 $ map huToList tf
191191 ctest = take 25 cf
192192 ctrain = drop 25 cf
193 qtest = take 25 qf
194 qtrain = drop 25 qf
195 ttest = take 25 tf
196 ttrain = drop 25 tf
193 qtest = map (replaceClass 1) $ take 25 qf
194 qtrain = map (replaceClass 1) $ drop 25 qf
195 ttest = map (replaceClass 2) $ take 25 tf
196 ttrain = map (replaceClass 2) $ drop 25 tf
197197 kd = KD.fromList (ctrain ++ qtrain ++ ttrain)
198198 --b = sparseRandomBasis
199199 b = gaussianRandomBasis
226226 --print xmins
227227 --print xmaxs
228228 print $ map (\xs -> (head xs, length xs)) $ group $ L.sort $
229 concatMap (knear kd) ctest
229 concatMap (knear kd 5) ctest
230230 print $ map (\xs -> (head xs, length xs)) $ group $ L.sort $
231 concatMap (knear kd) qtest
231 concatMap (knear kd 5) qtest
232232 print $ map (\xs -> (head xs, length xs)) $ group $ L.sort $
233 concatMap (knear kd) ttest
233 concatMap (knear kd 5) ttest
234234 let
235235 cimgs = map (\h -> plotHistogram black margin h clear) chist
236236 qimgs = map (\h -> plotHistogram black margin h clear) qhist
l10-zernike.hs
(32 / 1)
  
1010
1111import ReadArgs
1212import System.IO.Unsafe
13import Control.Applicative
1314
1415pixelToRadial :: (Int,Int) -> Int -> ((Int,Int),Float)
1516 -> ((Int,Int),(Float,Float),Float)
9797 r = min cx cy
9898 rp = map (pixelToRadial (cx,cy) r) $ getPixels img
9999
100px x y = iToF $ x
101py x y = iToF $ y
102px2 x y = (iToF x)**2
103py2 x y = (iToF y)**2
104pxy x y = iToF $ x*y
105px3 x y = (iToF x)**3
106px2y x y = (iToF x)**2 * (iToF y)
107pxy2 x y = (iToF x) * (iToF y)**2
108py3 x y = (iToF y)**3
109
110pixelToPoly f ((x,y),v) = ((x,y), f x y)
111
112drawPoly rp img = unsafePerformIO $ do
113 mimg <- toMutable img
114 mapM_ (setP mimg) rp
115 unitNormalize <$> fromMutable mimg
116 where
117 setP mimg ((x,y),v) = setPixel (x,y) v mimg
118
100119drawRadial rp img = unsafePerformIO $ do
101120 mimg <- toMutable img
102121 mapM_ (setR mimg) rp
158158 rp = map (pixelToRadial (50,50) 50) $ getPixels clear
159159 r n m = unitNormalize $ drawRadialRe n m rp clear
160160 i n m = unitNormalize $ drawRadialIm n m rp clear
161 saveImage outputImage $ unitNormalize zr
161 saveImage outputImage $ montage (3,3) 2 $
162 [ drawPoly (map (pixelToPoly px) $ getPixels clear) clear
163 , drawPoly (map (pixelToPoly py) $ getPixels clear) clear
164 , drawPoly (map (pixelToPoly px2) $ getPixels clear) clear
165 , drawPoly (map (pixelToPoly pxy) $ getPixels clear) clear
166 , drawPoly (map (pixelToPoly py2) $ getPixels clear) clear
167 , drawPoly (map (pixelToPoly px3) $ getPixels clear) clear
168 , drawPoly (map (pixelToPoly px2y) $ getPixels clear) clear
169 , drawPoly (map (pixelToPoly pxy2) $ getPixels clear) clear
170 , drawPoly (map (pixelToPoly py3) $ getPixels clear) clear
171 ]
172 --saveImage outputImage $ unitNormalize zr
162173 saveImage "zre.png" $ montage (11,6) 2 $
163174 [ clear, clear, clear, clear, clear,(r 0 0), clear, clear, clear, clear, clear
164175 , clear, clear, clear, clear,(r 1 (-1)),(r 1 0),(r 1 1), clear, clear, clear, clear
l11-knn.hs
(37 / 0)
  
1module Main where
2
3import Moments
4
5import Data.List as L
6import qualified Data.ByteString as B
7import Data.Serialize as S
8import Data.Trees.KdTree as KD
9
10knear kd k p = map fst $ KD.kNearestNeighbors kd k p
11
12readData :: FilePath -> IO [HuFeature]
13readData p = do
14 cb <- B.readFile p
15 case S.decode cb of
16 Left e -> error e
17 Right cs -> return cs
18
19main = do
20 cf <- readData "circles.dat"
21 qf <- readData "quads.dat"
22 tf <- readData "triangles.dat"
23 let
24 ctest = take 25 cf
25 ctrain = drop 25 cf
26 qtest = take 25 qf
27 qtrain = drop 25 qf
28 ttest = take 25 tf
29 ttrain = drop 25 tf
30 kd = KD.fromList (ctrain ++ qtrain ++ ttrain)
31 k = 15
32 print $ map (\xs -> (head xs, length xs)) $ group $ L.sort $
33 concatMap (knear kd k) ctest
34 print $ map (\xs -> (head xs, length xs)) $ group $ L.sort $
35 concatMap (knear kd k) qtest
36 print $ map (\xs -> (head xs, length xs)) $ group $ L.sort $
37 concatMap (knear kd k) ttest
l11-neuralnet.hs
(114 / 0)
  
1module Main where
2
3import AI.ScomaNN.MLP as MLP
4
5import Control.Monad
6import Control.Applicative
7import System.Random.MWC
8import System.Random
9import System.Random.Shuffle
10import System.Directory
11import System.FilePath
12import qualified Data.ByteString as B
13import Data.Serialize as S
14import Data.List as L
15import Data.Ord
16import Text.Printf
17
18import BasicUtils
19import Moments
20import Random
21
22randomShuffle :: [a] -> [a]
23randomShuffle is = shuffle' is (length is) (mkStdGen 41234)
24
25huToFeat (c,(h1,h2,h3,h4,h5,h6,h7,h8)) =
26 ([h1,h2,h3,h4,h5,h6,h7,h8],cToVec c)
27 where
28 cToVec 0 = [1,0,0]
29 cToVec 1 = [0,1,0]
30 cToVec 2 = [0,0,1]
31
32readData :: FilePath -> IO [HuFeature]
33readData p = do
34 cb <- B.readFile p
35 case S.decode cb of
36 Left e -> error e
37 Right cs -> return cs
38
39runMLP :: MLP.MLP -> ([Double],[Double]) -> (Int,Bool,Double)
40runMLP mlp (input,target) = check (findBest $ MLP.feed mlp input, findBest $ target)
41 where
42 check ((c1,v1):(_,v2):_, (c2,_):_) = (c2,c1==c2,v1-v2)
43 findBest o = reverse $ L.sortBy (comparing snd) $ zip [0..] o
44 thresh = map t
45 t :: Double -> Int
46 t v | v > 0.3 = 1
47 | otherwise = 0
48
49summarize rs = map (norm.(foldr combine (0,0,0,0))) $
50 groupBy (fst3eq) $ sortBy (comparing fst3) rs
51 where
52 fst3 (a,_,_) = a
53 fst3eq (a1,_,_) (a2,_,_) = a1 == a2
54 combine (c,t,d) (_,tp,n,td)
55 | t = (c,tp+1,n+1,td+d)
56 | otherwise = (c,tp, n+1,td+d)
57 norm (c,tp,n,td) = (c,tp,n,td / (fromIntegral n))
58
59bestRandomStart m r nstarts traindata = do
60 let
61 seeds = map round $ getUniformVector 1 1000000 nstarts
62 inputs = map fst traindata
63 targets = map snd traindata
64 weights = replicate (length inputs) [1]
65 config s = MLPConfig [8,m,3] s r 0.00001 10000
66 configs = map config seeds
67 trainMLP i o w c = MLP.train c i o w
68 minimumBy (comparing snd) <$> mapM (trainMLP inputs targets weights) configs
69
70replaceClass c (_,f) = (c,f)
71
72testLayers r nstarts traindata testdata m = do
73 (mlp,fval) <- bestRandomStart m r nstarts traindata
74 print m
75 print fval
76 print $ summarize $ map (runMLP mlp) testdata
77
78testReg m nstarts traindata testdata r = do
79 (mlp,fval) <- bestRandomStart m r nstarts traindata
80 print r
81 print fval
82 print $ summarize $ map (runMLP mlp) testdata
83 tval <- MLP.test mlp (map fst testdata) (map snd testdata)
84 (replicate (length testdata) [1])
85 print tval
86
87main = do
88 cf <- readData "circles.dat"
89 qf <- readData "quads.dat"
90 tf <- readData "triangles.dat"
91 let
92 ctest = take 25 cf
93 ctrain = drop 25 cf
94 qtest = take 25 qf
95 qtrain = drop 25 qf
96 ttest = take 25 tf
97 ttrain = drop 25 tf
98 traindata :: [([Double],[Double])]
99 traindata = randomShuffle $ map huToFeat (ctrain ++ qtrain ++ ttrain)
100 testdata :: [([Double],[Double])]
101 testdata = map huToFeat (ctest ++ qtest ++ ttest)
102 -- for running individual tests
103 --(mlp,fval) <- bestRandomStart 1 0.001 1 traindata
104 --print fval
105 --tval <- MLP.test mlp (map fst testdata) (map snd testdata)
106 -- (replicate (length testdata) [1])
107 --print tval
108 -- for finding the best layer size
109 --mapM_ (testLayers 0.001 5 traindata testdata) $
110 -- [1,2,3,4,5,6,7,8]
111 -- [8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24]
112 -- for finding the best regularization coefficient
113 mapM_ (testReg 5 5 traindata testdata) $
114 [0.5,0.1,0.05,0.01,0.005,0.001,0.0005,0.0001]