classify-frog 0.2.3 → 0.2.4.1
raw patch · 5 files changed
+176/−126 lines, 5 filesdep +comfort-arraydep +hmm-lapackdep +lapackdep −hmatrixdep −hmm-hmatrixdep ~containers
Dependencies added: comfort-array, hmm-lapack, lapack
Dependencies removed: hmatrix, hmm-hmatrix
Dependency ranges changed: containers
Files
- classify-frog.cabal +9/−5
- src/Feature.hs +2/−2
- src/HiddenMarkovModel.hs +57/−30
- src/HiddenMarkovModel/Hardwired.hs +77/−55
- src/Main.hs +31/−34
classify-frog.cabal view
@@ -1,5 +1,5 @@ Name: classify-frog-Version: 0.2.3+Version: 0.2.4.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -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:
src/Feature.hs view
@@ -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] ->
src/HiddenMarkovModel.hs view
@@ -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 $
src/HiddenMarkovModel/Hardwired.hs view
@@ -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 }
src/Main.hs view
@@ -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 =