squeeze 1.0.2.4 → 1.0.3.0
raw patch · 14 files changed
+448/−339 lines, 14 files
Files
- changelog +7/−0
- debian/DEBIAN/control +1/−1
- makefile +1/−1
- man/man1/squeeze.1 +47/−29
- squeeze.cabal +11/−3
- squeeze.spec +3/−4
- src/Main.hs +150/−72
- src/Squeeze/Control/Concurrent/DivideAndConquer.hs +77/−0
- src/Squeeze/Data/CommandOptions.hs +29/−39
- src/Squeeze/Data/File.hs +36/−4
- src/Squeeze/Data/FileCombination.hs +54/−33
- src/Squeeze/Squeeze.hs +14/−130
- src/Squeeze/Test/Performance.hs +10/−4
- src/Squeeze/Test/QC.hs +8/−19
changelog view
@@ -65,4 +65,11 @@ * Re-implemented logging using "Control.Monad.Writer.Writer" & renamed 'Squeeze.Squeeze.findBestFitM' to 'Squeeze.Squeeze.findBestFitWriter'. * Implemented 'verbose' functionality in "Squeeze.Test.Performance". * Added command-line flag 'includeEmpty', to allow one to include empty files & directories in any solution.+1.0.3.0+ * Changed "Main" to replace calls to 'error' from inside the IO-monad, with 'Control.Monad.fail'.+ * Changed "Main"; by adding a command-line option to define the seed for the random-generator used for performance-testing; to permitting 'includeEmpty' take an optional Boolean argument, rather than a mandatory one; to read 'Squeeze.Data.CommandOptions.getMinimumUsageRatio' as a 'Double', rather than a 'Rational'.+ * Renamed the accessors in "Squeeze.Data.CommandOptions", & removed 'bisectionRatio' & associated code.+ * Added "Squeeze.Control.Concurrent.DivideAndConquer", called from "Main" to utilise multiple CPU-cores where available.+ * Trapped command-line arguments to which garbage has been appended.+ * Changed "Data.CommandOptions" to use 'Distribution.Verbosity.Verbosity'.
debian/DEBIAN/control view
@@ -1,5 +1,5 @@ Package: squeeze-Version: 1.0.2.4-1+Version: 1.0.3.0-1 Section: utils Priority: optional Architecture: i386
makefile view
@@ -52,7 +52,7 @@ rpm: $(PACKAGE_NAME).spec rpmbuild -bb --nodeps -- $^- mv -- `find /usr/src/packages/ -type f -name '$(PACKAGE_NAME)*.rpm' -mtime 0 -print` ./+ mv -- `find ~/rpmbuild -type f -name '$(PACKAGE_NAME)*.rpm' -mtime 0 -print` ./ rpmlint: $(PACKAGE_NAME).spec @$@ $^
man/man1/squeeze.1 view
@@ -5,40 +5,48 @@ \fBsqueeze\fR [\fIOPTIONS\fR] [\fIFile-path\fR ...] .SH DESCRIPTION .PP-Finds the subset of the specified \fIFile-path\fRs, which fits into the specified \fIBytes\fR, with least room to spare, whilst meeting \fBminimumUsageRatio\fR.+Finds the subset of the specified \fIFile-path\fRs, which fits into the specified space with least room to spare, whilst also meeting the minimum usage-requirements. .PP Any directories amongst the specified \fIFile-path\fRs are treated as atomic units, & therefore only solutions which involve either all or none of the files contained, are returned. .PP-Because of its exponential time-complexity, solutions of increasing suitability are continuously returned, rather than waiting until the optimal solution is known (which might take an inordinately long time).+Because of its exponential time-complexity, solutions of increasing suitability are produced lazily,+rather than waiting until the optimal solution is known (which might take an inordinately long time). .SH OPTIONS .SS "Selection" .TP-\fB-b\fR, \fB--bisectionRatio='\fR\fILHS%Total\fR\fB'\fR-Defines the ratio (in the closed unit-interval [0,1], defaulting to '\fB1%2\fR', i.e. 50%), @ which the list of file-paths will be bisected.-The first of the combinations generated from the first list, is then concatenated with each of the combinations generated from the second list.-The same operation is then performed on subsequent combinations generated from the first list.-This alters the order in which file-combinations are assessed, & so the set of suitable combinations returned may differ, though the optimum value remains the same.-.TP \fB-M\fR, \fB--maximumBytes=\fR\fIBytes\fR Defines the maximum available space, in bytes; defaulting to the space available on a DVD, i.e. \fB4700000000\fR bytes. .TP \fB-m\fR, \fB--minimumUsageRatio='\fR\fIRational\fR\fB'\fR-Defines the minimum acceptable usage-ratio (in the closed unit-interval [0,1], defaulting to '\fB99%100\fR', i.e. 99%), of \fBmaximumBytes\fR.+Defines the minimum acceptable usage-ratio (in the closed unit-interval [0,1]); defaulting to '\fB0.99\fR', i.e. 99% of \fBmaximumBytes\fR. .TP-\fB-z\fR, \fB--includeEmpty=\fR\fIBool\fR-When \fBTrue\fR, any empty file or directory, can be a member of all solutions.+\fB-z\fR\fIBool\fR, \fB--includeEmpty\fR[\fB=\fR\fIBool\fR]+When "\fBTrue\fR", any empty file or directory, can be a member of all solutions. .br-CAVEAT: for \fIn\fR such files or directories, a factor of \fI2^n\fR more viable solutions exist, obscuring the minimal solutions on which they're based.+The default value, in the absence of this option, is "\fBFalse\fR",+but in the absence of only the boolean argument, "\fBTrue\fR" will be inferred.+.br+CAVEAT: for \fIn\fR such files or directories, a factor of \fI2^n\fR times more viable solutions exist, obscuring the minimal solutions on which they're based. .SS Test .TP \fB-q\fR, \fB--runQuickChecks\fR-Uses \fBQuickCheck\fR to validate invariant properties, using arbitrary data ... & then exits.+Validates some invariant properties, using arbitrary data ... & then exits. .TP+\fB-r\fR\fIInt\fR, \fB--randomSeed\fR[\fB=\fR\fIInt\fR]+This option takes an optional integral argument with which to seed the unique random-number generator used for all random operations.+.br+In the absence of this option, the random-number generator will be seeded unpredictably from the operating-system,+but in the absence of only the integral argument, "\fB0\fR" will be inferred.+.br+CAVEAT: it must be specified before either "\fBtestPerformance\fR" or "\fBgraphPerformance\fR".+.TP \fB--testPerformance='(\fR\fIInteger\fR\fB,\fR \fBPoissonDistribution\fR \fIlambda\fR\fB)'\fR Measures the CPU-time required to find the best fit, for the specified number of randomly generated virtual files, the size of which conform to the specified probability-distribution, & the names of which reflect their size ... & then exits.+.br+NB: this test is performed on a single thread. .TP \fB--graphPerformance='\fR\fBPoissonDistribution\fR \fIlambda\fR\fB'\fR Measures the CPU-time required to find the best fit,@@ -46,33 +54,40 @@ the size of which conform to the specified probability-distribution, & the names of which reflect their size. .br+NB: this test is performed on a single thread.+.br Doesn't normally terminate. .TP-\fB-v\fR, \fB--verbose\fR+\fB--verbosity=\fR\fBSilent\fR|\fBNormal\fR|\fBVerbose\fR|\fBDeafening\fR Produces additional explanatory output where appropriate. .br This option, if required, may need to precede other options. .SS "Generic Program-information" .TP-.B --version+\fB-v\fR, \fB--version\fR Outputs version-information & then exits. .TP \fB-?\fR, \fB--help\fR Displays help & then exits. .SS "File-paths" .TP-If \fIFile-path\fR is a single hyphen-minus (\fB-\fR), replace it with the list of file-paths read from standard-input.+If \fIFile-path\fR is a single hyphen-minus (\fB-\fR), then the list of file-paths will be read from standard-input. .SH EXIT-STATUS \fB0\fR on success, & >\fB0\fR if an error occurs. .SH EXAMPLES .SS Trial 1 Say we've a directory of audio-files, categorised by artist.-.TP-\fBls -p\fR-ArabStrap/ BobDylan/ JeffBuckley/ JohnMartyn/ JoniMitchell/ ReservoirDogsOST/ RichardThompson/ SethLakeman/ SusheelaRaman/ TeddyThompson/ Vangelis/+.IP+.B ls -p+.nf+ ArabStrap/ BobDylan/ JeffBuckley/ JohnMartyn/ JoniMitchell/ ReservoirDogsOST/+ RichardThompson/ SethLakeman/ SusheelaRaman/ TeddyThompson/ Vangelis/+.fi .PP+We want to find which combinations can be stored on a CD without wasting inordinate amounts of space.+.IP+.B squeeze -M 700000000 -m 0.999 * .nf-\fBsqueeze -M 700000000 -m '999%1000' *\fR 699871313 ["BobDylan","RichardThompson","SethLakeman","TeddyThompson"] 699893320 ["ArabStrap","BobDylan","JeffBuckley","JohnMartyn","SethLakeman","SusheelaRaman"] \fI699998310\fR ["ArabStrap","BobDylan","JoniMitchell","ReservoirDogsOST","SethLakeman","TeddyThompson","Vangelis"]@@ -81,33 +96,38 @@ Note that the proposed solutions don't split any of the directories, into their constituent files. .PP We can confirm the validity of the optimal result:-.PP+.IP+.B find ArabStrap BobDylan JoniMitchell ReservoirDogsOST SethLakeman TeddyThompson Vangelis -type f -print | perl -e 'use List::Util qw(sum); printf(qq(%d\\n), sum map { chomp; (stat)[7] } <>);' .nf-\fBfind ArabStrap BobDylan JoniMitchell ReservoirDogsOST SethLakeman TeddyThompson Vangelis -type f -print | perl -e 'use List::Util qw(sum); printf(qq(%d\\n), sum map { chomp; (stat)[7] } <>);'\fR 699998310 .fi .PP NB: \fBdu\fR will return a slightly larger size, since it includes the space required for directory-structures. .SS Trial 2 We can improve on that result if we're prepared to split some of the artist-specific directories into individual albums.-.PP+With the expection of more solutions from which to select, we also raise the bar for what is acceptible.+.br+NB: from version \fB1.0.3.0\fR, the runtime can be passed a \fB-N\fR flag to request parallel execution on multiple cores.+Selecting this option will not only result in reduced execution-time (given appropriate hardware),+but as a side-effect will alter the selection of sub-optimal solutions to return.+.IP+.B squeeze -M 700000000 -m 0.99999 ArabStrap BobDylan/* JeffBuckley JohnMartyn JoniMitchell ReservoirDogsOST RichardThompson SethLakeman SusheelaRaman TeddyThompson Vangelis +RTS -N .nf-\fBsqueeze -M 700000000 -m '99999%100000' ArabStrap BobDylan/* JeffBuckley JohnMartyn JoniMitchell ReservoirDogsOST RichardThompson SethLakeman SusheelaRaman TeddyThompson Vangelis\fR 699995815 ["ArabStrap","BobDylan/BlondeOnBlonde","BobDylan/Highway61Revisited","BobDylan/ModernTimes","BobDylan/StreetLegal","BobDylan/SubterraneanHomesickBlues","JoniMitchell","RichardThompson","SusheelaRaman","TeddyThompson","Vangelis"] 699998578 ["BobDylan/Desire","BobDylan/Highway61Revisited","BobDylan/Infidels","BobDylan/StreetLegal","JeffBuckley","JohnMartyn","JoniMitchell","RichardThompson","SethLakeman","SusheelaRaman","TeddyThompson","Vangelis"] \fI699999112\fR ["BobDylan/BlondeOnBlonde","BobDylan/Desire","BobDylan/Highway61Revisited","BobDylan/Infidels","BobDylan/ModernTimes","JeffBuckley","JohnMartyn","ReservoirDogsOST","RichardThompson","SusheelaRaman","TeddyThompson","Vangelis"] .fi .SS Trial 3 If we're prepared to add individual files from another artist:-.PP+.IP+.B squeeze -M 700000000 -m 0.9999999 ArabStrap BobDylan/* JeffBuckley JohnMartyn JoniMitchell ReservoirDogsOST $(find RichardThompson -type f) SethLakeman SusheelaRaman TeddyThompson Vangelis +RTS -N .nf-\fBsqueeze -M 700000000 -m '9999999%10000000' ArabStrap BobDylan/* JeffBuckley JohnMartyn JoniMitchell ReservoirDogsOST $(find RichardThompson -type f) SethLakeman SusheelaRaman TeddyThompson Vangelis\fR 699999964 ["ArabStrap","BobDylan/Desire","BobDylan/Infidels","BobDylan/ModernTimes","BobDylan/OhMercy","BobDylan/SubterraneanHomesickBlues","BobDylan/TimeOutOfMind","JeffBuckley","JohnMartyn","JoniMitchell","ReservoirDogsOST","RichardThompson/FrontParlourBallads/RichardThompson-06-MySoulMySoul.ogg","RichardThompson/RumorAndSigh/RichardThompson-12-MotherKnowsBest.ogg","RichardThompson/TheOldKitBag/RichardThompson-01-Gethsemane.ogg","RichardThompson/TheOldKitBag/RichardThompson-11-OutsideOfTheInside.ogg","SethLakeman","SusheelaRaman","TeddyThompson","Vangelis"] 699999987 ["BobDylan/BlondeOnBlonde","BobDylan/BloodOnTheTracks","BobDylan/Desire","BobDylan/ModernTimes","BobDylan/OhMercy","BobDylan/StreetLegal","BobDylan/SubterraneanHomesickBlues","BobDylan/TimeOutOfMind","JoniMitchell","ReservoirDogsOST","RichardThompson/FrontParlourBallads/RichardThompson-01-LetItBlow.ogg","RichardThompson/IWantToSeeTheBrightLightsTonight/RichardAndLindaThompson-13-TheCalvaryCross[Live-Bonus].ogg","RichardThompson/TheOldKitBag/RichardThompson-01-Gethsemane.ogg","RichardThompson/TheOldKitBag/RichardThompson-06-FirstBreath.ogg","RichardThompson/TheOldKitBag/RichardThompson-11-OutsideOfTheInside.ogg","SethLakeman","SusheelaRaman","TeddyThompson","Vangelis"] \fI700000000\fR ["ArabStrap","BobDylan/Desire","BobDylan/Highway61Revisited","BobDylan/Infidels","BobDylan/ModernTimes","BobDylan/StreetLegal","BobDylan/SubterraneanHomesickBlues","BobDylan/TimeOutOfMind","JeffBuckley","JoniMitchell","ReservoirDogsOST","RichardThompson/FrontParlourBallads/RichardThompson-01-LetItBlow.ogg","RichardThompson/RumorAndSigh/RichardThompson-08-BacklashLoveAffair.ogg","RichardThompson/RumorAndSigh/RichardThompson-12-MotherKnowsBest.ogg","RichardThompson/TheOldKitBag/RichardThompson-01-Gethsemane.ogg","RichardThompson/TheOldKitBag/RichardThompson-04-ALoveYouCantSurvive.ogg","RichardThompson/TheOldKitBag/RichardThompson-06-FirstBreath.ogg","SusheelaRaman","TeddyThompson","Vangelis"] .fi .PP-^C+.B ^C .PP The exact match isn't unexpected, given the 2^71 possible combinations. The process was terminated after this solution was found, though where time permits, one may choose to wait for alternative exact matches.@@ -131,5 +151,3 @@ Source-documentation is generated by \fBHaddock\fR, & is available in the distribution. .IP \(bu .I http://www.haskell.org/haddock/-.IP \(bu-.I http://en.wikipedia.org/wiki/QuickCheck
squeeze.cabal view
@@ -1,6 +1,6 @@ --Package-properties Name: squeeze-Version: 1.0.2.4+Version: 1.0.3.0 Cabal-Version: >= 1.6 Copyright: (C) 2010 Dr. Alistair Ward License: GPL@@ -11,22 +11,27 @@ Build-Type: Simple Description: Returns progressively better subsets of the specified files, selected to fit into a limited space, without wasting more than the specific ratio. Category: Utils-Tested-With: GHC == 6.10, GHC == 6.12, GHC == 7.0, GHC == 7.4+Tested-With: GHC == 7.4 Homepage: http://functionalley.eu Maintainer: squeeze <at> functionalley <dot> eu Bug-reports: squeeze <at> functionalley <dot> eu Data-files:-Extra-Source-Files: changelog copyright debian/DEBIAN/control makefile man/man1/*.1 *.spec+Extra-Source-Files: changelog copyright debian/DEBIAN/control makefile man/man1/squeeze.1 squeeze.spec flag llvm Description: Whether the 'llvm' compiler-backend has been installed and is required for code-generation. manual: True default: False +flag threaded+ Description: Build for parallel runtime.+ default: True+ Executable squeeze hs-source-dirs: src Main-Is: Main.hs Other-modules:+ Squeeze.Control.Concurrent.DivideAndConquer Squeeze.Data.CommandOptions Squeeze.Data.File Squeeze.Data.FileCombination@@ -52,6 +57,9 @@ GHC-prof-options: -prof -fprof-auto -fprof-cafs else GHC-prof-options: -prof -auto-all -caf-all++ if flag(threaded)+ GHC-options: -threaded if impl(ghc >= 7.0) GHC-options: -rtsopts
squeeze.spec view
@@ -17,13 +17,12 @@ %define tarBall %package.tar.gz %define _bindir %prefix/bin %define _sharedir %prefix/share-%define _datadir %_sharedir/%package %define _docdir %_sharedir/doc/%package %define _mandir %_sharedir/man Summary: Finds the optimal subset of the specified files, to fit into a limited space, with minimal wastage Name: squeeze-Version: 1.0.2.4+Version: 1.0.3.0 Release: 1 License: GPLv3 #From '/usr/share/doc/packages/rpm/GROUPS'.@@ -47,8 +46,8 @@ %install cd '%package/' #Descend into the build-directory. runhaskell Setup copy --destdir=%buildroot #Install the package in the target-directory.-mkdir -p -- '%buildroot%_docdir' && mv -- changelog copyright LICENSE '%buildroot%_docdir/'-mkdir -p -- '%buildroot%_mandir' && mv -- 'man/man1' '%buildroot%_mandir/'+mkdir -p -- '%buildroot%_docdir' && mv changelog copyright LICENSE '%buildroot%_docdir/'+mkdir -p -- '%buildroot%_mandir' && mv 'man/man1' '%buildroot%_mandir/' %clean make --directory='%package' clobber
src/Main.hs view
@@ -23,34 +23,35 @@ * Contains the entry-point of the application. * Processes the command-line arguments.++ * Delegates the task to 'Squeeze.findBestFit', potentially on multiple threads. -} -module Main(--- * Types--- ** Type-synonyms--- CommandOptions',--- CommandLineAction,--- * Functions--- read',--- readCommandArg,- main-) where+module Main(main) where import Control.Applicative((<*>), (<$>))+import Control.Arrow((&&&))+import qualified Control.Concurrent+import qualified Control.Monad+import qualified Control.Monad.Writer import qualified Data.List-import qualified Data.Ratio+import qualified Data.Maybe+import qualified Data.Ord import qualified Data.Version import qualified Distribution.Package import qualified Distribution.Text+import qualified Distribution.Verbosity import qualified Distribution.Version import qualified Factory.Math.Probability-import qualified Paths_squeeze as Paths --Either local stub, or package-instance autogenerated by 'Setup.hs build'.-import qualified Squeeze.Data.CommandOptions as Data.CommandOptions-import qualified Squeeze.Data.File as Data.File-import qualified Squeeze.Squeeze as Squeeze-import qualified Squeeze.Test.Performance as Test.Performance-import qualified Squeeze.Test.QC as Test.QC-import qualified System.Console.GetOpt as G+import qualified Paths_squeeze as Paths --Either local stub, or package-instance autogenerated by 'Setup.hs build'.+import qualified Squeeze.Control.Concurrent.DivideAndConquer as Control.Concurrent.DivideAndConquer+import qualified Squeeze.Data.CommandOptions as Data.CommandOptions+import qualified Squeeze.Data.File as Data.File+import qualified Squeeze.Data.FileCombination as Data.FileCombination+import qualified Squeeze.Squeeze as Squeeze+import qualified Squeeze.Test.Performance as Test.Performance+import qualified Squeeze.Test.QC as Test.QC+import qualified System.Console.GetOpt as G import qualified System.Environment import qualified System.Exit import qualified System.FilePath@@ -63,30 +64,78 @@ import qualified ToolShed.System.TimeAction -- | Coerce the polymorphic data-type to concrete instance, in order that it's fields may be read from the command-line.-type CommandOptions' = Data.CommandOptions.CommandOptions Data.Ratio.Rational --'Double' would also be a suitable type-parameter.+type CommandOptions' = Data.CommandOptions.CommandOptions Rational --'Double' would also be a suitable type-parameter. -- | Used to thread user-defined command-line options, though the list of functions which implement them.-type CommandLineAction = (CommandOptions' -> IO CommandOptions') --Supplied as the type-argument to 'G.OptDescr'.+type CommandLineAction = CommandOptions' -> IO CommandOptions' --Supplied as the type-argument to 'G.OptDescr'. -- | On failure to parse the specified string, returns an explanatory error. read' :: Read a => String -> String -> a read' errorMessage s = case reads s of- [(x, _)] -> x+ [(x, "")] -> x _ -> error $ errorMessage ++ show s -- | On failure to parse a command-line argument, returns an explanatory error. readCommandArg :: Read a => String -> a-readCommandArg = read' "Failed to parse command-line argument "+readCommandArg = read' "failed to parse command-line argument " +-- | Reads a bounded integral from the command-line, guarding against overflow.+readBoundedIntegral :: Integral i => String -> i+readBoundedIntegral s+ | fromIntegral bounded /= unbounded = error $ "integral value exceeds permissible bounds; " ++ show unbounded ++ "."+ | otherwise = bounded+ where+ unbounded = readCommandArg s+ bounded = fromInteger unbounded+ {- |- * Parses the command-line arguments, to determine 'Data.CommandOptions.CommandOptions', some of which may over-ride the 'ToolShed.Defaultable.defaultValue'.+ * Recursively bisects the task, distributing the parts to 'Squeeze.findBestFit', to utilise the available CPU-cores. + * Recombines the part solutions to finds the single monotonically increasing list of file-combinations matching the specified criteria.+-}+distribute+ :: RealFrac ratio+ => Int -- ^ The number of CPU-cores available.+ -> Data.CommandOptions.CommandOptions ratio+ -> [Data.File.FileSizeAndPath] -- ^ The unordered list of files & sizes.+ -> IO [Data.FileCombination.FileCombination]+distribute _ _ [] = return []++distribute 1 commandOptions fileSizeAndPathList = let+ solutionSizeBounds = Data.CommandOptions.solutionSizeBounds commandOptions+ in do+ Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions == maxBound) . System.IO.hPutStrLn System.IO.stderr $ "Solution-size bounds " ++ show solutionSizeBounds++ return $ Squeeze.findBestFit solutionSizeBounds fileSizeAndPathList --Single-threaded.++distribute numCapabilities commandOptions fileSizeAndPathList = let+ distribute' = distribute $ numCapabilities `div` 2 --Partially apply.+ (selectedFileSizeAndPath, remainingFileSizeAndPaths) = Data.List.minimumBy (Data.Ord.comparing Data.File.getSize) &&& filter (/= selectedFileSizeAndPath) $ fileSizeAndPathList --Balance the load on the two threads, by selecting the smallest file rather than the largest; this makes a big difference.+ in do+ Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions == maxBound) . System.IO.hPutStrLn System.IO.stderr $ "Splitting task into those including & those excluding, " ++ show selectedFileSizeAndPath++ fileCombinationsExcludingSelected <- distribute' commandOptions remainingFileSizeAndPaths --Recurse.+ fileCombinationsIncludingSelected <- map (+ Data.FileCombination.prepend selectedFileSizeAndPath --Prepend to all file-combinations, the file we previously removed.+ ) <$> distribute' (+ commandOptions {+ Data.CommandOptions.getMaximumBytes = Data.CommandOptions.getMaximumBytes commandOptions - Data.File.getSize selectedFileSizeAndPath+ } --Reduce the maximum size; there's no need to account for the minimum, since this s defined as a ratio of the maximum.+ ) remainingFileSizeAndPaths --Recurse.++ Control.Concurrent.DivideAndConquer.divideAndConquer (+ Data.FileCombination.risingMerge $ Data.Ord.comparing Data.FileCombination.getAggregateFileSize+ ) fileCombinationsExcludingSelected fileCombinationsIncludingSelected --Merge the part-solutions.++{- |+ * Parses the command-line arguments, to determine 'Data.CommandOptions.CommandOptions', which over-ride the default value.+ * Any arguments which follow known 'Data.CommandOptions.CommandOptions', are interpreted as file-names to consider when attempting to find a suitable fit for the specified space-constraints. * If the specified file-name is /-/, then the actual file-names are read from /standard input/, to augment any other non-options specified. - * Delegates the donkey-work to 'Squeeze.squeeze'.+ * Delegates the donkey-work to 'distribute'. Because this may take a long time, it prints the results in real time, rather than batching until the optimum has been determined. * If /verbose/ has been specified, prints the CPU-time used.@@ -96,35 +145,40 @@ progName <- System.Environment.getProgName let- defaultValue :: CommandOptions'- defaultValue = ToolShed.Defaultable.defaultValue+ defaultCommandOptions :: CommandOptions'+ defaultCommandOptions = ToolShed.Defaultable.defaultValue + defaultRandomSeed :: Int+ defaultRandomSeed = 0+ optDescrList :: [G.OptDescr CommandLineAction] optDescrList = [ -- String [String] (G.ArgDescr CommandLineAction) String G.Option "?" ["help"] (G.NoArg $ const printUsage) "Display this help, & then exit.",- G.Option "v" ["verbose"] (G.NoArg $ return . Data.CommandOptions.setVerbose) "Produce additional explanatory output where appropriate. CAVEAT: to be effective, it should precede other options.",- G.Option "" ["version"] (G.NoArg $ const printVersion) "Print version-information, & then exit.",- G.Option "b" ["bisectionRatio"] (setBisectionRatio `G.ReqArg` "<Rational>") ("The list of file-paths is bisected at LHS/Total, & combinations from the LHS, concatenated with each of those from the RHS; default '" ++ show (Data.CommandOptions.bisectionRatio defaultValue) ++ "'."),- G.Option "z" ["includeEmpty"] (setIncludeEmpty `G.ReqArg` "<Bool>") ("Whether empty files & directories may be included in any solution; default '" ++ show (Data.CommandOptions.includeEmpty defaultValue) ++ "'."),- G.Option "M" ["maximumBytes"] (setMaximumBytes `G.ReqArg` "<Integer>") ("The maximum bytes of available space; default '" ++ show (Data.CommandOptions.maximumBytes defaultValue) ++ "'."),- G.Option "m" ["minimumUsageRatio"] (setMinimumUsageRatio `G.ReqArg` "<Rational>") ("The minimum acceptable space usage-ratio; default '" ++ show (Data.CommandOptions.minimumUsageRatio defaultValue) ++ "'."),+ G.Option "" ["verbosity"] (+ setVerbosity `G.ReqArg` show [minBound :: Distribution.Verbosity.Verbosity .. maxBound]+ ) ("define the log-level; default '" ++ show (Data.CommandOptions.getVerbosity defaultCommandOptions) ++ "'. CAVEAT: to be effective, it must precede other options."+ ),+ G.Option "v" ["version"] (G.NoArg $ const printVersion) "Print version-information, & then exit.",+ G.Option "z" ["includeEmpty"] (setIncludeEmpty `G.OptArg` "<Bool>") ("Whether empty files & directories may be included in any solution; default '" ++ show (Data.CommandOptions.getIncludeEmpty defaultCommandOptions) ++ "'."),+ G.Option "M" ["maximumBytes"] (setMaximumBytes `G.ReqArg` "<Int>") ("The maximum bytes of available space; default '" ++ show (Data.CommandOptions.getMaximumBytes defaultCommandOptions) ++ "'."),+ G.Option "m" ["minimumUsageRatio"] (setMinimumUsageRatio `G.ReqArg` "<Float>") ("The minimum acceptable space usage-ratio; default '" ++ show (realToFrac $ Data.CommandOptions.getMinimumUsageRatio defaultCommandOptions :: Double) ++ "'."), G.Option "q" ["runQuickChecks"] (G.NoArg runQuickChecks) "Run Quick-checks using arbitrary data, & then exit.",+ G.Option "r" ["randomSeed"] (G.OptArg setRandomSeed "<Int>") ("Seed the random number-generator with the specified integer, to produce a repeatable pseudo-random sequence as required for performance-testing. If this option is unspecified then the seed is unpredictable, but if only its argument is unspecified then the seed defaults to '" ++ show defaultRandomSeed ++ "'. CAVEAT: to be effective, it must precede either 'testPerformance' or 'graphPerformance'."), G.Option "" ["testPerformance"] (- testPerformance `G.ReqArg` "(<Integer>, <Probability-distribution>)"- ) "Test the performance, using the specified number of randomly generated virtual files, the size of which conform to the specified probability-distribution, & then exit",+ testPerformance `G.ReqArg` "(<Int>, <Probability-distribution>)"+ ) "Test the single-threaded performance, using the specified number of randomly generated virtual files, the size of which conform to the specified probability-distribution, & then exit", G.Option "" ["graphPerformance"] ( graphPerformance `G.ReqArg` "<Probability-distribution>"- ) "Graph the performance, against a linearly increasing number of randomly generated virtual files, the size of which conform to the specified probability-distribution. Doesn't normally terminate."+ ) "Graph the single-threaded performance, against a linearly increasing number of randomly generated virtual files, the size of which conform to the specified probability-distribution. Doesn't normally terminate." ] where- setBisectionRatio, setIncludeEmpty, setMaximumBytes, setMinimumUsageRatio, testPerformance, graphPerformance :: String -> CommandLineAction- setBisectionRatio arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.bisectionRatio = readCommandArg arg}- setIncludeEmpty arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.includeEmpty = readCommandArg arg}- setMaximumBytes arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.maximumBytes = readCommandArg arg}- setMinimumUsageRatio arg commandOptions = return {-to IO-monad-} commandOptions {Data.CommandOptions.minimumUsageRatio = readCommandArg arg}+ setMaximumBytes, setMinimumUsageRatio, setVerbosity, testPerformance, graphPerformance :: String -> CommandLineAction+ setMaximumBytes arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getMaximumBytes = readCommandArg arg }+ setMinimumUsageRatio arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getMinimumUsageRatio = realToFrac (readCommandArg arg :: Double) }+ setVerbosity arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getVerbosity = readCommandArg arg } testPerformance arg commandOptions- | not $ ToolShed.SelfValidate.isValid commandOptions = error $ ToolShed.SelfValidate.getFirstError commandOptions+ | not $ ToolShed.SelfValidate.isValid commandOptions = fail $ ToolShed.SelfValidate.getFirstError commandOptions | otherwise = do ToolShed.System.TimeAction.printCPUSeconds $ Test.Performance.run commandOptions fileCount probabilityDistribution >>= mapM_ print @@ -135,7 +189,7 @@ (fileCount, probabilityDistribution) = readCommandArg arg graphPerformance arg commandOptions- | not $ ToolShed.SelfValidate.isValid commandOptions = error $ ToolShed.SelfValidate.getFirstError commandOptions+ | not $ ToolShed.SelfValidate.isValid commandOptions = fail $ ToolShed.SelfValidate.getFirstError commandOptions | otherwise = do mapM_ (\fileCount -> ToolShed.System.TimeAction.printCPUSeconds $ Test.Performance.run commandOptions fileCount probabilityDistribution >>= mapM_ print) [1 ..] @@ -144,16 +198,20 @@ probabilityDistribution :: Factory.Math.Probability.DiscreteDistribution Double probabilityDistribution = readCommandArg arg + setIncludeEmpty, setRandomSeed :: Maybe String -> CommandLineAction+ setIncludeEmpty arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getIncludeEmpty = Data.Maybe.maybe True readCommandArg arg }+ setRandomSeed arg commandOptions = return {-to IO-monad-} commandOptions { Data.CommandOptions.getMaybeRandomSeed = Just $ Data.Maybe.maybe defaultRandomSeed readBoundedIntegral arg }+ runQuickChecks :: (Num f, Ord f, Show f) => Data.CommandOptions.CommandOptions f -> IO (Data.CommandOptions.CommandOptions f) runQuickChecks commandOptions- | not $ ToolShed.SelfValidate.isValid commandOptions = error $ ToolShed.SelfValidate.getFirstError commandOptions+ | not $ ToolShed.SelfValidate.isValid commandOptions = fail $ ToolShed.SelfValidate.getFirstError commandOptions | otherwise = do- Test.QC.quickChecks $ if Data.CommandOptions.verbose commandOptions+ Test.QC.quickChecks $ if Data.CommandOptions.getVerbosity commandOptions > Distribution.Verbosity.normal then #if MIN_VERSION_QuickCheck(2,4,0) Test.QuickCheck.verboseCheck #else- error "'Test.QuickCheck.verboseCheck' is only available as of 'QuickCheck-2.4'."+ fail "'Test.QuickCheck.verboseCheck' is only available as of 'QuickCheck-2.4'." #endif else Test.QuickCheck.quickCheck @@ -171,14 +229,14 @@ packageName = Distribution.Text.display packageIdentifier author = "Dr. Alistair Ward" - printUsage = Text.Printf.hPrintf System.IO.stderr "Usage:\t%s %s\n\nEBNF argument-format:\n\t%-23s = %s;\n\t%-23s = %s;\n\t%-23s = %s;\n\t%-23s = %s;\n\t%-23s = %s;\n\nE.g.\n\t%s\n\t%s\n" (+ printUsage = Text.Printf.hPrintf System.IO.stderr "Usage:\t%s %s\n\nEBNF argument-format:\n\t%-23s = %s;\n\t%-23s = %s;\n\t%-23s = %s;\n\t%-23s = %s;\n\t%-23s = %s;\n\nE.g.\n\t%s\n\t%s\n" ( G.usageInfo progName optDescrList- ) "[<File-path> ...]" "Bool" "\"True\" | \"False\"\t(* Case-sensitive *)" "Integer" "[0-9]+" "File-path" (- "File-name | File-name '" ++ [System.FilePath.pathSeparator] ++ "' File-path"- ) "ProbabilityDistribution" "PoissonDistribution Integer\t(* Defines both mean & variance *)" "Rational" "Integer '%' Integer\t(* I.e. a fraction *)" (- progName ++ " -M 700000000 *.ogg\t#Find the best-fit for the globbed file-names, into the space available on a CD."+ ) "[<File-path> ...]" "Bool" "\"True\" | \"False\"\t(* Case-sensitive *)" "Int" "[0-9]+" "File-path" (+ "File-name ('" ++ [System.FilePath.pathSeparator] ++ "' File-name)*"+ ) "ProbabilityDistribution" "PoissonDistribution Int\t(* Defines both mean & variance *)" "Float" "Int ('.' Int)?" (+ progName ++ " -M 700000000 *.ogg +RTS -N\t#Find the best-fit for the globbed file-names, into the space available on a CD, using multiple CPU-cores where available." ) (- progName ++ " -v --testPerformance='(100, PoissonDistribution 1000000000)'\t#Test performance."+ progName ++ " --verbosity=Verbose -r --testPerformance='(100, PoissonDistribution 1000000000)'\t#Test performance." ) >> System.Exit.exitWith System.Exit.ExitSuccess args <- System.Environment.getArgs@@ -191,28 +249,48 @@ ) {-transform using CommandLineAction-mutators-} commandLineActions --ie: do o1 <- CommandLineAction[0] commandOptions[0]; o2 <- CommandLineAction[1] o1; ... if not $ ToolShed.SelfValidate.isValid commandOptions- then error $ ToolShed.SelfValidate.getFirstError commandOptions- else (- if Data.CommandOptions.verbose commandOptions- then ToolShed.System.TimeAction.printCPUSeconds- else id- ) $ mapM_ print {-print immediately rather than batching-} =<< Squeeze.squeeze commandOptions =<< if null nonOptions- then error "No file-paths specified."- else if "-" `elem` nonOptions- then let- getFilePaths :: IO Data.File.FilePathList- getFilePaths = do- eof <- System.IO.isEOF+ then fail $ ToolShed.SelfValidate.getFirstError commandOptions+ else if null nonOptions+ then fail "No file-paths specified"+ else (+ if Data.CommandOptions.getVerbosity commandOptions > Distribution.Verbosity.normal+ then ToolShed.System.TimeAction.printCPUSeconds+ else id+ ) $ do+ filePaths <- if "-" `elem` nonOptions+ then let+ getFilePaths :: IO Data.File.FilePathList+ getFilePaths = do+ eof <- System.IO.isEOF - if eof- then return {-to IO-monad-} []- else {-more to read-} (:) <$> getLine <*> getFilePaths {-recurse-}- in do- filePaths <- (filter (/= "-") nonOptions ++) <$> getFilePaths+ if eof+ then return {-to IO-monad-} []+ else {-more to read-} (:) <$> getLine <*> getFilePaths {-recurse-}+ in do+ filePaths <- (filter (/= "-") nonOptions ++) <$> getFilePaths - if null filePaths- then error "No file-paths."- else return filePaths- else {-real fileNames-} return {-to IO-monad-} nonOptions+ if null filePaths+ then fail "No file-paths"+ else return filePaths+ else {-real fileNames-} return {-to IO-monad-} nonOptions+++ (acceptedFileSizeAndPathList, logFile) <- Control.Monad.Writer.runWriter . Data.File.selectSuitableFileSizes (Data.CommandOptions.isWithinSizeBounds commandOptions) <$> Data.File.findSizes (Data.List.nub filePaths)++ Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions > minBound) . System.IO.hPutStrLn System.IO.stderr $ Data.List.intercalate "\n" logFile++ if null acceptedFileSizeAndPathList+ then fail "There are zero suitable files"+ else let+ aggregateSize = Data.File.aggregateSize acceptedFileSizeAndPathList+ minimumBytes = Data.CommandOptions.deriveMinimumBytes commandOptions+ in if aggregateSize < minimumBytes+ then fail $ "The aggregate size of all suitable files, is insufficient; " ++ show (aggregateSize, minimumBytes)+ else do+ numCapabilities <- Control.Concurrent.getNumCapabilities --Find how many CPU-cores are available.++ Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions == maxBound) . System.IO.hPutStrLn System.IO.stderr $ show numCapabilities ++ " available CPU-cores"++ mapM_ print {-lazy evaluation-} =<< distribute numCapabilities commandOptions acceptedFileSizeAndPathList (_, _, errors) -> System.IO.Error.ioError . System.IO.Error.userError $ concatMap init {-chop-} errors
+ src/Squeeze/Control/Concurrent/DivideAndConquer.hs view
@@ -0,0 +1,77 @@+{-+ Copyright (C) 2013 Dr. Alistair Ward++ This program is free software: you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation, either version 3 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program. If not, see <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@] Dr. Alistair Ward++ [@DESCRIPTION@]++ Provides the capability to write two unevaluated lists to separate concurrent channels,+ read them both & merge the results into a single list, evaluating in parallel, lazily on demand.+-}++module Squeeze.Control.Concurrent.DivideAndConquer(+-- * Types+-- * Type-synonyms+-- TerminatedChannel,+-- * Functions+-- writeListToChan,+-- readListFromChan,+ divideAndConquer+) where++import Control.Applicative((<*>), (<$>))+import qualified Control.Concurrent+import qualified Control.Concurrent.Chan+import qualified System.IO.Unsafe+import qualified Control.Monad+import qualified Data.Maybe++-- | A channel terminated by a sentinel.+type TerminatedChannel a = Control.Concurrent.Chan.Chan (Maybe a)++-- | Write the specified list to the specified channel, terminating it with a sentinel.+writeListToChan :: TerminatedChannel a -> [a] -> IO ()+writeListToChan chan l = mapM_ (Control.Concurrent.Chan.writeChan chan . Just) l >> Control.Concurrent.Chan.writeChan chan Nothing {-sentinel-}++{- |+ * Read the contents of the specified channel, up to the sentinel.++ * Any attempt to read beyond the sentinel, will block forever since the writer is out of data.+-}+readListFromChan :: TerminatedChannel a -> IO [a]+readListFromChan chan = System.IO.Unsafe.unsafeInterleaveIO {-read on demand; i.e. lazy-} $ Control.Concurrent.Chan.readChan chan >>= Data.Maybe.maybe (+ return {-to IO-monad-} []+ ) (+ \x -> (x :) <$> readListFromChan chan {-recurse-}+ )++-- | Writes the two unevaluated lists to separate concurrent channels, reads them both & merges the results into a single list, evaluating in parallel, lazily on demand.+divideAndConquer+ :: ([a] -> [a] -> [a]) -- ^ Merge-function, which reads from the two channels, to produce a results-list.+ -> [a] -- ^ Data for first channel.+ -> [a] -- ^ Data for second channel.+ -> IO [a]+divideAndConquer merge l r = do+ chan0 <- Control.Concurrent.Chan.newChan+ chan1 <- Control.Concurrent.Chan.newChan++ Control.Monad.void . Control.Concurrent.forkIO $ writeListToChan chan0 l++ Control.Monad.void . Control.Concurrent.forkIO $ writeListToChan chan1 r++ merge <$> readListFromChan chan0 <*> readListFromChan chan1+
src/Squeeze/Data/CommandOptions.hs view
@@ -31,74 +31,64 @@ -- ** Data-types CommandOptions( -- MkCommandOptions,- bisectionRatio,- includeEmpty,- maximumBytes,- minimumUsageRatio,- verbose+ getIncludeEmpty,+ getMaybeRandomSeed,+ getMaximumBytes,+ getMinimumUsageRatio,+ getVerbosity ), -- * Functions solutionSizeBounds,--- minimumBytes,- setVerbose,+ deriveMinimumBytes, -- ** Predicates- withinSizeBounds+ isWithinSizeBounds ) where +import qualified Distribution.Verbosity import qualified Factory.Data.Interval import qualified Squeeze.Data.File as Data.File import qualified ToolShed.Defaultable import qualified ToolShed.SelfValidate -{- |- * Declare a record to contain command-line options.-- * This data-type is polymorphic, but the constraint is only applied at the level of individual functions.--}+-- | Declares a record to contain command-line options. data CommandOptions ratio = MkCommandOptions {- bisectionRatio :: ratio, -- ^ The file-list is bisected at LHS/Total, and combinations from the LHS are concatenated with each of those from the RHS.- includeEmpty :: Bool, -- ^ Whether empty directories or files should be included in any solution.- maximumBytes :: Data.File.FileSize, -- ^ The maximum space (in bytes) available in which to store a subset of the specified files.- minimumUsageRatio :: ratio, -- ^ The minimum acceptable usage of 'maximumBytes'.- verbose :: Bool -- ^ Output ancillary information.+ getIncludeEmpty :: Bool, -- ^ Whether empty directories or files should be included in any solution.+ getMaximumBytes :: Data.File.FileSize, -- ^ The maximum space (in bytes) available in which to store a subset of the specified files.+ getMaybeRandomSeed :: Maybe Int, -- ^ Optionally seed the random-number generator to produce a repeatable pseudo-random sequence.+ getMinimumUsageRatio :: ratio, -- ^ The minimum acceptable usage of 'getMaximumBytes'.+ getVerbosity :: Distribution.Verbosity.Verbosity -- ^ Set the threshold for ancillary information-output. } deriving Show instance Fractional f => ToolShed.Defaultable.Defaultable (CommandOptions f) where defaultValue = MkCommandOptions {- bisectionRatio = recip 2, --Bisection the file-list into equal halves.- includeEmpty = False,- maximumBytes = 4700000000, --DVD-size; just under 4.4GiB.- minimumUsageRatio = 99 / 100, --99% full.- verbose = False+ getIncludeEmpty = False,+ getMaximumBytes = 4700000000, --DVD-size; just under 4.4GiB.+ getMaybeRandomSeed = Nothing,+ getMinimumUsageRatio = 99 / 100, --99% full.+ getVerbosity = Distribution.Verbosity.normal } instance (Num ratio, Ord ratio, Show ratio) => ToolShed.SelfValidate.SelfValidator (CommandOptions ratio) where getErrors commandOptions = map snd $ filter (($ commandOptions) . fst) [- ((< 0) . bisectionRatio, "Invalid bisectionRatio='" ++ show (bisectionRatio commandOptions) ++ "'."),- ((> 1) . bisectionRatio, "Invalid bisectionRatio='" ++ show (bisectionRatio commandOptions) ++ "'."),- ((< 0) . maximumBytes, "Invalid maximumBytes=" ++ show (maximumBytes commandOptions) ++ "."),- ((< 0) . minimumUsageRatio, "Invalid minimumUsageRatio='" ++ show (minimumUsageRatio commandOptions) ++ "'."),- ((> 1) . minimumUsageRatio, "Invalid minimumUsageRatio='" ++ show (minimumUsageRatio commandOptions) ++ "'.")+ ((< 0) . getMaximumBytes, "Invalid maximumBytes=" ++ show (getMaximumBytes commandOptions) ++ "."),+ ((< 0) . getMinimumUsageRatio, "Invalid minimumUsageRatio='" ++ show (getMinimumUsageRatio commandOptions) ++ "'."),+ ((> 1) . getMinimumUsageRatio, "Invalid minimumUsageRatio='" ++ show (getMinimumUsageRatio commandOptions) ++ "'.") ] -- | Derives the minimum number of bytes, from other options.-minimumBytes :: RealFrac f => CommandOptions f -> Data.File.FileSize-minimumBytes commandOptions = floor $ minimumUsageRatio commandOptions * realToFrac (maximumBytes commandOptions)+deriveMinimumBytes :: RealFrac f => CommandOptions f -> Data.File.FileSize+deriveMinimumBytes commandOptions = floor $ getMinimumUsageRatio commandOptions * realToFrac (getMaximumBytes commandOptions) -- | The bounds on the aggregate size of the set of files. solutionSizeBounds :: RealFrac f => CommandOptions f -> Factory.Data.Interval.Interval Data.File.FileSize-solutionSizeBounds commandOptions = (minimumBytes commandOptions, maximumBytes commandOptions)---- | Mutator.-setVerbose :: CommandOptions f -> CommandOptions f-setVerbose commandOptions = commandOptions { verbose = True }+solutionSizeBounds commandOptions = (deriveMinimumBytes commandOptions, getMaximumBytes commandOptions) -- | Whether a file of the specified size is an acceptable component of any solution.-withinSizeBounds :: CommandOptions f -> Data.File.FileSize -> Bool-withinSizeBounds commandOptions size = all ($ size) [- if includeEmpty commandOptions+isWithinSizeBounds :: CommandOptions f -> Data.File.FileSize -> Bool+isWithinSizeBounds commandOptions size = all ($ size) [+ if getIncludeEmpty commandOptions then (>= 0) else (> 0),- (<= maximumBytes commandOptions)+ (<= getMaximumBytes commandOptions) ]
src/Squeeze/Data/File.hs view
@@ -32,18 +32,22 @@ -- findSize, findSizes, orderBySize,+-- getFileSizeStatistics,+ selectSuitableFileSizes, -- ** Accessors getSize, getPath, -- ** Predicates- hasSize+ hasSizeBy ) where import Control.Applicative((<$>)) import qualified Control.Exception---import qualified Data.Int+import qualified Control.Monad+import qualified Control.Monad.Writer import qualified Data.List import qualified Data.Ord+import qualified Factory.Math.Statistics import qualified System.Directory import System.FilePath((</>)) import qualified System.IO@@ -99,9 +103,37 @@ orderBySize = Data.List.sortBy (flip $ Data.Ord.comparing getSize) -- | True if the specified file has the required size according to the specified predicate.-hasSize+hasSizeBy :: (FileSize -> Bool) -- ^ The predicate. -> FileSizeAndPath -- ^ The file-parameters to be tested. -> Bool-hasSize f = f . getSize+hasSizeBy f = f . getSize++-- | Acquire statistics related to a list of files.+getFileSizeStatistics+ :: (Fractional mean, Floating standardDeviation)+ => [FileSizeAndPath]+ -> (Int, FileSize, mean, standardDeviation) -- ^ (Number of components, Total size, Mean size, Standard-deviation).+getFileSizeStatistics l = (+ length l,+ sum sizes,+ Factory.Math.Statistics.getMean sizes,+ Factory.Math.Statistics.getStandardDeviation sizes+ ) where+ sizes = map getSize l++{- |+ * Partitions the specified list of file-sizes & paths, into those whose size is suitable according to the specified predicate & those which are unsuitable.++ * Logs the results.+-}+selectSuitableFileSizes :: (FileSize -> Bool) -> [FileSizeAndPath] -> Control.Monad.Writer.Writer [String] [FileSizeAndPath]+selectSuitableFileSizes predicate fileSizeAndPathList = let+ (accepted, rejected) = Data.List.partition (hasSizeBy predicate) fileSizeAndPathList+ in do+ Control.Monad.unless (null rejected) $ Control.Monad.Writer.tell ["WARNING: rejecting components of unsuitable size; " ++ show rejected]++ Control.Monad.unless (null accepted) $ Control.Monad.Writer.tell ["Component-(count, total size, mean, standard-deviation): " ++ show (getFileSizeStatistics accepted :: (Int, FileSize, Double, Double))]++ return {-to Writer-monad-} accepted
src/Squeeze/Data/FileCombination.hs view
@@ -31,13 +31,13 @@ -- * Constants nullFileCombination, -- * Functions+ prepend,+ risingFilter,+ risingMerge, -- ** Constructors singleton,--- ** Operators- (<+>),- (+>), -- ** Predicates- hasSize+ hasSizeBy ) where import qualified Data.List@@ -46,14 +46,11 @@ -- | Declare a list of files qualified by its aggregate size. data FileCombination = MkFileCombination { getAggregateFileSize :: !Data.File.FileSize, -- ^ The aggregate size of the files referenced by 'getFilePathList'.- getFilePathList :: Data.File.FilePathList -- ^ A list of the paths, defining a set of files.-} deriving (Eq, Ord)+ getFilePathList :: Data.File.FilePathList -- ^ A list of paths, defining a set of files.+} deriving Eq instance Show FileCombination where- showsPrec _ MkFileCombination {- getAggregateFileSize = s,- getFilePathList = l- } = shows s . showChar '\t' . shows (Data.List.sort l)+ showsPrec _ fileCombination = shows (getAggregateFileSize fileCombination) . showChar '\t' . shows (Data.List.sort $ getFilePathList fileCombination) -- | A constant empty instance. nullFileCombination :: FileCombination@@ -63,35 +60,59 @@ singleton :: Data.File.FileSizeAndPath -> FileCombination singleton (fileSize, filePath) = MkFileCombination fileSize [filePath] --- | Prepend a 'Data.File.FileSizeAndPath' to an existing 'FileCombination'.-{-# INLINE (+>) #-}-(+>)+{- |+ * Prepend a 'Data.File.FileSizeAndPath' to an existing 'FileCombination'.++ * CAVEAT: performance hot-spot.+-}+{-# INLINE prepend #-}+prepend :: Data.File.FileSizeAndPath -- ^ The new path to prepend to the incumbent file-combination. -> FileCombination -- ^ The incumbent combination of files. -> FileCombination-(fileSize, filePath) +> MkFileCombination {- getAggregateFileSize = s,- getFilePathList = l-} = MkFileCombination (fileSize + s) (filePath : l)---- | Add two 'FileCombination's.-(<+>)- :: FileCombination -- ^ The combination to be prepended.- -> FileCombination -- ^ The incumbent to which the new value is prepended.- -> FileCombination-MkFileCombination {- getAggregateFileSize = sL,- getFilePathList = lL-} <+> MkFileCombination {- getAggregateFileSize = sR,- getFilePathList = lR-} = MkFileCombination (sL + sR) (lL ++ lR)+prepend (fileSize, filePath) fileCombination = MkFileCombination {+ getAggregateFileSize = fileSize + getAggregateFileSize fileCombination,+ getFilePathList = filePath : getFilePathList fileCombination+} -- | Predicate used to determine whether a specific file-combination matches a size-related requirement.-{-# INLINE hasSize #-}-hasSize+{-# INLINE hasSizeBy #-}+hasSizeBy :: (Data.File.FileSize -> Bool) -- ^ The predicate. -> FileCombination -- ^ The input datum to be tested. -> Bool-hasSize f MkFileCombination { getAggregateFileSize = s } = f s+hasSizeBy predicate = predicate . getAggregateFileSize++-- | Progressively raises the selection-criterion as each match is found, to produce monotonically increasing file-combinations.+risingFilter+ :: Data.File.FileSize -- ^ The initial minimum byte-size of file to accept.+ -> [FileCombination] -- ^ The input list of files to filter.+ -> [FileCombination] -- ^ The resulting list of files, which have met rising criterion.+risingFilter _ [] = []+risingFilter minimumSize (x : xs)+ | aggregateFileSize >= minimumSize = x : risingFilter aggregateFileSize xs+ | otherwise = risingFilter minimumSize xs+ where+ aggregateFileSize = getAggregateFileSize x++{- |+ * Merges two lists of monotonically increasing values, into a single monotonically increasing list, by dropping values which compare less than results already found.++ * CAVEAT: both lists must produce an element, in order to determine which is selected.+ As a result, if one list produces a value, it can't be returned until the other does (which make take a long time), even if ultimately the first is then selected.+-}+risingMerge+ :: (FileCombination -> FileCombination -> Ordering) -- ^ Comparator used to select the best file-combination from the heads of the two list supplied.+ -> [FileCombination] -- ^ A list of monotonically increasing file-combinations.+ -> [FileCombination] -- ^ A list of monotonically increasing file-combinations.+ -> [FileCombination]+risingMerge cmp = slave nullFileCombination where+ slave bar [] r = dropWhile ((== LT) . (`cmp` bar)) r+ slave bar l [] = dropWhile ((== LT) . (`cmp` bar)) l+ slave _ (x : xs) (y : ys)+ | o == GT = x : slave x xs ys+ | o == LT = y : slave y xs ys+ | otherwise = x : y : slave x xs ys+ where+ o = x `cmp` y
src/Squeeze/Squeeze.hs view
@@ -33,43 +33,17 @@ module Squeeze.Squeeze( -- * Functions--- risingFilter, findCombinations,- distribute,- findBestFit,--- getFileSizeStatistics,- findBestFitWriter,- squeeze+ findBestFit ) where -import Control.Applicative((<$>)) import Control.Arrow((&&&))-import qualified Control.Arrow-import qualified Control.Monad-import qualified Control.Monad.Writer-import qualified Data.List import qualified Factory.Data.Interval-import qualified Factory.Math.Statistics-import qualified Squeeze.Data.CommandOptions as Data.CommandOptions import qualified Squeeze.Data.File as Data.File import qualified Squeeze.Data.FileCombination as Data.FileCombination-import Squeeze.Data.FileCombination((<+>), (+>))-import qualified System.IO --- | Progressively raises the selection-criterion, as each match is found.-risingFilter- :: Data.File.FileSize -- ^ The initial minimum byte-size of file to accept.- -> [Data.FileCombination.FileCombination] -- ^ The input list of files to filter.- -> [Data.FileCombination.FileCombination] -- ^ The resulting list of files, which have met rising criterion.-risingFilter _ [] = []-risingFilter minimumSize (x : xs)- | aggregateFileSize >= minimumSize = x : risingFilter aggregateFileSize xs- | otherwise = risingFilter minimumSize xs- where- aggregateFileSize = Data.FileCombination.getAggregateFileSize x- {- |- * Checks that theo total aggregate 'Data.File.FileSize', meets or exceeds 'minimumBytes'.+ * Checks that the total aggregate 'Data.File.FileSize', meets or exceeds 'minimumBytes'. * Drops excessively large files, assuming that the file-list has been sorted by size, largest first. @@ -80,17 +54,17 @@ though the order in which the combinations are concatenated is rather arbitrary. -} findCombinations- :: Factory.Data.Interval.Interval Data.File.FileSize -- ^ The acceptable size-span of file-combinations.- -> [Data.File.FileSizeAndPath] -- ^ The input list of file-names and sizes.+ :: Factory.Data.Interval.Interval Data.File.FileSize -- ^ The closed interval of acceptible aggregate size, for file-combinations.+ -> [Data.File.FileSizeAndPath] -- ^ The list of file-names & sizes, ordered by decreasing size. -> [Data.FileCombination.FileCombination] -- ^ The resulting unordered list of suitable file-combinations. findCombinations (minimumCombinationSize, maximumCombinationSize) = filter (- Data.FileCombination.hasSize (>= minimumCombinationSize)+ Data.FileCombination.hasSizeBy (>= minimumCombinationSize) ) . (- Data.FileCombination.nullFileCombination : --Required to form combinations with the other portion of the bisected file-list.+ Data.FileCombination.nullFileCombination : ) . nonEmptyCombinations minimumCombinationSize . uncurry zip . ( id &&& Data.File.accumulateSize --Associate the list of possible files with its accumulating size. ) . dropWhile (- Data.File.hasSize (> maximumCombinationSize) --Remove files which individually exceed the maximum permissible; assuming they've been reverse sorted by size.+ Data.File.hasSizeBy (> maximumCombinationSize) --Remove files which individually exceed the maximum permissible; assuming they've been reverse sorted by size. ) where nonEmptyCombinations :: Data.File.FileSize -> [(Data.File.FileSizeAndPath, Data.File.FileSize)] -> [Data.FileCombination.FileCombination] nonEmptyCombinations _ [] = []@@ -102,106 +76,16 @@ where binaryChoice :: Data.FileCombination.FileCombination -> [Data.FileCombination.FileCombination] -> [Data.FileCombination.FileCombination] binaryChoice combinationExcluding- | Data.FileCombination.hasSize (<= maximumCombinationSize) combinationIncluding = (combinationExcluding :) . (combinationIncluding :)- | otherwise = (combinationExcluding :)+ | Data.FileCombination.hasSizeBy (<= maximumCombinationSize) combinationIncluding = (combinationExcluding :) . (combinationIncluding :)+ | otherwise = (combinationExcluding :) where combinationIncluding :: Data.FileCombination.FileCombination- combinationIncluding = fileSizeAndPath +> combinationExcluding---- | Bisects the data and calls 'findCombinations' on the halves.-distribute- :: RealFrac ratio- => ratio -- ^ The ratio at which to bisect the list of files, in a /divide-and-conquer/ strategy.- -> Factory.Data.Interval.Interval Data.File.FileSize -- ^ The /interval/ within which to find file-combinations.- -> [Data.File.FileSizeAndPath] -- ^ The input list of file-names and sizes.- -> [Data.FileCombination.FileCombination] -- ^ The complete unordered list of suitable file-combinations.-distribute bisectionRatio solutionSizeBounds fileSizeAndPathList- | any ($ bisectionIndex) [- (<= 0),- (>= fileSizeAndPathListLength)- ] = findCombinations solutionSizeBounds fileSizeAndPathList --Bisecting @ either the zeroeth, or the last element, leaves only one non-null list.- | otherwise = distribute' `uncurry` splitAt bisectionIndex fileSizeAndPathList- where- fileSizeAndPathListLength, bisectionIndex :: Int- fileSizeAndPathListLength = length fileSizeAndPathList- bisectionIndex = round $ bisectionRatio * fromIntegral fileSizeAndPathListLength-- distribute' :: [Data.File.FileSizeAndPath] -> [Data.File.FileSizeAndPath] -> [Data.FileCombination.FileCombination]- distribute' fileSizeAndPathListL fileSizeAndPathListR = concatMap (- \combinationL -> (combinationL <+>) `map` findCombinations (- negate (Data.FileCombination.getAggregateFileSize combinationL) `Factory.Data.Interval.shift` solutionSizeBounds- ) fileSizeAndPathListR- ) $ Control.Arrow.first (+ negate (Data.File.aggregateSize fileSizeAndPathListR)) {-Adjust the lower bound-} solutionSizeBounds `findCombinations` fileSizeAndPathListL--{- |- * Calls 'Data.File.order' to sort the files by size (largest first), on the empirical basis that the generated file-combinations, will more quickly result in a good match for the available space.-- * Calls 'distribute' to split the job, to facilitate parallelization.+ combinationIncluding = Data.FileCombination.prepend fileSizeAndPath combinationExcluding - * Calls the private function 'risingFilter' to progressively select better file-combinations from those returned by 'distribute'.--}+-- | Orders the files by decreasing size, calls 'findCombinations', calls 'Data.FileCombination.risingFilter' to select progressively better solutions. findBestFit- :: RealFrac ratio- => ratio -- ^ The ratio at which to bisect the list of files, in a /divide-and-conquer/ strategy.- -> Factory.Data.Interval.Interval Data.File.FileSize -- ^ The /interval/ within which to find file-combinations.+ :: Factory.Data.Interval.Interval Data.File.FileSize -- ^ The closed interval of acceptible sizes for file-combinations. -> [Data.File.FileSizeAndPath] -- ^ The input list of file-names and sizes.- -> [Data.FileCombination.FileCombination] -- ^ A reduced list of suitable file-combinations, sorted best first.-findBestFit bisectionRatio solutionSizeBounds = risingFilter (Factory.Data.Interval.getMinBound solutionSizeBounds) . distribute bisectionRatio solutionSizeBounds . Data.File.orderBySize---- | Acquire statistics related to a list of files.-getFileSizeStatistics- :: (Fractional mean, Floating standardDeviation)- => [Data.File.FileSizeAndPath]- -> (Int, Data.File.FileSize, mean, standardDeviation) -- ^ (Number of components, Total size, Mean size, Standard-deviation).-getFileSizeStatistics l = (- length l,- sum sizes,- Factory.Math.Statistics.getMean sizes,- Factory.Math.Statistics.getStandardDeviation sizes- ) where- sizes = map Data.File.getSize l--{- |- * Unpacks the command-line options.-- * Removes files which individually are of unsuitable size.-- * Optionally writes file-size statistics.-- * Calls 'findBestFit' to solve the problem.--}-findBestFitWriter- :: RealFrac ratio- => Data.CommandOptions.CommandOptions ratio -- ^ The caller's selection-criteria.- -> [Data.File.FileSizeAndPath] -- ^ The input list of file-names and sizes.- -> Control.Monad.Writer.Writer [String] [Data.FileCombination.FileCombination] -- ^ A reduced list of suitable file-combinations, sorted best first.-findBestFitWriter commandOptions fileSizeAndPathList = let- (fileSizeAndPathList', rejectedFiles) = Data.List.partition (- Data.File.hasSize (Data.CommandOptions.withinSizeBounds commandOptions)- ) fileSizeAndPathList- in do- Control.Monad.unless (null rejectedFiles) $ Control.Monad.Writer.tell ["Rejecting components of unsuitable size; " ++ show rejectedFiles]-- Control.Monad.Writer.tell ["Component-(count, total size, mean, standard-deviation):\t" ++ show (getFileSizeStatistics fileSizeAndPathList' :: (Int, Data.File.FileSize, Double, Double))]-- return {-to Writer-monad-} $ findBestFit (Data.CommandOptions.bisectionRatio commandOptions) (Data.CommandOptions.solutionSizeBounds commandOptions) fileSizeAndPathList'--{- |- * Removes duplicate file-names.-- * Determines the size of each specified file.-- * Calls 'findBestFitWriter' to solve the problem.--}-squeeze- :: RealFrac ratio- => Data.CommandOptions.CommandOptions ratio -- ^ The caller's selection-criteria.- -> Data.File.FilePathList -- ^ The list of file-names from which to select.- -> IO [Data.FileCombination.FileCombination]-squeeze commandOptions filePathList = do- (bestFileCombinations, log') <- Control.Monad.Writer.runWriter . findBestFitWriter commandOptions <$> Data.File.findSizes (Data.List.nub filePathList)-- Control.Monad.when (Data.CommandOptions.verbose commandOptions) $ mapM_ (System.IO.hPutStrLn System.IO.stderr) log'-- return {-to IO-monad-} bestFileCombinations+ -> [Data.FileCombination.FileCombination] -- ^ A reduced list of increasingly suitable file-combinations.+findBestFit solutionSizeBounds = Data.FileCombination.risingFilter (Factory.Data.Interval.getMinBound solutionSizeBounds) . findCombinations solutionSizeBounds . Data.File.orderBySize {-which makes findCombinations faster-}
src/Squeeze/Test/Performance.hs view
@@ -25,12 +25,14 @@ run ) where -import Control.Applicative((<$>)) import Control.Arrow((&&&)) import qualified Control.Monad import qualified Control.Monad.Writer+import qualified Data.List+import qualified Data.Maybe import qualified Factory.Math.Probability import qualified Squeeze.Data.CommandOptions as Data.CommandOptions+import qualified Squeeze.Data.File as Data.File import qualified Squeeze.Data.FileCombination as Data.FileCombination import qualified Squeeze.Squeeze as Squeeze import qualified System.IO@@ -49,9 +51,13 @@ -> Factory.Math.Probability.DiscreteDistribution f -> IO [Data.FileCombination.FileCombination] run commandOptions fileCount probabilityDistribution = do- (bestFileCombinations, log') <- Control.Monad.Writer.runWriter . Squeeze.findBestFitWriter commandOptions . map (id &&& show) . Factory.Math.Probability.generateDiscretePopulation fileCount probabilityDistribution <$> System.Random.getStdGen+ randomGen <- Data.Maybe.maybe System.Random.getStdGen {-use the global random-number generator-} (+ return {-to IO-monad-} . System.Random.mkStdGen --Seed the random-number generator as specified.+ ) $ Data.CommandOptions.getMaybeRandomSeed commandOptions --Select a random-number generator. - Control.Monad.when (Data.CommandOptions.verbose commandOptions) $ mapM_ (System.IO.hPutStrLn System.IO.stderr) log'+ let (acceptedFileSizeAndPathList, logFile) = Control.Monad.Writer.runWriter . Data.File.selectSuitableFileSizes (Data.CommandOptions.isWithinSizeBounds commandOptions) . Data.List.nub . map (id &&& show) $ Factory.Math.Probability.generateDiscretePopulation fileCount probabilityDistribution randomGen - return {-to IO-monad-} bestFileCombinations+ Control.Monad.when (Data.CommandOptions.getVerbosity commandOptions > minBound) . System.IO.hPutStrLn System.IO.stderr $ Data.List.intercalate "\n" logFile++ return {-to IO-monad-} $ Squeeze.findBestFit (Data.CommandOptions.solutionSizeBounds commandOptions) acceptedFileSizeAndPathList
src/Squeeze/Test/QC.hs view
@@ -29,41 +29,27 @@ ) where import qualified Control.Arrow+import Control.Arrow((&&&)) import qualified Data.List import qualified Factory.Data.Interval import qualified Squeeze.Data.File as Data.File import qualified Squeeze.Data.FileCombination as Data.FileCombination import qualified Squeeze.Squeeze as Squeeze import qualified Test.QuickCheck-import Test.QuickCheck((==>)) type Testable = [Data.File.FileSizeAndPath] -> Test.QuickCheck.Property -- | Defines invariant properties, which must hold for any 'FileSizeAndPath'. quickChecks :: (Testable -> IO ()) -> IO ()-quickChecks = (`mapM_` [prop_bisectionRatio, prop_totalCombinations, prop_bounds, prop_all]) where+quickChecks = (`mapM_` [prop_totalCombinations, prop_bounds, prop_all, prop_monotonic]) where translate :: [Data.File.FileSizeAndPath] -> [Data.File.FileSizeAndPath] translate = Data.List.nub . map (Control.Arrow.first abs) - prop_bisectionRatio, prop_totalCombinations, prop_bounds, prop_all :: Testable- prop_bisectionRatio fileSizeAndPathList = not (null l) ==> Test.QuickCheck.label "prop_bisectionRatio" $ (== 1) . length . Data.List.nub . map (- \bisectionRatio -> Data.List.sort . Squeeze.distribute bisectionRatio fileSizeBounds $ Data.File.orderBySize l- ) . take (length l) $ map recip [1 :: Double ..] where- l :: [Data.File.FileSizeAndPath]- l = take 14 {-arbitrarily-} $ translate fileSizeAndPathList --CAVEAT: may be shorter than requested.-- fileSizeBounds :: Factory.Data.Interval.Interval Data.File.FileSize- fileSizeBounds = (minimumBytes, maximumBytes) where- maximumBytes, minimumBytes :: Data.File.FileSize- maximumBytes = round $ fromIntegral (Data.File.aggregateSize l) / (4.0 :: Double) --Arbitrarily.- minimumBytes = maximumBytes `div` 2 --Arbitrarily.-+ prop_totalCombinations, prop_bounds, prop_all :: Testable prop_totalCombinations fileSizeAndPathList = Test.QuickCheck.label "prop_totalCombinations" $ (length . Data.List.nub . Squeeze.findCombinations (0, fromIntegral (maxBound :: Int)) $ Data.File.orderBySize l) == 2 ^ length l where- l :: [Data.File.FileSizeAndPath] l = take 10 {-arbitrarily-} $ translate fileSizeAndPathList --CAVEAT: may be shorter than requested. prop_bounds fileSizeAndPathList = Test.QuickCheck.label "prop_bounds" . all ((`Factory.Data.Interval.elem'` fileSizeBounds) . Data.FileCombination.getAggregateFileSize) . Squeeze.findCombinations fileSizeBounds $ Data.File.orderBySize l where- l :: [Data.File.FileSizeAndPath] l = take 16 {-arbitrarily-} $ translate fileSizeAndPathList --CAVEAT: may be shorter than requested. fileSizeBounds :: Factory.Data.Interval.Interval Data.File.FileSize@@ -72,10 +58,13 @@ maximumBytes = round $ fromIntegral (Data.File.aggregateSize l) / (4.0 :: Double) --Arbitrarily. minimumBytes = maximumBytes `div` 2 --Arbitrarily. - prop_all fileSizeAndPathList = Test.QuickCheck.label "prop_all" . (== bytes) . last . map Data.FileCombination.getAggregateFileSize $ Squeeze.findBestFit (recip 2 :: Double) (Factory.Data.Interval.precisely bytes) l where- l :: [Data.File.FileSizeAndPath]+ prop_all fileSizeAndPathList = Test.QuickCheck.label "prop_all" . (== bytes) . last . map Data.FileCombination.getAggregateFileSize $ Squeeze.findBestFit (Factory.Data.Interval.precisely bytes) l where l = take 16 {-arbitrarily-} $ translate fileSizeAndPathList --CAVEAT: may be shorter than requested. bytes :: Data.File.FileSize bytes = Data.File.aggregateSize l++ prop_monotonic :: Testable+ prop_monotonic fileSizeAndPathList = Test.QuickCheck.label "prop_monotonic" . uncurry (==) . (id &&& Data.List.sort) . map Data.FileCombination.getAggregateFileSize $ Squeeze.findBestFit (0, fromIntegral (maxBound :: Int)) l where+ l = take 16 {-arbitrarily-} $ translate fileSizeAndPathList --CAVEAT: may be shorter than requested.