{-# LANGUAGE DeriveGeneric, OverloadedStrings, LambdaCase, DataKinds #-}
module Numeric.Datasets.Mushroom (
mushroom
, MushroomEntry(..)
, CapShape(..), CapSurface(..), CapColor(..), Odor(..)
, GillAttachment(..), GillSpacing(..), GillSize(..), GillColor(..), StalkShape(..)
, StalkRoot(..), StalkSurfaceAboveRing(..), StalkSurfaceBelowRing(..)
, StalkColorAboveRing(..), StalkColorBelowRing(..), VeilType(..), VeilColor(..)
, RingNumber(..), RingType(..), SporePrintColor(..), Population(..), Habitat(..)
) where
import Numeric.Datasets
import Data.Csv
import GHC.Generics
import Network.HTTP.Req ((/:), Scheme(..))
data MushroomEntry = MushroomEntry {
edible :: Bool
, capShape :: CapShape
, capSurface :: CapSurface
, capColor :: CapColor
, bruises :: Bool
, odor :: Odor
, gillAttachment :: GillAttachment
, gillSpacing :: GillSpacing
, gillSize :: GillSize
, gillColor :: GillColor
, stalkShape :: StalkShape
, stalkRoot :: Maybe StalkRoot
, stalkSurfaceAboveRing :: StalkSurfaceAboveRing
, stalkSurfaceBelowRing :: StalkSurfaceBelowRing
, stalkColorAboveRing :: StalkColorAboveRing
, stalkColorBelowRing :: StalkColorBelowRing
, veilType :: VeilType
, veilColor :: VeilColor
, ringNumber :: RingNumber
, ringType :: RingType
, sporePrintColor :: SporePrintColor
, population :: Population
, habitat :: Habitat } deriving (Show, Read, Generic)
instance FromRecord MushroomEntry where
parseRecord v = MushroomEntry <$>
(charToClassification <$> v .! 0) <*>
(charToCapShape <$> v .! 1) <*>
(charToCapSurface <$> v .! 2) <*>
(charToCapColor <$> v .! 3) <*>
(charToBruises <$> v .! 4) <*>
(charToOdor <$> v .! 5) <*>
(charToGillAttachment <$> v .! 6) <*>
(charToGillSpacing <$> v .! 7) <*>
(charToGillSize <$> v .! 8) <*>
(charToGillColor <$> v .! 9) <*>
(charToStalkShape <$> v .! 10) <*>
(charToStalkRoot <$> v .! 11) <*>
(charToSsar <$> v .! 12) <*>
(charToSsbr <$> v .! 13) <*>
(charToScar <$> v .! 14) <*>
(charToScbr <$> v .! 15) <*>
(charToVeilType <$> v .! 16) <*>
(charToVeilColor <$> v .! 17) <*>
(charToRingNumber <$> v .! 18) <*>
(charToRingType <$> v .! 19) <*>
(charToSporePrintColor <$> v .! 20) <*>
(charToPopulation <$> v .! 21) <*>
(charToHabitat <$> v .! 22)
charToClassification :: Char -> Bool
charToClassification = \case
'p' -> False
'e' -> True
x -> error $ unwords ["Unexpected feature value :", show x]
data CapShape = Bell | Conical | Convex | Flat | Knobbed | Sunken deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToCapShape :: Char -> CapShape
charToCapShape = \case
'b' -> Bell
'c' -> Conical
'x' -> Convex
'f' -> Flat
'k' -> Knobbed
's' -> Sunken
x -> error $ unwords ["Unexpected feature value :", show x]
data CapSurface = CSFibrous | CSGrooves | CSScaly | CSSmooth deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToCapSurface :: Char -> CapSurface
charToCapSurface = \case
'f' -> CSFibrous
'g' -> CSGrooves
'y' -> CSScaly
's' -> CSSmooth
x -> error $ unwords ["Unexpected feature value :", show x]
data CapColor = CCBrown | CCBuff | CCCinnamon | CCGray | CCGreen | CCPink | CCPurple | CCRed | CCWhite | CCYellow deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToCapColor :: Char -> CapColor
charToCapColor = \case
'n' -> CCBrown
'b' -> CCBuff
'c' -> CCCinnamon
'g' -> CCGray
'r' -> CCGreen
'p' -> CCPink
'u' -> CCPurple
'e' -> CCRed
'w' -> CCWhite
'y' -> CCYellow
x -> error $ unwords ["Unexpected feature value :", show x]
charToBruises :: Char -> Bool
charToBruises c = case c of
't' -> True
'f' -> False
x -> error $ unwords ["Unexpected feature value :", show x]
data Odor = Almond | Anise | Creosote | Fishy | Foul | Musty | None | Pungent | Spicy deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToOdor :: Char -> Odor
charToOdor = \case
'a' -> Almond
'l' -> Anise
'c' -> Creosote
'y' -> Fishy
'f' -> Foul
'm' -> Musty
'n' -> None
'p' -> Pungent
's' -> Spicy
x -> error $ unwords ["Unexpected feature value :", show x]
data GillAttachment = Attached | Descending | Free | Notched deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToGillAttachment :: Char -> GillAttachment
charToGillAttachment = \case
'a' -> Attached
'd' -> Descending
'f' -> Free
'n' -> Notched
x -> error $ unwords ["Unexpected feature value :", show x]
data GillSpacing = Close | Crowded | Distant deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToGillSpacing :: Char -> GillSpacing
charToGillSpacing = \case
'c' -> Close
'w' -> Crowded
'd' -> Distant
x -> error $ unwords ["Unexpected feature value :", show x]
data GillSize = Broad | Narrow deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToGillSize :: Char -> GillSize
charToGillSize = \case
'b' -> Broad
'n' -> Narrow
x -> error $ unwords ["Unexpected feature value :", show x]
data GillColor = GCBlack | GCBrown | GCBuff | GCChocolate | GCGray | GCGreen | GCOrange | GCPink | GCPurple | GCRed | GCWhite | GCYellow deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToGillColor :: Char -> GillColor
charToGillColor = \case
'k' -> GCBlack
'n' -> GCBrown
'b' -> GCBuff
'h' -> GCChocolate
'g' -> GCGray
'r' -> GCGreen
'o' -> GCOrange
'p' -> GCPink
'u' -> GCPurple
'e' -> GCRed
'w' -> GCYellow
x -> error $ unwords ["Unexpected feature value :", show x]
data StalkShape = Enlarging | Tapering deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToStalkShape :: Char -> StalkShape
charToStalkShape = \case
'e' -> Enlarging
't' -> Tapering
x -> error $ unwords ["Unexpected feature value :", show x]
data StalkRoot = Bulbous | Club | Cup | Equal | Rhizomorphs | Rooted deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToStalkRoot :: Char -> Maybe StalkRoot
charToStalkRoot c = case c of
'b' -> Just Bulbous
'c' -> Just Club
'u' -> Just Cup
'e' -> Just Equal
'z' -> Just Rhizomorphs
'r' -> Just Rooted
'?' -> Nothing
x -> error $ unwords ["Unexpected feature value :", show x]
data StalkSurfaceAboveRing = SSARFibrous | SSARScaly | SSARSilky | SSARSmooth deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToSsar :: Char -> StalkSurfaceAboveRing
charToSsar = \case
'f' -> SSARFibrous
'y' -> SSARScaly
'k' -> SSARSilky
's' -> SSARSmooth
x -> error $ unwords ["Unexpected feature value :", show x]
data StalkSurfaceBelowRing = SSBRFibrous | SSBRScaly | SSBRSilky | SSBRSmooth deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToSsbr :: Char -> StalkSurfaceBelowRing
charToSsbr = \case
'f' -> SSBRFibrous
'y' -> SSBRScaly
'k' -> SSBRSilky
's' -> SSBRSmooth
x -> error $ unwords ["Unexpected feature value :", show x]
data StalkColorAboveRing = SCARBrown | SCARBuff | SCARCinnamon | SCARGray | SCAROrange | SCARPink | SCARRed | SCARWhite | SCARYellow deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToScar :: Char -> StalkColorAboveRing
charToScar = \case
'n' -> SCARBrown
'b' -> SCARBuff
'c' -> SCARCinnamon
'g' -> SCARGray
'o' -> SCAROrange
'p' -> SCARPink
'e' -> SCARRed
'w' -> SCARWhite
'y' -> SCARYellow
x -> error $ unwords ["Unexpected feature value :", show x]
data StalkColorBelowRing = SCBRBrown | SCBRBuff | SCBRCinnamon | SCBRGray | SCBROrange | SCBRPink | SCBRRed | SCBRWhite | SCBRYellow deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToScbr :: Char -> StalkColorBelowRing
charToScbr = \case
'n' -> SCBRBrown
'b' -> SCBRBuff
'c' -> SCBRCinnamon
'g' -> SCBRGray
'o' -> SCBROrange
'p' -> SCBRPink
'e' -> SCBRRed
'w' -> SCBRWhite
'y' -> SCBRYellow
x -> error $ unwords ["Unexpected feature value :", show x]
data VeilType = Partial | Universal deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToVeilType :: Char -> VeilType
charToVeilType = \case
'p' -> Partial
'u' -> Universal
x -> error $ unwords ["Unexpected feature value :", show x]
data VeilColor = VCBrown | VCOrange | VCWhite | VCYellow deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToVeilColor :: Char -> VeilColor
charToVeilColor = \case
'n' -> VCBrown
'o' -> VCOrange
'w' -> VCWhite
'y' -> VCYellow
x -> error $ unwords ["Unexpected feature value :", show x]
data RingNumber = RNNone | RNOne | RNTwo deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToRingNumber :: Char -> RingNumber
charToRingNumber = \case
'n' -> RNNone
'o' -> RNOne
't' -> RNTwo
x -> error $ unwords ["Unexpected feature value :", show x]
data RingType = RTCobwebby | RTEvanescent | RTFlaring | RTLarge | RTNone | RTPendant | RTSheathing | RTZone deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToRingType :: Char -> RingType
charToRingType = \case
'c' -> RTCobwebby
'e' -> RTEvanescent
'f' -> RTFlaring
'l' -> RTLarge
'n' -> RTNone
'p' -> RTPendant
's' -> RTSheathing
'z' -> RTZone
x -> error $ unwords ["Unexpected feature value :", show x]
data SporePrintColor = SPCBlack | SPCBrown | SPCBuff | SPCChocolate | SPCGreen | SPCOrange | SPCPurple | SPCWhite | SPCYellow deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToSporePrintColor :: Char -> SporePrintColor
charToSporePrintColor = \case
'k' -> SPCBlack
'n' -> SPCBrown
'b' -> SPCBuff
'h' -> SPCChocolate
'r' -> SPCGreen
'o' -> SPCOrange
'u' -> SPCPurple
'w' -> SPCWhite
'y' -> SPCYellow
x -> error $ unwords ["Unexpected feature value :", show x]
data Population = Abundant | Clustered | Numerous | Scattered | Several | Solitary deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToPopulation :: Char -> Population
charToPopulation = \case
'a' -> Abundant
'c' -> Clustered
'n' -> Numerous
's' -> Scattered
'v' -> Several
'y' -> Solitary
x -> error $ unwords ["Unexpected feature value :", show x]
data Habitat = Grasses | Leaves | Meadows | Paths | Urban | Waste | Woods deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
charToHabitat :: Char -> Habitat
charToHabitat = \case
'g' -> Grasses
'l' -> Leaves
'm' -> Meadows
'p' -> Paths
'u' -> Urban
'w' -> Waste
'd' -> Woods
x -> error $ unwords ["Unexpected feature value :", show x]
mushroom :: Dataset MushroomEntry
mushroom = csvDataset
$ URL $ uciMLDB /: "mushroom" /: "agaricus-lepiota.data"