content: {-# LANGUAGE DeriveGeneric, OverloadedStrings, LambdaCase, DataKinds #-}
  
  {- |
  Mushroom data set
  
  UCI ML Repository link <https://archive.ics.uci.edu/ml/datasets/mushroom>
  
  This data set includes descriptions of hypothetical samples corresponding to 23 species of gilled mushrooms in the Agaricus and Lepiota Family. Each species is identified as definitely edible, definitely poisonous, or of unknown edibility and not recommended. This latter class was combined with the poisonous one.
  
  
  Attribute Information:
  
  All the attributes are discrete (categorical), and attribute 11 ("stalk-root") lacks some entries. The 'classification' attribute has been mapped to a Boolean value (where edible = True).
  
  0. classification: poisonous=p, edible=e
  
  1. cap-shape: bell=b,conical=c,convex=x,flat=f, knobbed=k,sunken=s
  2. cap-surface: fibrous=f,grooves=g,scaly=y,smooth=s
  3. cap-color: brown=n,buff=b,cinnamon=c,gray=g,green=r, pink=p,purple=u,red=e,white=w,yellow=y
  4. bruises?: bruises=t,no=f
  5. odor: almond=a,anise=l,creosote=c,fishy=y,foul=f, musty=m,none=n,pungent=p,spicy=s
  6. gill-attachment: attached=a,descending=d,free=f,notched=n
  7. gill-spacing: close=c,crowded=w,distant=d
  8. gill-size: broad=b,narrow=n
  9. gill-color: black=k,brown=n,buff=b,chocolate=h,gray=g, green=r,orange=o,pink=p,purple=u,red=e, white=w,yellow=y
  10. stalk-shape: enlarging=e,tapering=t
  11. stalk-root: bulbous=b,club=c,cup=u,equal=e, rhizomorphs=z,rooted=r,missing=?
  12. stalk-surface-above-ring: fibrous=f,scaly=y,silky=k,smooth=s
  13. stalk-surface-below-ring: fibrous=f,scaly=y,silky=k,smooth=s
  14. stalk-color-above-ring: brown=n,buff=b,cinnamon=c,gray=g,orange=o, pink=p,red=e,white=w,yellow=y
  15. stalk-color-below-ring: brown=n,buff=b,cinnamon=c,gray=g,orange=o, pink=p,red=e,white=w,yellow=y
  16. veil-type: partial=p,universal=u
  17. veil-color: brown=n,orange=o,white=w,yellow=y
  18. ring-number: none=n,one=o,two=t
  19. ring-type: cobwebby=c,evanescent=e,flaring=f,large=l, none=n,pendant=p,sheathing=s,zone=z
  20. spore-print-color: black=k,brown=n,buff=b,chocolate=h,green=r, orange=o,purple=u,white=w,yellow=y
  21. population: abundant=a,clustered=c,numerous=n, scattered=s,several=v,solitary=y
  22. habitat: grasses=g,leaves=l,meadows=m,paths=p, urban=u,waste=w,woods=d
  
  Example rows:
  
  p,x,s,n,t,p,f,c,n,k,e,e,s,s,w,w,p,w,o,p,k,s,u
  
  e,x,s,y,t,a,f,c,b,k,e,c,s,s,w,w,p,w,o,p,n,n,g
  -}
  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 Control.Applicative
  import Network.HTTP.Req ((/:), Scheme(..))
  
  data MushroomEntry = MushroomEntry {
      edible :: Bool -- ^ Is the mushroom edible?
    , 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)     
  
  -- | Whether a mushroom sample is poisonous or edible; the classification tasks involves predicting this label.
  -- data Classification = Poisonous | Edible deriving (Eq, Read, Show, Ord, Enum, Bounded, Generic)
  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]    
    
  -- | 18. ring-number: none=n,one=o,two=t
  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"
  