0 | module NN.Training.Examples.LinearRegression
 1 |
 2 | import System.Random
 3 |
 4 | import Data.Tensor
 5 | import NN.Architectures
 6 | import NN.Optimisers
 7 | import NN.Training
 8 | import Data.Autodiff
 9 |
10 | public export
11 | exampleInputs : Vect 5 Double
12 | exampleInputs = [1, 2, 3, 4, 5]
13 |
14 | public export
15 | groundTruth : Double -> Double
16 | groundTruth x = 2 * x + 1
17 |
18 | public export
19 | linearRegressionDataLoader : Monad m => m (DataLoader Double Double)
20 | linearRegressionDataLoader = makeDataLoader exampleInputs (pure . groundTruth)
21 |
22 | public export
23 | linearRegression : (f : ParaAddDLens (Const Double) (Const Double)) ->
24 |   Neg (GetParam f).Shp => Fractional (GetParam f).Shp =>
25 |   Sqrt (GetParam f).Shp =>
26 |   Random (GetParam f).Shp =>
27 |   FromDouble (GetParam f).Shp => ScientificDisplay (GetParam f).Shp =>
28 |   (isFlat : IsFlat (GetParam f)) =>
29 |   (numSteps : Nat) ->
30 |   IO ()
31 | linearRegression f@(MkPara (MkAddCont (Const p)) _)
32 |   {isFlat = MkIsFlat p @{mon}} numSteps = do
33 |   putStrLn "Training a linear regression model..."
34 |   trainData <- linearRegressionDataLoader
35 |   testDataLoader <- makeDataLoader [20, 50, 100] (pure . groundTruth)
36 |   pTrained <- fst <$> optimise
37 |     {l=Const Double, e=pushDown (Const Double >< Const Double)}
38 |     (buildSupervisedLearningSystem f SquaredDifference)
39 |     (handleData trainData)
40 |     (GDMomentum {pType=(GetParam f).Shp})
41 |     numSteps
42 |   fromCostate (eval f pTrained) (snd $ inputs testDataLoader)
43 |   avgLoss <- fromCostate (averageLoss f SquaredDifference pTrained) (dataset testDataLoader)
44 |   putStrLn "Average loss: \{showSci avgLoss}"
45 |
46 | {- 
47 | public export
48 | minimiseCopyMulGD : (startingValue : Double) ->
49 |   (numSteps : Nat) ->
50 |   IO Double
51 | minimiseCopyMulGD startingValue numSteps =
52 |   let opt = GD {pType=Double} {lr=0.001}
53 |   in fst <$> optimise {e=Scalar} ?hehe opt numSteps
54 |
55 | public export
56 | minimiseCopyMulMomentum : (startingValue : Double) ->
57 |   (numSteps : Nat) ->
58 |   IO Double
59 | minimiseCopyMulMomentum startingValue numSteps =
60 |   let opt = GDMomentum {pType=Double} {lr=0.001} {gamma=0.9}
61 |   in fst <$> optimise (pure $ (Copy %>> Mul)) opt numSteps
62 |
63 | {-
64 | public export
65 | DotTensor : {n: Nat} ->
66 |   (Tensor [n] Double, Tensor [n] Double) -> Tensor [] Double
67 | DotTensor (t1, t2) = dot t1 t2
68 |
69 | public export
70 | dotDifferentiable : {n : Nat} -> BwDifferentiable (DotTensor {n})
71 | dotDifferentiable = MkBwDiff (\(t1, t2), dt =>
72 |   ((\x => x * extract dt) <$> t2, (\x => x * extract dt) <$> t1))
73 |
74 |
75 | public export
76 | assembleLearningSystem :
77 |   Para Unit input ->
78 |   Para input output ->
79 |   Para output l ->
80 |   Para Unit l
81 | assembleLearningSystem pi pf pl = pi \>> pf \>> pl
82 |
83 |
84 | public export
85 | train : {input, output, l : Type} ->
86 |   Show l =>
87 |   (model : Model input output) ->
88 |   (init : (x : input) -> IO (Param model x)) ->
89 |   (dataSampler : IO (input, output)) ->
90 |   (loss : (output, output) -> l) ->
91 |   IO ()
92 | train model init dataSampler loss = do
93 |   (x, yTrue) <- dataSampler
94 |   p <- init x
95 |   let yPred = Run model x p
96 |   let l' = loss (yPred, yTrue)
97 |   print l'
98 |   pure ?hmm