Jaro similarity: Difference between revisions

m
→‎{{header|Haskell}}: Applied Hlint, Ormolu. Removed an import.
m (→‎{{header|Phix}}: added syntax colouring the hard way)
m (→‎{{header|Haskell}}: Applied Hlint, Ormolu. Removed an import.)
Line 1,500:
 
=={{header|Haskell}}==
<lang Haskell>import Data.List (sortBy, elemIndex, intercalate, sortOn)
import Data.Ord (comparing)
import Text.Printf (printf)
import Data.Maybe (mapMaybe)
import Text.Printf (printf)
 
---------------------- JARO DISTANCE ---------------------
 
jaro :: Ord a => [a] -> [a] -> Float
jaro x y =
let| f0 == (fromIntegralm .= length)0
| otherwise =
[m, t] = [f, fromIntegral . transpositions] <*> [matches x y]
(1 / 3)
[s1, s2] = [f] <*> [x, y]
_ ->* (1 / 3) * ((m / s1) + (m / s2) + ((m - t) / m))
in case m of
where
0 -> 0
f = fromIntegral . length
_ -> (1 / 3) * ((m / s1) + (m / s2) + ((m - t) / m))
[m, t] =
[m, t] = [f, fromIntegral . transpositions] <*> [matches x y]
<*> [matches x y]
[s1, s2] = [f] <*> [x, y]
 
matches :: Eq a => [a] -> [a] -> [(Int, a)]
matches s1 s2 =
let [(l1, xs), (l2, ys)] =
->sortOn
sortBy (comparing fst) ((length >>= (,)) <$> [s1, s2])
0 -> 0 fst
sortBy (comparing fst) ((length >>= (,)) <$> [s1, s2])
r = quot l2 2 - 1
in mapMaybe
( \(c, n) ->
-- Initial chars out of range ?
 
->
let offset = max 0 (n - (r + 1))
in -- Any offset for this char within range.
in elemIndex c (drop offset (take (n + r) ys)) >>=
>>= (\i -> Just (offset + i, c)))
(zip xs [1 ..])
(zip xs [1 ..])
 
transpositions :: Ord a => [(Int, a)] -> Int
transpositions = length . filter (uncurry (>)) . (zip <*> tail)
length
. filter (uncurry (>))
. (zip <*> tail)
 
-- TEST --------------------------------------------- TEST -------------------------
main :: IO ()
main =
mapM_ putStrLn $
fmap
(\(s1, s2) -> intercalate " -> " [s1, s2, printf "%.3f\n" $ jaro s1 s2]) <$>
[ ("DWAYNE" \(s1, "DUANE"s2) ->
intercalate
, ("MARTHA", "MARHTA")
, ("DIXON", "DICKSONX -> ")
(\(s1, s2) -> intercalate " -> " [s1, s2, printf "%.3f\n" $ jaro s1 s2]) <$>
, ("JELLYFISH", "SMELLYFISH")
)
]</lang>
[ ("DWAYNE", "DUANE"),
, ("MARTHA", "MARHTA"),
("DIXON", "DICKSONX"),
, ("JELLYFISH", "SMELLYFISH")
]</lang>
{{Out}}
<pre>DWAYNE -> DUANE -> 0.822
9,655

edits