diff options
| -rwxr-xr-x | challenge-010/stuart-little/haskell/ch-1.hs | 14 | ||||
| -rwxr-xr-x | challenge-010/stuart-little/haskell/ch-2.hs | 33 |
2 files changed, 47 insertions, 0 deletions
diff --git a/challenge-010/stuart-little/haskell/ch-1.hs b/challenge-010/stuart-little/haskell/ch-1.hs new file mode 100755 index 0000000000..74994a7686 --- /dev/null +++ b/challenge-010/stuart-little/haskell/ch-1.hs @@ -0,0 +1,14 @@ +#!/usr/bin/env runghc + +-- run <script> <number, arabic or roman; it will be converted to the other format> + +import Data.Char (toUpper,) +import System.Environment (getArgs,) +import Text.Numeral.Roman (fromRoman,toRoman,) + +main = do + numeral <- getArgs >>= return . (map toUpper) . head + let tryParseRom = fromRoman numeral + putStrLn $ case tryParseRom of + Nothing -> toRoman $ (read::String->Int) numeral + Just parsed -> show parsed diff --git a/challenge-010/stuart-little/haskell/ch-2.hs b/challenge-010/stuart-little/haskell/ch-2.hs new file mode 100755 index 0000000000..3bcab95aab --- /dev/null +++ b/challenge-010/stuart-little/haskell/ch-2.hs @@ -0,0 +1,33 @@ +#!/usr/bin/env runghc + +-- run <script> <1st string> <2nd string> + +import Data.List (inits,isPrefixOf,elemIndices,intersect,) +import Data.List.Extra (notNull,) +import System.Environment (getArgs,) + +matching :: String -> String -> String +matching from to = map snd $ filter (\(i,x) -> notNull $ intersect [i-l..i+l] $ elemIndices x to) $ zip [0..] from where + l = (div (max (length from) (length to)) 2) -1 + +trnsp :: String -> String -> Float +trnsp s1 s2 = flip (/) 2 $ fromIntegral $ length $ filter (\(p,q)-> p /= q) $ zip s1 s2 + +jSim :: String -> String -> Float +jSim s1 s2 + |m==0 =0 + |otherwise =(m/l1 + m/l2 +(m-t)/m)/3 where + (l1:l2:_) = map (fromIntegral.length) [s1,s2] + match1 = matching s1 s2 + match2 = matching s2 s1 + m = fromIntegral $ length match1 + t = trnsp match1 match2 + +jwDist :: Float -> Int -> String -> String -> Float +jwDist p n s1 s2 = (1-l*p)*(1-sim) where + sim = jSim s1 s2 + l = fromIntegral $ min n $ (length $ takeWhile (flip isPrefixOf s2) $ inits s1) -1 + +main = do + (s1:s2:_) <- getArgs + print $ jwDist 0.1 4 s1 s2 |