diff --git a/chemical-equation.cabal b/chemical-equation.cabal --- a/chemical-equation.cabal +++ b/chemical-equation.cabal @@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: chemical-equation -Version: 0.0 +Version: 0.0.1 Synopsis: Balance chemical equations Description: Balance coefficients of chemical equations. @@ -19,12 +19,15 @@ > $ balance-chemical-equation C8H18 O2 CO2 H2O > 2 C8H18 + 25 O2 <=> 16 CO2 + 18 H2O . - > $ balance-chemical-equation N2 H2 NH3 - > N2 + 3 H2 <=> 2 NH3 + You may use a custom reaction arrow: . - > $ balance-chemical-equation HCl NaOH NaCl H2O - > HCl + NaOH <=> NaCl + H2O + > $ balance-chemical-equation --arrow="->" HCl NaOH NaCl H2O + > HCl + NaOH -> NaCl + H2O . + You may choose output of Unicode subscript and arrow characters: + . + > $ balance-chemical-equation --unicode --arrow=$'\u21CC' N2 H2 NH3 + . If you mix multiple reactions then the program takes them apart, again. However, the resulting partial reactions may not be chemically sensible. @@ -66,7 +69,7 @@ Default: False Source-Repository this - Tag: 0.0 + Tag: 0.0.1 Type: darcs Location: https://hub.darcs.net/thielema/chemical-equation @@ -78,8 +81,10 @@ Build-Depends: numeric-quest >=0.2.1 && <0.3, shell-utility >=0.1 && <0.2, + optparse-applicative >=0.11 && <0.20, comfort-array >=0.5 && <0.6, parsec >=3.1 && <3.2, + unicode >=0.0 && <0.1, transformers >=0.3 && <0.7, containers >=0.4 && <0.9, non-empty >=0.3 && <0.4, @@ -96,8 +101,10 @@ If flag(flint) Build-Depends: shell-utility >=0.1 && <0.2, + optparse-applicative >=0.11 && <0.20, comfort-array >=0.5 && <0.6, parsec >=3.1 && <3.2, + unicode >=0.0 && <0.1, transformers >=0.3 && <0.7, containers >=0.4 && <0.9, non-empty >=0.3 && <0.4, @@ -122,10 +129,12 @@ If flag(lapack) Build-Depends: shell-utility >=0.1 && <0.2, + optparse-applicative >=0.11 && <0.20, lapack >=0.4 && <0.6, netlib-ffi >=0.1 && <0.2, comfort-array >=0.5 && <0.6, parsec >=3.1 && <3.2, + unicode >=0.0 && <0.1, containers >=0.4 && <0.9, non-empty >=0.3 && <0.4, utility-ht >=0.0.11 && <0.1, diff --git a/src/Common.hs b/src/Common.hs --- a/src/Common.hs +++ b/src/Common.hs @@ -8,6 +8,8 @@ import qualified Data.List as List import qualified Data.NonEmpty.Class as NonEmptyC import qualified Data.NonEmpty as NonEmpty +import qualified Data.Char.Small as Unicode +import qualified Data.Char as Char import Data.Map (Map) import Data.Set (Set) import Data.Maybe (mapMaybe, isNothing) @@ -18,11 +20,13 @@ import Text.Printf (printf) +import qualified Options.Applicative as OP +import qualified Shell.Utility.Verbosity as Verbosity import qualified Shell.Utility.Log as Log import Shell.Utility.Verbosity (Verbosity) import Control.Monad (when) -import Control.Applicative (liftA2, (<$>)) +import Control.Applicative (liftA2, liftA3, (<$>)) @@ -98,16 +102,23 @@ Map.unionsWith (+) . Map.elems . Map.mapWithKey (\r k -> fmap (k*) r) -formatEquation :: [(Reactant,String)] -> Map Reactant Integer -> String -formatEquation rs reactantMap = - let tagged = + +type Format = [(Reactant,String)] -> Map Reactant Integer -> String + +formatEquation :: Bool -> String -> Format +formatEquation useUnicode arrow rs reactantMap = + let applyCond b f x = if b then f x else x + toSubscript = + applyCond useUnicode + (map (\c -> applyCond (Char.isDigit c) Unicode.subscript c)) + tagged = mapMaybe (\(r,name) -> let n = reactantMap Map.! r in case compare n 0 of EQ -> Nothing - GT -> Just $ (True,(n,name)) - LT -> Just $ (False,(-n,name))) + GT -> Just $ (True, ( n, toSubscript name)) + LT -> Just $ (False, (-n, toSubscript name))) rs (lhs,rhs) = (case tagged of ((True,_):_) -> id; _ -> swap) $ @@ -116,13 +127,14 @@ formatSum = List.intercalate " + " . map (\(n,str) -> if n==1 then str else printf "%d %s" n str) - in formatSum lhs ++ " <=> " ++ formatSum rhs + in formatSum lhs ++ " " ++ arrow ++ " " ++ formatSum rhs displaySolutions :: - Verbosity -> [(Reactant, String)] -> [Map Reactant Integer] -> IO () -displaySolutions verbosity reactants sols = do + Verbosity -> Format -> + [(Reactant, String)] -> [Map Reactant Integer] -> IO () +displaySolutions verbosity format reactants sols = do Fold.for_ sols $ \sol -> do - putStrLn . formatEquation reactants $ sol + putStrLn . format reactants $ sol let probe = integerLinearCombination sol when (Fold.any (0/=) probe) $ Log.warn verbosity $ "probe failed\n" ++ show probe ++ "\n" @@ -136,3 +148,44 @@ Log.warn verbosity $ printf "Unused reactants: %s\n" $ List.intercalate ", " $ map snd $ filter (flip Set.member unused . fst) $ reactants + + + +info :: OP.Parser a -> OP.ParserInfo a +info p = + OP.info + (OP.helper <*> p) + (OP.fullDesc <> + OP.progDesc "Balance chemical equations") + +parser :: OP.Parser (Verbosity, Format, [String]) +parser = + liftA3 (,,) + (OP.option (OP.eitherReader Verbosity.parse) $ + OP.value Verbosity.normal <> + OP.short 'v' <> + OP.long "verbose" <> + OP.metavar "0..3" <> + OP.help "verbosity") + parseFormatting + (OP.some $ + OP.strArgument + (OP.metavar "STRING" <> + OP.help "reactant")) + +parseFormatting :: OP.Parser Format +parseFormatting = + pure formatEquation + <*> + OP.switch + (OP.long "unicode" <> + OP.help "format output using Unicode symbols") + <*> + {- + Equilibrium equation: rightwards harpoon over leftwards harpoon + -} + OP.strOption + (OP.long "arrow" <> + OP.metavar "STRING" <> + OP.value "<=>" <> + OP.help "alternative arrow symbol") diff --git a/src/FLINT.hs b/src/FLINT.hs --- a/src/FLINT.hs +++ b/src/FLINT.hs @@ -16,9 +16,7 @@ import qualified Data.Set as Set import Data.Set (Set) -import qualified Shell.Utility.Verbosity as Verbosity - -import System.Environment (getArgs) +import qualified Options.Applicative as OP import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Cont (ContT(ContT), evalContT) @@ -51,9 +49,9 @@ -} main :: IO () main = do - let verbosity = Verbosity.normal + (verbosity,format,args) <- OP.execParser $ info parser (reactantSet,reactantsWithoutDuplicates) - <- preprocessArguments verbosity =<< getArgs + <- preprocessArguments verbosity args sols <- evalContT $ do mat <- matrixFromReactantSet reactantSet @@ -66,5 +64,5 @@ Trav.for reactantIndices $ \i -> F.integerPreludeFromFlint =<< FmpzMat.entry nullBasis i j - displaySolutions verbosity reactantsWithoutDuplicates $ + displaySolutions verbosity format reactantsWithoutDuplicates $ map cancelIntegerVector sols diff --git a/src/LAPACK.hs b/src/LAPACK.hs --- a/src/LAPACK.hs +++ b/src/LAPACK.hs @@ -17,9 +17,7 @@ import Text.Printf (printf) -import qualified Shell.Utility.Verbosity as Verbosity - -import System.Environment (getArgs) +import qualified Options.Applicative as OP @@ -71,9 +69,9 @@ main :: IO () main = do - let verbosity = Verbosity.normal + (verbosity,format,args) <- OP.execParser $ info parser (reactantSet,reactantsWithoutDuplicates) - <- preprocessArguments verbosity =<< getArgs + <- preprocessArguments verbosity args {- LU decomposition for wide matrix fails for C2H5OH CH4 O2 CO2 H2O. @@ -96,6 +94,6 @@ (Shape.size $ Matrix.width tall) (Shape.size $ Matrix.height tall) - displaySolutions verbosity reactantsWithoutDuplicates $ + displaySolutions verbosity format reactantsWithoutDuplicates $ map (cancelIntegerVector . fmap round . Array.toMap) $ Matrix.toColumns $ nullspace tall diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -15,9 +15,7 @@ import Data.Set (Set) import Data.Ratio ((%)) -import qualified Shell.Utility.Verbosity as Verbosity - -import System.Environment (getArgs) +import qualified Options.Applicative as OP @@ -51,9 +49,9 @@ main :: IO () main = do - let verbosity = Verbosity.normal + (verbosity,format,args) <- OP.execParser $ info parser (reactantSet,reactantsWithoutDuplicates) - <- preprocessArguments verbosity =<< getArgs + <- preprocessArguments verbosity args let mat = matrixFromReactantSet reactantSet let sols = @@ -64,5 +62,5 @@ ListHT.sliceVertical (Set.size reactantSet) $ Array.toList mat - displaySolutions verbosity reactantsWithoutDuplicates $ + displaySolutions verbosity format reactantsWithoutDuplicates $ map normalizeRationalVector sols