Created
December 16, 2015 14:03
-
-
Save ahalbert/06c89adbd138dcb50585 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| import qualified Data.Map as Map | |
| import qualified Data.Text as Text | |
| import qualified Data.List.Split as Split | |
| import Text.Regex.PCRE | |
| --Units represent | |
| --Adding and subtraction can only be done on the same unit | |
| --Multiplication combines units | |
| --Exponentiation mult/div units | |
| --Can only Ord things of the same unit | |
| type UnitMap = Map.Map String Double | |
| data Unit = Unit { magnitude :: Double | |
| , unit :: UnitMap | |
| } | |
| --General utilities | |
| unitMaker :: Double -> [(String, Double)] -> Unit | |
| unitMaker m u = Unit m (cleanUnits (Map.fromList u)) | |
| cleanUnits :: UnitMap -> UnitMap | |
| cleanUnits u = Map.filter (\x -> x /= 0.0) u | |
| --Mapping and common maps | |
| incompatibleUnitError u u2 = error ("Error: Units " ++ u ++ " and " ++ u2 ++ "are not compatible.") | |
| mapUnits :: (Double -> Double) -> UnitMap -> UnitMap | |
| mapUnits f u = cleanUnits (Map.map f u) | |
| negateUnits u = mapUnits (*(-1)) u | |
| --Union and common unions | |
| mergeUnits f u u2 = cleanUnits (Map.unionWith (f) u u2) | |
| addUnits u u2 = mergeUnits (+) u u2 | |
| --Overload common math operations | |
| -- instance Show UnitMap where | |
| -- | | |
| instance Num Unit where | |
| Unit m u + Unit m2 u2 | |
| | u == u2 = Unit (m + m2) u | |
| | otherwise = error "Incompatible Units" | |
| Unit m u - Unit m2 u2 | |
| | u == u2 = Unit (m - m2) u | |
| | otherwise = error "Incompatible Units" | |
| Unit m u * Unit m2 u2 = Unit (m * m2) (addUnits u u2) | |
| abs (Unit m u) = Unit (abs m) u | |
| signum (Unit m u) = Unit (signum m) u | |
| fromInteger a = Unit (fromInteger a) (Map.fromList []) | |
| instance Eq Unit where | |
| Unit m u == Unit m2 u2 | |
| | u == u2 = m < m2 | |
| | otherwise = error "Incompatible Units" | |
| instance Ord Unit where | |
| Unit m u > Unit m2 u2 | |
| | u == u2 = m > m2 | |
| | otherwise = error "Incompatible Units" | |
| Unit m u < Unit m2 u2 | |
| | u == u2 = m < m2 | |
| | otherwise = error "Incompatible Units" | |
| Unit m u <= Unit m2 u2 | |
| | u == u2 = m <= m2 | |
| | otherwise = error "Incompatible Units" | |
| Unit m u >= Unit m2 u2 | |
| | u == u2 = m >= m2 | |
| | otherwise = error "Incompatible Units" | |
| instance Fractional Unit where | |
| Unit m u / Unit m2 u2 = Unit (m / m2) (addUnits u (negateUnits u2)) | |
| fromRational a = Unit (fromRational a) (Map.fromList []) | |
| instance Floating Unit where | |
| Unit m u ** Unit m2 u2 = Unit (m**m2) (mergeUnits (*) u u2) | |
| instance Show Unit where | |
| show u = showUnitString u | |
| --note that this should be a Unit Map | |
| showUnitString :: Unit -> String | |
| showUnitString (Unit m u) | |
| | (null posUnits) && (null negUnits) = ms | |
| | null posUnits = ms ++ " 1/" ++ (showall negUnits) | |
| | null negUnits = ms ++ (showall posUnits) | |
| | otherwise = ms ++ (showall negUnits) ++ "/" ++ (showall negUnits) | |
| where negUnits = Map.map (abs) (Map.filter (\ x -> x < 0.0) u) | |
| posUnits = Map.filter (\ x -> x > 0.0) u | |
| ms = show m | |
| showall :: UnitMap -> String | |
| showall u = Map.foldrWithKey (\ k v r -> r ++ "*" ++ (showUnit k v)) "" u | |
| showUnit :: String -> Double -> String | |
| showUnit k v | |
| | v == 1.0 = k | |
| | otherwise = k ++ "^" ++ (show v) | |
| --How the regex works ^[a-zA-Z]+(\^{1}(-?\d+))?(\*[a-zA-Z]+(\^{1}(-?\d+))?)*$ | |
| --[a-zA-Z]+ - matches a unit name | |
| -- (-?\d)+ - negative/postive integer regex - int | |
| -- (\^{1}(-?\d+))? - matches ^ exactly once followed by an integer | |
| -- ^[a-zA-Z]+(\^{1}(-?\d+))? matches unit with a possible ^ followed by a digit. This requires the first one | |
| -- ^ and $ ensure the entire line is matched | |
| -- (\*[a-zA-Z]+(\^{1}(-?\d+))?)* Same as first unit, but allows * to chain them together. | |
| validUnitRe = "^[a-zA-Z]+(\\^{1}(-?\\d+))?(\\*[a-zA-Z]+(\\^{1}(-?\\d+))?)*/[a-zA-Z]+(\\^{1}(-?\\d+))?(\\*[a-zA-Z]+(\\^{1}(-?\\d+))?)*" | |
| parseUnits :: String -> UnitMap | |
| parseUnits s | |
| | not (s =~ validUnitRe :: Bool) = error "Incorrect unit syntax." | |
| | length divsplit == 2 = addUnits (Map.fromList (parseDivisor (head divsplit))) (negateUnits $ Map.fromList (parseDivisor (last divsplit))) | |
| | otherwise = Map.fromList $ parseDivisor (head divsplit) | |
| where divsplit = Split.splitOn "/" s | |
| --Splits on * | |
| parseDivisor :: String -> [(String, Double)] | |
| parseDivisor s = map (parseUnit) (Split.splitOn "*" s) | |
| --Splits on ^ | |
| parseUnit :: String -> (String, Double) | |
| parseUnit s | |
| | length caretSplit == 2 = ((head caretSplit), fst (head (reads (last caretSplit) :: [(Double, String)]))) | |
| | otherwise = (head caretSplit, 1.0) | |
| where caretSplit = Split.splitOn "^" s |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment