diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,4 @@ +#!/usr/bin/env runhaskell + import Distribution.Simple main = defaultMain diff --git a/Text/ARFF.hs b/Text/ARFF.hs --- a/Text/ARFF.hs +++ b/Text/ARFF.hs @@ -37,8 +37,6 @@ import System.Locale (defaultTimeLocale) import Text.Show.ByteString (putAscii, putAsciiStr, showp, unlinesP, unwordsP) import qualified Text.Show.ByteString as B -import Prelude hiding (Show) -import Prelude as P -- | Show a 'Value' in the 'Put' monad. type Putter = Value -> Put @@ -48,7 +46,7 @@ StringAttribute { put :: Putter } | RealAttribute { put :: Putter } | IntegerAttribute { put :: Putter } - | forall a . (Enum a, B.Show a) => NominalAttribute { put :: Putter, enum :: [a] } + | forall a . Show a => NominalAttribute { put :: Putter, enum :: [a] } | DateAttribute { put :: Putter, format :: String } -- | Attribute with associated type and name. @@ -60,8 +58,8 @@ | StringValue { fromStringValue :: String } | RealValue { fromRealValue :: Double } | IntegerValue { fromIntegerValue :: Integer } - | forall a . (Enum a, B.Show a) => NominalValue { fromNominalValue :: a } - | forall a . (FormatTime a) => DateValue { fromDateValue :: a } + | forall a . (Show a) => NominalValue { fromNominalValue :: a } + | forall a . (FormatTime a) => DateValue { fromDateValue :: a } -- | ARFF relation. data Relation = Relation @@ -99,7 +97,7 @@ putType (StringAttribute _) = putAsciiStr "string" putType (RealAttribute _) = putAsciiStr "real" putType (IntegerAttribute _) = putAsciiStr "integer" -putType (NominalAttribute _ es) = putAscii '{' >> (uncommaP <<< map showp) es >> putAscii '}' +putType (NominalAttribute _ es) = putAscii '{' >> (uncommaP <<< map (putAsciiStr.show)) es >> putAscii '}' putType (DateAttribute _ fmt) = unwordsP [putAsciiStr "date", showp fmt] putAttribute :: Attribute -> Put @@ -108,7 +106,7 @@ putMissingValue :: Put putMissingValue = putAscii '?' -instance P.Show (Value) where +instance Show (Value) where show (StringValue _) = "String" show (RealValue _) = "Real" show (IntegerValue _) = "Integer" @@ -137,7 +135,7 @@ putInteger a v = typeError a "Integer" v putNominal :: String -> Value -> Put -putNominal _ (NominalValue x) = showp x +putNominal _ (NominalValue x) = putAsciiStr (show x) putNominal _ MissingValue = putMissingValue putNominal a v = typeError a "Nominal" v @@ -168,11 +166,11 @@ a_int a = Attribute (IntegerAttribute (putInteger a)) a -- | Nominal attribute constructor. -a_nominal :: (Enum a, B.Show a) => [a] -> String -> Attribute +a_nominal :: (Show a) => [a] -> String -> Attribute a_nominal xs a = Attribute (NominalAttribute (putNominal a) xs) a -- | Nominal attribute constructor. -a_nominalFromTo :: (Enum a, B.Show a) => a -> a -> String -> Attribute +a_nominalFromTo :: (Enum a, Show a) => a -> a -> String -> Attribute a_nominalFromTo lo hi = a_nominal (enumFromTo lo hi) -- | Date attribute constructor. @@ -203,7 +201,7 @@ int = IntegerValue -- | Nominal value constructor. -nominal :: (Enum a, B.Show a) => a -> Value +nominal :: (Show a) => a -> Value nominal = NominalValue -- | Date value constructor diff --git a/arff.cabal b/arff.cabal --- a/arff.cabal +++ b/arff.cabal @@ -1,5 +1,5 @@ name: arff -version: 0.0.1 +version: 0.1.0 synopsis: Generate Attribute-Relation File Format (ARFF) files description: Generate Attribute-Relation File Format (ARFF) files. . @@ -17,6 +17,8 @@ build-type: Simple cabal-version: >= 1.2 +extra-source-files: examples/test.hs + library exposed-modules: Text.ARFF @@ -29,5 +31,3 @@ time >= 1 extensions: ExistentialQuantification - - ghc-options: -O2 -funbox-strict-fields diff --git a/examples/test.hs b/examples/test.hs new file mode 100644 --- /dev/null +++ b/examples/test.hs @@ -0,0 +1,59 @@ +import Data.ByteString.Lazy as B +import Data.Time (UTCTime, addUTCTime, getCurrentTime) +import Text.ARFF (date, int, missing, nominal, real, string) +import qualified Text.ARFF as ARFF +import Prelude hiding (Show) +import qualified Prelude as P + +data Strength = + ExtremelyLow + | Low + | Medium + | High + | ExtremelyHigh + deriving (Enum, Eq, P.Show) + +relation :: UTCTime -> ARFF.Relation +relation t = + ARFF.relation "Prosemus" + -- Header + [ARFF.a_date "onset", + ARFF.a_real "duration", + ARFF.a_int "note", + ARFF.a_int "velocity", + ARFF.a_nominalFromTo ExtremelyLow ExtremelyHigh "metro", + ARFF.a_string "cluster"] + -- Data + [[date (addUTCTime (realToFrac 0.277037) t) , real 0.4774 , int 63 , int 85 , nominal ExtremelyLow , string "C1"], + [date (addUTCTime (realToFrac 0.556944) t) , real 0.750504 , int 65 , int 73 , nominal Low , string "C2"], + [date (addUTCTime (realToFrac 0.750504) t) , real 0.997803 , int 63 , int 81 , nominal ExtremelyLow , string "C2"], + [date (addUTCTime (realToFrac 0.997803) t) , real 1.7697 , int 65 , int 83 , nominal Medium , string "C2"], + [date (addUTCTime (realToFrac 1.7697 ) t) , real 1.99961 , int 63 , int 63 , nominal ExtremelyLow , string "C1"], + [date (addUTCTime (realToFrac 2.10516 ) t) , real 2.46032 , int 70 , int 84 , nominal High , string "C2"], + [date (addUTCTime (realToFrac 2.52704 ) t) , real 3.8507 , int 70 , int 93 , nominal Low , string "C2"], + [date (addUTCTime (realToFrac 4.25177 ) t) , real 4.48958 , int 68 , int 69 , nominal ExtremelyLow , string "C1"], + [date (addUTCTime (realToFrac 4.55694 ) t) , real 4.7505 , int 70 , int 67 , nominal Low , string "C2"], + [date (addUTCTime (realToFrac 4.7505 ) t) , real 4.9978 , int 68 , int 81 , nominal ExtremelyLow , string "C2"], + [date (addUTCTime (realToFrac 4.9978 ) t) , real 5.7505 , int 70 , int 89 , nominal Medium , string "C2"], + [date (addUTCTime (realToFrac 5.7505 ) t) , real 6.0139 , int 68 , int 88 , nominal ExtremelyLow , string "C1"], + [date (addUTCTime (realToFrac 6.1644 ) t) , real 6.50429 , int 75 , int 86 , nominal ExtremelyLow , string "C2"], + [date (addUTCTime (realToFrac 6.50429 ) t) , real 7.00479 , int 73 , int 74 , nominal Low , string "C1"], + [date (addUTCTime (realToFrac 7.01768 ) t) , real 7.45781 , int 72 , int 65 , nominal Medium , string "C2"], + [date (addUTCTime (realToFrac 7.50429 ) t) , real 8.00479 , int 70 , int 68 , nominal Low , string "C1"], + [date (addUTCTime (realToFrac 8.55694 ) t) , real 8.96425 , int 73 , int 58 , nominal Low , string "C2"], + [date (addUTCTime (realToFrac 8.96425 ) t) , real 9.3604 , int 70 , int 91 , nominal Medium , string "C1"], + [date (addUTCTime (realToFrac 9.36378 ) t) , real 9.63658 , int 66 , int 70 , nominal ExtremelyLow , string "C2"], + [date (addUTCTime (realToFrac 9.69892 ) t) , real 9.94381 , int 58 , int 69 , nominal ExtremelyLow , string "C1"], + [date (addUTCTime (realToFrac 10.1052 ) t) , real 10.9101 , int 65 , int 81 , nominal High , string "C2"], + [date (addUTCTime (realToFrac 11.0952 ) t) , real 11.6182 , int 63 , int 62 , nominal Medium , string "C2"], + [date (addUTCTime (realToFrac 12.2518 ) t) , real 12.4896 , int 61 , int 71 , nominal ExtremelyLow , string "C2"], + [date (addUTCTime (realToFrac 12.5569 ) t) , real 12.7522 , int 63 , int 65 , nominal Low , string "C1"], + [date (addUTCTime (realToFrac 12.8012 ) t) , real 12.9547 , int 65 , int 76 , nominal ExtremelyLow , missing ], + [date (addUTCTime (realToFrac 12.9955 ) t) , real 13.5069 , int 68 , int 11 , nominal Medium , string "C1"], + [date (addUTCTime (realToFrac 13.527 ) t) , real 13.4966 , int 68 , int 94 , nominal Low , string "C2"], + [date (addUTCTime (realToFrac 13.4966 ) t) , real 13.8325 , int 70 , int 75 , nominal Low , string "C2"], + [date (addUTCTime (realToFrac 13.8325 ) t) , real 14.0093 , int 64 , int 73 , nominal ExtremelyLow , string "C1"], + [date (addUTCTime (realToFrac 14.1052 ) t) , real 15.8096 , int 61 , int 64 , nominal High , string "C0"] ] + +main :: IO () +main = getCurrentTime >>= B.putStr . ARFF.encode . relation