Permalink
Browse files

Big improvements to test driver

  • Loading branch information...
1 parent e30097f commit e523e4f7d0c133cc60edf857f62efd515ec8e4a3 @batterseapower committed Sep 13, 2008
Showing with 73 additions and 15 deletions.
  1. +73 −15 Algorithms/MachineLearning/Tests/Driver.hs
@@ -1,8 +1,9 @@
-module Main where
+module Main (main) where
import Algorithms.MachineLearning.BasisFunctions
import Algorithms.MachineLearning.Framework
import Algorithms.MachineLearning.LinearAlgebra
+import Algorithms.MachineLearning.LinearClassification
import Algorithms.MachineLearning.LinearRegression
import Algorithms.MachineLearning.Tests.Data
import Algorithms.MachineLearning.Utilities
@@ -22,36 +23,93 @@ basisFunctions
= gaussianBasisFamily (map rationalToDouble [-1,-0.5..1]) 0.09
-- = gaussianBasisFamily (map rationalToDouble [-1,-0.9..1]) 0.04
-sumOfSquaresError :: [(Double, Double)] -> Double
-sumOfSquaresError targetsAndPredictions = sum $ map (abs . uncurry (-)) targetsAndPredictions
+basisFunctions2D :: [(Double, Double) -> Double]
+basisFunctions2D = map ((. \(x, y) -> fromList [x, y])) $ multivariateIsotropicGaussianBasisFamily [fromList [x, y] | x <- range, y <- range] 0.1
+ where range = map rationalToDouble [-1,-0.8..1]
-sampleFunction :: (Double -> Double) -> [(Double, Double)]
-sampleFunction f = map (\(x :: Rational) -> let x' = rationalToDouble x in (x', f x')) [0,0.01..1.0]
+sampleFunction :: (Double -> a) -> [(Double, a)]
+sampleFunction f = map (\(x :: Rational) -> let x' = rationalToDouble x in (x', f x'))
+ [0,0.01..1.0]
-evaluate :: (Model model Double Double, Show model) => model -> DataSet Double Double -> IO ()
+sampleFunction2D :: ((Double, Double) -> a) -> [((Double, Double), a)]
+sampleFunction2D f = map (\((x, y) :: (Rational, Rational)) -> let x' = rationalToDouble x; y' = rationalToDouble y in ((x', y'), f (x', y')))
+ [(x, y) | x <- [-1.0,-0.99..1.0], y <- [-1.0,-0.99..1.0]]
+
+evaluate :: (Vectorable input, Vectorable target, Model model input target, MetricSpace target) => model -> DataSet input target -> IO ()
evaluate model true_data = do
- putStrLn $ "Target Mean = " ++ show (vectorMean (head $ toRows $ ds_targets true_data))
+ putStrLn $ "Target Raw Means = " ++ show (map vectorMean (toColumns $ ds_targets true_data))
putStrLn $ "Error = " ++ show (modelSumSquaredError model true_data)
plot :: [[(Double, Target)]] -> IO ()
plot sampless = do
plotPaths [EPS "output.ps"] (map (sortBy (comparing fst)) sampless)
void $ rawSystem "open" ["output.ps"]
-main :: IO ()
-main = do
+plotClasses :: [((Double, Double), Class)] -> IO ()
+plotClasses classess = do
+ let -- Utilize a hack to obtain color output :-)
+ color_eps filename = [EPS filename, ColorBox (Just [";set terminal postscript enhanced color"])]
+ red_cross_style = (Points, CustomStyle [PointType 1])
+ blue_circle_style = (Points, CustomStyle [PointType 6]) -- These are actually /green/ circles, but who's counting?
+ generations = [ (red_cross_style, [position | (position, RedCross) <- classess])
+ , (blue_circle_style, [position | (position, BlueCircle) <- classess]) ]
+ plot2dMultiGen (color_eps "output.ps") generations
+ void $ rawSystem "open" ["output.ps"]
+
+
+linearModelTest :: IO ()
+linearModelTest = do
+ -- Do the regression
+ let used_data = sinDataSet
+ model = regressLinearModel basisFunctions used_data
+
+ -- Show some model statistics
+ evaluate model used_data
+ putStrLn $ "Model For Target:\n" ++ show model
+
+ -- Show some graphical information about the model
+ plot [dataSetToSampleList used_data, sampleFunction $ predict model]
+
+bayesianLinearModelTest :: IO ()
+bayesianLinearModelTest = do
gen <- newStdGen
- let --used_data = sinDataSet
- used_data = sampleDataSet gen 10 sinDataSet
- --model = regressLinearModel basisFunctions used_data
+ let used_data = sampleDataSet gen 10 sinDataSet
(model, variance_model) = regressBayesianLinearModel 1 (1 / 0.09) basisFunctions used_data
- --(model, variance_model, gamma) = regressEMBayesianLinearModel 1 (1 / 0.09) basisFunctions used_data
-- Show some model statistics
evaluate model used_data
putStrLn $ "Model For Target:\n" ++ show model
putStrLn $ "Model For Variance:\n" ++ show variance_model
- --putStrLn $ "Gamma = " ++ show gamma
-- Show some graphical information about the model
- plot [dataSetToSampleList used_data, sampleFunction $ predict model, sampleFunction $ (sqrt . predict variance_model)]
+ plot [dataSetToSampleList used_data, sampleFunction $ predict model, sampleFunction $ (sqrt . predict variance_model)]
+
+emBayesianLinearModelTest :: IO ()
+emBayesianLinearModelTest = do
+ gen <- newStdGen
+ let used_data = sampleDataSet gen 10 sinDataSet
+ (model, variance_model, gamma) = regressEMBayesianLinearModel 1 (1 / 0.09) basisFunctions used_data
+
+ -- Show some model statistics
+ evaluate model used_data
+ putStrLn $ "Model For Target:\n" ++ show model
+ putStrLn $ "Model For Variance:\n" ++ show variance_model
+ putStrLn $ "Gamma = " ++ show gamma
+
+ -- Show some graphical information about the model
+ plot [dataSetToSampleList used_data, sampleFunction $ predict model, sampleFunction $ (sqrt . predict variance_model)]
+
+linearClassificationModelTest :: IO ()
+linearClassificationModelTest = do
+ let used_data = classificationDataSet
+ model = regressLinearClassificationModel basisFunctions2D used_data
+
+ -- Show some model statistics
+ evaluate model used_data
+
+ -- Show some graphical information about the model
+ plotClasses (dataSetToSampleList classificationDataSet)
+ plotClasses (sampleFunction2D $ predict model)
+
+main :: IO ()
+main = linearClassificationModelTest

0 comments on commit e523e4f

Please sign in to comment.