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