Cheryl's birthday: Difference between revisions
m (→{{header|zkl}}: rewrite) |
(→{{header|Python}}: Added a first draft in Python) |
||
Line 445: | Line 445: | ||
{{Out}} |
{{Out}} |
||
<pre>[["July","16"]]</pre> |
<pre>[["July","16"]]</pre> |
||
=={{header|Python}}== |
|||
<lang python>from itertools import (groupby) |
|||
from re import (split) |
|||
# main :: IO () |
|||
def main(): |
|||
(month, day) = (0, 1) |
|||
print( |
|||
# (A's month contains only one remaining day) |
|||
# (3 :: A "Then I also know") |
|||
uniquePairing(month)( |
|||
# (B's day is paired with only one remaining month) |
|||
# (2 :: B "I know now") |
|||
uniquePairing(day)( |
|||
# (A's month is not among those with unique days) |
|||
# (1 :: A "I know that Bernard does not know") |
|||
monthsWithUniqueDays(False)( |
|||
# 0 :: Cheryl's list: |
|||
list(map( |
|||
lambda x: tuple(x.split()), |
|||
split( |
|||
', ', |
|||
'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)] |
|||
def monthsWithUniqueDays(blnInclude): |
|||
def go(xs): |
|||
(month, day) = (0, 1) |
|||
months = list(map(fst, uniquePairing(day)(xs))) |
|||
return list(filter( |
|||
lambda md: ( |
|||
id if blnInclude else _not |
|||
)(md[month] in months), |
|||
xs |
|||
)) |
|||
return lambda xs: go(xs) |
|||
# uniquePairing :: Int -> [(Month, Day)] -> [(Month, Day)] |
|||
def uniquePairing(i): |
|||
def go(xs): |
|||
def inner(md): |
|||
dct = md[i] |
|||
matches = list(filter( |
|||
lambda k: 1 == len(dct[k]), |
|||
dct.keys() |
|||
)) |
|||
return filter(lambda tpl: tpl[i] in matches, xs) |
|||
return inner |
|||
return lambda xs: bindPairs(xs)(go(xs)) |
|||
# bindPairs |
|||
# :: [(Month, Day)] |
|||
# -> ((M.Map String [Text], M.Map Text [Text]) -> [(Month, Day)]) |
|||
# -> [(Month, Day)] |
|||
def bindPairs(xs): |
|||
return lambda f: list(f( |
|||
(dictFromPairs(xs), dictFromPairs(map(swap, xs))) |
|||
)) |
|||
# dictFromPairs :: [(Month, Day)] -> Map String [String] |
|||
def dictFromPairs(xs): |
|||
return dict( |
|||
map( |
|||
lambda m: (m[0][0], list(map(snd, m))), |
|||
groupBy(fst)( |
|||
sorted(xs, key=fst) |
|||
) |
|||
) |
|||
) |
|||
# GENERIC ------------------------------------------------- |
|||
# fst :: (a, b) -> a |
|||
def fst(tpl): |
|||
return tpl[0] |
|||
# groupBy :: (a -> b) -> [a] -> [[a]] |
|||
def groupBy(f): |
|||
return lambda xs: list(map( |
|||
lambda x: list(x[1]), |
|||
groupby(xs, key=f) |
|||
)) |
|||
# id :: a -> a |
|||
def id(x): |
|||
return x |
|||
# _not :: Bool -> Bool |
|||
def _not(bln): |
|||
return not bln |
|||
# snd :: (a, b) -> b |
|||
def snd(tpl): |
|||
return tpl[1] |
|||
# swap :: (a, b) -> (b, a) |
|||
def swap(tpl): |
|||
return (tpl[1], tpl[0]) |
|||
# MAIN --- |
|||
main()</lang> |
|||
{{Out}} |
|||
<pre>[('July', '16')]</pre> |
|||
=={{header|Perl}}== |
=={{header|Perl}}== |
Revision as of 12:34, 24 October 2018
Albert and Bernard just became friends with Cheryl, and they want to know when her birthday is.
Cheryl gave them a list of 10 possible dates:
May 15, May 16, May 19 June 17, June 18 July 14, July 16 August 14, August 15, August 17
Cheryl then tells Albert and Bernard separately the month and the day of the birthday respectively.
1) Albert: I don't know when Cheryl's birthday is, but I know that Bernard does not know too.
2) Bernard: At first I don't know when Cheryl's birthday is, but I know now.
3) Albert: Then I also know when Cheryl's birthday is.
- Task
Write a program in your language to deduce, by successive elimination, Cheryl's birthday.
See the Wikipedia article of the same name.
- Related task
Common Lisp
<lang lisp>
- 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)) </lang>
F#
<lang fsharp> //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(fun (_,n)-> n) |> fN let i = n |> List.concat |> List.map(fun (n,_)->n) |> Set.ofList let _,g = dates |> List.filter(fun (n,_)->not (Set.contains n i)) |> List.groupBy(fun (_,n)-> n)|> fN let _,e = List.concat g |> List.groupBy(fun (n,_)->n) |> fN printfn "%A" e </lang>
- Output:
[[(July, 16)]]
Go
<lang go>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!") }
}</lang>
- Output:
Cheryl's birthday is July 16
Haskell
<lang haskell>{-# LANGUAGE OverloadedStrings #-}
import Data.List as L (filter, groupBy, head, length, sortBy) 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)
type Month = Text
type Day = 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 True -- among the days with unique months, -- -- (B's day is paired with only one remaining month) -- (2 :: B "I know now") (uniquePairing False -- 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 -> [(Month, Day)] -> [(Month, Day)] monthsWithUniqueDays bln xs =
let months = fst <$> uniquePairing False xs in L.filter (\(m, _) -> (if bln then id else not) (m `elem` months)) xs
uniquePairing :: Bool -> [(Month, Day)] -> [(Month, Day)] uniquePairing bln xs =
let f = (if bln then fst else snd) in bindPairs xs (\md -> let dct :: M.Map Text [Text] dct = f md matches = L.filter ((1 ==) . L.length . fromJust . flip M.lookup dct) (keys dct) in L.filter ((`elem` matches) . f) xs)
bindPairs
:: [(Month, Day)] -> ((M.Map Text [Text], M.Map Text [Text]) -> [(Month, Day)]) -> [(Month, Day)]
bindPairs xs f = f (mapFromPairs xs, mapFromPairs (swap <$> xs))
mapFromPairs :: [(Month, Day)] -> Map Text [Text] mapFromPairs xs =
M.fromList $ ((,) . fst . L.head) <*> fmap snd <$> L.groupBy (on (==) fst) (L.sortBy (comparing fst) xs)</lang>
- Output:
[("July","16")]
JavaScript
<lang javascript>(() => {
'use strict';
// main :: IO () const main = () => 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(fst)(
// among the days with unique months,
// (B's day is paired with only one remaining month) // (2 :: B "I know now") uniquePairing(snd)(
// 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();
})();</lang>
- Output:
[["July","16"]]
Python
<lang python>from itertools import (groupby) from re import (split)
- main :: IO ()
def main():
(month, day) = (0, 1) print( # (A's month contains only one remaining day) # (3 :: A "Then I also know") uniquePairing(month)( # (B's day is paired with only one remaining month) # (2 :: B "I know now") uniquePairing(day)( # (A's month is not among those with unique days) # (1 :: A "I know that Bernard does not know") monthsWithUniqueDays(False)( # 0 :: Cheryl's list: list(map( lambda x: tuple(x.split()), split( ', ', '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)]
def monthsWithUniqueDays(blnInclude):
def go(xs): (month, day) = (0, 1) months = list(map(fst, uniquePairing(day)(xs))) return list(filter( lambda md: ( id if blnInclude else _not )(md[month] in months), xs )) return lambda xs: go(xs)
- uniquePairing :: Int -> [(Month, Day)] -> [(Month, Day)]
def uniquePairing(i):
def go(xs): def inner(md): dct = md[i] matches = list(filter( lambda k: 1 == len(dct[k]), dct.keys() )) return filter(lambda tpl: tpl[i] in matches, xs) return inner return lambda xs: bindPairs(xs)(go(xs))
- bindPairs
- :: [(Month, Day)]
- -> ((M.Map String [Text], M.Map Text [Text]) -> [(Month, Day)])
- -> [(Month, Day)]
def bindPairs(xs):
return lambda f: list(f( (dictFromPairs(xs), dictFromPairs(map(swap, xs))) ))
- dictFromPairs :: [(Month, Day)] -> Map String [String]
def dictFromPairs(xs):
return dict( map( lambda m: (m[0][0], list(map(snd, m))), groupBy(fst)( sorted(xs, key=fst) ) ) )
- GENERIC -------------------------------------------------
- fst :: (a, b) -> a
def fst(tpl):
return tpl[0]
- groupBy :: (a -> b) -> [a] -> a
def groupBy(f):
return lambda xs: list(map( lambda x: list(x[1]), groupby(xs, key=f) ))
- id :: a -> a
def id(x):
return x
- _not :: Bool -> Bool
def _not(bln):
return not bln
- snd :: (a, b) -> b
def snd(tpl):
return tpl[1]
- swap :: (a, b) -> (b, a)
def swap(tpl):
return (tpl[1], tpl[0])
- MAIN ---
main()</lang>
- Output:
[('July', '16')]
Perl
<lang perl>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";</lang>
- Output:
Cheryl's birthday is July 16.
Perl 6
<lang perl6>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>}.";</lang>
- Output:
Cheryl's birthday is July 16.
zkl
<lang zkl>dates:=T(T("May", 15), T("May", 16), T("May", 19),
T("June", 17), T("June", 18),
T("July", 14), T("July", 16), T("August",14), T("August",15), T("August",17) ); mDs:=dates.pump(Dictionary().appendKV); // "June":(15,16,19), ... dMs:=dates.pump(Dictionary().appendKV,"reverse"); // 15:"May", 16:"May", 19:"May", ...
// remove unique days (18,19) --> "July":(14,16),"August":(14,15,17) dMs.values.apply2('wrap(ms){ if(ms.len()==1) mDs.del(ms[0]) });
// find intersection of above days --> (14) fcn intersection(l1,l2){ l1.pump(List,l2.holds,'==(True),Void.Filter) } badDs:=mDs.values.reduce(intersection);
// --> July:(16),August:(15,17) --> ( ("July",(16)) ) theDay:=mDs.filter('wrap([(m,ds)]){ ds.removeEach(badDs).len()==1 });
// print birthday such that muliples are shown, if any println("Cheryl's birthday is ",theDay.flatten().flatten().concat(" "));</lang>
- Output:
Cheryl's birthday is July 16