Haskell
Moja wersja jest dość długa, ponieważ postanowiłem skoncentrować się na czytelności. Pomyślałem, że sformalizowanie algorytmu w kodzie będzie interesujące. Sumuję liczby znaków w lewej zakładce , w zasadzie śnieżkami je razem i kolejność jest w kolejności ich występowania w ciągu. Udało mi się również zastąpić część algorytmu, która normalnie wymagałaby indeksowania tablicy przez gięcie list . Okazuje się, że twój algorytm zasadniczo polega na zwijaniu listy liczb na pół i dodawaniu wyrównanych liczb razem. Istnieją dwa przypadki zginania, parzyste listy dzielone ładnie na środku, nieparzyste listy wyginają się wokół środkowego elementu i ten element nie uczestniczy dodatkowo. Rozłam bierze listę i dzieli liczby, które nie są już pojedynczymi cyframi, jak> = 10 . Musiałem napisać własny rozkład , nie jestem pewien, czy to rzeczywiście rozkład , ale wydaje się, że robi to, czego potrzebuję. Cieszyć się.
import qualified Data.Char as Char
import qualified System.Environment as Env
-- | Takes a seed value and builds a list using a function starting
-- from the last element
unfoldl :: (t -> Maybe (t, a)) -> t -> [a]
unfoldl f b =
case f b of
Just (new_b, a) -> (unfoldl f new_b) ++ [a]
Nothing -> []
-- | Builds a list from integer digits
number_to_digits :: Integral a => a -> [a]
number_to_digits n = unfoldl (\x -> if x == 0
then Nothing
else Just (div x 10, mod x 10)) n
-- | Builds a number from a list of digits
digits_to_number :: Integral t => [t] -> t
digits_to_number ds = number
where (number, _) = foldr (\d (n, p) -> (n+d*10^p, p+1)) (0,0) ds
-- | Bends a list at n and returns a tuple containing both parts
-- aligned at the bend
bend_at :: Int -> [a] -> ([a], [a])
bend_at n xs = let
(left, right) = splitAt n xs
in ((reverse left), right)
-- | Takes a list and bends it around a pivot at n, returns a tuple containing
-- left fold and right fold aligned at the bend and a pivot element in between
bend_pivoted_at :: Int -> [t] -> ([t], t, [t])
bend_pivoted_at n xs
| n > 1 = let
(left, pivot:right) = splitAt (n-1) xs
in ((reverse left), pivot, right)
-- | Split elements of a list that satisfy a predicate using a fission function
fission_by :: (a -> Bool) -> (a -> [a]) -> [a] -> [a]
fission_by _ _ [] = []
fission_by p f (x:xs)
| (p x) = (f x) ++ (fission_by p f xs)
| otherwise = x : (fission_by p f xs)
-- | Bend list in the middle and zip resulting folds with a combining function.
-- Automatically uses pivot bend for odd lists and normal bend for even lists
-- to align ends precisely one to one
fold_in_half :: (b -> b -> b) -> [b] -> [b]
fold_in_half f xs
| odd l = let
middle = (l-1) `div` 2 + 1
(left, pivot, right) = bend_pivoted_at middle xs
in pivot:(zipWith f left right)
| otherwise = let
middle = l `div` 2
(left, right) = bend_at middle xs
in zipWith f left right
where
l = length xs
-- | Takes a list of character counts ordered by their first occurrence
-- and keeps folding it in half with addition as combining function
-- until digits in a list form into any number less or equal to 100
-- and returns that number
foldup :: Integral a => [a] -> a
foldup xs
| n > 100 = foldup $ fission $ reverse $ (fold_in_half (+) xs)
| otherwise = n
where
n = (digits_to_number xs)
fission = fission_by (>= 10) number_to_digits
-- | Accumulate counts of keys in an associative array
count_update :: (Eq a, Integral t) => [(a, t)] -> a -> [(a, t)]
count_update [] x = [(x,1)]
count_update (p:ps) a
| a == b = (b,c+1) : ps
| otherwise = p : (count_update ps a)
where
(b,c) = p
-- | Takes a string and produces a list of character counts in order
-- of their first occurrence
ordered_counts :: Integral b => [Char] -> [b]
ordered_counts s = snd $ unzip $ foldl count_any_alpha [] s
where
count_any_alpha m c
| Char.isAlpha c = count_update m (Char.toLower c)
| otherwise = m
-- | Take two names and perform the calculation
love_chances n1 n2 = foldup $ ordered_counts (n1 ++ " loves " ++ n2)
main = do
args <- Env.getArgs
if (null args) || (length args < 2)
then do
putStrLn "\nUSAGE:\n"
putStrLn "Enter two names separated by space\n"
else let
n1:n2:_ = args
in putStrLn $ show (love_chances n1 n2) ++ "%"
Niektóre wyniki:
„Romeo” „Julia” 97% - ważne są testy empiryczne
„Romeo” „Julier” 88% - nowoczesna wersja skrócona ...
„Horst Draper” „Jane” 20%
„Horst Draper” „Jane (koń)” 70% - Nastąpił rozwój ...
„Bender Bender Rodriguez” „Fenny Wenchworth” 41% - Bender mówi „Składanie jest dla kobiet!”
„Philip Fry” „Turanga Leela” 53% - Cóż, widać, dlaczego zajęło im 7 sezonów, by poślubić
„Marię” „Abraham” - 98%
„John” „Jane” 76%