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