chemical-equation 0.0 → 0.0.1
raw patch · 5 files changed
+90/−34 lines, 5 filesdep +optparse-applicativedep +unicode
Dependencies added: optparse-applicative, unicode
Files
- chemical-equation.cabal +15/−6
- src/Common.hs +63/−10
- src/FLINT.hs +4/−6
- src/LAPACK.hs +4/−6
- src/Main.hs +4/−6
chemical-equation.cabal view
@@ -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,
src/Common.hs view
@@ -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")
src/FLINT.hs view
@@ -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
src/LAPACK.hs view
@@ -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
src/Main.hs view
@@ -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