Skip to content

Instantly share code, notes, and snippets.

@martijnbastiaan
Created June 14, 2018 08:53
Show Gist options
  • Save martijnbastiaan/b8c962d726b9de3465ba097d1f37174c to your computer and use it in GitHub Desktop.
Save martijnbastiaan/b8c962d726b9de3465ba097d1f37174c to your computer and use it in GitHub Desktop.
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module Lib where
import Numeric.LinearAlgebra hiding (Vector, Matrix)
import qualified Numeric.LinearAlgebra as LA
import qualified Data.Vector.Storable as VS
import GHC.TypeLits
import Data.Proxy
import System.Random
import Control.Monad
newtype Vector (n :: Nat) = Vector { _vec :: VS.Vector Float }
natToInt :: forall n . KnownNat n => Int
natToInt = fromIntegral . natVal $ Proxy @n
vecFromList :: forall n. KnownNat n => [Float] -> Vector n
vecFromList = Vector . VS.fromList . take (natToInt @n) . cycle
vecLength :: forall n. KnownNat n => Vector n -> Int
vecLength _ = natToInt @n
newtype Matrix (n :: Nat) (m :: Nat) = Matrix { _mat :: LA.Matrix Float }
matrixWidth :: forall n m. KnownNat n => KnownNat m => Matrix m n -> Int
matrixWidth _ = natToInt @n
matrixHeight :: forall n m. KnownNat n => KnownNat m => Matrix m n -> Int
matrixHeight _ = natToInt @m
matFromList :: forall n m. KnownNat n => KnownNat m => [Float] -> Matrix n m
matFromList = Matrix . (w><h) . cycle
where
w = natToInt @n
h = natToInt @m
randomMatrix :: forall n m. (KnownNat n, KnownNat m) => IO (Matrix n m)
randomMatrix = matFromList <$> replicateM (w*h) (randomRIO (0.001, 0.1))
where
w = natToInt @n
h = natToInt @m
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment