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:
parent
375349dfb6
commit
96674c2a87
60
src/Luhn.hs
60
src/Luhn.hs
@ -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
|
Loading…
Reference in New Issue
Block a user