{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
module Variable.R.Stype where
import Data.Aeson (ToJSON (..), Value)
import Data.Kind (Type)
import Data.Text (Text)
import qualified Data.Vector as V
import GHC.Generics (Generic)
import Variable.R.Factor
import Variable.R.SEXP
data StypeRole = StypeCovariate | StypeOutcome deriving (StypeRole -> StypeRole -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StypeRole -> StypeRole -> Bool
$c/= :: StypeRole -> StypeRole -> Bool
== :: StypeRole -> StypeRole -> Bool
$c== :: StypeRole -> StypeRole -> Bool
Eq, forall x. Rep StypeRole x -> StypeRole
forall x. StypeRole -> Rep StypeRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StypeRole x -> StypeRole
$cfrom :: forall x. StypeRole -> Rep StypeRole x
Generic, Int -> StypeRole -> ShowS
[StypeRole] -> ShowS
StypeRole -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StypeRole] -> ShowS
$cshowList :: [StypeRole] -> ShowS
show :: StypeRole -> String
$cshow :: StypeRole -> String
showsPrec :: Int -> StypeRole -> ShowS
$cshowsPrec :: Int -> StypeRole -> ShowS
Show)
data StypeAttrs = MkStypeAttrs
{
StypeAttrs -> Text
short_label :: Text,
StypeAttrs -> Text
long_label :: Text,
StypeAttrs -> Maybe StypeRole
study_role :: Maybe StypeRole
}
deriving (StypeAttrs -> StypeAttrs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StypeAttrs -> StypeAttrs -> Bool
$c/= :: StypeAttrs -> StypeAttrs -> Bool
== :: StypeAttrs -> StypeAttrs -> Bool
$c== :: StypeAttrs -> StypeAttrs -> Bool
Eq, forall x. Rep StypeAttrs x -> StypeAttrs
forall x. StypeAttrs -> Rep StypeAttrs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StypeAttrs x -> StypeAttrs
$cfrom :: forall x. StypeAttrs -> Rep StypeAttrs x
Generic, Int -> StypeAttrs -> ShowS
[StypeAttrs] -> ShowS
StypeAttrs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StypeAttrs] -> ShowS
$cshowList :: [StypeAttrs] -> ShowS
show :: StypeAttrs -> String
$cshow :: StypeAttrs -> String
showsPrec :: Int -> StypeAttrs -> ShowS
$cshowsPrec :: Int -> StypeAttrs -> ShowS
Show)
data WrappedStypeAttrs = MkWrappedStypeAttrs
{
WrappedStypeAttrs -> Text
short_label :: Text,
WrappedStypeAttrs -> Text
long_label :: Text,
WrappedStypeAttrs -> Maybe StypeRole
study_role :: Maybe StypeRole,
WrappedStypeAttrs -> Text
stypeType :: Text,
WrappedStypeAttrs -> Value
special_attrs :: Value
}
deriving (WrappedStypeAttrs -> WrappedStypeAttrs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WrappedStypeAttrs -> WrappedStypeAttrs -> Bool
$c/= :: WrappedStypeAttrs -> WrappedStypeAttrs -> Bool
== :: WrappedStypeAttrs -> WrappedStypeAttrs -> Bool
$c== :: WrappedStypeAttrs -> WrappedStypeAttrs -> Bool
Eq, forall x. Rep WrappedStypeAttrs x -> WrappedStypeAttrs
forall x. WrappedStypeAttrs -> Rep WrappedStypeAttrs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WrappedStypeAttrs x -> WrappedStypeAttrs
$cfrom :: forall x. WrappedStypeAttrs -> Rep WrappedStypeAttrs x
Generic, Int -> WrappedStypeAttrs -> ShowS
[WrappedStypeAttrs] -> ShowS
WrappedStypeAttrs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WrappedStypeAttrs] -> ShowS
$cshowList :: [WrappedStypeAttrs] -> ShowS
show :: WrappedStypeAttrs -> String
$cshow :: WrappedStypeAttrs -> String
showsPrec :: Int -> WrappedStypeAttrs -> ShowS
$cshowsPrec :: Int -> WrappedStypeAttrs -> ShowS
Show)
wrappedStypeAttrs :: Stype r -> WrappedStypeAttrs
wrappedStypeAttrs :: forall (r :: SEXPTYPE). Stype r -> WrappedStypeAttrs
wrappedStypeAttrs (Binary RTypeRep 'LGLSXP
_ StypeAttrs
a) = Text
-> Text -> Maybe StypeRole -> Text -> Value -> WrappedStypeAttrs
MkWrappedStypeAttrs StypeAttrs
a.short_label StypeAttrs
a.long_label StypeAttrs
a.study_role Text
"v_binary" (forall a. ToJSON a => a -> Value
toJSON ())
wrappedStypeAttrs (Continuous RTypeRep 'REALSXP
_ StypeAttrs
a) = Text
-> Text -> Maybe StypeRole -> Text -> Value -> WrappedStypeAttrs
MkWrappedStypeAttrs StypeAttrs
a.short_label StypeAttrs
a.long_label StypeAttrs
a.study_role Text
"v_continuous" (forall a. ToJSON a => a -> Value
toJSON ())
wrappedStypeAttrs (ContinuousNonneg RTypeRep 'REALSXP
_ StypeAttrs
a) = Text
-> Text -> Maybe StypeRole -> Text -> Value -> WrappedStypeAttrs
MkWrappedStypeAttrs StypeAttrs
a.short_label StypeAttrs
a.long_label StypeAttrs
a.study_role Text
"v_continuous_nonneg" (forall a. ToJSON a => a -> Value
toJSON ())
wrappedStypeAttrs (Count RTypeRep 'INTSXP
_ StypeAttrs
a) = Text
-> Text -> Maybe StypeRole -> Text -> Value -> WrappedStypeAttrs
MkWrappedStypeAttrs StypeAttrs
a.short_label StypeAttrs
a.long_label StypeAttrs
a.study_role Text
"v_count" (forall a. ToJSON a => a -> Value
toJSON ())
wrappedStypeAttrs (Nominal Factor
fv StypeAttrs
a) = Text
-> Text -> Maybe StypeRole -> Text -> Value -> WrappedStypeAttrs
MkWrappedStypeAttrs StypeAttrs
a.short_label StypeAttrs
a.long_label StypeAttrs
a.study_role Text
"v_nominal" (forall a. ToJSON a => a -> Value
toJSON [Text]
sa)
where
sa :: [Text]
sa = forall a. Vector a -> [a]
V.toList forall a b. (a -> b) -> a -> b
$ Factor -> Vector Text
levels Factor
fv
wrappedStypeAttrs (Ordered Factor
fv StypeAttrs
a) = Text
-> Text -> Maybe StypeRole -> Text -> Value -> WrappedStypeAttrs
MkWrappedStypeAttrs StypeAttrs
a.short_label StypeAttrs
a.long_label StypeAttrs
a.study_role Text
"v_ordered" (forall a. ToJSON a => a -> Value
toJSON [Text]
sa)
where
sa :: [Text]
sa = forall a. Vector a -> [a]
V.toList forall a b. (a -> b) -> a -> b
$ Factor -> Vector Text
levels Factor
fv
wrappedStypeAttrs (Proportion RTypeRep 'REALSXP
_ StypeAttrs
a) = Text
-> Text -> Maybe StypeRole -> Text -> Value -> WrappedStypeAttrs
MkWrappedStypeAttrs StypeAttrs
a.short_label StypeAttrs
a.long_label StypeAttrs
a.study_role Text
"v_proportion" (forall a. ToJSON a => a -> Value
toJSON ())
data Stype :: SEXPTYPE -> Type where
Binary :: RTypeRep 'LGLSXP -> StypeAttrs -> Stype 'LGLSXP
Continuous :: RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
ContinuousNonneg :: RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
Count :: RTypeRep 'INTSXP -> StypeAttrs -> Stype 'INTSXP
Nominal :: Factor -> StypeAttrs -> Stype 'STRSXP
Ordered :: Factor -> StypeAttrs -> Stype 'STRSXP
Proportion :: RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
instance ToJSON StypeRole
instance ToJSON StypeAttrs
instance ToJSON WrappedStypeAttrs
instance (Show (SEXPElem s)) => Show (Stype s) where
show :: Stype s -> String
show (Binary RTypeRep 'LGLSXP
v StypeAttrs
a) = String
"Binary " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show RTypeRep 'LGLSXP
v forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show StypeAttrs
a
show (Continuous RTypeRep 'REALSXP
v StypeAttrs
a) = String
"Continuous " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show RTypeRep 'REALSXP
v forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show StypeAttrs
a
show (ContinuousNonneg RTypeRep 'REALSXP
v StypeAttrs
a) = String
"ContinuousNonneg " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show RTypeRep 'REALSXP
v forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show StypeAttrs
a
show (Count RTypeRep 'INTSXP
v StypeAttrs
a) = String
"Count " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show RTypeRep 'INTSXP
v forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show StypeAttrs
a
show (Nominal Factor
v StypeAttrs
a) = String
"Nominal " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Factor
v forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show StypeAttrs
a
show (Ordered Factor
v StypeAttrs
a) = String
"Ordered " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Factor
v forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show StypeAttrs
a
show (Proportion RTypeRep 'REALSXP
v StypeAttrs
a) = String
"Proportion " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show RTypeRep 'REALSXP
v forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show StypeAttrs
a
v_binary :: RTypeRep 'LGLSXP -> StypeAttrs -> Stype 'LGLSXP
v_binary :: RTypeRep 'LGLSXP -> StypeAttrs -> Stype 'LGLSXP
v_binary = RTypeRep 'LGLSXP -> StypeAttrs -> Stype 'LGLSXP
Binary
as_v_binary :: (AsLogical a) => a -> StypeAttrs -> Stype 'LGLSXP
as_v_binary :: forall a. AsLogical a => a -> StypeAttrs -> Stype 'LGLSXP
as_v_binary a
v = RTypeRep 'LGLSXP -> StypeAttrs -> Stype 'LGLSXP
v_binary (forall a. AsLogical a => a -> RTypeRep 'LGLSXP
as_logical a
v)
v_continuous :: RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
v_continuous :: RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
v_continuous = RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
Continuous
as_v_continuous :: (AsNumeric a) => a -> StypeAttrs -> Stype 'REALSXP
as_v_continuous :: forall a. AsNumeric a => a -> StypeAttrs -> Stype 'REALSXP
as_v_continuous a
v = RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
v_continuous (forall a. AsNumeric a => a -> RTypeRep 'REALSXP
as_numeric a
v)
v_continuous_nonneg :: RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
v_continuous_nonneg :: RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
v_continuous_nonneg = RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
ContinuousNonneg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Vector a -> Vector b
V.map forall {a}. (Ord a, Num a) => Maybe a -> Maybe a
op
where
op :: Maybe a -> Maybe a
op Maybe a
Nothing = forall a. Maybe a
Nothing
op (Just a
x) = if a
x forall a. Ord a => a -> a -> Bool
< a
0 then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
x
as_v_continuous_nonneg :: (AsNumeric a) => a -> StypeAttrs -> Stype 'REALSXP
as_v_continuous_nonneg :: forall a. AsNumeric a => a -> StypeAttrs -> Stype 'REALSXP
as_v_continuous_nonneg a
v = RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
v_continuous_nonneg (forall a. AsNumeric a => a -> RTypeRep 'REALSXP
as_numeric a
v)
v_count :: RTypeRep 'INTSXP -> StypeAttrs -> Stype 'INTSXP
v_count :: RTypeRep 'INTSXP -> StypeAttrs -> Stype 'INTSXP
v_count = RTypeRep 'INTSXP -> StypeAttrs -> Stype 'INTSXP
Count forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Vector a -> Vector b
V.map forall {a}. (Ord a, Num a) => Maybe a -> Maybe a
op
where
op :: Maybe a -> Maybe a
op Maybe a
Nothing = forall a. Maybe a
Nothing
op (Just a
x) = if a
x forall a. Ord a => a -> a -> Bool
< a
0 then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
x
as_v_count :: (AsInteger a) => a -> StypeAttrs -> Stype 'INTSXP
as_v_count :: forall a. AsInteger a => a -> StypeAttrs -> Stype 'INTSXP
as_v_count a
v = RTypeRep 'INTSXP -> StypeAttrs -> Stype 'INTSXP
v_count (forall a. AsInteger a => a -> RTypeRep 'INTSXP
as_integer a
v)
v_nominal ::
(AsCharacter a) =>
a ->
V.Vector Text ->
StypeAttrs ->
Stype 'STRSXP
v_nominal :: forall a.
AsCharacter a =>
a -> Vector Text -> StypeAttrs -> Stype 'STRSXP
v_nominal a
rv Vector Text
lvls = Factor -> StypeAttrs -> Stype 'STRSXP
Nominal (forall a. AsCharacter a => a -> Vector Text -> Factor
factor a
rv Vector Text
lvls)
v_ordered ::
(AsCharacter (RTypeRep r)) =>
RTypeRep r ->
V.Vector Text ->
StypeAttrs ->
Stype 'STRSXP
v_ordered :: forall (r :: SEXPTYPE).
AsCharacter (RTypeRep r) =>
RTypeRep r -> Vector Text -> StypeAttrs -> Stype 'STRSXP
v_ordered RTypeRep r
rv Vector Text
lvls = Factor -> StypeAttrs -> Stype 'STRSXP
Ordered (forall a. AsCharacter a => a -> Vector Text -> Factor
factor RTypeRep r
rv Vector Text
lvls)
v_proportion :: RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
v_proportion :: RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
v_proportion = RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
Proportion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Vector a -> Vector b
V.map forall {a}. (Ord a, Num a) => Maybe a -> Maybe a
op
where
op :: Maybe a -> Maybe a
op Maybe a
Nothing = forall a. Maybe a
Nothing
op (Just a
x) = if a
x forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| a
x forall a. Ord a => a -> a -> Bool
> a
1 then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
x
as_v_proportion :: (AsNumeric a) => a -> StypeAttrs -> Stype 'REALSXP
as_v_proportion :: forall a. AsNumeric a => a -> StypeAttrs -> Stype 'REALSXP
as_v_proportion a
v = RTypeRep 'REALSXP -> StypeAttrs -> Stype 'REALSXP
v_proportion (forall a. AsNumeric a => a -> RTypeRep 'REALSXP
as_numeric a
v)
as_canonical :: Stype r -> RTypeRep r
as_canonical :: forall (r :: SEXPTYPE). Stype r -> RTypeRep r
as_canonical = forall (r :: SEXPTYPE). Stype r -> RTypeRep r
stypeRTypeRep
stypeRTypeRep :: Stype r -> RTypeRep r
stypeRTypeRep :: forall (r :: SEXPTYPE). Stype r -> RTypeRep r
stypeRTypeRep Stype r
sv = case Stype r
sv of
Binary RTypeRep 'LGLSXP
rv StypeAttrs
_ -> RTypeRep 'LGLSXP
rv
Continuous RTypeRep 'REALSXP
rv StypeAttrs
_ -> RTypeRep 'REALSXP
rv
ContinuousNonneg RTypeRep 'REALSXP
rv StypeAttrs
_ -> RTypeRep 'REALSXP
rv
Count RTypeRep 'INTSXP
rv StypeAttrs
_ -> RTypeRep 'INTSXP
rv
Nominal Factor
rv StypeAttrs
_ -> Factor -> RTypeRep 'STRSXP
values Factor
rv
Ordered Factor
rv StypeAttrs
_ -> Factor -> RTypeRep 'STRSXP
values Factor
rv
Proportion RTypeRep 'REALSXP
rv StypeAttrs
_ -> RTypeRep 'REALSXP
rv
stypeInfoOf :: Stype r -> (Text, StypeAttrs)
stypeInfoOf :: forall (r :: SEXPTYPE). Stype r -> (Text, StypeAttrs)
stypeInfoOf Stype r
v = case Stype r
v of
Binary RTypeRep 'LGLSXP
rv StypeAttrs
sattrs -> (forall (r :: SEXPTYPE). SingI r => RTypeRep r -> Text
textSEXPTYPEOf RTypeRep 'LGLSXP
rv, StypeAttrs
sattrs)
Continuous RTypeRep 'REALSXP
rv StypeAttrs
sattrs -> (forall (r :: SEXPTYPE). SingI r => RTypeRep r -> Text
textSEXPTYPEOf RTypeRep 'REALSXP
rv, StypeAttrs
sattrs)
ContinuousNonneg RTypeRep 'REALSXP
rv StypeAttrs
sattrs -> (forall (r :: SEXPTYPE). SingI r => RTypeRep r -> Text
textSEXPTYPEOf RTypeRep 'REALSXP
rv, StypeAttrs
sattrs)
Count RTypeRep 'INTSXP
rv StypeAttrs
sattrs -> (forall (r :: SEXPTYPE). SingI r => RTypeRep r -> Text
textSEXPTYPEOf RTypeRep 'INTSXP
rv, StypeAttrs
sattrs)
Nominal Factor
f StypeAttrs
sattrs -> (forall (r :: SEXPTYPE). SingI r => RTypeRep r -> Text
textSEXPTYPEOf (Factor -> RTypeRep 'STRSXP
values Factor
f), StypeAttrs
sattrs)
Ordered Factor
f StypeAttrs
sattrs -> (forall (r :: SEXPTYPE). SingI r => RTypeRep r -> Text
textSEXPTYPEOf (Factor -> RTypeRep 'STRSXP
values Factor
f), StypeAttrs
sattrs)
Proportion RTypeRep 'REALSXP
rv StypeAttrs
sattrs -> (forall (r :: SEXPTYPE). SingI r => RTypeRep r -> Text
textSEXPTYPEOf RTypeRep 'REALSXP
rv, StypeAttrs
sattrs)