diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -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'. diff --git a/debian/DEBIAN/control b/debian/DEBIAN/control --- a/debian/DEBIAN/control +++ b/debian/DEBIAN/control @@ -1,5 +1,5 @@ Package: squeeze -Version: 1.0.2.4-1 +Version: 1.0.3.0-1 Section: utils Priority: optional Architecture: i386 diff --git a/makefile b/makefile --- a/makefile +++ b/makefile @@ -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 @$@ $^ diff --git a/man/man1/squeeze.1 b/man/man1/squeeze.1 --- a/man/man1/squeeze.1 +++ b/man/man1/squeeze.1 @@ -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 diff --git a/squeeze.cabal b/squeeze.cabal --- a/squeeze.cabal +++ b/squeeze.cabal @@ -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 functionalley eu Bug-reports: squeeze functionalley 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 diff --git a/squeeze.spec b/squeeze.spec --- a/squeeze.spec +++ b/squeeze.spec @@ -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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` "") ("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` "") ("Whether empty files & directories may be included in any solution; default '" ++ show (Data.CommandOptions.includeEmpty defaultValue) ++ "'."), - G.Option "M" ["maximumBytes"] (setMaximumBytes `G.ReqArg` "") ("The maximum bytes of available space; default '" ++ show (Data.CommandOptions.maximumBytes defaultValue) ++ "'."), - G.Option "m" ["minimumUsageRatio"] (setMinimumUsageRatio `G.ReqArg` "") ("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` "") ("Whether empty files & directories may be included in any solution; default '" ++ show (Data.CommandOptions.getIncludeEmpty defaultCommandOptions) ++ "'."), + G.Option "M" ["maximumBytes"] (setMaximumBytes `G.ReqArg` "") ("The maximum bytes of available space; default '" ++ show (Data.CommandOptions.getMaximumBytes defaultCommandOptions) ++ "'."), + G.Option "m" ["minimumUsageRatio"] (setMinimumUsageRatio `G.ReqArg` "") ("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 "") ("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` "(, )" - ) "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` "(, )" + ) "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` "" - ) "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 - ) "[ ...]" "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." + ) "[ ...]" "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 diff --git a/src/Squeeze/Control/Concurrent/DivideAndConquer.hs b/src/Squeeze/Control/Concurrent/DivideAndConquer.hs new file mode 100644 --- /dev/null +++ b/src/Squeeze/Control/Concurrent/DivideAndConquer.hs @@ -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 . +-} +{- | + [@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 + diff --git a/src/Squeeze/Data/CommandOptions.hs b/src/Squeeze/Data/CommandOptions.hs --- a/src/Squeeze/Data/CommandOptions.hs +++ b/src/Squeeze/Data/CommandOptions.hs @@ -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) ] diff --git a/src/Squeeze/Data/File.hs b/src/Squeeze/Data/File.hs --- a/src/Squeeze/Data/File.hs +++ b/src/Squeeze/Data/File.hs @@ -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 diff --git a/src/Squeeze/Data/FileCombination.hs b/src/Squeeze/Data/FileCombination.hs --- a/src/Squeeze/Data/FileCombination.hs +++ b/src/Squeeze/Data/FileCombination.hs @@ -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 diff --git a/src/Squeeze/Squeeze.hs b/src/Squeeze/Squeeze.hs --- a/src/Squeeze/Squeeze.hs +++ b/src/Squeeze/Squeeze.hs @@ -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-} diff --git a/src/Squeeze/Test/Performance.hs b/src/Squeeze/Test/Performance.hs --- a/src/Squeeze/Test/Performance.hs +++ b/src/Squeeze/Test/Performance.hs @@ -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 diff --git a/src/Squeeze/Test/QC.hs b/src/Squeeze/Test/QC.hs --- a/src/Squeeze/Test/QC.hs +++ b/src/Squeeze/Test/QC.hs @@ -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.