Source code in the applescript programming language

-- AMICABLE PAIRS ------------------------------------------------------------

-- amicablePairsUpTo :: Int -> Int
on amicablePairsUpTo(max)
    
    -- amicable :: [Int] -> Int -> Int -> [Int] -> [Int]
    script amicable
        on |λ|(a, m, n, lstSums)
            if (m > n) and (m ≤ max) and ((item m of lstSums) = n) then
                a & [[n, m]]
            else
                a
            end if
        end |λ|
    end script
    
    -- divisorsSummed :: Int -> Int
    script divisorsSummed
        -- sum :: Int -> Int -> Int
        script sum
            on |λ|(a, b)
                a + b
            end |λ|
        end script
        
        on |λ|(n)
            foldl(sum, 0, properDivisors(n))
        end |λ|
    end script
    
    foldl(amicable, {}, ¬
        map(divisorsSummed, enumFromTo(1, max)))
end amicablePairsUpTo


-- TEST ----------------------------------------------------------------------
on run
    
    amicablePairsUpTo(20000)
    
end run


-- PROPER DIVISORS -----------------------------------------------------------

-- properDivisors :: Int -> [Int]
on properDivisors(n)
    
    -- isFactor :: Int -> Bool 
    script isFactor
        on |λ|(x)
            n mod x = 0
        end |λ|
    end script
    
    -- integerQuotient :: Int -> Int
    script integerQuotient
        on |λ|(x)
            (n / x) as integer
        end |λ|
    end script
    
    if n = 1 then
        {1}
    else
        set realRoot to n ^ (1 / 2)
        set intRoot to realRoot as integer
        set blnPerfectSquare to intRoot = realRoot
        
        -- Factors up to square root of n,
        set lows to filter(isFactor, enumFromTo(1, intRoot))
        
        -- and quotients of these factors beyond the square root,
        -- excluding n itself (last item)
        items 1 thru -2 of (lows & map(integerQuotient, ¬
            items (1 + (blnPerfectSquare as integer)) thru -1 of reverse of lows))
    end if
end properDivisors

-- GENERIC FUNCTIONS ---------------------------------------------------------

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m > n then
        set d to -1
    else
        set d to 1
    end if
    set lst to {}
    repeat with i from m to n by d
        set end of lst to i
    end repeat
    return lst
end enumFromTo

-- filter :: (a -> Bool) -> [a] -> [a]
on filter(f, xs)
    tell mReturn(f)
        set lst to {}
        set lng to length of xs
        repeat with i from 1 to lng
            set v to item i of xs
            if |λ|(v, i, xs) then set end of lst to v
        end repeat
        return lst
    end tell
end filter

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- Lift 2nd class handler function into 1st class script wrapper 
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn


{{220, 284}, {1184, 1210}, {2620, 2924}, {5020, 5564},
{6232, 6368}, {10744, 10856}, {12285, 14595}, {17296, 18416}}


on properDivisors(n)
    set output to {}
    
    if (n > 1) then
        set sqrt to n ^ 0.5
        set limit to sqrt div 1
        if (limit = sqrt) then
            set end of output to limit
            set limit to limit - 1
        end if
        repeat with i from limit to 2 by -1
            if (n mod i is 0) then
                set beginning of output to i
                set end of output to n div i
            end if
        end repeat
        set beginning of output to 1
    end if
    
    return output
end properDivisors

on sumList(listOfNumbers)
    script o
        property l : listOfNumbers
    end script
    set sum to 0
    repeat with n in o's l
        set sum to sum + n
    end repeat
    
    return sum
end sumList

on amicablePairsBelow(limitPlus1)
    script o
        property pdSums : {missing value} -- Sums of proper divisors. (Dummy item for 1's.)
    end script
    set limit to limitPlus1 - 1
    repeat with n from 2 to limit
        set end of o's pdSums to sumList(properDivisors(n))
    end repeat
    
    set output to {}
    repeat with n1 from 2 to (limit - 1)
        set n2 to o's pdSums's item n1
        if ((n1 < n2) and (n2 < limitPlus1) and (o's pdSums's item n2 = n1)) then ¬
            set end of output to {n1, n2}
    end repeat
    
    return output
end amicablePairsBelow

on join(lst, delim)
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to delim
    set txt to lst as text
    set AppleScript's text item delimiters to astid
    return txt
end join

on task()
    set output to amicablePairsBelow(20000)
    repeat with thisPair in output
        set thisPair's contents to join(thisPair, " & ")
    end repeat
    return join(output, linefeed)
end task

task()


"220 & 284
1184 & 1210
2620 & 2924
5020 & 5564
6232 & 6368
10744 & 10856
12285 & 14595
17296 & 18416"