factor/extra/rosetta-code/luhn-test/luhn-test.factor

72 lines
2.1 KiB
Factor

! Copyright (c) 2012 Anonymous
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.parser math.order math.ranges sequences ;
IN: rosetta-code.luhn-test
! http://rosettacode.org/wiki/Luhn_test_of_credit_card_numbers
! The Luhn test is used by some credit card companies to
! distinguish valid credit card numbers from what could be a
! random selection of digits.
! Those companies using credit card numbers that can be
! validated by the Luhn test have numbers that pass the following
! test:
! 1. Reverse the order of the digits in the number.
! 2. Take the first, third, ... and every other odd digit in the
! reversed digits and sum them to form the partial sum s1
! 3. Taking the second, fourth ... and every other even digit in
! the reversed digits:
! a. Multiply each digit by two and sum the digits if the
! answer is greater than nine to form partial sums for the
! even digits
! b. Sum the partial sums of the even digits to form s2
! 4. 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.
! For example, if the trial number is 49927398716:
! Reverse the digits:
! 61789372994
! Sum the odd digits:
! 6 + 7 + 9 + 7 + 9 + 4 = 42 = s1
! The even digits:
! 1, 8, 3, 2, 9
! Two times each even digit:
! 2, 16, 6, 4, 18
! Sum the digits of each multiplication:
! 2, 7, 6, 4, 9
! Sum the last:
! 2 + 7 + 6 + 4 + 9 = 28 = s2
! s1 + s2 = 70 which ends in zero which means that 49927398716
! passes the Luhn test
! The task is to write a function/method/procedure/subroutine
! that will validate a number with the Luhn test, and use it to
! validate the following numbers:
! 49927398716
! 49927398717
! 1234567812345678
! 1234567812345670
: reversed-digits ( n -- list )
{ } swap
[ dup 0 > ]
[ 10 /mod swapd suffix swap ]
while drop ;
: luhn-digit ( n -- n )
reversed-digits dup length <iota> [
2dup swap nth
swap odd? [ 2 * 10 /mod + ] when
] map sum 10 mod
nip ;
: luhn? ( n -- ? )
luhn-digit 0 = ;