{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE NoStarIsType #-}

module Torch.Typed.NamedTensor where

import Data.Default.Class
import Data.Kind
import Data.Maybe (fromJust)
import Data.Vector.Sized (Vector)
import qualified Data.Vector.Sized as V
import GHC.Exts
import GHC.Generics
import GHC.TypeLits
import qualified Torch.DType as D
import qualified Torch.Device as D
import Torch.Lens
import qualified Torch.Tensor as D
import Torch.Typed.Factories
import Torch.Typed.Functional
import Torch.Typed.Tensor

class NamedTensorLike a where
  type ToNestedList a :: Type
  toNestedList :: a -> ToNestedList a
  asNamedTensor :: a -> NamedTensor '( 'D.CPU, 0) (ToDType a) (ToShape a)
  fromNestedList :: ToNestedList a -> a
  fromNamedTensor :: NamedTensor '( 'D.CPU, 0) (ToDType a) (ToShape a) -> a

instance NamedTensorLike Bool where
  type ToNestedList Bool = Bool
  toNestedList :: Bool -> ToNestedList Bool
toNestedList = Bool -> Bool
Bool -> ToNestedList Bool
forall a. a -> a
id
  asNamedTensor :: Bool -> NamedTensor '( 'CPU, 0) (ToDType Bool) (ToShape Bool)
asNamedTensor = Tensor '( 'CPU, 0) 'Bool '[] -> NamedTensor '( 'CPU, 0) 'Bool '[]
forall t (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
(Unnamed t, IsUnnamed t device dtype shape) =>
Tensor device dtype shape -> t
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
IsUnnamed (NamedTensor '( 'CPU, 0) 'Bool '[]) device dtype shape =>
Tensor device dtype shape -> NamedTensor '( 'CPU, 0) 'Bool '[]
fromUnnamed (Tensor '( 'CPU, 0) 'Bool '[] -> NamedTensor '( 'CPU, 0) 'Bool '[])
-> (Bool -> Tensor '( 'CPU, 0) 'Bool '[])
-> Bool
-> NamedTensor '( 'CPU, 0) 'Bool '[]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor -> Tensor '( 'CPU, 0) 'Bool '[]
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
Tensor -> Tensor device dtype shape
UnsafeMkTensor (Tensor -> Tensor '( 'CPU, 0) 'Bool '[])
-> (Bool -> Tensor) -> Bool -> Tensor '( 'CPU, 0) 'Bool '[]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Tensor
forall a. TensorLike a => a -> Tensor
D.asTensor
  fromNestedList :: ToNestedList Bool -> Bool
fromNestedList = Bool -> Bool
ToNestedList Bool -> Bool
forall a. a -> a
id
  fromNamedTensor :: NamedTensor '( 'CPU, 0) (ToDType Bool) (ToShape Bool) -> Bool
fromNamedTensor = Tensor -> Bool
forall a. TensorLike a => Tensor -> a
D.asValue (Tensor -> Bool)
-> (NamedTensor '( 'CPU, 0) 'Bool '[] -> Tensor)
-> NamedTensor '( 'CPU, 0) 'Bool '[]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedTensor '( 'CPU, 0) 'Bool '[] -> Tensor
forall t. Unnamed t => t -> Tensor
toDynamic

instance NamedTensorLike Int where
  type ToNestedList Int = Int
  toNestedList :: Int -> ToNestedList Int
toNestedList = Int -> Int
Int -> ToNestedList Int
forall a. a -> a
id
  asNamedTensor :: Int -> NamedTensor '( 'CPU, 0) (ToDType Int) (ToShape Int)
asNamedTensor = Tensor '( 'CPU, 0) 'Int64 '[] -> NamedTensor '( 'CPU, 0) 'Int64 '[]
forall t (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
(Unnamed t, IsUnnamed t device dtype shape) =>
Tensor device dtype shape -> t
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
IsUnnamed
  (NamedTensor '( 'CPU, 0) 'Int64 '[]) device dtype shape =>
Tensor device dtype shape -> NamedTensor '( 'CPU, 0) 'Int64 '[]
fromUnnamed (Tensor '( 'CPU, 0) 'Int64 '[]
 -> NamedTensor '( 'CPU, 0) 'Int64 '[])
-> (Int -> Tensor '( 'CPU, 0) 'Int64 '[])
-> Int
-> NamedTensor '( 'CPU, 0) 'Int64 '[]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor -> Tensor '( 'CPU, 0) 'Int64 '[]
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
Tensor -> Tensor device dtype shape
UnsafeMkTensor (Tensor -> Tensor '( 'CPU, 0) 'Int64 '[])
-> (Int -> Tensor) -> Int -> Tensor '( 'CPU, 0) 'Int64 '[]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Tensor
forall a. TensorLike a => a -> Tensor
D.asTensor
  fromNestedList :: ToNestedList Int -> Int
fromNestedList = Int -> Int
ToNestedList Int -> Int
forall a. a -> a
id
  fromNamedTensor :: NamedTensor '( 'CPU, 0) (ToDType Int) (ToShape Int) -> Int
fromNamedTensor = Tensor -> Int
forall a. TensorLike a => Tensor -> a
D.asValue (Tensor -> Int)
-> (NamedTensor '( 'CPU, 0) 'Int64 '[] -> Tensor)
-> NamedTensor '( 'CPU, 0) 'Int64 '[]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedTensor '( 'CPU, 0) 'Int64 '[] -> Tensor
forall t. Unnamed t => t -> Tensor
toDynamic

instance NamedTensorLike Float where
  type ToNestedList Float = Float
  toNestedList :: Float -> ToNestedList Float
toNestedList = Float -> Float
Float -> ToNestedList Float
forall a. a -> a
id
  asNamedTensor :: Float -> NamedTensor '( 'CPU, 0) (ToDType Float) (ToShape Float)
asNamedTensor = Tensor '( 'CPU, 0) 'Float '[] -> NamedTensor '( 'CPU, 0) 'Float '[]
forall t (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
(Unnamed t, IsUnnamed t device dtype shape) =>
Tensor device dtype shape -> t
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
IsUnnamed
  (NamedTensor '( 'CPU, 0) 'Float '[]) device dtype shape =>
Tensor device dtype shape -> NamedTensor '( 'CPU, 0) 'Float '[]
fromUnnamed (Tensor '( 'CPU, 0) 'Float '[]
 -> NamedTensor '( 'CPU, 0) 'Float '[])
-> (Float -> Tensor '( 'CPU, 0) 'Float '[])
-> Float
-> NamedTensor '( 'CPU, 0) 'Float '[]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor -> Tensor '( 'CPU, 0) 'Float '[]
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
Tensor -> Tensor device dtype shape
UnsafeMkTensor (Tensor -> Tensor '( 'CPU, 0) 'Float '[])
-> (Float -> Tensor) -> Float -> Tensor '( 'CPU, 0) 'Float '[]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Tensor
forall a. TensorLike a => a -> Tensor
D.asTensor
  fromNestedList :: ToNestedList Float -> Float
fromNestedList = Float -> Float
ToNestedList Float -> Float
forall a. a -> a
id
  fromNamedTensor :: NamedTensor '( 'CPU, 0) (ToDType Float) (ToShape Float) -> Float
fromNamedTensor = Tensor -> Float
forall a. TensorLike a => Tensor -> a
D.asValue (Tensor -> Float)
-> (NamedTensor '( 'CPU, 0) 'Float '[] -> Tensor)
-> NamedTensor '( 'CPU, 0) 'Float '[]
-> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedTensor '( 'CPU, 0) 'Float '[] -> Tensor
forall t. Unnamed t => t -> Tensor
toDynamic

instance NamedTensorLike Double where
  type ToNestedList Double = Double
  toNestedList :: Double -> ToNestedList Double
toNestedList = Double -> Double
Double -> ToNestedList Double
forall a. a -> a
id
  asNamedTensor :: Double -> NamedTensor '( 'CPU, 0) (ToDType Double) (ToShape Double)
asNamedTensor = Tensor '( 'CPU, 0) 'Double '[]
-> NamedTensor '( 'CPU, 0) 'Double '[]
forall t (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
(Unnamed t, IsUnnamed t device dtype shape) =>
Tensor device dtype shape -> t
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
IsUnnamed
  (NamedTensor '( 'CPU, 0) 'Double '[]) device dtype shape =>
Tensor device dtype shape -> NamedTensor '( 'CPU, 0) 'Double '[]
fromUnnamed (Tensor '( 'CPU, 0) 'Double '[]
 -> NamedTensor '( 'CPU, 0) 'Double '[])
-> (Double -> Tensor '( 'CPU, 0) 'Double '[])
-> Double
-> NamedTensor '( 'CPU, 0) 'Double '[]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor -> Tensor '( 'CPU, 0) 'Double '[]
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
Tensor -> Tensor device dtype shape
UnsafeMkTensor (Tensor -> Tensor '( 'CPU, 0) 'Double '[])
-> (Double -> Tensor) -> Double -> Tensor '( 'CPU, 0) 'Double '[]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Tensor
forall a. TensorLike a => a -> Tensor
D.asTensor
  fromNestedList :: ToNestedList Double -> Double
fromNestedList = Double -> Double
ToNestedList Double -> Double
forall a. a -> a
id
  fromNamedTensor :: NamedTensor '( 'CPU, 0) (ToDType Double) (ToShape Double) -> Double
fromNamedTensor = Tensor -> Double
forall a. TensorLike a => Tensor -> a
D.asValue (Tensor -> Double)
-> (NamedTensor '( 'CPU, 0) 'Double '[] -> Tensor)
-> NamedTensor '( 'CPU, 0) 'Double '[]
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedTensor '( 'CPU, 0) 'Double '[] -> Tensor
forall t. Unnamed t => t -> Tensor
toDynamic

instance (KnownNat n, D.TensorLike (ToNestedList a), NamedTensorLike a) => NamedTensorLike (Vector n a) where
  type ToNestedList (Vector n a) = [ToNestedList a]
  toNestedList :: Vector n a -> ToNestedList (Vector n a)
toNestedList Vector n a
v = (a -> ToNestedList a) -> [a] -> [ToNestedList a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ToNestedList a
forall a. NamedTensorLike a => a -> ToNestedList a
toNestedList (Vector n a -> [a]
forall (n :: Natural) a. Vector n a -> [a]
V.toList Vector n a
v)
  asNamedTensor :: Vector n a
-> NamedTensor
     '( 'CPU, 0) (ToDType (Vector n a)) (ToShape (Vector n a))
asNamedTensor Vector n a
v = Tensor '( 'CPU, 0) (ToDType a) (n : ToNats (ToShape a))
-> NamedTensor
     '( 'CPU, 0) (ToDType a) (Vector Vector n : ToShape a)
Tensor '( 'CPU, 0) (ToDType a) (n : ToNats (ToShape a))
-> NamedTensor
     '( 'CPU, 0) (ToDType (Vector n a)) (ToShape (Vector n a))
forall t (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
(Unnamed t, IsUnnamed t device dtype shape) =>
Tensor device dtype shape -> t
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
IsUnnamed
  (NamedTensor '( 'CPU, 0) (ToDType a) (Vector Vector n : ToShape a))
  device
  dtype
  shape =>
Tensor device dtype shape
-> NamedTensor
     '( 'CPU, 0) (ToDType a) (Vector Vector n : ToShape a)
fromUnnamed (Tensor '( 'CPU, 0) (ToDType a) (n : ToNats (ToShape a))
 -> NamedTensor
      '( 'CPU, 0) (ToDType (Vector n a)) (ToShape (Vector n a)))
-> ([ToNestedList a]
    -> Tensor '( 'CPU, 0) (ToDType a) (n : ToNats (ToShape a)))
-> [ToNestedList a]
-> NamedTensor
     '( 'CPU, 0) (ToDType (Vector n a)) (ToShape (Vector n a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor -> Tensor '( 'CPU, 0) (ToDType a) (n : ToNats (ToShape a))
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
Tensor -> Tensor device dtype shape
UnsafeMkTensor (Tensor -> Tensor '( 'CPU, 0) (ToDType a) (n : ToNats (ToShape a)))
-> ([ToNestedList a] -> Tensor)
-> [ToNestedList a]
-> Tensor '( 'CPU, 0) (ToDType a) (n : ToNats (ToShape a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ToNestedList a] -> Tensor
forall a. TensorLike a => a -> Tensor
D.asTensor ([ToNestedList a]
 -> NamedTensor
      '( 'CPU, 0) (ToDType (Vector n a)) (ToShape (Vector n a)))
-> [ToNestedList a]
-> NamedTensor
     '( 'CPU, 0) (ToDType (Vector n a)) (ToShape (Vector n a))
forall a b. (a -> b) -> a -> b
$ Vector n a -> ToNestedList (Vector n a)
forall a. NamedTensorLike a => a -> ToNestedList a
toNestedList Vector n a
v
  fromNestedList :: ToNestedList (Vector n a) -> Vector n a
fromNestedList = (ToNestedList a -> a)
-> Vector Vector n (ToNestedList a) -> Vector n a
forall a b. (a -> b) -> Vector Vector n a -> Vector Vector n b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ToNestedList a -> a
forall a. NamedTensorLike a => ToNestedList a -> a
fromNestedList (Vector Vector n (ToNestedList a) -> Vector n a)
-> ([ToNestedList a] -> Vector Vector n (ToNestedList a))
-> [ToNestedList a]
-> Vector n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Vector Vector n (ToNestedList a))
-> Vector Vector n (ToNestedList a)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Vector Vector n (ToNestedList a))
 -> Vector Vector n (ToNestedList a))
-> ([ToNestedList a] -> Maybe (Vector Vector n (ToNestedList a)))
-> [ToNestedList a]
-> Vector Vector n (ToNestedList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ToNestedList a] -> Maybe (Vector Vector n (ToNestedList a))
forall (n :: Natural) a. KnownNat n => [a] -> Maybe (Vector n a)
V.fromList
  fromNamedTensor :: NamedTensor
  '( 'CPU, 0) (ToDType (Vector n a)) (ToShape (Vector n a))
-> Vector n a
fromNamedTensor = [ToNestedList a] -> Vector n a
ToNestedList (Vector n a) -> Vector n a
forall a. NamedTensorLike a => ToNestedList a -> a
fromNestedList ([ToNestedList a] -> Vector n a)
-> (NamedTensor
      '( 'CPU, 0) (ToDType a) (Vector Vector n : ToShape a)
    -> [ToNestedList a])
-> NamedTensor
     '( 'CPU, 0) (ToDType a) (Vector Vector n : ToShape a)
-> Vector n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor -> [ToNestedList a]
forall a. TensorLike a => Tensor -> a
D.asValue (Tensor -> [ToNestedList a])
-> (NamedTensor
      '( 'CPU, 0) (ToDType a) (Vector Vector n : ToShape a)
    -> Tensor)
-> NamedTensor
     '( 'CPU, 0) (ToDType a) (Vector Vector n : ToShape a)
-> [ToNestedList a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedTensor '( 'CPU, 0) (ToDType a) (Vector Vector n : ToShape a)
-> Tensor
forall t. Unnamed t => t -> Tensor
toDynamic

instance {-# OVERLAPS #-} (Coercible (vec n a) (Vector n a), KnownNat n, D.TensorLike (ToNestedList a), NamedTensorLike a) => NamedTensorLike (vec n a) where
  type ToNestedList (vec n a) = [ToNestedList a]
  toNestedList :: vec n a -> ToNestedList (vec n a)
toNestedList vec n a
v = (a -> ToNestedList a) -> [a] -> [ToNestedList a]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. NamedTensorLike a => a -> ToNestedList a
toNestedList @a) (Vector n a -> [a]
forall (n :: Natural) a. Vector n a -> [a]
V.toList (vec n a -> Vector n a
forall a b. Coercible a b => a -> b
coerce vec n a
v :: Vector n a))
  asNamedTensor :: vec n a
-> NamedTensor '( 'CPU, 0) (ToDType (vec n a)) (ToShape (vec n a))
asNamedTensor vec n a
v = Tensor '( 'CPU, 0) (ToDType a) (ToNat (vec n) : ToNats (ToShape a))
-> NamedTensor '( 'CPU, 0) (ToDType a) (vec n : ToShape a)
Tensor '( 'CPU, 0) (ToDType a) (ToNat (vec n) : ToNats (ToShape a))
-> NamedTensor '( 'CPU, 0) (ToDType (vec n a)) (ToShape (vec n a))
forall t (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
(Unnamed t, IsUnnamed t device dtype shape) =>
Tensor device dtype shape -> t
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
IsUnnamed
  (NamedTensor '( 'CPU, 0) (ToDType a) (vec n : ToShape a))
  device
  dtype
  shape =>
Tensor device dtype shape
-> NamedTensor '( 'CPU, 0) (ToDType a) (vec n : ToShape a)
fromUnnamed (Tensor
   '( 'CPU, 0) (ToDType a) (ToNat (vec n) : ToNats (ToShape a))
 -> NamedTensor '( 'CPU, 0) (ToDType (vec n a)) (ToShape (vec n a)))
-> ([ToNestedList a]
    -> Tensor
         '( 'CPU, 0) (ToDType a) (ToNat (vec n) : ToNats (ToShape a)))
-> [ToNestedList a]
-> NamedTensor '( 'CPU, 0) (ToDType (vec n a)) (ToShape (vec n a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor
-> Tensor
     '( 'CPU, 0) (ToDType a) (ToNat (vec n) : ToNats (ToShape a))
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
Tensor -> Tensor device dtype shape
UnsafeMkTensor (Tensor
 -> Tensor
      '( 'CPU, 0) (ToDType a) (ToNat (vec n) : ToNats (ToShape a)))
-> ([ToNestedList a] -> Tensor)
-> [ToNestedList a]
-> Tensor
     '( 'CPU, 0) (ToDType a) (ToNat (vec n) : ToNats (ToShape a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ToNestedList a] -> Tensor
forall a. TensorLike a => a -> Tensor
D.asTensor ([ToNestedList a]
 -> NamedTensor '( 'CPU, 0) (ToDType (vec n a)) (ToShape (vec n a)))
-> [ToNestedList a]
-> NamedTensor '( 'CPU, 0) (ToDType (vec n a)) (ToShape (vec n a))
forall a b. (a -> b) -> a -> b
$ vec n a -> ToNestedList (vec n a)
forall a. NamedTensorLike a => a -> ToNestedList a
toNestedList vec n a
v
  fromNestedList :: ToNestedList (vec n a) -> vec n a
fromNestedList ToNestedList (vec n a)
v = Vector n a -> vec n a
forall a b. Coercible a b => a -> b
coerce ((ToNestedList a -> a)
-> Vector Vector n (ToNestedList a) -> Vector n a
forall a b. (a -> b) -> Vector Vector n a -> Vector Vector n b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ToNestedList a -> a
forall a. NamedTensorLike a => ToNestedList a -> a
fromNestedList (Vector Vector n (ToNestedList a) -> Vector n a)
-> (ToNestedList (vec n a) -> Vector Vector n (ToNestedList a))
-> ToNestedList (vec n a)
-> Vector n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Vector Vector n (ToNestedList a))
-> Vector Vector n (ToNestedList a)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Vector Vector n (ToNestedList a))
 -> Vector Vector n (ToNestedList a))
-> ([ToNestedList a] -> Maybe (Vector Vector n (ToNestedList a)))
-> [ToNestedList a]
-> Vector Vector n (ToNestedList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ToNestedList a] -> Maybe (Vector Vector n (ToNestedList a))
forall (n :: Natural) a. KnownNat n => [a] -> Maybe (Vector n a)
V.fromList (ToNestedList (vec n a) -> Vector n a)
-> ToNestedList (vec n a) -> Vector n a
forall a b. (a -> b) -> a -> b
$ ToNestedList (vec n a)
v :: Vector n a)
  fromNamedTensor :: NamedTensor '( 'CPU, 0) (ToDType (vec n a)) (ToShape (vec n a))
-> vec n a
fromNamedTensor = [ToNestedList a] -> vec n a
ToNestedList (vec n a) -> vec n a
forall a. NamedTensorLike a => ToNestedList a -> a
fromNestedList ([ToNestedList a] -> vec n a)
-> (NamedTensor '( 'CPU, 0) (ToDType a) (vec n : ToShape a)
    -> [ToNestedList a])
-> NamedTensor '( 'CPU, 0) (ToDType a) (vec n : ToShape a)
-> vec n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor -> [ToNestedList a]
forall a. TensorLike a => Tensor -> a
D.asValue (Tensor -> [ToNestedList a])
-> (NamedTensor '( 'CPU, 0) (ToDType a) (vec n : ToShape a)
    -> Tensor)
-> NamedTensor '( 'CPU, 0) (ToDType a) (vec n : ToShape a)
-> [ToNestedList a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedTensor '( 'CPU, 0) (ToDType a) (vec n : ToShape a) -> Tensor
forall t. Unnamed t => t -> Tensor
toDynamic

instance {-# OVERLAPS #-} (Generic (g a), Default (g a), HasTypes (g a) a, KnownNat (ToNat g), D.TensorLike (ToNestedList a), NamedTensorLike a) => NamedTensorLike (g a) where
  type ToNestedList (g a) = [ToNestedList a]
  toNestedList :: g a -> ToNestedList (g a)
toNestedList g a
v = (a -> ToNestedList a) -> [a] -> [ToNestedList a]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. NamedTensorLike a => a -> ToNestedList a
toNestedList @a) (Traversal' (g a) a -> g a -> [a]
forall a s. Traversal' s a -> s -> [a]
flattenValues (forall a s. HasTypes s a => Traversal' s a
types @a) g a
v)
  asNamedTensor :: g a -> NamedTensor '( 'CPU, 0) (ToDType (g a)) (ToShape (g a))
asNamedTensor g a
v = Tensor '( 'CPU, 0) (ToDType a) (ToNat g : ToNats (ToShape a))
-> NamedTensor '( 'CPU, 0) (ToDType a) (g : ToShape a)
Tensor '( 'CPU, 0) (ToDType a) (ToNat g : ToNats (ToShape a))
-> NamedTensor '( 'CPU, 0) (ToDType (g a)) (ToShape (g a))
forall t (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
(Unnamed t, IsUnnamed t device dtype shape) =>
Tensor device dtype shape -> t
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
IsUnnamed
  (NamedTensor '( 'CPU, 0) (ToDType a) (g : ToShape a))
  device
  dtype
  shape =>
Tensor device dtype shape
-> NamedTensor '( 'CPU, 0) (ToDType a) (g : ToShape a)
fromUnnamed (Tensor '( 'CPU, 0) (ToDType a) (ToNat g : ToNats (ToShape a))
 -> NamedTensor '( 'CPU, 0) (ToDType (g a)) (ToShape (g a)))
-> ([ToNestedList a]
    -> Tensor '( 'CPU, 0) (ToDType a) (ToNat g : ToNats (ToShape a)))
-> [ToNestedList a]
-> NamedTensor '( 'CPU, 0) (ToDType (g a)) (ToShape (g a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor
-> Tensor '( 'CPU, 0) (ToDType a) (ToNat g : ToNats (ToShape a))
forall (device :: (DeviceType, Natural)) (dtype :: DType)
       (shape :: [Natural]).
Tensor -> Tensor device dtype shape
UnsafeMkTensor (Tensor
 -> Tensor '( 'CPU, 0) (ToDType a) (ToNat g : ToNats (ToShape a)))
-> ([ToNestedList a] -> Tensor)
-> [ToNestedList a]
-> Tensor '( 'CPU, 0) (ToDType a) (ToNat g : ToNats (ToShape a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ToNestedList a] -> Tensor
forall a. TensorLike a => a -> Tensor
D.asTensor ([ToNestedList a]
 -> NamedTensor '( 'CPU, 0) (ToDType (g a)) (ToShape (g a)))
-> [ToNestedList a]
-> NamedTensor '( 'CPU, 0) (ToDType (g a)) (ToShape (g a))
forall a b. (a -> b) -> a -> b
$ g a -> ToNestedList (g a)
forall a. NamedTensorLike a => a -> ToNestedList a
toNestedList g a
v
  fromNestedList :: ToNestedList (g a) -> g a
fromNestedList ToNestedList (g a)
v = Traversal' (g a) a -> g a -> [a] -> g a
forall a s. Traversal' s a -> s -> [a] -> s
replaceValues (forall a s. HasTypes s a => Traversal' s a
types @a) g a
forall a. Default a => a
def ((ToNestedList a -> a) -> [ToNestedList a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ToNestedList a -> a
forall a. NamedTensorLike a => ToNestedList a -> a
fromNestedList [ToNestedList a]
ToNestedList (g a)
v)
  fromNamedTensor :: NamedTensor '( 'CPU, 0) (ToDType (g a)) (ToShape (g a)) -> g a
fromNamedTensor = [ToNestedList a] -> g a
ToNestedList (g a) -> g a
forall a. NamedTensorLike a => ToNestedList a -> a
fromNestedList ([ToNestedList a] -> g a)
-> (NamedTensor '( 'CPU, 0) (ToDType a) (g : ToShape a)
    -> [ToNestedList a])
-> NamedTensor '( 'CPU, 0) (ToDType a) (g : ToShape a)
-> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor -> [ToNestedList a]
forall a. TensorLike a => Tensor -> a
D.asValue (Tensor -> [ToNestedList a])
-> (NamedTensor '( 'CPU, 0) (ToDType a) (g : ToShape a) -> Tensor)
-> NamedTensor '( 'CPU, 0) (ToDType a) (g : ToShape a)
-> [ToNestedList a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedTensor '( 'CPU, 0) (ToDType a) (g : ToShape a) -> Tensor
forall t. Unnamed t => t -> Tensor
toDynamic