diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Copyright (c) 2014 Henning Thielemann
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. Neither the name of the University nor the names of its contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
diff --git a/Makefile b/Makefile
new file mode 100644
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,35 @@
+FLATPAK = $$FLATPAKBUILD
+
+all:	ReadMe.html
+
+%.html: %.md
+	pandoc --standalone --metadata pagetitle="$*" --output=$@ $<
+
+
+ghci:
+	ghci -Wall -i:src src/Main.hs
+
+testbuild:
+	runhaskell Setup configure --user
+	runhaskell Setup build
+	runhaskell Setup haddock
+
+%.flv:	%.flac
+	ffmpeg -r 6 -i /suse10/sound-collage/market/%06d.jpeg \
+	   -i $< -t 00:03:03 -b:a 384k -b:v 4000k $@
+
+# dist-newstyle/cache/plan.json:
+#	cabal new-build --dry-run
+
+flatpak.json:	flatpak.cabal.json dist-newstyle/cache/plan.json
+	cabal-flatpak --cabal-install --arch x86_64 --arch i386 $< $@
+
+repo-%:	flatpak.json
+	flatpak-builder --jobs=4 --force-clean --arch=$* --repo=$(FLATPAK)/repository --state-dir=$(FLATPAK)/builder/ $(FLATPAK)/build/sound-collage $<
+	touch $@
+
+sound-collage.%.flatpak:	repo-%
+	flatpak build-bundle --arch=$* $(FLATPAK)/repository $@ com.github.thielema.sound-collage \
+	  --runtime-repo=https://flathub.org/repo/flathub.flatpakrepo
+
+flatpak-all:	sound-collage.x86_64.flatpak sound-collage.i386.flatpak
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#! /usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/sound-collage.cabal b/sound-collage.cabal
new file mode 100644
--- /dev/null
+++ b/sound-collage.cabal
@@ -0,0 +1,57 @@
+Cabal-Version:  2.2
+Name:           sound-collage
+Version:        0.2.1
+License:        BSD-3-Clause
+License-File:   LICENSE
+Author:         Henning Thielemann <haskell@henning-thielemann.de>
+Maintainer:     Henning Thielemann <haskell@henning-thielemann.de>
+Category:       Sound
+Synopsis:       Approximate a song from other pieces of sound
+Description:
+  This program allows you to decompose a set of audio files into chunks
+  and use these chunks for building a new audio file
+  that matches another given audio file.
+  This is very similar to constructing an image
+  from small images that are layed out in a rectangular grid.
+Tested-With:    GHC==7.4.2, GHC==8.6.5
+Build-Type:     Simple
+Extra-Source-Files:
+  Makefile
+
+Source-Repository this
+  Tag:         0.2.1
+  Type:        darcs
+  Location:    https://hub.darcs.net/thielema/sound-collage/
+
+Source-Repository head
+  Type:        darcs
+  Location:    https://hub.darcs.net/thielema/sound-collage/
+
+Executable sound-collage
+  Build-Depends:
+    comfort-fftw >=0.0 && <0.1,
+    comfort-array >=0.5 && <0.6,
+    storablevector >=0.2 && <0.3,
+    synthesizer-core >=0.7 && <0.9,
+    soxlib >=0.0.1 && <0.1,
+    sample-frame >=0.0 && <0.1,
+    numeric-prelude >=0.4.1 && <0.5,
+    shell-utility >=0.0 && <0.2,
+    optparse-applicative >=0.11 && <0.17,
+    pathtype >=0.8 && <0.9,
+    filepath >=1.3 && <1.5,
+    temporary >=1.1 && <1.4,
+    containers >=0.2 && <0.7,
+    transformers >=0.4 && <0.7,
+    utility-ht >=0.0.12 && <0.1,
+    base >= 3 && <5
+
+  Default-Language: Haskell98
+  GHC-Prof-Options: -rtsopts
+  GHC-Options:    -Wall
+  Hs-Source-Dirs: src
+  Main-Is:        Main.hs
+  Other-Modules:
+    SoundCollage
+    Option
+    PathFormat
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,115 @@
+module Main where
+
+import qualified SoundCollage
+import qualified Option
+import qualified Options.Applicative as OP
+
+import qualified Sound.SoxLib as SoxLib
+
+import qualified Shell.Utility.Log as Shell
+
+import qualified PathFormat as PathFmt
+import qualified System.IO.Temp as Temp
+import qualified System.Path as Path
+
+import Control.Monad (liftM2, )
+import Control.Applicative (pure, (<*>), )
+import Data.Monoid ((<>), )
+import Data.Maybe (isNothing, )
+
+
+withSystemTempDirectory :: String -> (Path.AbsDir -> IO a) -> IO a
+withSystemTempDirectory name f =
+   Temp.withSystemTempDirectory name (f . Path.absDir)
+
+setChunkSize :: Int -> SoundCollage.Parameters -> SoundCollage.Parameters
+setChunkSize chunkSize params =
+   params {
+      SoundCollage.paramShift =
+         div chunkSize (SoundCollage.paramOverlap params)
+   }
+
+setNumChannels :: Int -> SoundCollage.Parameters -> SoundCollage.Parameters
+setNumChannels numChannels params =
+   params {
+      SoundCollage.paramChannels = numChannels
+   }
+
+setParams ::
+   Maybe Int -> Maybe Int ->
+   SoundCollage.Parameters -> SoundCollage.Parameters
+setParams maybeChunkSize maybeChannels =
+   maybe id setNumChannels maybeChannels .
+   maybe id setChunkSize maybeChunkSize
+
+makeParams :: Option.T -> SoundCollage.Parameters
+makeParams (Option.Cons _verbosity maybeChunkSize maybeChannels) =
+   setParams maybeChunkSize maybeChannels SoundCollage.defltParams
+
+commandParser :: Option.Command (Option.T -> IO ())
+commandParser =
+   Option.decompose
+      (pure (\flags -> SoundCollage.runDecompose (makeParams flags)))
+   <>
+   Option.decomposeSlow
+      (pure (\flags -> SoundCollage.runDecomposeSlow (makeParams flags)))
+   <>
+   Option.compose
+      (pure (\flags -> SoundCollage.runCompose (makeParams flags)))
+   <>
+   Option.associate
+      (pure (\pool flags -> SoundCollage.runAssociate (makeParams flags) pool)
+       <*> Option.pool)
+   <>
+   Option.adjacent
+      (pure
+         (\cohesion pool flags ->
+            SoundCollage.runAdjacent (Option.verbosity flags)
+               (makeParams flags) cohesion pool)
+       <*> Option.cohesion
+       <*> Option.pool)
+   <>
+   Option.auto
+      (pure
+         (\cohesion pool
+               (Option.Cons verbosity maybeChunkSize maybeChannels) src dst ->
+            withSystemTempDirectory "sound-chunks" $ \chunkDir ->
+            withSystemTempDirectory "sound-collage" $ \collDir -> do
+               params <-
+                  fmap (setParams maybeChunkSize maybeChannels) $
+                  if isNothing $ liftM2 (,) maybeChunkSize maybeChannels
+                    then do
+                       (chunkSize, numChannels) <-
+                          SoundCollage.parametersFromPool pool
+                       return $
+                          setNumChannels numChannels $
+                          setChunkSize chunkSize SoundCollage.defltParams
+                    else return SoundCollage.defltParams
+               Shell.notice verbosity $
+                  "chunk size: " ++
+                  show (SoundCollage.paramChunkSize params)
+               Shell.notice verbosity $
+                  "number of channels: " ++
+                  show (SoundCollage.paramChannels params)
+               Shell.notice verbosity $ "decompose to " ++ Path.toString chunkDir
+               SoundCollage.runDecompose params src
+                  (PathFmt.File chunkDir "%06d")
+               Shell.notice verbosity $ "associate to " ++ Path.toString collDir
+               SoundCollage.runAssociate params
+                  pool chunkDir (PathFmt.File collDir "%06d")
+               Shell.notice verbosity $ "update adjacent"
+               SoundCollage.runAdjacent verbosity params cohesion
+                  pool chunkDir collDir
+               Shell.notice verbosity $ "compose"
+               SoundCollage.runCompose params collDir dst)
+       <*> Option.cohesion
+       <*> Option.pool)
+
+main :: IO ()
+main = SoxLib.formatWith $ do
+   action <-
+      OP.execParser $
+      OP.info
+         (OP.helper <*> (OP.subparser commandParser <*> Option.parseFlags))
+         Option.desc
+   action
diff --git a/src/Option.hs b/src/Option.hs
new file mode 100644
--- /dev/null
+++ b/src/Option.hs
@@ -0,0 +1,131 @@
+module Option where
+
+import qualified Shell.Utility.Verbosity as Verbosity
+import Shell.Utility.Verbosity (Verbosity)
+
+import qualified PathFormat as PathFmt
+import qualified System.Path.PartClass as PathC
+import qualified System.Path as Path
+
+import qualified Options.Applicative as OP
+import Options.Applicative
+          (Parser, long, short, help, metavar, option, argument, )
+
+import Control.Applicative (pure, (<*>), )
+import Data.Monoid ((<>), )
+
+
+data T =
+   Cons {
+      verbosity :: Verbosity,
+      chunkSize :: Maybe Int,
+      channels :: Maybe Int
+   }
+   deriving (Show)
+
+
+path :: (PathC.FileDir fd) => OP.ReadM (Path.AbsRel fd)
+path = OP.eitherReader Path.parse
+
+type Command = OP.Mod OP.CommandFields
+
+simpleAction :: String -> String -> Parser a -> Command a
+simpleAction name helpText act =
+   OP.command name $ OP.info (OP.helper <*> act) (OP.progDesc helpText)
+
+pool :: Parser Path.AbsRelDir
+pool = argument path (metavar "POOL")
+
+src, dst :: (PathC.FileDir fd) => Parser (Path.AbsRel fd)
+src = argument path (metavar "SRC")
+dst = argument path (metavar "DST")
+
+dstFmt :: Parser PathFmt.AbsRelFile
+dstFmt = argument (OP.eitherReader PathFmt.parse) (metavar "DST")
+
+transferAction ::
+   (PathC.FileDir fd) =>
+   Parser dst ->
+   String -> String ->
+   Parser (T -> Path.AbsRel fd -> dst -> a) ->
+   Command (T -> a)
+transferAction dstp name helpText act =
+   OP.command name $
+   OP.info
+      (OP.helper <*> (pure (\f s d opt -> f opt s d) <*> act <*> src <*> dstp))
+      (OP.progDesc helpText)
+
+cohesion :: Parser Float
+cohesion =
+   option OP.auto
+       ( OP.value 1
+      <> long "cohesion"
+      <> metavar "FACTOR"
+      <> help "preference of adjacent chunks" )
+
+
+decompose, decomposeSlow, associate ::
+   (PathC.FileDir fd) =>
+   Parser (T -> Path.AbsRel fd -> PathFmt.AbsRelFile -> a) ->
+   Command (T -> a)
+
+adjacent, compose, auto ::
+   (PathC.FileDir fd0, PathC.FileDir fd1) =>
+   Parser (T -> Path.AbsRel fd0 -> Path.AbsRel fd1 -> a) ->
+   Command (T -> a)
+
+decompose =
+   transferAction dstFmt "decompose"
+      "Chop audio file in chunks and add them to the pool"
+
+decomposeSlow =
+   transferAction dstFmt "decompose-slow"
+      ("Chop audio file in chunks and add them to the pool. " ++
+       "Requires less memory but more file accesses.")
+
+associate =
+   transferAction dstFmt "associate"
+      "Associate chunks with chunks from the pool"
+
+adjacent =
+   transferAction dst "adjacent"
+      "Replace selected chunks if originally adjacent chunks match better"
+
+compose =
+   transferAction dst "compose"
+      "Compose audio file from selected pool chunks"
+
+auto =
+   transferAction dst "auto"
+      "Automatically perform 'decompose', 'associate', 'adjacent', 'compose'"
+
+
+parseFlags :: Parser T
+parseFlags =
+   pure Cons
+    <*> option (OP.eitherReader Verbosity.parse)
+           ( OP.value Verbosity.normal
+          <> short 'v'
+          <> long "verbose"
+          <> metavar "0..3"
+          <> help "verbosity" )
+    <*> option (fmap Just OP.auto)
+           ( OP.value Nothing
+          <> long "chunksize"
+          <> metavar "NUMSAMPLES"
+          <> help "size of decomposed chunks" )
+    <*> option (fmap Just OP.auto)
+           ( OP.value Nothing
+          <> long "channels"
+          <> metavar "NUMBER"
+          <> help "number of channels" )
+
+
+desc :: OP.InfoMod a
+desc =
+   OP.fullDesc
+   <>
+   OP.progDesc "Approximate an audio file by a collection of chunks"
+
+info :: OP.ParserInfo T
+info = OP.info (OP.helper <*> parseFlags) desc
diff --git a/src/PathFormat.hs b/src/PathFormat.hs
new file mode 100644
--- /dev/null
+++ b/src/PathFormat.hs
@@ -0,0 +1,25 @@
+module PathFormat where
+
+import qualified System.FilePath as StrPath
+import qualified System.Path.PartClass as PathC
+import qualified System.Path.Part as PathPart
+import qualified System.Path as Path
+import System.Path ((</>), )
+
+import qualified Text.Printf as Pf
+
+
+data File ar = File (Path.Dir ar) FilePath
+
+type AbsRelFile = File PathPart.AbsRel
+
+
+printf :: (PathC.AbsRel ar) => File ar -> Int -> Path.File ar
+printf (File dir fmt) arg =
+   dir </> Path.relFile (Pf.printf fmt arg)
+
+parse :: (PathC.AbsRel ar) => String -> Either String (File ar)
+parse str = do
+   let (dir, file) = StrPath.splitFileName str
+   dirPath <- Path.parse dir
+   return $ File dirPath file
diff --git a/src/SoundCollage.hs b/src/SoundCollage.hs
new file mode 100644
--- /dev/null
+++ b/src/SoundCollage.hs
@@ -0,0 +1,628 @@
+{-# LANGUAGE RebindableSyntax #-}
+{- |
+Very much inspired by NoiseReduction.
+
+A refined algorithm may increase the clusters for the full scans.
+E.g. if a block in the original song
+has highest Fourier coefficient at frequency k,
+then we might not only scan chunks from the pool with dominant frequency k,
+but instead scan some frequencies around k, too.
+This way we can hold a subset of the pool chunks in memory for some time.
+It would also solve the current problem
+of not finding a pool chunk with matching maximum frequency.
+
+An alternative algorithm may use a full-table scan
+for searching the best matching chunk
+but perform the scan only on some spectral coefficients.
+For instance we could choose the spectral coefficients
+with the largest variance across all spectra in the pool.
+Then we choose a number of indices,
+such that all feature vectors fit in memory.
+Then we could choose the best matching spectrum
+from a number of vectors that best match the selected Fourier coefficients.
+
+Another alternative is to keep only the n largest Fourier coefficients
+of each chunk from the pool.
+The other coefficients are treated as zero.
+This is simpler than the above method and probably maintains more information.
+We could measure the ratio of the largest to smallest kept frequency
+and we could measure the sum of suppressed frequencies
+in order to get an idea of the loss of information.
+
+A variation of the above approach is to approximate the frequency spectrum
+by a piecewise constant function.
+A hierarchical cluster algorithm could divide the spectrum
+into ranges of balanced area.
+
+Both of these strategies allow to hold a compressed form
+of the whole pool in memory,
+but the detailed search at the second stage requires lot of disk accesses.
+Optimally, the first stage is good enough
+such that we do not need the second stage, at all.
+
+Every one of these approaches could be complemented
+with a lossy audio compression
+that reduces the spectral information
+to the ones that the human auditory system can perceive.
+-}
+module SoundCollage (
+   testChopCompose,
+   runDecompose, runDecomposeSlow, runAssociate, runAdjacent, runCompose,
+   Parameters(..), paramChunkSize, defltParams, parametersFromPool,
+   ) where
+
+import qualified Sound.SoxLib as SoxLib
+import qualified Sound.Frame as Sample
+
+import qualified Numeric.FFTW.Rank1 as Trafo1
+
+import qualified Synthesizer.Storable.Signal as SigSt
+import qualified Synthesizer.Generic.Filter.NonRecursive as FiltNRG
+import qualified Synthesizer.Basic.Binary as Bin
+
+import qualified Data.StorableVector.Lazy as SVL
+import qualified Data.StorableVector as SV
+import qualified Data.Array.Comfort.Storable as Array
+import qualified Data.Array.Comfort.Shape as Shape
+import Foreign.Storable (Storable, peek, sizeOf, )
+
+import qualified Shell.Utility.Log as Shell
+import Shell.Utility.Verbosity (Verbosity)
+
+import qualified PathFormat as PathFmt
+import qualified System.Path.Directory as Dir
+import qualified System.Path.IO as PathIO
+import qualified System.Path.PartClass as PathC
+import qualified System.Path as Path
+import qualified System.IO as IO
+import System.Path ((</>), (<++>), )
+
+import Control.Monad.Trans.Except (Except, throwE, runExcept, )
+import Control.Monad (forM_, zipWithM_, (<=<), )
+
+import qualified Data.Sequence as Seq
+import qualified Data.Map as Map
+import Data.Map (Map, )
+
+import qualified Data.Traversable as Trav
+import qualified Data.Foldable as Fold
+import qualified Data.List.Key as Key
+import qualified Data.List.HT as ListHT
+import qualified Data.List as List
+import Data.Tuple.HT (mapPair, mapFst, mapSnd, swap, )
+import Data.Ord.HT (comparing, )
+import Data.Maybe.HT (toMaybe, )
+import Data.Maybe (fromMaybe, mapMaybe, )
+import Data.Bool.HT (if', )
+import Data.Monoid (mappend, )
+
+import qualified Data.Complex as Complex98
+import Data.Int (Int16, )
+
+import Text.Printf (printf, )
+
+import qualified Algebra.Transcendental as Trans
+import qualified Algebra.RealRing as Real
+import qualified Algebra.Additive as Additive
+
+import NumericPrelude.Numeric
+import NumericPrelude.Base
+import Prelude ()
+
+
+
+pillow ::
+   (Trans.C a, Storable a) =>
+   Int -> SV.Vector a
+pillow n =
+   SV.sample n (\i -> sin (pi * fromIntegral i / fromIntegral n))
+
+chop ::
+   (Additive.C a, Storable a) =>
+   Int -> Int -> SVL.Vector a -> [SVL.Vector a]
+chop numOverlap shift =
+   takeWhile (not . SVL.null) .
+   iterate (SVL.drop shift) .
+   SVL.append (SVL.fromChunks [SV.replicate ((numOverlap-1) * shift) zero])
+
+{- |
+The chunks in the chunks list must have length numOverlap*shift.
+This is not checked.
+If you use the result of 'chop'  then you are safe.
+-}
+compose ::
+   (Additive.C a, Storable a) =>
+   Int -> Int -> [SVL.Vector a] -> SVL.Vector a
+compose numOverlap shift =
+   foldl1 SigSt.mix .
+   zipWith SVL.drop [0, shift ..] .
+   reverse . map SVL.concat .
+   ListHT.sliceHorizontal numOverlap
+
+
+{- |
+test reconstruction
+-}
+testChopCompose :: IO ()
+testChopCompose =
+   let shift = 42
+       overlap = 5
+       chunkSize = shift*overlap
+       pilPre = SVL.fromChunks [pillow chunkSize]
+       pilPost = SVL.map (2 / fromIntegral overlap *) pilPre
+       xs :: SVL.Vector Float
+       xs =
+          SVL.fromChunks
+             [SV.sample 10000 (\i -> cos (pi * fromIntegral i / 10000))]
+   in  SVL.writeFile "/tmp/test.f32" $
+          SVL.zipWith (\_ y -> y) xs $
+          compose overlap shift $
+          map (FiltNRG.envelope pilPost) $
+          map (FiltNRG.envelope pilPre) $
+          chop overlap shift $
+          SVL.append xs $ SVL.fromChunks [SV.replicate chunkSize zero]
+
+
+data Parameters =
+   Parameters {
+      paramShift, paramOverlap, paramChannels :: Int
+   }
+
+defltParams :: Parameters
+defltParams =
+   Parameters {
+      paramShift = 4096,
+      paramOverlap = 2,
+      paramChannels = 1
+   }
+
+
+paramChunkSize :: Parameters -> Int
+paramChunkSize params =
+   let shift = paramShift params
+       overlap = paramOverlap params
+   in  shift*overlap
+
+maxCoeff :: SV.Vector Float -> Int
+maxCoeff ys =
+   Key.maximum (SV.index ys) $ take (SV.length ys) [0..]
+
+featuresFromChunk ::
+   Parameters -> SV.Vector Float -> SV.Vector Float
+featuresFromChunk _params =
+   Array.toStorableVector .
+   Array.map Complex98.magnitude . Trafo1.fourierRC .
+   Array.mapShape (\(Shape.ZeroBased n) -> Shape.Cyclic n) .
+   Array.fromStorableVector
+
+chopChannel ::
+   Parameters -> SVL.Vector Float -> [SV.Vector Float]
+chopChannel params input =
+   let shift = paramShift params
+       overlap = paramOverlap params
+       chunkSize = shift*overlap
+
+       pilPre = pillow chunkSize
+
+   in  takeWhile ((chunkSize==) . SV.length) $
+       map (FiltNRG.envelope pilPre . SV.concat . SVL.chunks) $
+       chop overlap shift $
+       SVL.append input $
+       SVL.fromChunks [SV.replicate chunkSize zero]
+
+
+
+
+spectrumSuffix, chunkSuffix, indexSuffix, originSuffix, targetSuffix :: String
+spectrumSuffix = "-spec.f32"
+chunkSuffix = "-chunk.s16"
+indexSuffix = "-index.txt"
+originSuffix = "-origin.txt"
+targetSuffix = "-target.txt"
+
+
+withChopped ::
+   (PathC.AbsRel ar) =>
+   Parameters -> Path.File ar ->
+   ([(SV.Vector Float, SV.Vector Float)] -> IO ()) ->
+   IO ()
+withChopped params src f =
+   withFilePath (SoxLib.withRead SoxLib.defaultReaderInfo) src $ \fmtInPtr -> do
+      fmtIn <- peek fmtInPtr
+      let numChan =
+             fromMaybe 1 $ SoxLib.channels $ SoxLib.signalInfo fmtIn
+
+      inputs <-
+         fmap (SVL.deinterleave numChan . SVL.map Bin.toCanonical) $
+         SoxLib.readStorableVectorLazy fmtInPtr (SVL.ChunkSize 16384)
+
+      f $ uncurry zip $
+         mapPair
+            (foldl1 (zipWith (SV.zipWith (+))),
+             map SV.interleave . List.transpose) $
+         unzip $
+         map ((\chunks -> (map (featuresFromChunk params) chunks, chunks)) .
+              chopChannel params)
+            inputs
+
+
+createDirectoriesFor :: (PathC.AbsRel ar) => Path.File ar -> IO ()
+createDirectoriesFor =
+   Dir.createDirectoryIfMissing True . Path.takeDirectory
+
+runDecomposeSlow ::
+   (PathC.AbsRel ar0, PathC.AbsRel ar1) =>
+   Parameters -> Path.File ar0 -> PathFmt.File ar1 -> IO ()
+runDecomposeSlow params src dst =
+   withChopped params src $ \chopped ->
+
+      let write n (spec,chunk) = do
+            let path = PathFmt.printf dst (maxCoeff spec)
+            createDirectoriesFor path
+            PathIO.appendFile (path <++> indexSuffix) $
+               show (Path.toString src, n::Int) ++ "\n"
+            withFilePath SV.appendFile (path <++> spectrumSuffix) spec
+            withFilePath SV.appendFile (path <++> chunkSuffix) $
+               (SV.map (Bin.fromCanonicalWith Real.roundSimple) chunk
+                  :: SV.Vector Int16)
+
+      in  zipWithM_ write [0..] chopped
+
+runDecompose ::
+   (PathC.AbsRel ar0, PathC.AbsRel ar1) =>
+   Parameters -> Path.File ar0 -> PathFmt.File ar1 -> IO ()
+runDecompose params src dst =
+   withChopped params src $ \chopped ->
+
+      let keyValue n (spec,chunk) =
+            (maxCoeff spec,
+             (Seq.singleton n,
+              Seq.singleton spec,
+              Seq.singleton
+                 (SV.map (Bin.fromCanonicalWith Real.roundSimple) chunk
+                    :: SV.Vector Int16)))
+
+          write maxi (index, specs, chunks) = do
+            let path = PathFmt.printf dst maxi
+            createDirectoriesFor path
+            PathIO.appendFile (path <++> indexSuffix) $ unlines $
+               map (\n -> show (Path.toString src, n::Int)) $ Fold.toList index
+            withFilePath SVL.appendFile (path <++> spectrumSuffix) $
+               SVL.fromChunks $ Fold.toList specs
+            withFilePath SVL.appendFile (path <++> chunkSuffix) $
+               SVL.fromChunks $ Fold.toList chunks
+
+      in  Fold.sequence_ $ Map.mapWithKey write $
+          Map.fromListWith (flip mappend) $
+          zipWith keyValue [0..] chopped
+
+getDirectoryContents ::
+   (PathC.AbsRel ar) => Path.Dir ar -> IO [Path.RelFile]
+getDirectoryContents = fmap snd . Dir.relDirectoryContents
+
+fileSize :: (PathC.AbsRel ar) => Path.File ar -> IO Integer
+fileSize path = PathIO.withFile path IO.ReadMode IO.hFileSize
+
+divByteSize :: (Sample.C a) => a -> Integer -> Integer
+divByteSize x n =
+   div n (fromIntegral (Sample.sizeOfElement x))
+
+maybeSuffix ::
+   (PathC.AbsRel ar) =>
+   String -> Path.File ar -> Maybe (Path.File ar)
+maybeSuffix suffix =
+   Path.mapFileNameF $ ListHT.maybeSuffixOf suffix
+
+maybeSpectrumSuffix ::
+   (PathC.AbsRel ar) => Path.File ar -> Maybe (Path.File ar)
+maybeSpectrumSuffix = maybeSuffix spectrumSuffix
+
+isSuffixOf :: (PathC.AbsRel ar) => String -> Path.File ar -> Bool
+isSuffixOf suffix path = List.isSuffixOf suffix $ Path.toString path
+
+
+parametersFromPool :: (PathC.AbsRel ar) => Path.Dir ar -> IO (Int, Int)
+parametersFromPool dir = do
+   (specFiles, chunkFiles) <-
+      fmap
+         (unzip .
+          mapMaybe
+            (\file ->
+               fmap ((,) (dir </> file)) $
+               fmap ((dir </>) . (<++> chunkSuffix)) $
+               maybeSpectrumSuffix file)) $
+      getDirectoryContents dir
+   specSize <-
+      fmap (divByteSize (0::Float) . foldl gcd 0) $ mapM fileSize specFiles
+   chunkSize <-
+      fmap (divByteSize (0::Int16) . foldl gcd 0) $ mapM fileSize chunkFiles
+   let evenSize = (specSize-1)*2
+   let oddSize  = specSize*2-1
+   let (evenQuot, evenRem) = divMod chunkSize evenSize
+   let (oddQuot,  oddRem)  = divMod chunkSize oddSize
+   fmap (mapPair (fromInteger, fromInteger)) $
+      if' (evenRem == 0) (return (evenSize, evenQuot)) $
+      if' (oddRem == 0)  (return (oddSize,  oddQuot)) $
+      ioError $ userError "inconsistent file sizes in pool"
+
+
+withFilePath ::
+   (PathC.AbsRel ar) => (FilePath -> a) -> (Path.File ar -> a)
+withFilePath f = f . Path.toString
+
+data SplitPath ar = SplitPath (Path.Dir ar) Path.RelFile
+   deriving (Eq, Ord, Show)
+
+loadSpectra ::
+   (PathC.AbsRel ar) =>
+   Parameters -> SplitPath ar -> IO [(SV.Vector Float, Int)]
+loadSpectra params (SplitPath dir name) =
+   fmap (flip zip [0..]) $
+   PathIO.withFile (dir </> name <++> spectrumSuffix) IO.ReadMode $ \h ->
+      let chunkSize = div (paramChunkSize params) 2 + 1
+          go = do
+             spec <- SV.hGet h chunkSize
+             let actualSize = SV.length spec
+              in if' (actualSize == chunkSize) (fmap (spec:) go) $
+                 if' (actualSize == 0) (return []) $
+                 ioError $ userError "loading spectra: bucket size not multiple of chunk size"
+      in  go
+
+loadIndex :: (PathC.AbsRel ar) => Path.File ar -> IO [(Path.AbsRelFile, Int)]
+loadIndex path =
+   fmap (map (mapFst Path.path . read) . lines) $ PathIO.readFile path
+
+success :: a -> Except e a
+success = return
+
+keyClash :: key -> Except key a -> Except key a -> Except key a
+keyClash key _ _ = throwE key
+
+catchKeyClash ::
+   (Show key) => String -> Map key (Except key a) -> IO (Map key a)
+catchKeyClash name em =
+   case runExcept $ Trav.sequenceA em of
+      Right m -> return m
+      Left key ->
+         ioError $ userError $ name ++ ": duplicate key " ++ show key
+
+loadOriginMap ::
+   (PathC.AbsRel ar) =>
+   SplitPath ar -> IO (Map (Path.RelFile, Int) (Path.AbsRelFile, Int))
+loadOriginMap (SplitPath dir name) = do
+   index <- loadIndex $ dir </> name <++> indexSuffix
+   catchKeyClash "load origin map" $
+      Map.fromListWithKey keyClash $
+      zipWith (\n orig -> ((name, n), success orig)) [0..] index
+
+loadOriginIndex ::
+   (PathC.AbsRel ar) => Path.File ar -> IO (Float, (Path.RelFile, Int))
+loadOriginIndex = fmap (mapSnd $ mapFst Path.path) . readIO <=< PathIO.readFile
+
+loadTargetIndex ::
+   (PathC.AbsRel ar) => Path.File ar -> IO (Path.RelFile, Int)
+loadTargetIndex = fmap (mapFst Path.path) . readIO <=< PathIO.readFile
+
+
+loadChunk ::
+   (PathC.AbsRel ar) =>
+   Parameters -> Path.File ar -> Int -> IO (SV.Vector Int16)
+loadChunk params path offset =
+   PathIO.withFile path IO.ReadMode $ \h -> do
+      let chanChunkSize = paramChannels params * paramChunkSize params
+      IO.hSeek h IO.AbsoluteSeek $
+         fromIntegral (offset * chanChunkSize * sizeOf (0::Int16))
+      SV.hGet h chanChunkSize
+
+loadSpectrum ::
+   (PathC.AbsRel ar) =>
+   Int -> Path.File ar -> Int -> IO (SV.Vector Float)
+loadSpectrum chunkSize path offset =
+   PathIO.withFile path IO.ReadMode $ \h -> do
+      let specSize = div chunkSize 2 + 1
+      IO.hSeek h IO.AbsoluteSeek $
+         fromIntegral (offset * specSize * sizeOf (0::Float))
+      SV.hGet h specSize
+
+
+norm2 :: SV.Vector Float -> Float
+norm2 = sqrt . SV.foldl' (+) 0 . SV.map (\x -> x*x)
+
+createSpectrumMap ::
+   (PathC.AbsRel ar) =>
+   Parameters -> SplitPath ar -> IO [(SV.Vector Float, (Float, Int))]
+createSpectrumMap params poolBucket = do
+   files <- loadSpectra params poolBucket
+   return $ flip map files $ \(spec, pos) ->
+      case normalizeSpectrum spec of
+         (normedSpec, norm) -> (normedSpec, (norm, pos))
+
+normalizeSpectrum :: SV.Vector Float -> (SV.Vector Float, Float)
+normalizeSpectrum spec =
+   let norm = norm2 spec
+   in  (SV.map (/norm) spec, norm)
+
+matchSpectrum :: SV.Vector Float -> SV.Vector Float -> Float
+matchSpectrum spec dict =
+   SV.foldl' (+) 0 $ SV.zipWith (*) spec dict
+
+asVector16 :: SV.Vector Int16 -> SV.Vector Int16
+asVector16 = id
+
+clip16 :: Float -> Float
+clip16 =
+   min (fromIntegral (maxBound::Int16)) .
+   max (fromIntegral (minBound::Int16))
+
+copyChunk ::
+   (PathC.AbsRel ar0, PathC.AbsRel ar1) =>
+   Parameters -> Float -> Float ->
+   SplitPath ar0 -> Int -> Path.File ar1 -> IO ()
+copyChunk params amp scalProd (SplitPath poolDir poolName) offset dstPath = do
+   PathIO.writeFile (dstPath <++> originSuffix) $
+      show (scalProd, (Path.toString poolName, offset))
+   withFilePath SV.writeFile (dstPath <++> chunkSuffix)
+      . asVector16
+      . SV.map (Real.roundSimple . clip16 . (*amp) . fromIntegral)
+      =<< loadChunk params (poolDir </> poolName <++> chunkSuffix) offset
+
+associateBucket ::
+   (PathC.AbsRel ar0, PathC.AbsRel ar1, PathC.AbsRel ar2) =>
+   Parameters -> SplitPath ar0 -> SplitPath ar1 -> PathFmt.File ar2 -> IO ()
+associateBucket params poolBucket srcBucket@(SplitPath srcDir srcName) dst = do
+
+   dict <- createSpectrumMap params poolBucket
+   files <- loadSpectra params srcBucket
+   srcIndex <- loadIndex $ srcDir </> srcName <++> indexSuffix
+   forM_ (zip files (map snd srcIndex)) $ \((spec, specIx), pos) -> do
+      let srcNorm = norm2 spec
+      let (scalProd, (poolNorm, matchingOffset)) =
+            List.maximumBy (comparing fst) $
+            map (mapFst (matchSpectrum spec)) dict
+      let dstPath = PathFmt.printf dst pos
+      createDirectoriesFor dstPath
+      PathIO.writeFile (dstPath <++> targetSuffix) $
+         show (Path.toString srcName, specIx)
+      copyChunk params (srcNorm/poolNorm)
+         scalProd poolBucket matchingOffset dstPath
+
+merge :: (Ord a) => [a] -> [a] -> [(a,a)]
+merge =
+   let go (x:xs) yt@(y0:ys0) =
+          if x <= y0
+             then (x,y0) : go xs yt
+             else
+                case ys0 of
+                   [] -> (x,y0) : []
+                   y1:_ys1 ->
+                      if x < y1
+                         then (x,y0) : go xs ys0
+                         else go (x:xs) ys0
+       go [] _ = []
+       go (_:_) [] = error "merge: second list empty"
+   in  go
+
+runAssociate ::
+   (PathC.AbsRel ar0, PathC.AbsRel ar1, PathC.AbsRel ar2) =>
+   Parameters -> Path.Dir ar0 -> Path.Dir ar1 -> PathFmt.File ar2 -> IO ()
+runAssociate params poolDir src dst = do
+   let getSpectra :: (PathC.AbsRel ar) => Path.Dir ar -> IO [Path.RelFile]
+       getSpectra =
+         fmap (List.sort . mapMaybe maybeSpectrumSuffix) . getDirectoryContents
+   srcDirs <- getSpectra src
+   poolDirs <- getSpectra poolDir
+   forM_ (merge srcDirs poolDirs) $ \(sdir,pdir) -> do
+      associateBucket params (SplitPath poolDir pdir) (SplitPath src sdir) dst
+
+
+mapUnionsWithKey ::
+   (Ord k) => (k -> a -> a -> a) -> [Map k a] -> Map k a
+mapUnionsWithKey f =
+   foldl (Map.unionWithKey f) Map.empty
+
+mapInverse :: (Ord a, Ord b, Show b) => Map a b -> Map b (Except b a)
+mapInverse =
+   Map.fromListWithKey keyClash .
+   map (mapSnd success . swap) . Map.toList
+
+runAdjacent ::
+   (PathC.AbsRel ar0, PathC.AbsRel ar1, PathC.AbsRel ar2) =>
+   Verbosity -> Parameters -> Float ->
+   Path.Dir ar0 -> Path.Dir ar1 -> Path.Dir ar2 -> IO ()
+runAdjacent verbosity params cohesion poolDir srcDir dstDir = do
+   originMap <-
+      catchKeyClash "unions of origin maps" . mapUnionsWithKey keyClash
+         =<< mapM (fmap (fmap success) . loadOriginMap . SplitPath poolDir)
+         .   mapMaybe maybeSpectrumSuffix
+         =<< getDirectoryContents poolDir
+
+   indexMap <- catchKeyClash "index inversion" $ mapInverse originMap
+
+   chunkNames <-
+      fmap (List.sort . mapMaybe (maybeSuffix chunkSuffix)) $
+      getDirectoryContents dstDir
+
+   case chunkNames of
+      [] -> ioError $ userError "no index file found"
+      name0 : remIndices ->
+         let chunkSize = paramChunkSize params
+             maybeNextBetter srcName srcOffset srcSpec dstName scalProd jx =
+                case Map.lookup jx indexMap of
+                   Nothing -> return Nothing
+                   Just (nextName, nextOffset) -> do
+                      (nextSpec, nextNorm) <-
+                         fmap normalizeSpectrum $
+                         loadSpectrum chunkSize
+                            (poolDir </> nextName <++> spectrumSuffix) nextOffset
+                      let nextScalProd = matchSpectrum srcSpec nextSpec
+                      Shell.debug verbosity $
+                         printf "%s: %s+%d %s+%d %f %f\n"
+                            (Path.toString dstName)
+                            (Path.toString $ srcDir </> srcName) srcOffset
+                            (Path.toString $ poolDir </> nextName) nextOffset
+                            nextScalProd scalProd
+                      return $
+                         toMaybe (cohesion*nextScalProd > scalProd)
+                            (nextName, nextOffset, nextScalProd, nextNorm)
+
+             lookupOrigin ix =
+                case Map.lookup ix originMap of
+                   Just n -> return n
+                   Nothing ->
+                      ioError $ userError $
+                         "original chunk for " ++ show ix ++ " not found"
+
+             go _ [] = return ()
+             go jx0 (dstName : is) = do
+                (scalProd, origIx) <-
+                   loadOriginIndex $ dstDir </> dstName <++> originSuffix
+
+                (srcName, srcOffset) <-
+                   loadTargetIndex $ dstDir </> dstName <++> targetSuffix
+
+                srcSpec <-
+                   loadSpectrum chunkSize
+                      (srcDir </> srcName <++> spectrumSuffix) srcOffset
+
+                m <- maybeNextBetter srcName srcOffset srcSpec dstName scalProd jx0
+                jx1 <-
+                   case m of
+                      Nothing -> lookupOrigin origIx
+                      Just (nextName, nextOffset, nextScalProd, nextNorm) -> do
+                         Shell.info verbosity $ "replace " ++ Path.toString dstName
+                         let dstPath = dstDir </> dstName
+                         copyChunk params (norm2 srcSpec / nextNorm)
+                            nextScalProd (SplitPath poolDir nextName)
+                            nextOffset dstPath
+                         return jx0
+                go (mapSnd succ jx1) is
+
+         in  do (_scalProd, origIx) <-
+                   loadOriginIndex $ dstDir </> name0 <++> originSuffix
+                ix <- lookupOrigin origIx
+                go (mapSnd succ ix) remIndices
+
+
+runCompose ::
+   (PathC.AbsRel ar0, PathC.AbsRel ar1) =>
+   Parameters -> Path.Dir ar0 -> Path.File ar1 -> IO ()
+runCompose params src dst = do
+   let shift = paramShift params
+       overlap = paramOverlap params
+       chunkSize = shift*overlap
+       deinterleave xs =
+          SV.deinterleave (div (SV.length xs) chunkSize) xs
+
+       pilPost = pillow chunkSize
+
+   chunks <-
+      mapM (withFilePath SV.readFile . (src </>)) . List.sort
+         . filter (isSuffixOf chunkSuffix)
+         =<< getDirectoryContents src
+
+   withFilePath SVL.writeFile dst $ SVL.interleaveFirstPattern $
+      map (compose overlap shift) $ List.transpose $
+      map
+         (map (SVL.fromChunks . (:[]) . FiltNRG.envelope pilPost) .
+          deinterleave . SV.map (Bin.toCanonical :: Int16 -> Float)) $
+      chunks