1
1
mirror of https://github.com/thma/WhyHaskellMatters.git synced 2024-11-22 11:52:21 +03:00

add implementaion for Luhn algorithm.

This commit is contained in:
Mahler, Thomas 2020-10-25 17:49:43 +01:00
parent 375349dfb6
commit 96674c2a87

View File

@ -1,11 +1,10 @@
--{-# LANGUAGE ScopedTypeVariables #-}
module Luhn where
import Data.Char (digitToInt)
import Control.Arrow ((>>>))
import Data.Natural (Natural)
{--
{-- From Rosetta Code:
Reverse the order of the digits in the number.
Take the first, third, ... and every other odd digit in the reversed digits and sum them to form the partial sum s1
Taking the second, fourth ... and every other even digit in the reversed digits:
@ -40,22 +39,33 @@ use it to validate the following numbers:
1234567812345670
--}
divisibleBy10 :: Int -> Bool
divisibleBy10 = (0 ==) . (`mod` 10)
sumDigits :: [Int] -> Int
sumDigits = sum . map (uncurry (+) . (`divMod` 10)) -- map (uncurry (+) . (`divMod` 10)) [6,2,7,16,9,6,7,4,9,18,4] -> [6,2,7,7,9,6,7,4,9,9,4]
{--
luhn :: String -> Bool
luhn = (0 ==) . (`mod` 10) . sum . map (uncurry (+) . (`divMod` 10)) . zipWith (*) (cycle [1,2]) . map digitToInt . reverse
---}
double2nd :: [Int] -> [Int]
double2nd = zipWith (*) (cycle [1,2]) -- zipWith (*) [6,1,7,8,9,3,7,2,9,9,4] [1,2,1,2,1,2,1,2,1,2,1] -> [6,2,7,16,9,6,7,4,9,18,4]
luhn :: String -> Bool
luhn =
reverse >>> map digitToInt >>>
zipWith (*) (cycle [1,2]) >>>
map (uncurry (+) . (`divMod` 10)) >>>
sum >>>
(`mod` 10) >>>
(0 ==)
toDigits :: Natural -> [Int]
toDigits = map digitToInt . show -- toDigits 49927398716 -> [4,9,9,2,7,3,9,8,7,1,6]
luhn1 :: Natural -> Bool
luhn1 = divisibleBy10 . sumDigits . double2nd . reverse . toDigits
luhn2 :: Natural -> Bool
luhn2 n = divisibleBy10 (sumDigits (double2nd (reverse (toDigits n))))
luhn3 :: Natural -> Bool
luhn3 = toDigits >>>
reverse >>>
double2nd >>>
sumDigits >>>
divisibleBy10
luhn4 :: Natural -> Bool
luhn4 = (0 ==) . (`mod` 10) . sum . map (uncurry (+) . (`divMod` 10)) . zipWith (*) (cycle [1,2]) . map digitToInt . reverse . show
{--
1. Reverse the order of the digits in the number.
@ -65,13 +75,16 @@ luhn =
5. Sum the partial sums of the even digits to form s2
6. If s1 + s2 ends in zero then the original number is in the form of a valid credit card number as verified by the Luhn test.
--}
luhnTest :: String -> Bool
luhnTest :: Natural -> Bool
luhnTest n =
let (odds, evens) = (oddsEvens . map digitToInt . reverse) n -- 1. and 3.
let (odds, evens) = (oddsEvens . map digitToInt . reverse . show ) n -- 1. and 3.
s1 = sum odds -- 2.
s2 = sum (map (crossSum . (* 2)) evens) -- 4. and 5.
in (s1 + s2) `rem` 10 == 0 -- 6.
in (s1 + s2) `rem` 10 == 0 -- 6.
where
crossSum :: Int -> Int
crossSum = uncurry (+) . (`divMod` 10)
oddsEvens :: [Int] -> ([Int], [Int])
oddsEvens xs = foldr collectOddsEvens ([], []) (zip xs [1 ..])
where
@ -80,11 +93,12 @@ oddsEvens xs = foldr collectOddsEvens ([], []) (zip xs [1 ..])
| odd i = (x : odds, evens)
| otherwise = (odds, x : evens)
crossSum :: Int -> Int
crossSum = uncurry (+) . (`divMod` 10) --sum . map digitToInt . show
main :: IO ()
main = do
let testcases = ["49927398716", "49927398717", "1234567812345678", "1234567812345670"]
let testcases = [49927398716, 49927398717, 1234567812345678, 1234567812345670]
print $ map luhnTest testcases
print $ map luhn testcases
print $ map luhn1 testcases
print $ map luhn2 testcases
print $ map luhn3 testcases
print $ map luhn4 testcases