broken state of affairs

app/Main.hs

@@ -2,12 +2,22 @@
 
 module Main (main) where
 
--- import Run (trainModel)
-import GPR (trainModel)
+import Run (trainModel)
+-- import GPR (trainModel)
 
 main :: IO ()
 main = do 
-    putStrLn $ "Training for " ++ show epochs ++ " epochs"
-    trainModel epochs
+    putStrLn $ "Training Net with " ++ p ++ " for " ++ show e ++ " epochs"
+    trainModel p e px py mx my
   where
-    epochs = 12
+    e  = 10
+    p  = "./data/volumes.csv"
+    px = ["rth"]
+    py = ["wb", "lb", "hb", "wfin", "hfin", "nfin", "vol"]
+    mx = ["rth"]
+    my = ["vol"]
+    -- p  = "./data/gans.csv"
+    -- px = ["v_ds_work", "i_d_max"]
+    -- py = ["r_ds_on","r_g","g_fs","v_gs_work","v_gs_max","v_th","c_iss","c_oss","c_rss"]
+    -- mx = ["v_ds_work", "i_d_max"]
+    -- my = ["r_ds_on","g_fs","c_iss","c_oss","c_rss"]

setenv

@@ -1,5 +1,5 @@
 #!/bin/sh
 
-LIB_DIR="$(readlink ./libtorch)/lib"
+LIB_DIR="$(readlink ./libtorch)lib"
 export DEVICE="cuda:0"
 export LD_LIBRARY_PATH="$LIB_DIR":$LD_LIBRARY_PATH

src/GPR.hs

@@ -99,7 +99,7 @@ fit' (p:params) = do
         when (mod i 100 == 0) . liftIO . putStrLn
             $ "\tNLL (" ++ show i ++ "): " ++ show (T.asValue l' :: Double)
         liftIO $ T.runStep p' o' l' α
-        ) (p,o) [ 1 .. 1000 :: Int ]
+        ) (p,o) [ 1 .. 666 :: Int ]
     y' <- nll x'
     liftIO . putStrLn $ "Final point " ++ show (length params) ++ ": " ++ show x'
     ((x',y'):) <$> fit' params
@@ -201,14 +201,14 @@ trainModel :: Int -> IO ()
 trainModel num = do
     modelDir <- createModelDir "./models"
 
-    -- (header,datRaw) <- readTSV dataPath
-    let (header,datRaw) = mkData 100 5 10
+    (header,datRaw) <- readCSV dataPath
+    -- let (header,datRaw) = mkData 1000 3 12
 
     let nRows = head $ T.shape datRaw
-    idx <- T.multinomialIO' (T.arange' 0 nRows 1) n 
+    idx <- T.multinomialIO' (T.arange' 0 nRows 1) n
 
-    let trainX' = headerSelect header paramsX datRaw
-        trainY' = headerSelect header paramsY datRaw
+    let trainX' = trafo maskX $ headerSelect header paramsX datRaw
+        trainY' = trafo maskY $ headerSelect header paramsY datRaw
         minX    = fst . T.minDim (Dim 0) RemoveDim $ trainX'
         maxX    = fst . T.maxDim (Dim 0) RemoveDim $ trainX'
         minY    = fst . T.minDim (Dim 0) RemoveDim $ trainY'
@@ -222,49 +222,49 @@ trainModel num = do
 
     let predictor x = T.transpose2D $ T.vstack [m,s]
           where
-            (m',s) = gpr $ scale minX maxX x
-            m      = scale' minY maxY m'
+            (m',s') = gpr . scale minX maxX $ trafo maskX x
+            m       = trafo' maskY $ scale' minY maxY m'
+            s       = T.mul m . T.mul s' $ T.sub maxY minY
 
     idx' <- T.multinomialIO' (T.arange' 0 nRows 1) 10 
-    let testX = T.indexSelect 0 idx' $ headerSelect header paramsX datRaw
-        testY = T.indexSelect 0 idx' $ headerSelect header paramsY datRaw
-        r = T.linspace' @Float @Float 0.0 1.0 10
-        g = T.linspace' @Float @Float 5.0 11.0 3
-        x = T.cartesian_prod [r,g]
-        y = T.exp . T.negative $ T.cumprod 1 T.Float x 
-
-    -- let (_,testD) = mkData 100 2 2
-    --     testX = headerSelect header paramsX testD
-    --     testY = headerSelect header paramsY testD
+    let x = T.indexSelect 0 idx' $ headerSelect header paramsX datRaw
+        y = T.squeezeAll . T.indexSelect 0 idx' $ headerSelect header paramsY datRaw
 
     testModel paramsX paramsY predictor x y
 
-    GPR.traceModel predictor >>= GPR.saveInferenceModel modelDir
+    traceModel predictor >>= saveInferenceModel modelDir
     mdl <- unTraceModel <$> loadInferenceModel modelDir 
 
-    testModel paramsX paramsY mdl testX testY
+    --mdl <- GPR.unTraceModel <$> GPR.loadInferenceModel "./models/20241004-124307"
+    --let (_,testD) = mkData 20 5 5
+    --    testX = headerSelect header paramsX testD
+    --    testY = T.squeezeAll $ headerSelect header paramsY testD
+
+    putStrLn $ "Model saved at " ++ modelDir ++ "/trace.pt"
+
+    GPR.testModel paramsX paramsY mdl x y
 
     pure ()
   where
-    dataPath = "./data/volumes.txt"
-    n        = 200
-    paramsX  = ["r_th", "g_th"]
-    paramsY  = ["volume"]
-    -- maskX    = boolMask' ["r_th"] paramsX
-    -- maskY    = boolMask' ["volume"] paramsY
+    dataPath = "./data/volumes.csv"
+    n        = 100
+    paramsX  = ["rth"]
+    paramsY  = ["vol"]
+    maskX    = boolMask' ["rth"] paramsX
+    maskY    = boolMask' ["vol"] paramsY
 
 testModel :: [String] -> [String] -> (Tensor -> Tensor) -> Tensor -> Tensor -> IO ()
 testModel paramsX paramsY mdl xs ys = do
     print ys
     print ys'
-    print . T.abs . flip T.div ys $ T.sub ys ys'
-    -- linePlot "Volume in cm^3" "R_th in Ohm" ["tru", "prd"] xs $ T.hstack [ys, ys']
-    -- compPlot "Volume in cm^3" ys ys'
+    print . T.abs . flip T.div ys $ T.sub ys' ys
+    linePlot "Volume in cm^3" "R_th in Ohm" ["tru", "prd"] xs yss
+    compPlot "Volume in cm^3" ys ys'
 
     pure ()
   where
-    ys'' = mdl . flip T.withTensorOptions opts $ xs
-    ys'  = T.reshape [-1,1] $ T.select 1 0 ys''
+    ys' = T.squeezeAll . T.select 1 0 $ mdl xs
+    yss = T.transpose2D $ T.vstack [ys, ys']
 
 mkData :: Int -> Int -> Int -> ([String], Tensor)
 mkData n l u = (header,values)
@@ -284,9 +284,7 @@ traceModel p = do
     T.toScriptModule rm
   where
     fun = pure . map p
-    r = T.linspace' @Float @Float 0.0 1.0 10
-    g = T.linspace' @Float @Float 5.0 11.0 3
-    x = T.cartesian_prod [r,g]
+    x = T.reshape [-1,1] $ T.linspace' @Float @Float 0.0 2.0 10
 
 -- | Trace to Function
 unTraceModel :: ScriptModule -> (Tensor -> Tensor)

src/Lib.hs

@@ -187,8 +187,8 @@ splitBatches bs = filter ((bs==) . head . T.shape) . T.split bs (Dim 0)
 readDSV :: String -> FilePath -> IO ([String], Tensor)
 readDSV sep path = do
     file <- lines <$> readFile path
-    let col = drop 2 . splitOn sep $ head file
-        dat = T.asTensor . map (map (read @Float) . drop 2 . splitOn sep) $ tail file
+    let col = splitOn sep $ head file
+        dat = T.asTensor . map (map (read @Float) . splitOn sep) $ tail file
     pure (col, dat)
 
 readCSV :: FilePath -> IO ([String], Tensor)

src/Plot.hs

@@ -25,11 +25,11 @@ linePlot :: String -> String -> [String] -> Tensor -> Tensor -> IO ()
 linePlot xlabel ylabel labels xs ys = Plt.onscreen plt
   where
     xs' = toList xs
-    ys' = map toList $ cols ys
+    ys' = map toList . cols $ T.transpose2D ys
     plt = Plt.plot xs' ys' % Plt.xlabel xlabel
                            % Plt.ylabel ylabel
                            % Plt.grid True
-                           @@ [o2 "labels" labels]
+                           -- @@ [o2 "labels" labels]
 
 compPlot :: String -> Tensor -> Tensor -> IO ()
 compPlot label xs ys = Plt.onscreen plt
@@ -41,7 +41,7 @@ compPlot label xs ys = Plt.onscreen plt
     plt    = Plt.scatter xs' ys' % Plt.xlabel xlabel
                                  % Plt.ylabel ylabel
                                  % Plt.grid True
-                                 @@ []
+                                 -- @@ []
 
 scatterPlot :: String -> String -> [String] -> Tensor -> Tensor -> IO ()
 scatterPlot xlabel ylabel labels xs ys = Plt.onscreen plt

src/Run.hs

@@ -95,7 +95,8 @@ trainEpoch (b:bs) = do
 shuffleData :: Tensor -> Tensor -> StateT TrainState IO [Batch]
 shuffleData xs ys = do
     TrainState{..} <- get
-    idx <- liftIO . flip T.multinomialIO' nRows . T.toDevice gpu $ T.arange' 0 nRows 1
+    idx <- liftIO . flip T.multinomialIO' nRows . T.toDevice gpu
+            $ T.arange' 0 nRows 1
     let xs' = splitBatches batchSize $ T.indexSelect 0 idx xs
         ys' = splitBatches batchSize $ T.indexSelect 0 idx ys
     pure $ zipWith Batch xs' ys'
@@ -125,20 +126,21 @@ runTraining td vd = do
     if epoch' <= 0 then pure model else runTraining td vd
 
 -- | Main Training Function
-trainModel :: Int -> IO ()
-trainModel num = do
+trainModel :: FilePath -> Int -> [String] -> [String] -> [String] -> [String]
+           -> IO ()
+trainModel dataPath epochs paramsX paramsY maskX maskY = do
     modelDir <- createModelDir "./models"
 
     (header,datRaw) <- readCSV dataPath
-    let dat'  = T.repeat [200,1] datRaw
+    let dat'  = datRaw -- T.repeat [200,1] datRaw
         nRows = head $ T.shape dat'
 
     !datShuffled <- flip (T.indexSelect 0) dat'
                       <$> T.multinomialIO' (T.arange' 0 nRows 1) nRows 
 
     let ts    = floor @Float $ 0.85 * realToFrac (head $ T.shape datShuffled)
-        datX' = trafo maskX $ headerSelect header paramsX datShuffled
-        datY' = trafo maskY $ headerSelect header paramsY datShuffled
+        datX' = trafo maskX' $ headerSelect header paramsX datShuffled
+        datY' = trafo maskY' $ headerSelect header paramsY datShuffled
         minX  = fst . T.minDim (Dim 0) RemoveDim $ datX'
         maxX  = fst . T.maxDim (Dim 0) RemoveDim $ datX'
         minY  = fst . T.minDim (Dim 0) RemoveDim $ datY'
@@ -152,7 +154,7 @@ trainModel num = do
     net <- T.toDevice gpu <$> T.sample spec
     opt <- T.initOptimizer opt' $ T.flattenParameters net
 
-    let initialState = TrainState num l l l l net opt α' bs' modelDir paramsX paramsY
+    let initialState = TrainState epochs l l l l net opt α' bs' modelDir paramsX paramsY
 
     tic <- getCurrentTime
     -- evalStateT (runTraining datTrain datValid) initialState
@@ -170,18 +172,21 @@ trainModel num = do
     -- let modelDir = "./models/20240923-101548"
     -- !net' <- loadCheckPoint modelDir spec >>= noGrad . fst
 
-    let predict = trafo' maskY . scale' minY maxY
+    let predict = trafo' maskY' . scale' minY maxY
                 . forward (T.toDevice cpu net')
-                . scale minX maxX . trafo maskX
+                . scale minX maxX . trafo maskX'
 
-    -- traceModel paramsX paramsY predict >>= saveInferenceModel modelDir
-    -- !net'' <- loadInferenceModel modelDir >>= noGrad . unTraceModel 
+    let testData = headerSelect header (paramsX ++ paramsY) datRaw
+    testModel modelDir paramsX paramsY testData predict
+
+    traceModel paramsX paramsY predict >>= saveInferenceModel modelDir
+    !net'' <- loadInferenceModel modelDir >>= noGrad . unTraceModel 
 
     -- traceGraph dimX predict >>= saveONNXModel modelDir
 
     tic' <- getCurrentTime
-    let testData = headerSelect header (paramsX ++ paramsY) datRaw
-    testModel modelDir paramsX paramsY testData predict
+    let testData' = headerSelect header (paramsX ++ paramsY) datRaw
+    testModel modelDir paramsX paramsY testData' net''
     toc' <- getCurrentTime
 
     let diff  = realToFrac $ diffUTCTime toc tic :: Float
@@ -191,15 +196,12 @@ trainModel num = do
 
     putStrLn $ "Final checkpoint in " ++ modelDir
   where
-    l        = []
-    dataPath = "./data/gans.csv"
-    paramsX  = ["v_ds_work", "i_d_max"]
-    paramsY  = ["r_ds_on","r_g","g_fs","v_gs_work","v_gs_max","v_th","c_iss","c_oss","c_rss"]
-    maskX    = boolMask' ["v_ds_work", "i_d_max"] paramsX
-    maskY    = boolMask' ["r_ds_on","g_fs","c_iss","c_oss","c_rss"] paramsY
-    dimX     = length paramsX
-    dimY     = length paramsY
-    spec     = NetSpec dimX dimY
+    l      = []
+    maskX' = boolMask' maskX paramsX
+    maskY' = boolMask' maskY paramsY
+    dimX   = length paramsX
+    dimY   = length paramsY
+    spec   = NetSpec dimX dimY
 
 testModel :: FilePath -> [String] -> [String] -> Tensor -> (T.Tensor -> T.Tensor) -> IO ()
 testModel modelDir paramsX paramsY dat net = do

stack.yaml

@@ -1,5 +1,5 @@
-resolver: lts-22.28
-compiler: ghc-9.6.5
+resolver: lts-22.36 # lts-22.28
+compiler: ghc-9.6.6 # ghc-9.6.5
 
 ghc-options:
   "$locals": -funfolding-use-threshold=16 -fexcess-precision -optc-O3 -optc-ffast-math -threaded -O2 -rtsopts -with-rtsopts=-N +RTS -xp -RTS # -v

stack.yaml.lock

@@ -45,7 +45,7 @@ packages:
     url: https://github.com/hasktorch/hasktorch/archive/ab8d09cb147eab39d096876d1b954bcf0be08191.tar.gz
 snapshots:
 - completed:
-    sha256: 87da71cb0ae9ee1ea1bf51a8eb9812f39f779be76abc0a3c926defd8afda05d1
-    size: 719139
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/28.yaml
-  original: lts-22.28
+    sha256: 6a553c5fa4f211a9b639da5e5359124a93627852dd9967bed202fdd71b25f15e
+    size: 720021
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/36.yaml
+  original: lts-22.36