diff --git a/classify-frog.cabal b/classify-frog.cabal --- a/classify-frog.cabal +++ b/classify-frog.cabal @@ -1,5 +1,5 @@ Name: classify-frog -Version: 0.2.3 +Version: 0.2.4.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann @@ -42,7 +42,7 @@ model/diclo/hmm-supervised.csv Source-Repository this - Tag: 0.2.3 + Tag: 0.2.4.1 Type: darcs Location: http://hub.darcs.net/thielema/classify-frog @@ -98,8 +98,9 @@ Hs-Source-Dirs: src Build-Depends: - hmm-hmatrix >=0.0 && <0.1, - hmatrix >=0.16 && <0.17, + hmm-lapack >=0.3 && <0.4, + lapack >=0.2 && <0.3, + comfort-array >=0.2 && <0.3, text >=1.1 && <1.3, lazy-csv >=0.5 && <0.6, tagchup >=0.4 && <0.5, @@ -125,7 +126,7 @@ pathtype >=0.8 && <0.9, non-empty >=0.3 && <0.4, semigroups >=0.1 && <1.0, - containers >=0.4 && <0.6, + containers >=0.4 && <0.7, explicit-exception >=0.1.8 && <0.2, transformers >=0.2 && <0.6, bifunctors >=5 && <6, @@ -160,6 +161,9 @@ Main-Is: SpectralDistributionTest.hs Other-Modules: SpectralDistribution + SignalProcessing + Rate + Parameters Hs-Source-Dirs: src If flag(buildSketch) Build-Depends: diff --git a/src/Feature.hs b/src/Feature.hs --- a/src/Feature.hs +++ b/src/Feature.hs @@ -105,7 +105,7 @@ data HMM = HMM { hmmClass :: Class, - hmmodel :: HMMNamed.Gaussian Double + hmmodel :: HMM.NamedGaussian } hmmHardwired :: HMM @@ -753,7 +753,7 @@ case ListHT.breakAfter ('\n'==) content of (featureRow, model) -> ME.resolveT (ioError . userError) $ ME.ExceptionalT $ return $ do - hmmNamed <- HMMNamed.fromCSV model + hmmNamed <- HMMNamed.fromCSV HMM.statesShape model featureDescr <- case CSV.parseCSV featureRow of [header] -> diff --git a/src/HiddenMarkovModel.hs b/src/HiddenMarkovModel.hs --- a/src/HiddenMarkovModel.hs +++ b/src/HiddenMarkovModel.hs @@ -8,11 +8,16 @@ import qualified Math.HiddenMarkovModel.Named as HMMNamed import qualified Math.HiddenMarkovModel as HMM -import qualified Numeric.Container as NC -import qualified Data.Packed.Matrix as Matrix -import qualified Data.Packed.Vector as Vector -import Data.Packed.Vector (Vector) +import qualified Numeric.LAPACK.Matrix as Matrix +import qualified Numeric.LAPACK.Vector as Vector +import Numeric.LAPACK.Matrix (ZeroInt) +import Numeric.LAPACK.Vector (Vector) +import qualified Data.Array.Comfort.Storable as ComfortArray +import qualified Data.Array.Comfort.Boxed as Array +import qualified Data.Array.Comfort.Shape as Shape +import Data.Array.Comfort.Boxed (Array, (!)) + import qualified Data.StorableVector.Lazy as SVL import Foreign.Storable (Storable) @@ -24,6 +29,7 @@ import qualified Control.Monad.Exception.Synchronous as ME import qualified Control.Parallel.Strategies as Par +import qualified Control.DeepSeq as DeepSeq import qualified Data.NonEmpty.Class as NonEmptyC import qualified Data.NonEmpty as NonEmpty @@ -37,12 +43,37 @@ import Data.Monoid ((<>)) import Data.NonEmpty ((!:)) import Data.Tuple.HT (swap) +import Data.Ix (Ix) import NumericPrelude.Numeric import NumericPrelude.Base +newtype State = State Int + deriving (Eq, Ord, Ix, Show) + +instance Enum State where + fromEnum (State k) = k + toEnum = State + +instance DeepSeq.NFData State where + rnf (State k) = DeepSeq.rnf k + +state :: Int -> State +state = State + +statesShape :: Int -> ShapeState +statesShape n = Shape.Range (state 0) (state (n-1)) + + +type ShapeInt = Shape.ZeroBased Int +type ShapeState = Shape.Range State +type Gaussian = HMM.Gaussian ShapeInt ShapeState Double +type GaussianTrained = HMM.GaussianTrained ShapeInt ShapeState Double +type NamedGaussian = HMMNamed.Gaussian ShapeInt ShapeState Double + + allStates :: [String] allStates = List.sort @@ -78,34 +109,33 @@ forbiddenTransitions :: Set (String, String) -> - Map HMM.State String -> - HMM.GaussianTrained Double -> Set (String, String) + Array ShapeState String -> + GaussianTrained -> Set (String, String) forbiddenTransitions admissible dict = flip Set.difference admissible . foldMap (foldMap (\(row, (col, x)) -> Mn.when (x > 0) $ - Set.singleton - (checkedLookup dict (HMM.state col), - checkedLookup dict (HMM.state row)))) . + Set.singleton (dict ! state col, dict ! state row))) . zipWith (\k -> map ((,) k) . zip [0..]) [0..] . - Matrix.toLists . HMM.trainedTransition + map Vector.toList . Matrix.toRows . HMM.trainedTransition -inverseMap :: Map HMM.State String -> Map String HMM.State +-- cf. Math.HiddenMarkovModel.Named.inverseMap +inverseMap :: Array ShapeState String -> Map String State inverseMap = Map.fromListWith (error "duplicate label") . - map swap . Map.toList + map swap . Array.toAssociations checkedLookup :: (Ord k, Show k) => Map k a -> k -> a checkedLookup m k = Map.findWithDefault (error $ "checkedLookup: unknown key " ++ show k) k m -mapsFromLabels :: [String] -> (Map String HMM.State, Map HMM.State String) +mapsFromLabels :: [String] -> (Map String State, Array ShapeState String) mapsFromLabels ss = - let m = Map.fromList $ zip (map HMM.state [0..]) ss + let m = Array.fromList (statesShape $ length ss) ss in (inverseMap m, m) @@ -124,36 +154,34 @@ (Storable a) => NonEmpty.T SVL.Vector a -> SVL.Vector a flattenStorableVectorLazy (NonEmpty.Cons x xs) = SVL.cons x xs -prepare :: [Named.NonEmptySignal] -> NonEmpty.T [] (Vector Double) +prepare :: [Named.NonEmptySignal] -> NonEmpty.T [] (Vector ZeroInt Double) prepare nxs = let xs = map Named.body nxs - vecFromList = NC.cmap realToFrac . Vector.fromList + vecFromList = ComfortArray.map realToFrac . Vector.autoFromList in (vecFromList $ map NonEmpty.head xs) !: (map vecFromList $ List.transpose $ map (SVL.unpack . NonEmpty.tail) xs) -label :: HMM.Gaussian Double -> [Named.NonEmptySignal] -> [HMM.State] +label :: Gaussian -> [Named.NonEmptySignal] -> [State] label model = NonEmpty.flatten . HMM.reveal model . prepare -analyze :: - HMMNamed.Gaussian Double -> - [Named.NonEmptySignal] -> LabelChain.T Int String +analyze :: NamedGaussian -> [Named.NonEmptySignal] -> LabelChain.T Int String analyze model = - fmap (checkedLookup $ HMMNamed.nameFromStateMap model) . + fmap (HMMNamed.nameFromStateMap model !) . LabelChain.segment . label (HMMNamed.model model) flattenIntervals :: - Map String HMM.State -> - LabelChain.T Int String -> [HMM.State] + Map String State -> + LabelChain.T Int String -> [State] flattenIntervals dict = LabelChain.flattenLabels . fmap (checkedLookup dict) trainSupervised :: (PathClass.AbsRel ar) => - Map String HMM.State -> Path.File ar -> + Map String State -> Path.File ar -> [Named.NonEmptySignal] -> LabelChain.T Int String -> - ME.Exceptional String (HMM.GaussianTrained Double) + ME.Exceptional String GaussianTrained trainSupervised dict input sig labels = do labelSig <- ME.fromMaybe @@ -161,13 +189,13 @@ Path.toString input) $ NonEmpty.fetch $ flattenIntervals dict labels return $ - HMM.trainSupervised (Map.size dict) $ + HMM.trainSupervised (statesShape $ Map.size dict) $ NonEmptyC.zip labelSig (prepare sig) trainMany :: (Traversable f) => - (trainingData -> HMM.GaussianTrained Double) -> - NonEmpty.T f trainingData -> HMM.Gaussian Double + (trainingData -> GaussianTrained) -> + NonEmpty.T f trainingData -> Gaussian trainMany train = HMM.finishTraining . NonEmpty.foldl1 HMM.mergeTrained . Par.withStrategy (Par.parTraversable Par.rdeepseq) . fmap train @@ -198,8 +226,7 @@ <> OP.metavar "PROB" <> OP.help "convergence tolerance for unsupervised training") -takeUntilConvergence :: - Convergence -> [HMM.Gaussian Double] -> [HMM.Gaussian Double] +takeUntilConvergence :: Convergence -> [Gaussian] -> [Gaussian] takeUntilConvergence opt = (\(hmm:hmms) -> (hmm :) $ map snd . take (cvgMaxIter opt) . takeWhile fst $ diff --git a/src/HiddenMarkovModel/Hardwired.hs b/src/HiddenMarkovModel/Hardwired.hs --- a/src/HiddenMarkovModel/Hardwired.hs +++ b/src/HiddenMarkovModel/Hardwired.hs @@ -1,6 +1,9 @@ module HiddenMarkovModel.Hardwired where -import HiddenMarkovModel (inverseMap) +import qualified HiddenMarkovModel as HMMF +import HiddenMarkovModel + (NamedGaussian, Gaussian, ShapeInt, ShapeState, + State(State), state, inverseMap) import qualified Label import qualified Math.HiddenMarkovModel.Distribution as Distr @@ -8,30 +11,38 @@ import qualified Math.HiddenMarkovModel.Named as HMMNamed import qualified Math.HiddenMarkovModel as HMM -import qualified Numeric.Container as NC -import qualified Data.Packed.Matrix as Matrix -import qualified Data.Packed.Vector as Vector -import Data.Packed.Matrix (Matrix) +import qualified Numeric.LAPACK.Matrix.Shape as MatrixShape +import qualified Numeric.LAPACK.Matrix.Hermitian as Hermitian +import qualified Numeric.LAPACK.Matrix.Square as Square +import qualified Numeric.LAPACK.Matrix as Matrix +import qualified Numeric.LAPACK.Vector as Vector +import Numeric.LAPACK.Matrix (ZeroInt) -import qualified Data.Map as Map; import Data.Map (Map) +import qualified Data.Array.Comfort.Boxed as Array +import Data.Array.Comfort.Boxed (Array) + +import qualified Data.NonEmpty as NonEmpty +import Data.Map (Map) import Data.Semigroup ((<>)) -import Data.Tuple.HT (mapFst) -pause, clickBegin, clickEnd, chirping, chirpingPause, growling :: HMM.State -pause = HMM.state 0 -clickBegin = HMM.state 1 -clickEnd = HMM.state 2 -chirping = HMM.state 3 -chirpingPause = HMM.state 4 -growling = HMM.state 5 +pause, clickBegin, clickEnd, chirping, chirpingPause, growling :: State +pause = state 0 +clickBegin = state 1 +clickEnd = state 2 +chirping = state 3 +chirpingPause = state 4 +growling = state 5 numberOfStates :: Int numberOfStates = 6 -formatState :: Distr.State -> String -formatState (Distr.State s) = +statesShape :: ShapeState +statesShape = HMMF.statesShape numberOfStates + +formatState :: State -> String +formatState (State s) = case s of 1 -> "click begin" 2 -> "click end" @@ -40,37 +51,39 @@ 5 -> "growling" _ -> "pause" -labelFromStateMap :: Map HMM.State String +labelFromStateMap :: Array ShapeState String labelFromStateMap = - Map.fromList $ map (mapFst HMM.state) $ - (0, Label.pause) : - (1, Label.clickBegin) : - (2, Label.clickEnd) : - (3, Label.chirpingMain) : - (4, Label.chirpingPause) : - (5, Label.growling) : + Array.fromList statesShape $ + Label.pause : + Label.clickBegin : + Label.clickEnd : + Label.chirpingMain : + Label.chirpingPause : + Label.growling : [] -stateFromLabelMap :: Map String HMM.State +stateFromLabelMap :: Map String State stateFromLabelMap = inverseMap labelFromStateMap +type Pattern = Pat.T ShapeState Double + infixr 7 *<> -(*<>) :: Int -> Pat.T Double -> Pat.T Double +(*<>) :: Int -> Pattern -> Pattern (*<>) = Pat.replicate -rasping :: Pat.T Double +rasping :: Pattern rasping = 15 *<> (600 *<> Pat.atom clickBegin <> 600 *<> Pat.atom clickEnd) -pattern :: Pat.T Double +pattern :: Pattern pattern = 10000 *<> Pat.atom pause <> @@ -92,16 +105,17 @@ -hmm :: HMM.Gaussian Double +hmm :: Gaussian hmm = hmmTrained -hmmTrained :: HMM.Gaussian Double +hmmTrained :: Gaussian hmmTrained = HMM.Cons { HMM.initial = - Vector.fromList [0.0,0.0,0.0,1.0,0.0,0.0], + Vector.fromList statesShape [0.0,0.0,0.0,1.0,0.0,0.0], HMM.transition = - Matrix.fromLists $ + Square.fromGeneral $ Matrix.fromRowArray statesShape $ + Array.fromList statesShape $ fmap (Vector.fromList statesShape) $ [0.9994586913864266,0.0,2.100090303883067e-5,0.0,0.0,1.0218978102189781e-2] : [0.0,0.9855812349085892,4.09517609257198e-3,0.0,2.4915465385299874e-3,0.0] : [0.0,1.4418765091410832e-2,0.9956108112648844,0.0,0.0,0.0] : @@ -110,30 +124,34 @@ [5.413086135733135e-4,0.0,0.0,0.0,0.0,0.9897810218978101] : [], HMM.distribution = - Distr.gaussian $ - (Vector.fromList [0.9513191890047871], covariance [[0.17689006357223516]]) : - (Vector.fromList [1.5879408507110250], covariance [[0.600575479836784]]) : - (Vector.fromList [0.7454942099113683], covariance [[0.4088353694711163]]) : - (Vector.fromList [1.0231037870319346], covariance [[0.19801719658707737]]) : - (Vector.fromList [0.6214106323233616], covariance [[0.3085570412459857]]) : - (Vector.fromList [1.5574159338071116], covariance [[0.6221472768351596]]) : + Distr.gaussian $ Array.fromList statesShape $ + (Vector.autoFromList [0.9513191890047871], covariance [[0.17689006357223516]]) : + (Vector.autoFromList [1.5879408507110250], covariance [[0.600575479836784]]) : + (Vector.autoFromList [0.7454942099113683], covariance [[0.4088353694711163]]) : + (Vector.autoFromList [1.0231037870319346], covariance [[0.19801719658707737]]) : + (Vector.autoFromList [0.6214106323233616], covariance [[0.3085570412459857]]) : + (Vector.autoFromList [1.5574159338071116], covariance [[0.6221472768351596]]) : []} -hmmPattern :: HMM.Gaussian Double +hmmPattern :: Gaussian hmmPattern = (HMM.finishTraining $ - Pat.finish numberOfStates (Distr.GaussianTrained Map.empty) pattern) + Pat.finish statesShape + (Distr.GaussianTrained $ + Array.fromList statesShape (replicate numberOfStates Nothing) :: + Distr.GaussianTrained ShapeInt ShapeState Double) + pattern) {HMM.distribution = - Distr.gaussian $ - (Vector.fromList [1.00], covariance [[0.17]]) : - (Vector.fromList [1.60], covariance [[0.60]]) : - (Vector.fromList [0.75], covariance [[0.40]]) : - (Vector.fromList [1.00], covariance [[0.20]]) : - (Vector.fromList [0.60], covariance [[0.30]]) : - (Vector.fromList [1.60], covariance [[0.60]]) : + Distr.gaussian $ Array.fromList statesShape $ + (Vector.autoFromList [1.00], covariance [[0.17]]) : + (Vector.autoFromList [1.60], covariance [[0.60]]) : + (Vector.autoFromList [0.75], covariance [[0.40]]) : + (Vector.autoFromList [1.00], covariance [[0.20]]) : + (Vector.autoFromList [0.60], covariance [[0.30]]) : + (Vector.autoFromList [1.60], covariance [[0.60]]) : []} -hmmNamed :: HMMNamed.Gaussian Double +hmmNamed :: NamedGaussian hmmNamed = HMMNamed.Cons { HMMNamed.model = hmm, @@ -142,17 +160,21 @@ } -covariance :: [[Double]] -> Matrix Double -covariance xs = - let m = Matrix.fromLists xs - in Matrix.trans m NC.<> m +type HermitianMatrix = Hermitian.Hermitian ZeroInt +covariance :: [[Double]] -> HermitianMatrix Double +covariance = + maybe + (Hermitian.autoFromList MatrixShape.RowMajor []) + (Hermitian.covariance . Matrix.fromRowsNonEmpty) . + NonEmpty.fetch . map Vector.autoFromList -scaleStdDev :: Double -> HMM.Gaussian Double -> HMM.Gaussian Double + +scaleStdDev :: Double -> Gaussian -> Gaussian scaleStdDev k model = model { HMM.distribution = let Distr.Gaussian arr = HMM.distribution model in Distr.Gaussian $ - fmap (\(center,dev,c) -> (center, NC.scale k dev, c/k)) arr + fmap (\(center,dev,c) -> (center, Vector.scale k dev, c/k)) arr } diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -3,7 +3,6 @@ module Main where import qualified HiddenMarkovModel as HMM -import qualified Math.HiddenMarkovModel.Distribution as Distr import qualified Math.HiddenMarkovModel.Named as HMMNamed import qualified Math.HiddenMarkovModel as HMM0 @@ -107,7 +106,7 @@ import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold -import qualified Data.Array as Array +import qualified Data.Array.Comfort.Boxed as Array import qualified Data.List.Match as Match import qualified Data.List.Key as Key import qualified Data.List.HT as ListHT @@ -120,6 +119,7 @@ import qualified Data.Empty as Empty import Data.Map (Map, ); import qualified Data.Map as Map import Data.Set (Set, ); import qualified Data.Set as Set +import Data.Array.Comfort.Boxed (Array, (!)) import Data.NonEmpty ((!:), ) import Data.Biapplicative (biliftA2, ) import Data.Bitraversable (bisequenceA, ) @@ -143,8 +143,7 @@ import System.Path ((), (<.>), ) import Text.Printf (printf, ) -import qualified Numeric.Container as NC - +import qualified Numeric.LAPACK.Vector as Vector import qualified Algebra.RealRing as Real import qualified Algebra.Ring as Ring import NumericPrelude.Numeric @@ -456,8 +455,8 @@ waitPlots = mapM_ waitPlot plotStateEmissions :: - String -> Map HMM0.State String -> - String -> [(HMM0.State, (Float, Float))] -> IO PlotProcess + String -> Array HMM.ShapeState String -> + String -> [(HMM.State, (Float, Float))] -> IO PlotProcess plotStateEmissions title dict subTitle ps = do (mvarIn, mvarOut) <- MVar.newEmpty let header = title ++ ": " ++ subTitle @@ -465,19 +464,17 @@ return $ PlotProcess mvarOut plotStateEmissionsSync :: - Map HMM0.State String -> - String -> [(HMM0.State, (Float, Float))] -> IO () + Array HMM.ShapeState String -> + String -> [(HMM.State, (Float, Float))] -> IO () plotStateEmissionsSync dict title ps = void $ GP.plotSync DefaultTerm.cons $ Frame.cons (Opts.title title Opts.deflt) $ Fold.foldMap (\(state, emissions) -> - Graph2D.lineSpec - (LineSpec.title (HMM.checkedLookup dict state) LineSpec.deflt) <$> + Graph2D.lineSpec (LineSpec.title (dict!state) LineSpec.deflt) <$> Plot2D.list Graph2D.points emissions) $ - Array.assocs $ - Array.accumArray (flip (:)) [] - (fst $ Map.findMin dict, fst $ Map.findMax dict) ps + Array.toAssociations $ + Array.accumulate (flip (:)) ([] <$ dict) ps emissionPairs :: [Named.Signal] -> [(String, [(Float, Float)])] emissionPairs = @@ -489,9 +486,9 @@ plotStateEmissionsSingle :: Bool -> String -> - Map HMM0.State String -> + Array HMM.ShapeState String -> [(String, [(Float, Float)])] -> - [HMM0.State] -> IO [PlotProcess] + [HMM.State] -> IO [PlotProcess] plotStateEmissionsSingle plot title labelFromStateMap featPoints labelled = guardPlot plot $ forM featPoints $ \(n,xs) -> @@ -500,8 +497,8 @@ plotStateEmissionsMulti :: (Functor map, Fold.Foldable map) => Bool -> String -> - Map String HMM0.State -> - Map HMM0.State String -> + Map String HMM.State -> + Array HMM.ShapeState String -> map ([Named.NonEmptySignal], LabelChain.T Int String) -> IO [PlotProcess] plotStateEmissionsMulti plot title stateFromLabelMap labelFromStateMap = @@ -517,8 +514,8 @@ checkAdmissibilityTrans :: (PathClass.AbsRel ar) => - Set (String, String) -> Map HMM0.State String -> - Path.FilePath ar -> HMM0.GaussianTrained Double -> IO () + Set (String, String) -> Array HMM.ShapeState String -> + Path.FilePath ar -> HMM.GaussianTrained -> IO () checkAdmissibilityTrans admissibleTransitions labelFromStateMap path hmmTrained = do let forbiddenTransitions = @@ -546,11 +543,11 @@ emptyIntervals -printLabelCounts :: Map String HMM0.State -> [(String, Int)] -> IO () +printLabelCounts :: Map String HMM.State -> [(String, Int)] -> IO () printLabelCounts stateFromLabelMap labelCounts = forM_ labelCounts $ \(label,count) -> do printf "%003d %s\t%5d\n" - (case stateFromLabelMap Map.! label of Distr.State s -> s) + (case stateFromLabelMap Map.! label of HMM.State s -> s) label count {- @@ -559,11 +556,11 @@ because it also compares initial probabilities and these are based on little data, namely one number per audio file. -} -printModelDifference :: HMM0.Gaussian Double -> HMM0.Gaussian Double -> IO () +printModelDifference :: HMM.Gaussian -> HMM.Gaussian -> IO () printModelDifference hmmSup hmmUnsup = void $ printf "difference between supervised and unsupervised: %f\n" $ - NC.maxElement $ NC.cmap abs $ - NC.sub (HMM0.transition hmmSup) (HMM0.transition hmmUnsup) + Vector.normInf $ + Vector.sub (HMM0.transition hmmSup) (HMM0.transition hmmUnsup) @@ -585,10 +582,10 @@ writeMLPackStates :: (PathClass.AbsRel ar) => - Path.FilePath ar -> String -> [HMM0.State] -> IO () + Path.FilePath ar -> String -> [HMM.State] -> IO () writeMLPackStates outputStem part = PathIO.writeFile (outputStem <-> "mlpack" <-> part <.> "csv") . unlines . - map (\(Distr.State s) -> show s) + map (\(HMM.State s) -> show s) @@ -669,8 +666,7 @@ let newIntervals = HMM.label hmm featSigsNE supervisedTrack <- writeLabelTrackInt rate outputStem supervisedName $ - HMM.checkedLookup labelFromStateMap <$> - LabelChain.segment newIntervals + fmap (labelFromStateMap!) $ LabelChain.segment newIntervals when mlpack $ writeMLPackStates outputStem "classified" newIntervals Option.notice flags "unsupervised training" @@ -728,15 +724,16 @@ step model = HMM0.finishTraining $ HMM0.trainUnsupervised model prep - states = HMM0.state 0 !: take (numStates-1) [HMM0.state 1 ..] + states = HMM.state 0 !: take (numStates-1) [HMM.state 1 ..] + statesShape = HMM.statesShape numStates hmms = HMM.takeUntilConvergence cvg $ iterate step $ - HMM0.uniform $ HMM0.distribution $ - HMM0.finishTraining $ HMM0.trainSupervised numStates $ + HMM0.uniform $ HMM0.distribution $ HMM0.finishTraining $ + HMM0.trainSupervised statesShape $ NonEmptyC.zip (NonEmpty.cycle states) prep hmm = last hmms labelFromStateMap = - Map.fromList $ map (\s -> (s, show $ fromEnum s)) $ + Array.fromList statesShape $ map (show . fromEnum) $ NonEmpty.flatten states addNames model = Feature.HMM { @@ -756,7 +753,7 @@ let labelled = HMM.label hmm featSigsNE unsupervisedTrack <- writeLabelTrackInt featRate outputStem unsupervisedName $ - (\(Distr.State s) -> show s) <$> LabelChain.segment labelled + (\(HMM.State s) -> show s) <$> LabelChain.segment labelled when mlpack $ writeMLPackStates outputStem "classified" labelled ((audPath, audFormat), (inputTrack, featSigTracks)) <- @@ -1735,7 +1732,7 @@ writeAnalyzedTracks :: (Rate.C rate, PathClass.AbsRel ar0, PathClass.AbsRel ar1) => - HMMNamed.Gaussian Double -> + HMM.NamedGaussian -> Signal.T rate (NonEmptyMap.T (Path.FilePath ar0) [Named.NonEmptySignal]) -> Path.DirPath ar1 -> IO (Map (Path.FilePath ar0) Audacity.Track) writeAnalyzedTracks hmmNamed (Signal.Cons featRate locFeatSigs) output =