use AppleScript version "2.4"
use framework "Foundation"
use scripting additions

property M : 1 -- Month
property D : 2 -- Day

on run
    -- The MONTH with only one remaining day
    -- among the DAYs with unique months,
    -- EXCLUDING months with unique days,
    -- in Cheryl's list:

    showList(uniquePairing(M, ¬
        uniquePairing(D, ¬
            monthsWithUniqueDays(false, ¬
                map(composeList({tupleFromList, |words|, toLower}), ¬
                    splitOn(", ", ¬
                        "May 15, May 16, May 19, June 17, June 18, " & ¬
                        "July 14, July 16, Aug 14, Aug 15, Aug 17"))))))

    --> "[('july', '16')]"
end run

-- QUERY FUNCTIONS ----------------------------------------

-- monthsWithUniqueDays :: Bool -> [(Month, Day)] -> [(Month, Day)]
on monthsWithUniqueDays(blnInclude, xs)
    set _months to map(my fst, uniquePairing(D, xs))
    script uniqueDay
        on |λ|(md)
            set bln to elem(fst(md), _months)
            if blnInclude then
                bln
            else
                not bln
            end if
        end |λ|
    end script
    filter(uniqueDay, xs)
end monthsWithUniqueDays

-- uniquePairing :: DatePart -> [(M, D)] -> [(M, D)]
on uniquePairing(dp, xs)
    script go
        property f : my mReturn(item dp of {my fst, my snd})
        on |λ|(md)

            set dct to f's |λ|(md)
            script unique
                on |λ|(k)
                    set mb to lookupDict(k, dct)
                    if Nothing of mb then
                        false
                    else
                        1 = length of (Just of mb)
                    end if
                end |λ|
            end script
            set uniques to filter(unique, keys(dct))

            script found
                on |λ|(tpl)
                    elem(f's |λ|(tpl), uniques)
                end |λ|
            end script
            filter(found, xs)
        end |λ|
    end script
    bindPairs(xs, go)
end uniquePairing

-- bindPairs :: [(M, D)] -> ((Dict Text [Text], Dict Text [Text])
--                                -> [(M, D)]) -> [(M, D)]
on bindPairs(xs, f)
    tell mReturn(f)
        |λ|(Tuple(dictFromPairs(xs), ¬
            dictFromPairs(map(my swap, xs))))
    end tell
end bindPairs

-- dictFromPairs :: [(M, D)] -> Dict Text [Text]
on dictFromPairs(mds)
    set gps to groupBy(|on|(my eq, my fst), ¬
        sortBy(comparing(my fst), mds))
    script kv
        on |λ|(gp)
            Tuple(fst(item 1 of gp), map(my snd, gp))
        end |λ|
    end script
    mapFromList(map(kv, gps))
end dictFromPairs

-- LIBRARY GENERICS ---------------------------------------

-- comparing :: (a -> b) -> (a -> a -> Ordering)
on comparing(f)
    script
        on |λ|(a, b)
            tell mReturn(f)
                set fa to |λ|(a)
                set fb to |λ|(b)
                if fa < fb then
                    -1
                else if fa > fb then
                    1
                else
                    0
                end if
            end tell
        end |λ|
    end script
end comparing

-- composeList :: [(a -> a)] -> (a -> a)
on composeList(fs)
    script
        on |λ|(x)
            script
                on |λ|(f, a)
                    mReturn(f)'s |λ|(a)
                end |λ|
            end script

            foldr(result, x, fs)
        end |λ|
    end script
end composeList

-- drop :: Int -> [a] -> [a]
-- drop :: Int -> String -> String
on drop(n, xs)
    set c to class of xs
    if c is not script then
        if c is not string then
            if n < length of xs then
                items (1 + n) thru -1 of xs
            else
                {}
            end if
        else
            if n < length of xs then
                text (1 + n) thru -1 of xs
            else
                ""
            end if
        end if
    else
        take(n, xs) -- consumed
        return xs
    end if
end drop

-- dropAround :: (a -> Bool) -> [a] -> [a]
-- dropAround :: (Char -> Bool) -> String -> String
on dropAround(p, xs)
    dropWhile(p, dropWhileEnd(p, xs))
end dropAround

-- dropWhile :: (a -> Bool) -> [a] -> [a]
-- dropWhile :: (Char -> Bool) -> String -> String
on dropWhile(p, xs)
    set lng to length of xs
    set i to 1
    tell mReturn(p)
        repeat while i ≤ lng and |λ|(item i of xs)
            set i to i + 1
        end repeat
    end tell
    drop(i - 1, xs)
end dropWhile

-- dropWhileEnd :: (a -> Bool) -> [a] -> [a]
-- dropWhileEnd :: (Char -> Bool) -> String -> String
on dropWhileEnd(p, xs)
    set i to length of xs
    tell mReturn(p)
        repeat while i > 0 and |λ|(item i of xs)
            set i to i - 1
        end repeat
    end tell
    take(i, xs)
end dropWhileEnd

-- elem :: Eq a => a -> [a] -> Bool
on elem(x, xs)
    considering case
        xs contains x
    end considering
end elem

-- enumFromToInt :: Int -> Int -> [Int]
on enumFromToInt(M, n)
    if M ≤ n then
        set lst to {}
        repeat with i from M to n
            set end of lst to i
        end repeat
        return lst
    else
        return {}
    end if
end enumFromToInt

-- eq (==) :: Eq a => a -> a -> Bool
on eq(a, b)
    a = b
end eq

-- 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

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

-- fst :: (a, b) -> a
on fst(tpl)
    if class of tpl is record then
        |1| of tpl
    else
        item 1 of tpl
    end if
end fst

-- Typical usage: groupBy(on(eq, f), xs)
-- groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
on groupBy(f, xs)
    set mf to mReturn(f)

    script enGroup
        on |λ|(a, x)
            if length of (active of a) > 0 then
                set h to item 1 of active of a
            else
                set h to missing value
            end if

            if h is not missing value and mf's |λ|(h, x) then
                {active:(active of a) & {x}, sofar:sofar of a}
            else
                {active:{x}, sofar:(sofar of a) & {active of a}}
            end if
        end |λ|
    end script

    if length of xs > 0 then
        set dct to foldl(enGroup, {active:{item 1 of xs}, sofar:{}}, rest of xs)
        if length of (active of dct) > 0 then
            sofar of dct & {active of dct}
        else
            sofar of dct
        end if
    else
        {}
    end if
end groupBy

-- insertMap :: Dict -> String -> a -> Dict
on insertMap(rec, k, v)
    tell (current application's NSMutableDictionary's ¬
        dictionaryWithDictionary:rec)
        its setValue:v forKey:(k as string)
        return it as record
    end tell
end insertMap

-- intercalateS :: String -> [String] -> String
on intercalateS(sep, xs)
    set {dlm, my text item delimiters} to {my text item delimiters, sep}
    set s to xs as text
    set my text item delimiters to dlm
    return s
end intercalateS

-- Just :: a -> Maybe a
on Just(x)
    {type:"Maybe", Nothing:false, Just:x}
end Just

-- keys :: Dict -> [String]
on keys(rec)
    (current application's NSDictionary's dictionaryWithDictionary:rec)'s allKeys() as list
end keys

-- lookupDict :: a -> Dict -> Maybe b
on lookupDict(k, dct)
    set ca to current application
    set v to (ca's NSDictionary's dictionaryWithDictionary:dct)'s objectForKey:k
    if v ≠ missing value then
        Just(item 1 of ((ca's NSArray's arrayWithObject:v) as list))
    else
        Nothing()
    end if
end lookupDict

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

-- 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

-- mapFromList :: [(k, v)] -> Dict
on mapFromList(kvs)
    set tpl to unzip(kvs)
    script
        on |λ|(x)
            x as string
        end |λ|
    end script
    (current application's NSDictionary's ¬
        dictionaryWithObjects:(|2| of tpl) ¬
            forKeys:map(result, |1| of tpl)) as record
end mapFromList

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- Nothing :: Maybe a
on Nothing()
    {type:"Maybe", Nothing:true}
end Nothing

-- e.g. sortBy(|on|(compare, |length|), ["epsilon", "mu", "gamma", "beta"])
-- on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
on |on|(f, g)
    script
        on |λ|(a, b)
            tell mReturn(g) to set {va, vb} to {|λ|(a), |λ|(b)}
            tell mReturn(f) to |λ|(va, vb)
        end |λ|
    end script
end |on|

-- partition :: predicate -> List -> (Matches, nonMatches)
-- partition :: (a -> Bool) -> [a] -> ([a], [a])
on partition(f, xs)
    tell mReturn(f)
        set ys to {}
        set zs to {}
        repeat with x in xs
            set v to contents of x
            if |λ|(v) then
                set end of ys to v
            else
                set end of zs to v
            end if
        end repeat
    end tell
    Tuple(ys, zs)
end partition

-- show :: a -> String
on show(e)
    set c to class of e
    if c = list then
        showList(e)
    else if c = record then
        set mb to lookupDict("type", e)
        if Nothing of mb then
            showDict(e)
        else
            script
                on |λ|(t)
                    if "Either" = t then
                        set f to my showLR
                    else if "Maybe" = t then
                        set f to my showMaybe
                    else if "Ordering" = t then
                        set f to my showOrdering
                    else if "Ratio" = t then
                        set f to my showRatio
                    else if class of t is text and t begins with "Tuple" then
                        set f to my showTuple
                    else
                        set f to my showDict
                    end if
                    tell mReturn(f) to |λ|(e)
                end |λ|
            end script
            tell result to |λ|(Just of mb)
        end if
    else if c = date then
        "\"" & showDate(e) & "\""
    else if c = text then
        "'" & e & "'"
    else if (c = integer or c = real) then
        e as text
    else if c = class then
        "null"
    else
        try
            e as text
        on error
            ("«" & c as text) & "»"
        end try
    end if
end show

-- showList :: [a] -> String
on showList(xs)
    "[" & intercalateS(", ", map(my show, xs)) & "]"
end showList

-- showTuple :: Tuple -> String
on showTuple(tpl)
    set ca to current application
    script
        on |λ|(n)
            set v to (ca's NSDictionary's dictionaryWithDictionary:tpl)'s objectForKey:(n as string)
            if v ≠ missing value then
                unQuoted(show(item 1 of ((ca's NSArray's arrayWithObject:v) as list)))
            else
                missing value
            end if
        end |λ|
    end script
    "(" & intercalateS(", ", map(result, enumFromToInt(1, length of tpl))) & ")"
end showTuple

-- snd :: (a, b) -> b
on snd(tpl)
    if class of tpl is record then
        |2| of tpl
    else
        item 2 of tpl
    end if
end snd

-- Enough for small scale sorts.
-- Use instead sortOn :: Ord b => (a -> b) -> [a] -> [a]
-- which is equivalent to the more flexible sortBy(comparing(f), xs)
-- and uses a much faster ObjC NSArray sort method
-- sortBy :: (a -> a -> Ordering) -> [a] -> [a]
on sortBy(f, xs)
    if length of xs > 1 then
        set h to item 1 of xs
        set f to mReturn(f)
        script
            on |λ|(x)
                f's |λ|(x, h) ≤ 0
            end |λ|
        end script
        set lessMore to partition(result, rest of xs)
        sortBy(f, |1| of lessMore) & {h} & ¬
            sortBy(f, |2| of lessMore)
    else
        xs
    end if
end sortBy

-- splitOn :: String -> String -> [String]
on splitOn(pat, src)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, pat}
    set xs to text items of src
    set my text item delimiters to dlm
    return xs
end splitOn

-- swap :: (a, b) -> (b, a)
on swap(ab)
    if class of ab is record then
        Tuple(|2| of ab, |1| of ab)
    else
        {item 2 of ab, item 1 of ab}
    end if
end swap

-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if list is c then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if string is c then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if script is c then
        set ys to {}
        repeat with i from 1 to n
            set v to xs's |λ|()
            if missing value is v then
                return ys
            else
                set end of ys to v
            end if
        end repeat
        return ys
    else
        missing value
    end if
end take

-- toLower :: String -> String
on toLower(str)
    set ca to current application
    ((ca's NSString's stringWithString:(str))'s ¬
        lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text
end toLower

-- Tuple (,) :: a -> b -> (a, b)
on Tuple(a, b)
    {type:"Tuple", |1|:a, |2|:b, length:2}
end Tuple

-- tupleFromList :: [a] -> (a, a ...)
on tupleFromList(xs)
    set lng to length of xs
    if 1 < lng then
        if 2 < lng then
            set strSuffix to lng as string
        else
            set strSuffix to ""
        end if
        script kv
            on |λ|(a, x, i)
                insertMap(a, (i as string), x)
            end |λ|
        end script
        foldl(kv, {type:"Tuple" & strSuffix}, xs) & {length:lng}
    else
        missing value
    end if
end tupleFromList

-- unQuoted :: String -> String
on unQuoted(s)
    script p
        on |λ|(x)
            --{34, 39} contains id of x
            34 = id of x
        end |λ|
    end script
    dropAround(p, s)
end unQuoted

-- unzip :: [(a,b)] -> ([a],[b])
on unzip(xys)
    set xs to {}
    set ys to {}
    repeat with xy in xys
        set end of xs to |1| of xy
        set end of ys to |2| of xy
    end repeat
    return Tuple(xs, ys)
end unzip

-- words :: String -> [String]
on |words|(s)
    set ca to current application
    (((ca's NSString's stringWithString:(s))'s ¬
        componentsSeparatedByCharactersInSet:(ca's ¬
            NSCharacterSet's whitespaceAndNewlineCharacterSet()))'s ¬
        filteredArrayUsingPredicate:(ca's ¬
            NSPredicate's predicateWithFormat:"0 < length")) as list
end |words|


import java.math.BigInteger;
import java.util.ArrayList;
import java.util.List;

public class ChernicksCarmichaelNumbers {

    public static void main(String[] args) {
        for ( long n = 3 ; n < 10 ; n++ ) {
            long m = 0;
            boolean foundComposite = true;
            List<Long> factors = null;
            while ( foundComposite ) {
                m += (n <= 4 ? 1 : (long) Math.pow(2, n-4) * 5);
                factors = U(n, m);
                foundComposite = false;
                for ( long factor : factors ) {
                    if ( ! isPrime(factor) ) {
                        foundComposite = true;
                        break;
                    }
                }
            }
            System.out.printf("U(%d, %d) = %s = %s %n", n, m, display(factors), multiply(factors));
        }
    }

    private static String display(List<Long> factors) {
        return factors.toString().replace("[", "").replace("]", "").replaceAll(", ", " * ");
    }

    private static BigInteger multiply(List<Long> factors) {
        BigInteger result = BigInteger.ONE;
        for ( long factor : factors ) {
            result = result.multiply(BigInteger.valueOf(factor));
        }
        return result;
    }

    private static List<Long> U(long n, long m) {
        List<Long> factors = new ArrayList<>();
        factors.add(6*m + 1);
        factors.add(12*m + 1);
        for ( int i = 1 ; i <= n-2 ; i++ ) {
            factors.add(((long)Math.pow(2, i)) * 9 * m + 1);
        }
        return factors;
    }

    private static final int MAX = 100_000;
    private static final boolean[] primes = new boolean[MAX];
    private static boolean SIEVE_COMPLETE = false;

    private static final boolean isPrimeTrivial(long test) {
        if ( ! SIEVE_COMPLETE ) {
            sieve();
            SIEVE_COMPLETE = true;
        }
        return primes[(int) test];
    }

    private static final void sieve() {
        //  primes
        for ( int i = 2 ; i < MAX ; i++ ) {
            primes[i] = true;
        }
        for ( int i = 2 ; i < MAX ; i++ ) {
            if ( primes[i] ) {
                for ( int j = 2*i ; j < MAX ; j += i ) {
                    primes[j] = false;
                }
            }
        }
    }

    //  See http://primes.utm.edu/glossary/page.php?sort=StrongPRP
    public static final boolean isPrime(long testValue) {
        if ( testValue == 2 ) return true;
        if ( testValue % 2 == 0 ) return false;
        if ( testValue <= MAX ) return isPrimeTrivial(testValue);
        long d = testValue-1;
        int s = 0;
        while ( d % 2 == 0 ) {
            s += 1;
            d /= 2;
        }
        if ( testValue < 1373565L ) {
            if ( ! aSrp(2, s, d, testValue) ) {
                return false;
            }
            if ( ! aSrp(3, s, d, testValue) ) {
                return false;
            }
            return true;
        }
        if ( testValue < 4759123141L ) {
            if ( ! aSrp(2, s, d, testValue) ) {
                return false;
            }
            if ( ! aSrp(7, s, d, testValue) ) {
                return false;
            }
            if ( ! aSrp(61, s, d, testValue) ) {
                return false;
            }
            return true;
        }
        if ( testValue < 10000000000000000L ) {
            if ( ! aSrp(3, s, d, testValue) ) {
                return false;
            }
            if ( ! aSrp(24251, s, d, testValue) ) {
                return false;
            }
            return true;
        }
        //  Try 5 "random" primes
        if ( ! aSrp(37, s, d, testValue) ) {
            return false;
        }
        if ( ! aSrp(47, s, d, testValue) ) {
            return false;
        }
        if ( ! aSrp(61, s, d, testValue) ) {
            return false;
        }
        if ( ! aSrp(73, s, d, testValue) ) {
            return false;
        }
        if ( ! aSrp(83, s, d, testValue) ) {
            return false;
        }
        //throw new RuntimeException("ERROR isPrime:  Value too large = "+testValue);
        return true;
    }

    private static final boolean aSrp(int a, int s, long d, long n) {
        long modPow = modPow(a, d, n);
        //System.out.println("a = "+a+", s = "+s+", d = "+d+", n = "+n+", modpow = "+modPow);
        if ( modPow == 1 ) {
            return true;
        }
        int twoExpR = 1;
        for ( int r = 0 ; r < s ; r++ ) {
            if ( modPow(modPow, twoExpR, n) == n-1 ) {
                return true;
            }
            twoExpR *= 2;
        }
        return false;
    }

    private static final long SQRT = (long) Math.sqrt(Long.MAX_VALUE);

    public static final long modPow(long base, long exponent, long modulus) {
        long result = 1;
        while ( exponent > 0 ) {
            if ( exponent % 2 == 1 ) {
                if ( result > SQRT || base > SQRT ) {
                    result = multiply(result, base, modulus);
                }
                else {
                    result = (result * base) % modulus;
                }
            }
            exponent >>= 1;
            if ( base > SQRT ) {
                base = multiply(base, base, modulus);
            }
            else {
                base = (base * base) % modulus;
            }
        }
        return result;
    }

    //  Result is a*b % mod, without overflow.
    public static final long multiply(long a, long b, long modulus) {
        long x = 0;
        long y = a % modulus;
        long t;
        while ( b > 0 ) {
            if ( b % 2 == 1 ) {
                t = x + y;
                x = (t > modulus ? t-modulus : t);
            }
            t = y << 1;
            y = (t > modulus ? t-modulus : t);
            b >>= 1;
        }
        return x % modulus;
    }

}


dates: [
    [May 15] [May 16] [May 19]
    [June 17] [June 18]
    [July 14] [July 16]
    [August 14] [August 15] [August 17]
]

print ["possible dates:" dates]

print "\n(1) Albert: I don't know when Cheryl's birthday is, but I know that Bernard does not know too."
print "\t-> meaning: the month cannot have a unique day"
dates: filter dates 'd [
    in? d\0 map select dates 'dd [
        1 = size select dates 'pd -> pd\1=dd\1
    ] 'dd -> dd\0
]
print ["\t-> remaining:" dates]

print "\n(2) Bernard: At first I don't know when Cheryl's birthday is, but I know now."
print "\t-> meaning: the day must be unique"
dates: select dates 'd [
    1 = size select dates 'pd -> pd\1=d\1
]
print ["\t-> remaining:" dates]

print "\n(3) Albert: Then I also know when Cheryl's birthday is."
print "\t-> meaning: the month must be unique"
dates: select dates 'd [
    1 = size select dates 'pd -> pd\0=d\0
]
print ["\t-> remaining:" dates]

print ["\nCheryl's birthday:" first dates]


oDates:=    {"May" : [        15,    16,         19]
            ,"Jun" : [                17, 18]
            ,"Jul" : [14,         16]
            ,"Aug" : [14,     15,     17]}

filter1(oDates)
filter2(oDates)
filter3(oDates)
MsgBox % result := checkAnswer(oDates)
return

filter1(ByRef oDates){                        ; remove months that has a unique day in it.
    for d, obj in MonthsOfDay(oDates)
        if (obj.count() = 1)
            for m, bool in obj
                oDates.Remove(m)
}

filter2(ByRef oDates){                        ; remove non-unique days from remaining months.
    for d, obj in MonthsOfDay(oDates)
        if (obj.count() > 1)
            for m, bool in obj
                for i, day in oDates[m]
                    if (day=d)
                        oDates[m].Remove(i)
}

filter3(ByRef oDates){                        ; remove months that has multiple days from remaining months.
    oRemove := []
    for m, obj in oDates
        if obj.count() > 1
            oRemove.Push(m)
    for i, m in oRemove
        oDates.Remove(m)
}

MonthsOfDay(oDates){                        ; create a list of months per day.
    MonthsOfDay := []
    for m, obj in oDates
        for i, d in obj
            MonthsOfDay[d, m] := 1
    return MonthsOfDay
}

checkAnswer(oDates){                        ; check unique answer if any.
    if oDates.count()>1
        return false
    for m, obj in oDates
        if obj.count() > 1
            return false
        else
            return m " " obj.1
}


using Primes

function trial_pretest(k::UInt64)

    if ((k %  3)==0 || (k %  5)==0 || (k %  7)==0 || (k % 11)==0 ||
        (k % 13)==0 || (k % 17)==0 || (k % 19)==0 || (k % 23)==0)
        return (k <= 23)
    end

    return true
end

function gcd_pretest(k::UInt64)

    if (k <= 107)
        return true
    end

    gcd(29*31*37*41*43*47*53*59*61*67, k) == 1 &&
    gcd(71*73*79*83*89*97*101*103*107, k) == 1
end

function is_chernick(n::Int64, m::UInt64)

    t = 9*m

    if (!trial_pretest(6*m + 1))
        return false
    end

    if (!trial_pretest(12*m + 1))
        return false
    end

    for i in 1:n-2
        if (!trial_pretest((t << i) + 1))
            return false
        end
    end

    if (!gcd_pretest(6*m + 1))
        return false
    end

    if (!gcd_pretest(12*m + 1))
        return false
    end

    for i in 1:n-2
        if (!gcd_pretest((t << i) + 1))
            return false
        end
    end

    if (!isprime(6*m + 1))
        return false
    end

    if (!isprime(12*m + 1))
        return false
    end

    for i in 1:n-2
        if (!isprime((t << i) + 1))
            return false
        end
    end

    return true
end

function chernick_carmichael(n::Int64, m::UInt64)
    prod = big(1)

    prod *= 6*m + 1
    prod *= 12*m + 1

    for i in 1:n-2
        prod *= ((big(9)*m)<<i) + 1
    end

    prod
end

function cc_numbers(from, to)

    for n in from:to

        multiplier = 1

        if (n > 4) multiplier = 1 << (n-4) end
        if (n > 5) multiplier *= 5 end

        m = UInt64(multiplier)

        while true

            if (is_chernick(n, m))
                println("a(", n, ") = ", chernick_carmichael(n, m))
                break
            end

            m += multiplier
        end
    end
end

cc_numbers(3, 10)


ClearAll[PrimeFactorCounts, U]
PrimeFactorCounts[n_Integer] := Total[FactorInteger[n][[All, 2]]]
U[n_, m_] := (6 m + 1) (12 m + 1) Product[2^i 9 m + 1, {i, 1, n - 2}]
FindFirstChernickCarmichaelNumber[n_Integer?Positive] :=
 Module[{step, i, m, formula, value},
  step = Ceiling[2^(n - 4)];
  If[n > 5, step *= 5];
  i = step;
  formula = U[n, m];
  PrintTemporary[Dynamic[i]];
  While[True,
   value = formula /. m -> i;
   If[PrimeFactorCounts[value] == n,
    Break[];
    ];
   i += step
   ];
  {i, value}
  ]
FindFirstChernickCarmichaelNumber[3]
FindFirstChernickCarmichaelNumber[4]
FindFirstChernickCarmichaelNumber[5]
FindFirstChernickCarmichaelNumber[6]
FindFirstChernickCarmichaelNumber[7]
FindFirstChernickCarmichaelNumber[8]
FindFirstChernickCarmichaelNumber[9]


import strutils, sequtils
import bignum

const
  Max = 10
  Factors: array[3..Max, int] = [1, 1, 2, 4, 8, 16, 32, 64]   # 1 for n=3 then 2^(n-4).
  FirstPrimes = [3, 5, 7, 11, 13, 17, 19, 23]

#---------------------------------------------------------------------------------------------------

iterator factors(n, m: Natural): Natural =
  ## Yield the factors of U(n, m).

  yield 6 * m + 1
  yield 12 * m + 1
  var k = 2
  for _ in 1..(n - 2):
    yield 9 * k * m + 1
    inc k, k

#---------------------------------------------------------------------------------------------------

proc mayBePrime(n: int): bool =
  ## First primality test.

  if n < 23: return true

  for p in FirstPrimes:
    if n mod p == 0:
      return false

  result = true

#---------------------------------------------------------------------------------------------------

proc isChernick(n, m: Natural): bool =
  ## Check if U(N, m) if a Chernick-Carmichael number.

  # Use the first and quick test.
  for factor in factors(n, m):
    if not factor.mayBePrime():
      return false

  # Use the slow probability test (need to use a big int).
  for factor in factors(n, m):
    if probablyPrime(newInt(factor), 25) == 0:
      return false

  result = true

#---------------------------------------------------------------------------------------------------

proc a(n: Natural): tuple[m: Natural, factors: seq[Natural]] =
  ## For a given "n", find the smallest Charnick-Carmichael number.

  var m: Natural = 0
  var incr = (if n >= 5: 5 else: 1) * Factors[n]  # For n >= 5, a(n) is a multiple of 5.

  while true:
    inc m, incr
    if isChernick(n, m):
      return (m, toSeq(factors(n, m)))

#———————————————————————————————————————————————————————————————————————————————————————————————————

import strformat

for n in 3..Max:
  let (m, factors) = a(n)

  stdout.write fmt"a({n}) = U({n}, {m}) = "
  var s = ""
  for factor in factors:
    s.addSep(" × ")
    s.add($factor)
  stdout.write s, '\n'


# syntax: GAWK -f CHERYLS_BIRTHDAY.AWK [-v debug={0|1}]
#
# sorting:
#   PROCINFO["sorted_in"] is used by GAWK
#   SORTTYPE is used by Thompson Automation's TAWK
#
BEGIN {
    debug += 0
    PROCINFO["sorted_in"] = "@ind_num_asc" ; SORTTYPE = 1
    n = split("05/15,05/16,05/19,06/17,06/18,07/14,07/16,08/14,08/15,08/17",arr,",")
    for (i=1; i<=n; i++) { # move dates to a more friendly structure
      mmdd_arr[arr[i]] = ""
    }
    print("Cheryl offers these ten MM/DD choices:")
    cb_show_dates()
    printf("Cheryl then tells Albert her birth 'month' and Bernard her birth 'day'.\n\n")
    print("1. Albert: I don't know when Cheryl's birthday is, but I know that Bernard does not know too.")
    cb_filter1()
    print("2. Bernard: At first I don't know when Cheryl's birthday is, but I know now.")
    cb_filter2()
    print("3. Albert: Then I also know when Cheryl's birthday is.")
    cb_filter3()
    exit(0)
}
function cb_filter1(  i,j) {
    print("deduction: the month cannot have a unique day, leaving:")
    cb_load_arrays(4)
    for (j in arr1) {
      if (arr1[j] == 1) {
        if (debug) { printf("unique day %s\n",j) }
        arr3[arr2[j]] = ""
      }
    }
    cb_remove_dates()
}
function cb_filter2(  i,j) {
    print("deduction: the day must be unique, leaving:")
    cb_load_arrays(4)
    for (j in arr1) {
      if (arr1[j] > 1) {
        if (debug) { printf("non-unique day %s\n",j) }
        arr3[j] = ""
      }
    }
    cb_remove_dates("...")
}
function cb_filter3(  i,j) {
    print("deduction: the month must be unique, leaving:")
    cb_load_arrays(1)
    for (j in arr1) {
      if (arr1[j] > 1) {
        if (debug) { printf("non-unique month %s\n",j) }
        arr3[j] = ""
      }
    }
    cb_remove_dates()
}
function cb_load_arrays(col,  i,key) {
    delete arr1
    delete arr2
    delete arr3
    for (i in mmdd_arr) {
      key = substr(i,col,2)
      arr1[key]++
      arr2[key] = substr(i,1,2)
    }
}
function cb_remove_dates(pattern,  i,j) {
    for (j in arr3) {
      for (i in mmdd_arr) {
        if (i ~ ("^" pattern j)) {
          if (debug) { printf("removing %s\n",i) }
          delete mmdd_arr[i]
        }
      }
    }
    cb_show_dates()
}
function cb_show_dates(  i) {
    if (debug) { printf("%d remaining\n",length(mmdd_arr)) }
    for (i in mmdd_arr) {
      printf("%s ",i)
    }
    printf("\n\n")
}


use 5.020;
use warnings;
use ntheory qw/:all/;
use experimental qw/signatures/;

sub chernick_carmichael_factors ($n, $m) {
    (6*$m + 1, 12*$m + 1, (map { (1 << $_) * 9*$m + 1 } 1 .. $n-2));
}

sub chernick_carmichael_number ($n, $callback) {

    my $multiplier = ($n > 4) ? (1 << ($n-4)) : 1;

    for (my $m = 1 ; ; ++$m) {
        my @f = chernick_carmichael_factors($n, $m * $multiplier);
        next if not vecall { is_prime($_) } @f;
        $callback->(@f);
        last;
    }
}

foreach my $n (3..9) {
    chernick_carmichael_number($n, sub (@f) { say "a($n) = ", vecprod(@f) });
}


with javascript_semantics
function chernick_carmichael_factors(integer n, m)
    sequence res = {6*m + 1, 12*m + 1}
    for i=1 to n-2 do
        res &= power(2,i) * 9*m + 1
    end for
    return res
end function

include mpfr.e
mpz p = mpz_init()

function m_prime(atom a)
    mpz_set_d(p,a)
    return mpz_prime(p)
end function

function is_chernick_carmichael(integer n, m)
    return iff(n==2 ? m_prime(6*m + 1) and m_prime(12*m + 1)
                    : m_prime(power(2,n-2) * 9*m + 1) and
                      is_chernick_carmichael(n-1, m))
end function

function chernick_carmichael_number(integer n)
    integer m = iff(n>4 ? power(2,n-4) : 1), mm = m
    while not is_chernick_carmichael(n, mm) do mm += m end while
    return {chernick_carmichael_factors(n, mm),mm}
end function

for n=3 to 9 do
    {sequence f, integer m} = chernick_carmichael_number(n)
    mpz_set_si(p,1)
    for i=1 to length(f) do
        mpz_mul_d(p,p,f[i])
        f[i] = sprintf("%d",f[i])
    end for
    printf(1,"U(%d,%d): %s = %s\n",{n,m,mpz_get_str(p),join(f," * ")})
end for


#include <stdbool.h>
#include <stdio.h>

char *months[] = {
    "ERR", "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
};

struct Date {
    int month, day;
    bool active;
} dates[] = {
    {5,15,true}, {5,16,true}, {5,19,true},
    {6,17,true}, {6,18,true},
    {7,14,true}, {7,16,true},
    {8,14,true}, {8,15,true}, {8,17,true}
};
#define UPPER_BOUND (sizeof(dates) / sizeof(struct Date))

void printRemaining() {
    int i, c;
    for (i = 0, c = 0; i < UPPER_BOUND; i++) {
        if (dates[i].active) {
            c++;
        }
    }
    printf("%d remaining.\n", c);
}

void printAnswer() {
    int i;
    for (i = 0; i < UPPER_BOUND; i++) {
        if (dates[i].active) {
            printf("%s, %d\n", months[dates[i].month], dates[i].day);
        }
    }
}

void firstPass() {
    // the month cannot have a unique day
    int i, j, c;
    for (i = 0; i < UPPER_BOUND; i++) {
        c = 0;

        for (j = 0; j < UPPER_BOUND; j++) {
            if (dates[j].day == dates[i].day) {
                c++;
            }
        }

        if (c == 1) {
            for (j = 0; j < UPPER_BOUND; j++) {
                if (!dates[j].active) continue;
                if (dates[j].month == dates[i].month) {
                    dates[j].active = false;
                }
            }
        }
    }
}

void secondPass() {
    // the day must now be unique
    int i, j, c;
    for (i = 0; i < UPPER_BOUND; i++) {
        if (!dates[i].active) continue;
        c = 0;

        for (j = 0; j < UPPER_BOUND; j++) {
            if (!dates[j].active) continue;
            if (dates[j].day == dates[i].day) {
                c++;
            }
        }

        if (c > 1) {
            for (j = 0; j < UPPER_BOUND; j++) {
                if (!dates[j].active) continue;
                if (dates[j].day == dates[i].day) {
                    dates[j].active = false;
                }
            }
        }
    }
}

void thirdPass() {
    // the month must now be unique
    int i, j, c;
    for (i = 0; i < UPPER_BOUND; i++) {
        if (!dates[i].active) continue;
        c = 0;

        for (j = 0; j < UPPER_BOUND; j++) {
            if (!dates[j].active) continue;
            if (dates[j].month == dates[i].month) {
                c++;
            }
        }

        if (c > 1) {
            for (j = 0; j < UPPER_BOUND; j++) {
                if (!dates[j].active) continue;
                if (dates[j].month == dates[i].month) {
                    dates[j].active = false;
                }
            }
        }
    }
}

int main() {
    printRemaining();
    // the month cannot have a unique day
    firstPass();

    printRemaining();
    // the day must now be unique
    secondPass();

    printRemaining();
    // the month must now be unique
    thirdPass();

    printAnswer();
    return 0;
}


?- use_module(library(primality)).

u(3, M, A * B * C) :-
    A is 6*M + 1, B is 12*M + 1, C is 18*M + 1, !.
u(N, M, U0 * D) :-
    succ(Pn, N), u(Pn, M, U0),
    D is 9*(1 << (N - 2))*M + 1.

prime_factorization(A*B) :- prime(B), prime_factorization(A), !.
prime_factorization(A) :- prime(A).

step(N, 1) :- N < 5, !.
step(5, 2) :- !.
step(N, K) :- K is 5*(1 << (N - 4)).

a(N, Factors) :- % due to backtracking nature of Prolog, a(n) will return all chernick-carmichael numbers.
    N > 2, !,
    step(N, I),
    between(1, infinite, J), M is I * J,
    u(N, M, Factors),
    prime_factorization(Factors).

main :-
    forall(
        (between(3, 9, K), once(a(K, Factorization)), N is Factorization),
        format("~w: ~w = ~w~n", [K, Factorization, N])),
    halt.

?- main.


"""

Python implementation of
http://rosettacode.org/wiki/Chernick%27s_Carmichael_numbers

"""

# use sympy for prime test

from sympy import isprime

# based on C version

def primality_pretest(k):
    if not (k % 3) or not (k % 5) or not (k % 7) or not (k % 11) or not(k % 13) or not (k % 17) or not (k % 19) or not (k % 23):
        return (k <= 23)

    return True

def is_chernick(n, m):

    t = 9 * m

    if not primality_pretest(6 * m + 1):
        return False

    if not primality_pretest(12 * m + 1):
        return False

    for i in range(1,n-1):
        if not primality_pretest((t << i) + 1):
            return False

    if not isprime(6 * m + 1):
        return False

    if not isprime(12 * m + 1):
        return False

    for i in range(1,n - 1):
        if not isprime((t << i) + 1):
            return False

    return True

for n in range(3,10):

    if n > 4:
        multiplier = 1 << (n - 4)
    else:
        multiplier = 1

    if n > 5:
        multiplier *= 5

    k = 1

    while True:
        m = k * multiplier

        if is_chernick(n, m):
            print("a("+str(n)+") has m = "+str(m))
            break

        k += 1


public static class CherylsBirthday
{
    public static void Main() {
        var dates = new HashSet<(string month, int day)> {
            ("May", 15),
            ("May", 16),
            ("May", 19),
            ("June", 17),
            ("June", 18),
            ("July", 14),
            ("July", 16),
            ("August", 14),
            ("August", 15),
            ("August", 17)
        };

        Console.WriteLine(dates.Count + " remaining.");
        //The month cannot have a unique day.
        var monthsWithUniqueDays = dates.GroupBy(d => d.day).Where(g => g.Count() == 1).Select(g => g.First().month).ToHashSet();
        dates.RemoveWhere(d => monthsWithUniqueDays.Contains(d.month));
        Console.WriteLine(dates.Count + " remaining.");
        //The day must now be unique.
        dates.IntersectWith(dates.GroupBy(d => d.day).Where(g => g.Count() == 1).Select(g => g.First()));
        Console.WriteLine(dates.Count + " remaining.");
        //The month must now be unique.
        dates.IntersectWith(dates.GroupBy(d => d.month).Where(g => g.Count() == 1).Select(g => g.First()));
        Console.WriteLine(dates.Single());
    }

}


use Inline::Perl5;
use ntheory:from<Perl5> <:all>;

sub chernick-factors ($n, $m) {
    6×$m + 1, 12×$m + 1, |((1 .. $n-2).map: { (1 +< $_) × 9×$m + 1 } )
}

sub chernick-carmichael-number ($n) {

    my $multiplier = 1 +< (($n-4) max 0);
    my $iterator   = $n < 5 ?? (1 .. *) !! (1 .. *).map: * × 5;

    $multiplier × $iterator.first: -> $m {
        [&&] chernick-factors($n, $m × $multiplier).map: { is_prime($_) }
    }

}

for 3 .. 9 -> $n {
    my $m = chernick-carmichael-number($n);
    my @f = chernick-factors($n, $m);
    say "U($n, $m): {[×] @f} = {@f.join(' ⨉ ')}";
}


func chernick_carmichael_factors (n, m) {
    [6*m + 1, 12*m + 1, {|i| 2**i * 9*m + 1 }.map(1 .. n-2)...]
}

func is_chernick_carmichael (n, m) {
    (n == 2) ? (is_prime(6*m + 1) && is_prime(12*m + 1))
             : (is_prime(2**(n-2) * 9*m + 1) && __FUNC__(n-1, m))
}

func chernick_carmichael_number(n, callback) {
    var multiplier = (n>4 ? 2**(n-4) : 1)
    var m = (1..Inf -> first {|m| is_chernick_carmichael(n, m * multiplier) })
    var f = chernick_carmichael_factors(n, m * multiplier)
    callback(f...)
}

for n in (3..9) {
    chernick_carmichael_number(n, {|*f| say "a(#{n}) = #{f.join(' * ')}" })
}


#include <algorithm>
#include <iostream>
#include <vector>
using namespace std;

const vector<string> MONTHS = {
    "Jan", "Feb", "Mar", "Apr", "May", "Jun",
    "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
};

struct Birthday {
    int month, day;

    friend ostream &operator<<(ostream &, const Birthday &);
};

ostream &operator<<(ostream &out, const Birthday &birthday) {
    return out << MONTHS[birthday.month - 1] << ' ' << birthday.day;
}

template <typename C>
bool monthUniqueIn(const Birthday &b, const C &container) {
    auto it = cbegin(container);
    auto end = cend(container);
    int count = 0;
    while (it != end) {
        if (it->month == b.month) {
            count++;
        }
        it = next(it);
    }
    return count == 1;
}

template <typename C>
bool dayUniqueIn(const Birthday &b, const C &container) {
    auto it = cbegin(container);
    auto end = cend(container);
    int count = 0;
    while (it != end) {
        if (it->day == b.day) {
            count++;
        }
        it = next(it);
    }
    return count == 1;
}

template <typename C>
bool monthWithUniqueDayIn(const Birthday &b, const C &container) {
    auto it = cbegin(container);
    auto end = cend(container);
    while (it != end) {
        if (it->month == b.month && dayUniqueIn(*it, container)) {
            return true;
        }
        it = next(it);
    }
    return false;
}

int main() {
    vector<Birthday> choices = {
        {5, 15}, {5, 16}, {5, 19}, {6, 17}, {6, 18},
        {7, 14}, {7, 16}, {8, 14}, {8, 15}, {8, 17},
    };

    // Albert knows the month but doesn't know the day.
    // So the month can't be unique within the choices.
    vector<Birthday> filtered;
    for (auto bd : choices) {
        if (!monthUniqueIn(bd, choices)) {
            filtered.push_back(bd);
        }
    }

    // Albert also knows that Bernard doesn't know the answer.
    // So the month can't have a unique day.
    vector<Birthday> filtered2;
    for (auto bd : filtered) {
        if (!monthWithUniqueDayIn(bd, filtered)) {
            filtered2.push_back(bd);
        }
    }

    // Bernard now knows the answer.
    // So the day must be unique within the remaining choices.
    vector<Birthday> filtered3;
    for (auto bd : filtered2) {
        if (dayUniqueIn(bd, filtered2)) {
            filtered3.push_back(bd);
        }
    }

    // Albert now knows the answer too.
    // So the month must be unique within the remaining choices.
    vector<Birthday> filtered4;
    for (auto bd : filtered3) {
        if (monthUniqueIn(bd, filtered3)) {
            filtered4.push_back(bd);
        }
    }

    if (filtered4.size() == 1) {
        cout << "Cheryl's birthday is " << filtered4[0] << '\n';
    } else {
        cout << "Something went wrong!\n";
    }

    return 0;
}


import "/big" for BigInt, BigInts
import "/fmt" for Fmt

var min = 3
var max = 9
var prod = BigInt.zero
var fact = BigInt.zero
var factors = List.filled(max, 0)
var bigFactors = List.filled(max, null)

var init = Fn.new {
    for (i in 0...max) bigFactors[i] = BigInt.zero
}

var isPrimePretest = Fn.new { |k|
    if (k%3 == 0 || k%5 == 0 || k%7 == 0 || k%11 == 0 ||
       (k%13 == 0) || k%17 == 0 || k%19 == 0 || k%23 == 0) return k <= 23
    return true
}

var ccFactors = Fn.new { |n, m|
    if (!isPrimePretest.call(6*m + 1)) return false
    if (!isPrimePretest.call(12*m + 1)) return false
    factors[0] = 6*m + 1
    factors[1] = 12*m + 1
    var t = 9 * m
    var i = 1
    while (i <= n-2) {
        var tt = (t << i) + 1
        if (!isPrimePretest.call(tt)) return false
        factors[i+1] = tt
        i = i + 1
    }
    for (i in 0...n) {
        fact = BigInt.new(factors[i])
        if (!fact.isProbablePrime(1)) return false
        bigFactors[i] = fact
    }
    return true
}

var ccNumbers = Fn.new { |start, end|
    for (n in start..end) {
        var mult = 1
        if (n > 4) mult = 1 << (n - 4)
        if (n > 5) mult = mult * 5
        var m = mult
        while (true) {
            if (ccFactors.call(n, m)) {
                var num = BigInts.prod(bigFactors.take(n))
                Fmt.print("a($d) = $i", n, num)
                Fmt.print("m($d) = $d", n, m)
                Fmt.print("Factors: $n\n", factors[0...n])
                break
            }
            m = m + mult
        }
    }
}

init.call()
ccNumbers.call(min, max)


;; Author: Amir Teymuri, Saturday 20.10.2018

(defparameter *possible-dates*
  '((15 . may) (16 . may) (19 . may)
    (17 . june) (18 . june)
    (14 . july) (16 . july)
    (14 . august) (15 . august) (17 . august)))

(defun unique-date-parts (possible-dates &key (alist-look-at #'car) (alist-r-assoc #'assoc))
  (let* ((date-parts (mapcar alist-look-at possible-dates))
	 (unique-date-parts (remove-if #'(lambda (part) (> (count part date-parts) 1)) date-parts)))
    (mapcar #'(lambda (part) (funcall alist-r-assoc part possible-dates))
    	    unique-date-parts)))

(defun person (person possible-dates)
  "Who's turn is it to think?"
  (case person
    ('albert (unique-date-parts possible-dates :alist-look-at #'cdr :alist-r-assoc #'rassoc))
    ('bernard (unique-date-parts possible-dates :alist-look-at #'car :alist-r-assoc #'assoc))))

(defun cheryls-birthday (possible-dates)
  (person 'albert
	  (person 'bernard
		  (set-difference
		   possible-dates
		   (person 'bernard possible-dates)
		   :key #'cdr))))

(cheryls-birthday *possible-dates*) ;; => ((16 . JULY))


import std.algorithm.iteration : filter, joiner, map;
import std.algorithm.searching : canFind;
import std.algorithm.sorting : sort;
import std.array : array;
import std.datetime.date : Date, Month;
import std.stdio : writeln;

void main() {
    auto choices = [
        // Month.jan
        Date(2019, Month.may, 15),
        Date(2019, Month.may, 16),
        Date(2019, Month.may, 19),  // unique day (1)

        Date(2019, Month.jun, 17),
        Date(2019, Month.jun, 18),  // unique day (1)

        Date(2019, Month.jul, 14),
        Date(2019, Month.jul, 16),  // final answer

        Date(2019, Month.aug, 14),
        Date(2019, Month.aug, 15),
        Date(2019, Month.aug, 17),
    ];

    // The month cannot have a unique day because Albert knows the month, and knows that Bernard does not know the answer
    auto uniqueMonths = choices.sort!"a.day < b.day".groupBy.filter!"a.array.length == 1".joiner.map!"a.month";
    // writeln(uniqueMonths.save);
    auto filter1 = choices.filter!(a => !canFind(uniqueMonths.save, a.month)).array;

    // Bernard now knows the answer, so the day must be unique within the remaining choices
    auto uniqueDays = filter1.sort!"a.day < b.day".groupBy.filter!"a.array.length == 1".joiner.map!"a.day";
    auto filter2 = filter1.filter!(a => canFind(uniqueDays.save, a.day)).array;

    // Albert knows the answer too, so the month must be unique within the remaining choices
    auto birthDay = filter2.sort!"a.month < b.month".groupBy.filter!"a.array.length == 1".joiner.front;

    // print the result
    writeln(birthDay.month, " ", birthDay.day);
}


var [const] BI=Import("zklBigNum");  // libGMP

fcn ccFactors(n,m){	// not re-entrant
   prod:=BI(6*m + 1);
   if(not prod.probablyPrime())    return(False);
   fact:=BI(12*m + 1);
   if(not fact.probablyPrime())    return(False);
   prod.mul(fact);
   foreach i in ([1..n-2]){
      fact.set((2).pow(i) *9*m + 1);
      if(not fact.probablyPrime()) return(False);
      prod.mul(fact);
   }
   prod
}

fcn ccNumbers(start,end){
   foreach n in ([start..end]){
      a,m := ( if(n<=4) 1  else (2).pow(n - 4) ), a;
      while(1){
	 if(num := ccFactors(n,m)){
	    println("a(%d) = %,d".fmt(n,num));
	    break;
	 }
	 m+=a;
      }
   }
}


//Find Cheryl's Birthday. Nigel Galloway: October 23rd., 2018
type Month = |May |June |July |August
let fN n= n |> List.filter(fun (_,n)->(List.length n) < 2) |> List.unzip
let dates = [(May,15);(May,16);(May,19);(June,17);(June,18);(July,14);(July,16);(August,14);(August,15);(August,17)]
let _,n = dates |> List.groupBy snd |> fN
let   i = n |> List.concat |> List.map fst |> Set.ofList
let _,g = dates |> List.filter(fun (n,_)->not (Set.contains n i)) |> List.groupBy snd |> fN
let _,e = List.concat g |> List.groupBy fst |> fN
printfn "%A" e


USING: assocs calendar.english fry io kernel prettyprint
sequences sets.extras ;

: unique-by ( seq quot -- newseq )
    2dup map non-repeating '[ @ _ member? ] filter ; inline

ALIAS: day first
ALIAS: month second

{
    { 15 5 } { 16 5 } { 19 5 } { 17 6 } { 18 6 }
    { 14 7 } { 16 7 } { 14 8 } { 15 8 } { 17 8 }
}

! the month cannot have a unique day
dup [ day ] map non-repeating over extract-keys values
'[ month _ member? ] reject

! of the remaining dates, day must be unique
[ day ] unique-by

! of the remaining dates, month must be unique
[ month ] unique-by

! print a date that looks like { { 16 7 } }
first first2 month-name write bl .


package main

import (
    "fmt"
    "time"
)

type birthday struct{ month, day int }

func (b birthday) String() string {
    return fmt.Sprintf("%s %d", time.Month(b.month), b.day)
}

func (b birthday) monthUniqueIn(bds []birthday) bool {
    count := 0
    for _, bd := range bds {
        if bd.month == b.month {
            count++
        }
    }
    if count == 1 {
        return true
    }
    return false
}

func (b birthday) dayUniqueIn(bds []birthday) bool {
    count := 0
    for _, bd := range bds {
        if bd.day == b.day {
            count++
        }
    }
    if count == 1 {
        return true
    }
    return false
}

func (b birthday) monthWithUniqueDayIn(bds []birthday) bool {
    for _, bd := range bds {
        if bd.month == b.month && bd.dayUniqueIn(bds) {
            return true
        }
    }
    return false
}

func main() {
    choices := []birthday{
        {5, 15}, {5, 16}, {5, 19}, {6, 17}, {6, 18},
        {7, 14}, {7, 16}, {8, 14}, {8, 15}, {8, 17},
    }

    // Albert knows the month but doesn't know the day.
    // So the month can't be unique within the choices.
    var filtered []birthday
    for _, bd := range choices {
        if !bd.monthUniqueIn(choices) {
            filtered = append(filtered, bd)
        }
    }

    // Albert also knows that Bernard doesn't know the answer.
    // So the month can't have a unique day.
    var filtered2 []birthday
    for _, bd := range filtered {
        if !bd.monthWithUniqueDayIn(filtered) {
            filtered2 = append(filtered2, bd)
        }
    }

    // Bernard now knows the answer.
    // So the day must be unique within the remaining choices.
    var filtered3 []birthday
    for _, bd := range filtered2 {
        if bd.dayUniqueIn(filtered2) {
            filtered3 = append(filtered3, bd)
        }
    }

    // Albert now knows the answer too.
    // So the month must be unique within the remaining choices.
    var filtered4 []birthday
    for _, bd := range filtered3 {
        if bd.monthUniqueIn(filtered3) {
            filtered4 = append(filtered4, bd)
        }
    }

    if len(filtered4) == 1 {
        fmt.Println("Cheryl's birthday is", filtered4[0])
    } else {
        fmt.Println("Something went wrong!")
    }
}


import java.time.Month

class Main {
    private static class Birthday {
        private Month month
        private int day

        Birthday(Month month, int day) {
            this.month = month
            this.day = day
        }

        Month getMonth() {
            return month
        }

        int getDay() {
            return day
        }

        @Override
        String toString() {
            return month.toString() + " " + day
        }
    }

    static void main(String[] args) {
        List<Birthday> choices = [
                new Birthday(Month.MAY, 15),
                new Birthday(Month.MAY, 16),
                new Birthday(Month.MAY, 19),
                new Birthday(Month.JUNE, 17),
                new Birthday(Month.JUNE, 18),
                new Birthday(Month.JULY, 14),
                new Birthday(Month.JULY, 16),
                new Birthday(Month.AUGUST, 14),
                new Birthday(Month.AUGUST, 15),
                new Birthday(Month.AUGUST, 17)
        ]
        println("There are ${choices.size()} candidates remaining.")

        // The month cannot have a unique day because Albert knows the month, and knows that Bernard does not know the answer
        Set<Birthday> uniqueMonths = choices.groupBy { it.getDay() }
                .values()
                .findAll() { it.size() == 1 }
                .flatten()
                .collect { ((Birthday) it).getMonth() }
                .toSet() as Set<Birthday>
        def f1List = choices.findAll { !uniqueMonths.contains(it.getMonth()) }
        println("There are ${f1List.size()} candidates remaining.")

        // Bernard now knows the answer, so the day must be unique within the remaining choices
        List<Birthday> f2List = f1List.groupBy { it.getDay() }
                .values()
                .findAll { it.size() == 1 }
                .flatten()
                .toList() as List<Birthday>
        println("There are ${f2List.size()} candidates remaining.")

        // Albert knows the answer too, so the month must be unique within the remaining choices
        List<Birthday> f3List = f2List.groupBy { it.getMonth() }
                .values()
                .findAll { it.size() == 1 }
                .flatten()
                .toList() as List<Birthday>
        println("There are ${f3List.size()} candidates remaining.")

        if (f3List.size() == 1) {
            println("Cheryl's birthday is ${f3List.head()}")
        } else {
            System.out.println("No unique choice found")
        }
    }
}


{-# LANGUAGE OverloadedStrings #-}

import Data.List as L (filter, groupBy, head, length, sortOn)
import Data.Map.Strict as M (Map, fromList, keys, lookup)
import Data.Text as T (Text, splitOn, words)
import Data.Maybe (fromJust)
import Data.Ord (comparing)
import Data.Function (on)
import Data.Tuple (swap)
import Data.Bool (bool)

data DatePart
  = Month
  | Day

type M = Text

type D = Text

main :: IO ()
main =
  print $
  -- The month with only one remaining day,
  --
  -- (A's month contains only one remaining day)
  -- (3 :: A "Then I also know")
  uniquePairing Month $
  -- among the days with unique months,
  --
  -- (B's day is paired with only one remaining month)
  -- (2 :: B "I know now")
  uniquePairing Day $
  -- excluding months with unique days,
  --
  -- (A's month is not among those with unique days)
  -- (1 :: A "I know that Bernard does not know")
  monthsWithUniqueDays False $
  -- from the given month-day pairs:
  --
  -- (0 :: Cheryl's list)
  (\(x:y:_) -> (x, y)) . T.words <$>
  splitOn
    ", "
    "May 15, May 16, May 19, June 17, June 18, \
              \July 14, July 16, Aug 14, Aug 15, Aug 17"

----------------------QUERY FUNCTIONS----------------------
monthsWithUniqueDays :: Bool -> [(M, D)] -> [(M, D)]
monthsWithUniqueDays bln xs =
  let months = fst <$> uniquePairing Day xs
  in L.filter (bool not id bln . (`elem` months) . fst) xs

uniquePairing :: DatePart -> [(M, D)] -> [(M, D)]
uniquePairing dp xs =
  let f =
        case dp of
          Month -> fst
          Day -> snd
  in (\md ->
         let dct = f md
             uniques =
               L.filter
                 ((1 ==) . L.length . fromJust . flip M.lookup dct)
                 (keys dct)
         in L.filter ((`elem` uniques) . f) xs)
       ((((,) . mapFromPairs) <*> mapFromPairs . fmap swap) xs)

mapFromPairs :: [(M, D)] -> Map Text [Text]
mapFromPairs xs =
  M.fromList $
  ((,) . fst . L.head) <*> fmap snd <$>
  L.groupBy (on (==) fst) (L.sortOn fst xs)


Dates=: <;._2 noun define
15 May
16 May
19 May
17 June
18 June
14 July
16 July
14 August
15 August
17 August
)

getDayMonth=: |:@:(' '&splitstring&>)                      NB. retrieve lists of days and months from dates
keep=: adverb def '] #~ u'                                 NB. apply mask to filter dates

monthsWithUniqueDay=: {./. #~ (1=#)/.                      NB. list months that have a unique day
isMonthWithoutUniqueDay=: (] [email protected] monthsWithUniqueDay)/@getDayMonth  NB. mask of dates with a month that doesn't have a unique day

uniqueDayInMonth=: [email protected][ #~ (1=#)/.                         NB. list of days that are unique to 1 month
isUniqueDayInMonth=: ([ e. uniqueDayInMonth)/@getDayMonth  NB. mask of dates with a day that is unique to 1 month

uniqueMonth=: [email protected]] #~ (1=#)/.~                             NB. list of months with 1 unique day
isUniqueMonth=: (] e. uniqueMonth)/@getDayMonth            NB. mask of dates with a month that has 1 unique day


import java.time.Month;
import java.util.Collection;
import java.util.List;
import java.util.Set;
import java.util.stream.Collectors;

public class Main {
    private static class Birthday {
        private Month month;
        private int day;

        public Birthday(Month month, int day) {
            this.month = month;
            this.day = day;
        }

        public Month getMonth() {
            return month;
        }

        public int getDay() {
            return day;
        }

        @Override
        public String toString() {
            return month + " " + day;
        }
    }

    public static void main(String[] args) {
        List<Birthday> choices = List.of(
            new Birthday(Month.MAY, 15),
            new Birthday(Month.MAY, 16),
            new Birthday(Month.MAY, 19),
            new Birthday(Month.JUNE, 17),
            new Birthday(Month.JUNE, 18),
            new Birthday(Month.JULY, 14),
            new Birthday(Month.JULY, 16),
            new Birthday(Month.AUGUST, 14),
            new Birthday(Month.AUGUST, 15),
            new Birthday(Month.AUGUST, 17)
        );
        System.out.printf("There are %d candidates remaining.\n", choices.size());

        // The month cannot have a unique day because Albert knows the month, and knows that Bernard does not know the answer
        Set<Month> uniqueMonths = choices.stream()
            .collect(Collectors.groupingBy(Birthday::getDay))
            .values()
            .stream()
            .filter(g -> g.size() == 1)
            .flatMap(Collection::stream)
            .map(Birthday::getMonth)
            .collect(Collectors.toSet());
        List<Birthday> f1List = choices.stream()
            .filter(birthday -> !uniqueMonths.contains(birthday.month))
            .collect(Collectors.toList());
        System.out.printf("There are %d candidates remaining.\n", f1List.size());

        // Bernard now knows the answer, so the day must be unique within the remaining choices
        List<Birthday> f2List = f1List.stream()
            .collect(Collectors.groupingBy(Birthday::getDay))
            .values()
            .stream()
            .filter(g -> g.size() == 1)
            .flatMap(Collection::stream)
            .collect(Collectors.toList());
        System.out.printf("There are %d candidates remaining.\n", f2List.size());

        // Albert knows the answer too, so the month must be unique within the remaining choices
        List<Birthday> f3List = f2List.stream()
            .collect(Collectors.groupingBy(Birthday::getMonth))
            .values()
            .stream()
            .filter(g -> g.size() == 1)
            .flatMap(Collection::stream)
            .collect(Collectors.toList());
        System.out.printf("There are %d candidates remaining.\n", f3List.size());

        if (f3List.size() == 1) {
            System.out.printf("Cheryl's birthday is %s\n", f3List.get(0));
        } else {
            System.out.println("No unique choice found");
        }
    }
}


(() => {
    'use strict';

    // main :: IO ()
    const main = () => {
        const
            month = fst,
            day = snd;
        showLog(
            map(x => Array.from(x), (

                // The month with only one remaining day,

                // (A's month contains only one remaining day)
                // (3 :: A "Then I also know")
                uniquePairing(month)(

                    // among the days with unique months,

                    // (B's day is paired with only one remaining month)
                    // (2 :: B "I know now")
                    uniquePairing(day)(

                        // excluding months with unique days,

                        // (A's month is not among those with unique days)
                        // (1 :: A "I know that Bernard does not know")
                        monthsWithUniqueDays(false)(

                            // from the given month-day pairs:

                            // (0 :: Cheryl's list)
                            map(x => tupleFromList(words(strip(x))),
                                splitOn(/,\s+/,
                                    `May 15, May 16, May 19,
                                        June 17, June 18, July 14, July 16,
                                        Aug 14, Aug 15, Aug 17`
                                )
                            )
                        )
                    )
                )
            ))
        );
    };

    // monthsWithUniqueDays :: Bool -> [(Month, Day)] -> [(Month, Day)]
    const monthsWithUniqueDays = blnInclude => xs => {
        const months = map(fst, uniquePairing(snd)(xs));
        return filter(
            md => (blnInclude ? id : not)(
                elem(fst(md), months)
            ),
            xs
        );
    };

    // uniquePairing :: ((a, a) -> a) ->
    //      -> [(Month, Day)] -> [(Month, Day)]
    const uniquePairing = f => xs =>
        bindPairs(xs,
            md => {
                const
                    dct = f(md),
                    matches = filter(
                        k => 1 === length(dct[k]),
                        Object.keys(dct)
                    );
                return filter(tpl => elem(f(tpl), matches), xs);
            }
        );

    // bindPairs :: [(Month, Day)] -> (Dict, Dict) -> [(Month, Day)]
    const bindPairs = (xs, f) => f(
        Tuple(
            dictFromPairs(fst)(snd)(xs),
            dictFromPairs(snd)(fst)(xs)
        )
    );

    // dictFromPairs :: ((a, a) -> a) -> ((a, a) -> a) -> [(a, a)] -> Dict
    const dictFromPairs = f => g => xs =>
        foldl((a, tpl) => Object.assign(
            a, {
                [f(tpl)]: (a[f(tpl)] || []).concat(g(tpl).toString())
            }
        ), {}, xs);

    // GENERIC ABSTRACTIONS -------------------------------

    // Tuple (,) :: a -> b -> (a, b)
    const Tuple = (a, b) => ({
        type: 'Tuple',
        '0': a,
        '1': b,
        length: 2
    });

    // elem :: Eq a => a -> [a] -> Bool
    const elem = (x, xs) => xs.includes(x);

    // filter :: (a -> Bool) -> [a] -> [a]
    const filter = (f, xs) => xs.filter(f);

    // foldl :: (a -> b -> a) -> a -> [b] -> a
    const foldl = (f, a, xs) => xs.reduce(f, a);

    // fst :: (a, b) -> a
    const fst = tpl => tpl[0];

    // id :: a -> a
    const id = x => x;

    // intersect :: (Eq a) => [a] -> [a] -> [a]
    const intersect = (xs, ys) =>
        xs.filter(x => -1 !== ys.indexOf(x));

    // Returns Infinity over objects without finite length
    // this enables zip and zipWith to choose the shorter
    // argument when one is non-finite, like cycle, repeat etc

    // length :: [a] -> Int
    const length = xs =>
        (Array.isArray(xs) || 'string' === typeof xs) ? (
            xs.length
        ) : Infinity;

    // map :: (a -> b) -> [a] -> [b]
    const map = (f, xs) => xs.map(f);

    // not :: Bool -> Bool
    const not = b => !b;

    // showLog :: a -> IO ()
    const showLog = (...args) =>
        console.log(
            args
            .map(JSON.stringify)
            .join(' -> ')
        );

    // snd :: (a, b) -> b
    const snd = tpl => tpl[1];

    // splitOn :: String -> String -> [String]
    const splitOn = (pat, src) =>
        src.split(pat);

    // strip :: String -> String
    const strip = s => s.trim();

    // tupleFromList :: [a] -> (a, a ...)
    const tupleFromList = xs =>
        TupleN.apply(null, xs);

    // TupleN :: a -> b ...  -> (a, b ... )
    function TupleN() {
        const
            args = Array.from(arguments),
            lng = args.length;
        return lng > 1 ? Object.assign(
            args.reduce((a, x, i) => Object.assign(a, {
                [i]: x
            }), {
                type: 'Tuple' + (2 < lng ? lng.toString() : ''),
                length: lng
            })
        ) : args[0];
    };

    // words :: String -> [String]
    const words = s => s.split(/\s+/);

    // MAIN ---
    return main();
})();


def count(stream; cond):
  reduce stream as $i (0; if $i|cond then .+1 else . end);

def Months: [
    "January", "February", "March", "April", "May", "June",
    "July", "August", "September", "October", "November", "December"
];

# tostring
def birthday: "\(Months[.month-1]) \(.day)";

# Input: a Birthday
def monthUniqueIn($bds):
  .month as $thisMonth
  | count( $bds[]; .month == $thisMonth) == 1;

# Input: a Birthday
def dayUniqueIn($bds):
  .day as $thisDay
  | count( $bds[]; .day == $thisDay) == 1;

# Input: a Birthday
def monthWithUniqueDayIn($bds):
  .month as $thisMonth
  | any( $bds[]; $thisMonth == .month and dayUniqueIn($bds));

def choices: [
    {month: 5, day: 15}, {month: 5, day: 16}, {month: 5, day: 19}, {month: 6, day: 17},
    {month: 6, day: 18}, {month: 7, day: 14}, {month: 7, day: 16}, {month: 8, day: 14},
    {month: 8, day: 15}, {month: 8, day: 17}
];

# Albert knows the month but doesn't know the day,
# so the month can't be unique within the choices.
def filter1:
  . as $in
  | map(select( monthUniqueIn($in) | not));

# Albert also knows that Bernard doesn't know the answer,
# so the month can't have a unique day.
def filter2:
  . as $in
  | map(select( monthWithUniqueDayIn($in) | not));

# Bernard now knows the answer,
# so the day must be unique within the remaining choices.
def filter3:
  . as $in
  | map(select( dayUniqueIn($in) ));

# Albert now knows the answer too.
# So the month must be unique within the remaining choices.
def filter4:
  . as $in
  | map(select( monthUniqueIn($in) ));

def solve:
  (choices | filter1 | filter2 | filter3 | filter4) as $bds
  | if $bds|length == 1
    then "Cheryl's birthday is \($bds[0]|birthday)."
    else "Whoops!"
    end;

solve


const dates = [[15, "May"], [16, "May"], [19, "May"], [17, "June"], [18, "June"],
    [14, "July"], [16, "July"], [14, "August"], [15, "August"], [17, "August"]]

uniqueday(parr) = filter(x -> count(y -> y[1] == x[1], parr) == 1, parr)

# At the start, they come to know that they have no unique day of month to identify.
const f1 = filter(m -> !(m[2] in [d[2] for d in uniqueday(dates)]), dates)

# After cutting months with unique dates, get months remaining that now have a unique date.
const f2 = uniqueday(f1)

# filter for those of the finally remaining months that have only one date left.
const bday = filter(x -> count(m -> m[2] == x[2], f2) == 1, f2)[]

println("Cheryl's birthday is $(bday[2]) $(bday[1]).")


// Version 1.2.71

val months = listOf(
    "January", "February", "March", "April", "May", "June",
    "July", "August", "September", "October", "November", "December"
)

class Birthday(val month: Int, val day: Int) {
    public override fun toString() = "${months[month - 1]} $day"

    public fun monthUniqueIn(bds: List<Birthday>): Boolean {
        return bds.count { this.month == it.month } == 1
    }

    public fun dayUniqueIn(bds: List<Birthday>): Boolean {
        return bds.count { this.day == it.day } == 1
    }

    public fun monthWithUniqueDayIn(bds: List<Birthday>): Boolean {
        return bds.any { (this.month == it.month) && it.dayUniqueIn(bds) }
    }
}

fun main(args: Array<String>) {
    val choices = listOf(
        Birthday(5, 15), Birthday(5, 16), Birthday(5, 19), Birthday(6, 17),
        Birthday(6, 18), Birthday(7, 14), Birthday(7, 16), Birthday(8, 14),
        Birthday(8, 15), Birthday(8, 17)
    )

    // Albert knows the month but doesn't know the day.
    // So the month can't be unique within the choices.
    var filtered = choices.filterNot { it.monthUniqueIn(choices) }

    // Albert also knows that Bernard doesn't know the answer.
    // So the month can't have a unique day.
    filtered = filtered.filterNot { it.monthWithUniqueDayIn(filtered) }

    // Bernard now knows the answer.
    // So the day must be unique within the remaining choices.
    filtered = filtered.filter { it.dayUniqueIn(filtered) }

    // Albert now knows the answer too.
    // So the month must be unique within the remaining choices.
    filtered = filtered.filter { it.monthUniqueIn(filtered) }

    if (filtered.size == 1)
        println("Cheryl's birthday is ${filtered[0]}")
    else
        println("Something went wrong!")
}


-- Cheryl's Birthday in Lua 6/15/2020 db

local function Date(mon,day)
  return { mon=mon, day=day, valid=true }
end

local choices = {
  Date("May", 15), Date("May", 16), Date("May", 19),
  Date("June", 17), Date("June", 18),
  Date("July", 14), Date("July", 16),
  Date("August", 14), Date("August", 15), Date("August", 17)
}

local function apply(t, f)
  for k, v in ipairs(t) do
    f(k, v)
  end
end

local function filter(t, f)
  local result = {}
  for k, v in ipairs(t) do
    if f(k, v) then
      result[#result+1] = v
    end
  end
  return result
end

local function map(t, f)
  local result = {}
  for k, v in ipairs(t) do
    result[#result+1] = f(k, v)
  end
  return result
end

local function count(t) return #t end
local function isvalid(k, v) return v.valid end
local function invalidate(k, v) v.valid = false end
local function remaining() return filter(choices, isvalid) end

local function listValidChoices()
  print("   " .. table.concat(map(remaining(), function(k, v) return v.mon .. " " .. v.day end), ", "))
  print()
end

print("Cheryl offers these ten choices:")
listValidChoices()

print("1) Albert knows that Bernard also cannot yet know, so cannot be a month with a unique day, leaving:")
apply(remaining(), function(k, v)
  if count(filter(choices, function(k2, v2) return v.day==v2.day end)) == 1 then
    apply(filter(remaining(), function(k2, v2) return v.mon==v2.mon end), invalidate)
  end
end)
listValidChoices()

print("2) After Albert's revelation, Bernard now knows, so day must be unique, leaving:")
apply(remaining(), function(k, v)
  local subset = filter(remaining(), function(k2, v2) return v.day==v2.day end)
  if count(subset) > 1 then apply(subset, invalidate) end
end)
listValidChoices()

print("3) After Bernard's revelation, Albert now knows, so month must be unique, leaving only:")
apply(remaining(), function(k, v)
  local subset = filter(remaining(), function(k2, v2) return v.mon==v2.mon end)
  if count(subset) > 1 then apply(subset, invalidate) end
end)
listValidChoices()


opts = Tuples[{{"May"}, {15, 16, 19}}]~Join~Tuples[{{"June"}, {17, 18}}]~Join~Tuples[{{"July"}, {14, 16}}]~Join~Tuples[{{"August"}, {14, 15, 17}}];
monthsdelete = Select[GatherBy[opts, Last], Length /* EqualTo[1]][[All, 1, 1]];
opts = DeleteCases[opts, {Alternatives @@ monthsdelete, _}]
removedates = [email protected][GatherBy[opts, Last], Length /* GreaterThan[1]];
opts = DeleteCases[opts, Alternatives @@ removedates]
Select[GatherBy[opts, First], Length /* EqualTo[1]]


import tables
import sets
import strformat

type Date = tuple[month: string, day: int]

const Dates = [Date ("May", 15), ("May", 16), ("May", 19), ("June", 17), ("June", 18),
               ("July", 14), ("July", 16), ("August", 14), ("August", 15), ("August", 17)]

const

  MonthTable: Table[int, HashSet[string]] =
                static:
                  var t: Table[int, HashSet[string]]
                  for date in Dates:
                    t.mgetOrPut(date.day, initHashSet[string]()).incl(date.month)
                  t

  DayTable: Table[string, HashSet[int]] =
              static:
                var t: Table[string, HashSet[int]]
                for date in Dates:
                  t.mgetOrPut(date.month, initHashSet[int]()).incl(date.day)
                t

var possibleMonths: HashSet[string]   # Set of possible months.
var possibleDays: HashSet[int]        # Set of possible days.

# Albert: I don't know when Cheryl's birthday is, ...
# => eliminate months with a single possible day.
for month, days in DayTable.pairs:
  if days.len > 1:
    possibleMonths.incl(month)

# ... but I know that Bernard does not know too.
# => eliminate months with one day present only in this month.
for month, days in DayTable.pairs:
  for day in days:
    if MonthTable[day].len == 1:
      possibleMonths.excl(month)
echo fmt"After first Albert's sentence, possible months are {possibleMonths}."

# Bernard:  At first I don't know when Cheryl's birthday is, ...
# => eliminate days with a single possible month.
for day, months in MonthTable.pairs:
  if months.len > 1:
    possibleDays.incl(day)

# ...  but I know now.
# => eliminate days which are compatible with several months in "possibleMonths".
var impossibleDays: HashSet[int]        # Days which are eliminated by this sentence.
for day in possibleDays:
  if (MonthTable[day] * possibleMonths).len > 1:
    impossibleDays.incl(day)
possibleDays.excl(impossibleDays)
echo fmt"After Bernard's sentence, possible days are {possibleDays}."

# Albert: Then I also know when Cheryl's birthday is.
# => eliminate months which are compatible with several days in "possibleDays".
var impossibleMonths: HashSet[string]   # Months which are eliminated by this sentence.
for month in possibleMonths:
  if (DayTable[month] * possibleDays).len > 1:
    impossibleMonths.incl(month)
possibleMonths.excl(impossibleMonths)

doAssert possibleMonths.len == 1
let month = possibleMonths.pop()
echo fmt"After second Albert's sentence, remaining month is {month}..."

possibleDays = possibleDays * DayTable[month]
doAssert possibleDays.len == 1
let day = possibleDays.pop()
echo fmt"and thus remaining day is {day}."

echo ""
echo fmt"So birthday date is {month} {day}."


sub filter {
    my($test,@dates) = @_;
    my(%M,%D,@filtered);

    # analysis of potential birthdays, keyed by month and by day
    for my $date (@dates) {
        my($mon,$day) = split '-', $date;
        $M{$mon}{cnt}++;
        $D{$day}{cnt}++;
        push @{$M{$mon}{day}},  $day;
        push @{$D{$day}{mon}},  $mon;
        push @{$M{$mon}{bday}}, "$mon-$day";
        push @{$D{$day}{bday}}, "$mon-$day";
    }

    # eliminates May/Jun dates based on 18th and 19th being singletons
    if ($test eq 'singleton') {
        my %skip;
        for my $day (grep { $D{$_}{cnt} == 1 } keys %D) { $skip{ @{$D{$day}{mon}}[0] }++    }
        for my $mon (grep { ! $skip{$_}      } keys %M) { push @filtered, @{$M{$mon}{bday}} }

    # eliminates Jul/Aug 14th because day count > 1 across months
    } elsif ($test eq 'duplicate') {
        for my $day (grep { $D{$_}{cnt} == 1 } keys %D) { push @filtered, @{$D{$day}{bday}} }

    # eliminates Aug 15th/17th because day count > 1, within month
    } elsif ($test eq 'multiple') {
        for my $day (grep { $M{$_}{cnt} == 1 } keys %M) { push @filtered, @{$M{$day}{bday}} }
    }
    return @filtered;
}

# doesn't matter what order singleton/duplicate tests are run, but 'multiple' must be last;
my @dates = qw<5-15 5-16 5-19 6-17 6-18 7-14 7-16 8-14 8-15 8-17>;
@dates = filter($_, @dates) for qw<singleton duplicate multiple>;

my @months = qw<_ January February March April May June July August September October November December>;

my ($m, $d) = split '-', $dates[0];
print "Cheryl's birthday is $months[$m] $d.\n";


-- demo\rosetta\Cheryls_Birthday.exw
with javascript_semantics
sequence choices = {{5, 15}, {5, 16}, {5, 19}, {6, 17}, {6, 18},
                    {7, 14}, {7, 16}, {8, 14}, {8, 15}, {8, 17}}

sequence mwud = repeat(false,12)    -- months with unique days

for step=1 to 4 do
    sequence {months,days} = columnize(choices)
    bool impossible = false
    for i=length(choices) to 1 by -1 do
        integer {m,d} = choices[i]
        switch step do
            case 1:   mwud[m] += (sum(sq_eq(days,d))=1)
            case 2: impossible = mwud[m]
            case 3: impossible = (sum(sq_eq(days,d))!=1)
            case 4: impossible = (sum(sq_eq(months,m))!=1)
        end switch
        if impossible then
            choices[i..i] = {}
        end if
    end for
end for
?choices


'''Cheryl's Birthday'''

from itertools import groupby
from re import split

# main :: IO ()
def main():
    '''Derivation of the date.'''

    month, day = 0, 1
    print(
        # (3 :: A "Then I also know")
        # (A's month contains only one remaining day)
        uniquePairing(month)(
            # (2 :: B "I know now")
            # (B's day is paired with only one remaining month)
            uniquePairing(day)(
                # (1 :: A "I know that Bernard does not know")
                # (A's month is not among those with unique days)
                monthsWithUniqueDays(False)([
                    # 0 :: Cheryl's list:
                    tuple(x.split()) for x in
                    split(
                        ', ',
                        'May 15, May 16, May 19, ' +
                        'June 17, June 18, ' +
                        'July 14, July 16, ' +
                        'Aug 14, Aug 15, Aug 17'
                    )
                ])
            )
        )
    )

# ------------------- QUERY FUNCTIONS --------------------

# monthsWithUniqueDays :: Bool -> [(Month, Day)] -> [(Month, Day)]
def monthsWithUniqueDays(blnInclude):
    '''The subset of months with (or without) unique days.
    '''
    def go(xs):
        month, day = 0, 1
        months = [fst(x) for x in uniquePairing(day)(xs)]
        return [
            md for md in xs
            if blnInclude or not (md[month] in months)
        ]
    return go

# uniquePairing :: DatePart -> [(Month, Day)] -> [(Month, Day)]
def uniquePairing(i):
    '''Subset of months (or days) with a unique intersection.
    '''
    def go(xs):
        def inner(md):
            dct = md[i]
            uniques = [
                k for k in dct.keys()
                if 1 == len(dct[k])
            ]
            return [tpl for tpl in xs if tpl[i] in uniques]
        return inner
    return ap(bindPairs)(go)

# bindPairs :: [(Month, Day)] ->
# ((Dict String [String], Dict String [String])
# -> [(Month, Day)]) -> [(Month, Day)]
def bindPairs(xs):
    '''List monad injection operator for lists
       of (Month, Day) pairs.
    '''
    return lambda f: f(
        (
            dictFromPairs(xs),
            dictFromPairs(
                [(b, a) for (a, b) in xs]
            )
        )
    )

# dictFromPairs :: [(Month, Day)] -> Dict Text [Text]
def dictFromPairs(xs):
    '''A dictionary derived from a list of
       month day pairs.
    '''
    return {
        k: [snd(x) for x in m] for k, m in groupby(
            sorted(xs, key=fst), key=fst
        )
    }

# ----------------------- GENERIC ------------------------

# ap :: (a -> b -> c) -> (a -> b) -> a -> c
def ap(f):
    '''Applicative instance for functions.
    '''
    def go(g):
        def fxgx(x):
            return f(x)(
                g(x)
            )
        return fxgx
    return go

# fst :: (a, b) -> a
def fst(tpl):
    '''First component of a pair.
    '''
    return tpl[0]

# snd :: (a, b) -> b
def snd(tpl):
    '''Second component of a pair.
    '''
    return tpl[1]

if __name__ == '__main__':
    main()


options <- dplyr::tibble(mon = rep(c("May", "June", "July", "August"),times = c(3,2,2,3)),
                         day = c(15, 16, 19, 17, 18, 14, 16, 14, 15, 17))

okMonths <- c()
#  Albert's first clue - it is a month with no unique day
for (i in unique(options$mon)){
  if(all(options$day[options$mon == i] %in% options$day[options$mon != i])) {okMonths <- c(okMonths, i)}
}

okDays <- c()
#  Bernard's clue - it is a day that only occurs once in the remaining dates
for (i in unique(options$day)){
  if(!all(options$mon[options$day == i] %in% options$mon[(options$mon %in% okMonths)])) {okDays <- c(okDays, i)}
}

remaining <- options[(options$mon %in% okMonths) & (options$day %in% okDays), ]
# Albert's second clue - must be a month with only one un-eliminated date
for(i in unique(remaining$mon)){
  if(sum(remaining$mon == i) == 1) {print(remaining[remaining$mon == i,])}
}


#lang racket

(define ((is x #:key [key identity]) y) (equal? (key x) (key y)))

(define albert first)
(define bernard second)

(define (((unique who) chs) date) (= 1 (count (is date #:key who) chs)))

(define (((unique-fix who-fix who) chs) date)
  (ormap (conjoin (is date #:key who-fix) ((unique who) chs)) chs))

(define-syntax-rule (solve <chs> [<act> <arg>] ...)
  (let* ([chs <chs>] [chs (<act> (<arg> chs) chs)] ...) chs))

(solve '((May 15) (May 16) (May 19) (June 17) (June 18)
         (July 14) (July 16) (August 14) (August 15) (August 17))

       ;; Albert knows the month but doesn't know the day.
       ;; So the month can't be unique within the choices.
       [filter-not (unique albert)]
       ;; Albert also knows that Bernard doesn't know the answer.
       ;; So the month can't have a unique day.
       [filter-not (unique-fix albert bernard)]
       ;; Bernard now knows the answer.
       ;; So the day must be unique within the remaining choices.
       [filter (unique bernard)]
       ;; Albert now knows the answer too.
       ;; So the month must be unique within the remaining choices
       [filter (unique albert)])


my @dates =
    { :15day, :5month },
    { :16day, :5month },
    { :19day, :5month },
    { :17day, :6month },
    { :18day, :6month },
    { :14day, :7month },
    { :16day, :7month },
    { :14day, :8month },
    { :15day, :8month },
    { :17day, :8month }
;

# Month can't have a unique day
my @filtered = @dates.grep(*.<month> != one(@dates.grep(*.<day> == one(@dates».<day>))».<month>));

# Day must be unique and unambiguous in remaining months
my $birthday = @filtered.grep(*.<day> == one(@filtered».<day>)).classify({.<month>})\
    .first(*.value.elems == 1).value[0];

# convenience array
my @months = <'' January February March April May June July August September October November December>;

say "Cheryl's birthday is { @months[$birthday<month>] } {$birthday<day>}.";


/*REXX pgm finds Cheryl's birth date based on a person knowing the birth month, another */
/*──────────────────────── person knowing the birth day, given a list of possible dates.*/
$= 'May-15 May-16 May-19 June-17 June-18 July-14 July-16 August-14 August-15 August-17'
call delDays unique('day')
$= unique('day')
$= unique('month')
if words($)==1  then say "Cheryl's birthday is"  translate($, , '-')
                else say "error in the program's logic."
exit 0
/*──────────────────────────────────────────────────────────────────────────────────────*/
unique:  arg u 2, dups;  #= words($);   $$= $
            do    j=#  to 2  by -1
            if u=='D'     then parse value word($, j)  with  '-'   x
                          else parse value word($, j)  with   x   '-'
               do k=1  for j-1
               if u=='D'  then parse value word($, k)  with  '-'   y
                          else parse value word($, k)  with   y   '-'
               if x==y    then dups= dups k j
               end   /*k*/
            end      /*j*/
                                  do    d=#  for #  by -1
                                     do p=1  for words(dups)  until ?==d;  ?= word(dups,p)
                                     if ?==d  then  $$= delword($$, ?, 1)
                                     end   /*d*/
                                  end      /*d*/
         if words($$)==0  then return $
                          else return $$
/*──────────────────────────────────────────────────────────────────────────────────────*/
delDays: parse arg days;  #= words(days)
           do    j=#   for #   by -1;  parse value word(days, j) with x '-';  ##= words($)
              do k=##  for ##  by -1;  parse value word($,    k) with y '-'
              if x\==y  then iterate;  $= delword($, k, 1)
              end   /*k*/
           end      /*j*/
         return $


dates = [
    ["May", 15],
    ["May", 16],
    ["May", 19],
    ["June", 17],
    ["June", 18],
    ["July", 14],
    ["July", 16],
    ["August", 14],
    ["August", 15],
    ["August", 17],
]

print dates.length, " remaining\n"

# the month cannot have a unique day
uniqueMonths = dates.group_by { |m,d| d }
                    .select { |k,v| v.size == 1 }
                    .map { |k,v| v.flatten }
                    .map { |m,d| m }
dates.delete_if { |m,d| uniqueMonths.include? m }
print dates.length, " remaining\n"

# the day must be unique
dates = dates   .group_by { |m,d| d }
                .select { |k,v| v.size == 1 }
                .map { |k,v| v.flatten }
print dates.length, " remaining\n"

# the month must now be unique
dates = dates   .group_by { |m,d| m }
                .select { |k,v| v.size == 1 }
                .map { |k,v| v }
                .flatten
print dates


// This version is based on the Go version on Rosettacode

#[derive(PartialEq, Debug, Copy, Clone)]
enum Month {
    May,
    June,
    July,
    August,
}

#[derive(PartialEq, Debug, Copy, Clone)]
struct Birthday {
    month: Month,
    day: u8,
}

impl Birthday {
    fn month_unique_in(&self, birthdays: &[Birthday]) -> bool {
        birthdays
            .iter()
            .filter(|birthday| birthday.month == self.month)
            .count()
            == 1
    }

    fn day_unique_in(&self, birthdays: &[Birthday]) -> bool {
        birthdays
            .iter()
            .filter(|birthday| birthday.day == self.day)
            .count()
            == 1
    }

    fn month_with_unique_day_in(&self, birthdays: &[Birthday]) -> bool {
        birthdays
            .iter()
            .any(|birthday| self.month == birthday.month && birthday.day_unique_in(birthdays))
    }
}

fn solution() -> Option<Birthday> {
    let mut choices: Vec<Birthday> = vec![
        Birthday {
            month: Month::May,
            day: 15,
        },
        Birthday {
            month: Month::May,
            day: 16,
        },
        Birthday {
            month: Month::May,
            day: 19,
        },
        Birthday {
            month: Month::June,
            day: 17,
        },
        Birthday {
            month: Month::June,
            day: 18,
        },
        Birthday {
            month: Month::July,
            day: 14,
        },
        Birthday {
            month: Month::July,
            day: 16,
        },
        Birthday {
            month: Month::August,
            day: 14,
        },
        Birthday {
            month: Month::August,
            day: 15,
        },
        Birthday {
            month: Month::August,
            day: 17,
        },
    ];

    // Albert knows the month but doesn't know the day.
    // So the month can't be unique within the choices.
    let choices_copy = choices.clone();
    choices.retain(|birthday| !(&birthday.month_unique_in(&choices_copy)));

    // Albert also knows that Bernard doesn't know the answer.
    // So the month can't have a unique day.
    let choices_copy = choices.clone();
    choices.retain(|birthday| !(birthday.month_with_unique_day_in(&choices_copy)));

    // Bernard now knows the answer.
    // So the day must be unique within the remaining choices.
    let choices_copy = choices.clone();
    choices.retain(|birthday| birthday.day_unique_in(&choices_copy));

    // Albert now knows the answer too.
    // So the month must be unique within the remaining choices.
    let choices_copy = choices.clone();
    choices.retain(|birthday| birthday.month_unique_in(&choices_copy));

    if choices.len() == 1 {
        Some(choices[0])
    } else {
        None
    }
}

fn main() {
    match solution() {
        Some(solution) => println!("Cheryl's birthday is {:?}", solution),
        None => panic!("Didn't work!"),
    }
}


import java.time.format.DateTimeFormatter
import java.time.{LocalDate, Month}

object Cheryl {
  def main(args: Array[String]): Unit = {
    val choices = List(
      LocalDate.of(2019, Month.MAY, 15),
      LocalDate.of(2019, Month.MAY, 16),
      LocalDate.of(2019, Month.MAY, 19),

      LocalDate.of(2019, Month.JUNE, 17),
      LocalDate.of(2019, Month.JUNE, 18),

      LocalDate.of(2019, Month.JULY, 14),
      LocalDate.of(2019, Month.JULY, 16),

      LocalDate.of(2019, Month.AUGUST, 14),
      LocalDate.of(2019, Month.AUGUST, 15),
      LocalDate.of(2019, Month.AUGUST, 17)
    )

    // The month cannot have a unique day because Albert knows the month, and knows that Bernard does not know the answer
    val uniqueMonths = choices.groupBy(_.getDayOfMonth)
      .filter(a => a._2.length == 1)
      .flatMap(a => a._2)
      .map(a => a.getMonth)
    val filter1 = choices.filterNot(a => uniqueMonths.exists(b => a.getMonth == b))

    // Bernard now knows the answer, so the day must be unique within the remaining choices
    val uniqueDays = filter1.groupBy(_.getDayOfMonth)
      .filter(a => a._2.length == 1)
      .flatMap(a => a._2)
      .map(a => a.getDayOfMonth)
    val filter2 = filter1.filter(a => uniqueDays.exists(b => a.getDayOfMonth == b))

    // Albert knows the answer too, so the month must be unique within the remaining choices
    val birthDay = filter2.groupBy(_.getMonth)
      .filter(a => a._2.length == 1)
      .flatMap(a => a._2)
      .head

    // print the result
    printf(birthDay.format(DateTimeFormatter.ofPattern("MMMM dd")))
  }
}


func f(day, month) {
    Date.parse("#{day} #{month}", "%d %B")
}

var dates = [
    f(15, "May"),
    f(16, "May"),
    f(19, "May"),
    f(17, "June"),
    f(18, "June"),
    f(14, "July"),
    f(16, "July"),
    f(14, "August"),
    f(15, "August"),
    f(17, "August")
]

var filtered = dates.grep {
    dates.grep {
        dates.map{ .day }.count(.day) == 1
    }.map{ .month }.count(.month) != 1
}

var birthday = filtered.grep {
    filtered.map{ .day }.count(.day) == 1
}.group_by{ .month }.values.first_by { .len == 1 }[0]

say "Cheryl's birthday is #{birthday.fullmonth} #{birthday.day}."


struct MonthDay: CustomStringConvertible {
  static let months = [
    "January", "February", "March", "April", "May", "June",
    "July", "August", "September", "October", "November", "December"
  ]

  var month: Int
  var day: Int

  var description: String { "\(MonthDay.months[month - 1]) \(day)" }

  private func isUniqueIn(months: [MonthDay], by prop: KeyPath<MonthDay, Int>) -> Bool {
    return months.lazy.filter({ $0[keyPath: prop] == self[keyPath: prop] }).count == 1
  }

  func monthIsUniqueIn(months: [MonthDay]) -> Bool {
    return isUniqueIn(months: months, by: \.month)
  }

  func dayIsUniqueIn(months: [MonthDay]) -> Bool {
    return isUniqueIn(months: months, by: \.day)
  }

  func monthWithUniqueDayIn(months: [MonthDay]) -> Bool {
    return months.firstIndex(where: { $0.month == month && $0.dayIsUniqueIn(months: months) }) != nil
  }
}

let choices = [
  MonthDay(month: 5, day: 15),
  MonthDay(month: 5, day: 16),
  MonthDay(month: 5, day: 19),
  MonthDay(month: 6, day: 17),
  MonthDay(month: 6, day: 18),
  MonthDay(month: 7, day: 14),
  MonthDay(month: 7, day: 16),
  MonthDay(month: 8, day: 14),
  MonthDay(month: 8, day: 15),
  MonthDay(month: 8, day: 17)
]

// Albert knows the month, but not the day, so he doesn't have a gimmie month
let albertKnows = choices.filter({ !$0.monthIsUniqueIn(months: choices) })

// Albert also knows that Bernard doesn't know, so it can't be a gimmie day
let bernardKnows = albertKnows.filter({ !$0.monthWithUniqueDayIn(months: albertKnows) })

// Bernard now knows the birthday, so it must be a unique day within the remaining choices
let bernardKnowsMore = bernardKnows.filter({ $0.dayIsUniqueIn(months: bernardKnows) })

// Albert knows the birthday now, so it must be a unique month within the remaining choices
guard let birthday = bernardKnowsMore.filter({ $0.monthIsUniqueIn(months: bernardKnowsMore) }).first else {
  fatalError()
}

print("Cheryl's birthday is \(birthday)")


with Ada.Numerics.Generic_Real_Arrays;
generic
   with package Matrix is new Ada.Numerics.Generic_Real_Arrays (<>);
package Decomposition is

   -- decompose a square matrix A by A = L * Transpose (L)
   procedure Decompose (A : Matrix.Real_Matrix; L : out Matrix.Real_Matrix);

end Decomposition;


#!/usr/local/bin/a68g --script #

MODE FIELD=LONG REAL;
PROC (FIELD)FIELD field sqrt = long sqrt;
INT field prec = 5;
FORMAT field fmt = $g(-(2+1+field prec),field prec)$;

MODE MAT = [0,0]FIELD;

PROC cholesky = (MAT a) MAT:(
    [UPB a, 2 UPB a]FIELD l;

    FOR i FROM LWB a TO UPB a DO
        FOR j FROM 2 LWB a TO i DO
            FIELD s := 0;
            FOR k FROM 2 LWB a TO j-1 DO
                s +:= l[i,k] * l[j,k]
            OD;
            l[i,j] := IF i = j
                      THEN field sqrt(a[i,i] - s)
                      ELSE 1.0 / l[j,j] * (a[i,j] - s) FI
        OD;
        FOR j FROM i+1 TO 2 UPB a DO
            l[i,j]:=0 # Not required if matrix is declared as triangular #
        OD
    OD;
    l
);

PROC print matrix v1 =(MAT a)VOID:(
    FOR i FROM LWB a TO UPB a DO
        FOR j FROM 2 LWB a TO 2 UPB a DO
            printf(($g(-(2+1+field prec),field prec)$, a[i,j]))
        OD;
        printf($l$)
    OD
);

PROC print matrix =(MAT a)VOID:(
    FORMAT vector fmt = $"("f(field  fmt)n(2 UPB a-2 LWB a)(", " f(field  fmt))")"$;
    FORMAT matrix fmt = $"("f(vector fmt)n(  UPB a-  LWB a)(","lxf(vector fmt))")"$;
    printf((matrix fmt, a))
);

main: (
    MAT m1 = ((25, 15, -5),
              (15, 18,  0),
              (-5,  0, 11));
    MAT c1 = cholesky(m1);
    print matrix(c1);
    printf($l$);

    MAT m2 = ((18, 22,  54,  42),
              (22, 70,  86,  62),
              (54, 86, 174, 134),
              (42, 62, 134, 106));
    MAT c2 = cholesky(m2);
    print matrix(c2)
)


Private Sub exclude_unique_days(w As Collection)
    Dim number_of_dates(31) As Integer
    Dim months_to_exclude As New Collection
    For Each v In w
        number_of_dates(v(1)) = number_of_dates(v(1)) + 1
    Next v
    For i = w.Count To 1 Step -1
        If number_of_dates(w(i)(1)) = 1 Then
            months_to_exclude.Add w(i)(0)
            w.Remove i
        End If
    Next i
    For Each m In months_to_exclude
        exclude_month w, m
    Next m
End Sub
Private Sub exclude_month(x As Collection, v As Variant)
    For i = x.Count To 1 Step -1
        If x(i)(0) = v Then x.Remove i
    Next i
End Sub
Private Sub exclude_non_unique_days(w As Collection)
    Dim number_of_dates(31) As Integer
    For Each v In w
        number_of_dates(v(1)) = number_of_dates(v(1)) + 1
    Next v
    For i = w.Count To 1 Step -1
        If number_of_dates(w(i)(1)) > 1 Then
            w.Remove i
        End If
    Next i
End Sub
Private Sub exclude_non_unique_months(w As Collection)
    Dim months As New Collection
    For Each v In w
        On Error GoTo 1
        months.Add v(0), v(0)
    Next v
1:
    For i = w.Count To 1 Step -1
        If w(i)(0) = v(0) Then
            w.Remove i
        End If
    Next i
End Sub
Public Sub cherylsbirthday()
    Dim v As New Collection
    s = "May 15, May 16, May 19, June 17, June 18, July 14, July 16, August 14, August 15, August 17"
    t = Split(s, ",")
    For Each u In t
        v.Add Split(Trim(u), " ")
    Next u
    '1) Albert: I don't know when Cheryl's birthday is, but I know that Bernard does not know too.
    exclude_unique_days v
    '2) Bernard: At first I don't know when Cheryl's birthday is, but I know now.
    exclude_non_unique_days v
    '3) Albert: Then I also know when Cheryl's birthday is.
    exclude_non_unique_months v
    Debug.Print v(1)(0); " "; v(1)(1)
End Sub


Module Module1

    Structure MonDay
        Dim month As String
        Dim day As Integer

        Sub New(m As String, d As Integer)
            month = m
            day = d
        End Sub

        Public Overrides Function ToString() As String
            Return String.Format("({0}, {1})", month, day)
        End Function
    End Structure

    Sub Main()
        Dim dates = New HashSet(Of MonDay) From {
            New MonDay("May", 15),
            New MonDay("May", 16),
            New MonDay("May", 19),
            New MonDay("June", 17),
            New MonDay("June", 18),
            New MonDay("July", 14),
            New MonDay("July", 16),
            New MonDay("August", 14),
            New MonDay("August", 15),
            New MonDay("August", 17)
        }
        Console.WriteLine("{0} remaining.", dates.Count)

        ' The month cannot have a unique day.
        Dim monthsWithUniqueDays = dates.GroupBy(Function(d) d.day).Where(Function(g) g.Count() = 1).Select(Function(g) g.First().month).ToHashSet()
        dates.RemoveWhere(Function(d) monthsWithUniqueDays.Contains(d.month))
        Console.WriteLine("{0} remaining.", dates.Count)

        ' The day must now be unique.
        dates.IntersectWith(dates.GroupBy(Function(d) d.day).Where(Function(g) g.Count() = 1).Select(Function(g) g.First()))
        Console.WriteLine("{0} remaining.", dates.Count)

        ' The month must now be unique.
        dates.IntersectWith(dates.GroupBy(Function(d) d.month).Where(Function(g) g.Count() = 1).Select(Function(g) g.First()))
        Console.WriteLine(dates.Single())
    End Sub

End Module


Cholesky_Decomposition(A){
    L := [], n := A.Count()
    L[1,1] := Sqrt(A[1,1])
    loop % n {
        k := A_Index
        loop % n-1 {
            i := A_Index+1

            Sigma := 0, j := 0
            while (++j <= k-1)
                Sigma += L[i, j] * L[k, j]
            L[i, k] := (A[i, k] - Sigma) / L[k, k]

            Sigma := 0, j := 0
            while (++j <= k-1)
                Sigma += (L[k, j])**2
            L[k, k] := Sqrt(A[k, k] - Sigma)
        }
    }
    loop % n{
        k := A_Index
        loop % n
            L[k, A_Index] := L[k, A_Index] ? L[k, A_Index] : 0
    }
    return L
}
ShowMatrix(L){
    for r, obj in L{
        row := ""
        for c, v in obj
            row .= Format("{:.3f}", v) ", "
        output .= "[" trim(row, ", ") "]`n,"
    }
    return "[" Trim(output, "`n,") "]"
}