theburningmonk.com

Prob­lem

In the card game poker, a hand con­sists of five cards and are ranked, from low­est to high­est, in the fol­low­ing way:

• High Card: High­est value card.
• One Pair: Two cards of the same value.
• Two Pairs: Two dif­fer­ent pairs.
• Three of a Kind: Three cards of the same value.
• Straight: All cards are con­sec­u­tive values.
• Flush: All cards of the same suit.
• Full House: Three of a kind and a pair.
• Four of a Kind: Four cards of the same value.
• Straight Flush: All cards are con­sec­u­tive val­ues of same suit.
• Royal Flush: Ten, Jack, Queen, King, Ace, in same suit.

The cards are val­ued in the order:

2, 3, 4, 5, 6, 7, 8, 9, 10, Jack, Queen, King, Ace.

If two play­ers have the same ranked hands then the rank made up of the high­est value wins; for exam­ple, a pair of eights beats a pair of fives (see exam­ple 1 below). But if two ranks tie, for exam­ple, both play­ers have a pair of queens, then high­est cards in each hand are com­pared (see exam­ple 4 below); if the high­est cards tie then the next high­est cards are com­pared, and so on.

Con­sider the fol­low­ing five hands dealt to two players:

The file, poker.txt, con­tains one-thousand ran­dom hands dealt to two play­ers. Each line of the file con­tains ten cards (sep­a­rated by a sin­gle space): the first five are Player 1’s cards and the last five are Player 2’s cards. You can assume that all hands are valid (no invalid char­ac­ters or repeated cards), each player’s hand is in no spe­cific order, and in each hand there is a clear winner.

How many hands does Player 1 win?

Solu­tion

open System.IO

// define the suits
type Suit = | Heart | Club | Spade | Diamond

// define the card values
type CardValue =
    | ValueCard of int | Jack | Queen | King | Ace
    // define the + unary operator on the CardValue type
    static member (~+) (value:CardValue) =
        match value with
        | ValueCard n -> if n < 10 then ValueCard (n+1) else Jack
        | Jack -> Queen | Queen -> King | King -> Ace | Ace -> ValueCard(2)

// define the Card type
type Card = { Value:CardValue; Suit:Suit }

// define the ranks
type Rank =
    | HighCard of CardValue
    | OnePair of CardValue
    | TwoPairs of CardValue * CardValue
    | Three of CardValue
    | Straight of CardValue // highest value card
    | Flush
    | FullHouse of CardValue * CardValue
    | Four of CardValue
    | StraightFlush of CardValue // highest value card & suit
    | RoyalFlush

// define function to check if cards are the same suit
let isSameSuit (cards:Card list) = cards |> List.forall (fun c -> c.Suit = cards.Head.Suit)

// define function to get the highest card
let getHighestCard(cards:Card list) = cards |> List.maxBy (fun card -> card.Value)

// define function to check if cards are a straight set
let isStraight (cards:Card list) =
    let flag = cards |> List.sort |> Seq.windowed 2
    |> Seq.forall (fun [|card1; card2|] -> card2.Value = +card1.Value)

    (flag, getHighestCard cards)

// define function to get the duplicated cards
let getDupes (cards:Card list) =
    cards
    |> Seq.groupBy (fun card -> card.Value)
    |> Seq.map (fun (k, seq) -> (k, Seq.length seq))
    |> Seq.filter (fun (k, len) -> len > 1)
    |> Seq.toList

// evaluate the given hand of cards to return the rank
let evaluateHand (cards:Card list) =
    let (isStraight, highCard) = isStraight cards
    let sameSuit = isSameSuit cards
    
    if sameSuit && isStraight && highCard.Value = Ace then RoyalFlush
    else if sameSuit && isStraight then StraightFlush(highCard.Value)
    else if sameSuit then Flush
    else if isStraight then Straight(highCard.Value)
    else
        let dupes = getDupes cards
        if dupes.Length = 0 then HighCard(highCard.Value)
        else if dupes.Length = 1 then
            match dupes.[0] with
            | (cardValue,2) -> OnePair(cardValue)
            | (cardValue,3) -> Three(cardValue)
            | (cardValue,4) -> Four(cardValue)
        else
            match dupes with
            | [(cardValue',2);(cardValue'',2)] -> TwoPairs(cardValue', cardValue'')
            | [(cardValue',3);(cardValue'',2)] -> FullHouse(cardValue', cardValue'')
            | [(cardValue',2);(cardValue'',3)] -> FullHouse(cardValue'', cardValue')

// define function to check if player 1 wins
let isP1Winner (p1:Card list) (p2:Card list) =
    let p1Rank, p2Rank = evaluateHand p1, evaluateHand p2

    if p1Rank > p2Rank then true
    else if p1Rank = p2Rank then
        let rec compareHighCard (p1':Card list) (p2':Card list) =
            let p1'HighCard, p2'HighCard = getHighestCard p1', getHighestCard p2'
            if p1'HighCard.Value > p2'HighCard.Value then true
            else if p1'HighCard.Value = p2'HighCard.Value then
                let p1'' = p1' |> List.filter (fun c -> c.Value < p1'HighCard.Value)
                let p2'' = p2' |> List.filter (fun c -> c.Value < p2'HighCard.Value)
                compareHighCard p1'' p2''
            else false

        compareHighCard p1 p2
    else false

// define function to parse, say, "3D" into a 3 of Diamond
let parseCard [|(value:char);(suit:char)|] =
    let cardValue =
        match value with
        | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' -> ValueCard(int(value.ToString()))
        | 'T' -> ValueCard(10) | 'J' -> Jack | 'Q' -> Queen | 'K' -> King | 'A' -> Ace
    let suit =
        match suit with
        | 'S' -> Spade | 'H' -> Heart | 'D' -> Diamond | 'C' -> Club
    { Card.Value=cardValue; Suit=suit }

// get the array of all the dealt hands from the poker text file
let hands =
    File.ReadAllLines(@"C:\TEMP\poker.txt")
    |> Array.map (fun str -> 
        str.Split(' ') 
        |> Array.map (fun str -> parseCard (str.ToCharArray())))

// separate the hands into two different arrays, one for player 1 and the other player 2
let p1Hands = hands |> Array.map (fun cards -> cards |> Seq.take 5 |> Seq.toList)
let p2Hands = hands |> Array.map (fun cards -> cards |> Seq.skip 5 |> Seq.toList)

let answer =
    Array.map2 (fun p1 p2 -> isP1Winner p1 p2) p1Hands p2Hands
    |> Array.filter (fun b -> b)
    |> Array.length

Prob­lem

The rules for writ­ing Roman numer­als allow for many ways of writ­ing each num­ber (see FAQ:Roman Numer­als). How­ever, there is always a “best” way of writ­ing a par­tic­u­lar number.

For exam­ple, the fol­low­ing rep­re­sent all of the legit­i­mate ways of writ­ing the num­ber sixteen:

IIIIIIIIIIIIIIII

VIIIIIIIIIII

VVIIIIII

XIIIIII

VVVI

XVI

The last exam­ple being con­sid­ered the most effi­cient, as it uses the least num­ber of numerals.

The 11K text file, roman.txt (right click and ‘Save Link/Target As…’), con­tains one thou­sand num­bers writ­ten in valid, but not nec­es­sar­ily min­i­mal, Roman numer­als; that is, they are arranged in descend­ing units and obey the sub­trac­tive pair rule (see FAQ for the defin­i­tive rules for this problem).

Find the num­ber of char­ac­ters saved by writ­ing each of these in their min­i­mal form.

Note: You can assume that all the Roman numer­als in the file con­tain no more than four con­sec­u­tive iden­ti­cal units.

Solu­tion

open System.IO

// define the set of available roman numerals
let romanNumerals = [(['I'],1I);(['I';'V'],4I);(['V'],5I);(['I';'X'],9I);
                     (['X'],10I);(['X';'L'],40I);(['L'],50I);(['X';'C'],90I);
                     (['C'],100I);(['C';'D'],400I);(['D'],500I);(['C';'M'],900I);
                     (['M'],1000I)]

// define function to get the numeric value of a roman numeral
let getNumericValue (numeral:char) =
    snd (romanNumerals |> Seq.filter (fun (l, v) -> l.Length = 1 && l.[0] = numeral) |> Seq.head)

// define function to convert a roman numerals to its corresponding numeric value
let toNumeric (numerals:string) =
    let rec toNumericRec ((head::tail):char list) (num:bigint) =
        match head, tail with
        | _, [] -> num + getNumericValue head
        | _, hd::tl when getNumericValue head >= getNumericValue hd ->
            toNumericRec tail (num + getNumericValue head)
        | _, hd::[] -> // subtractive pair as last number i.e. XIX - 19
            num + getNumericValue hd - getNumericValue head
        | _, hd::tl -> // subtractive pair not as last number XCV - 95
            toNumericRec tl (num + getNumericValue hd - getNumericValue head)

    toNumericRec (numerals.ToCharArray() |> Array.toList) 0I

// converts an integer value to corresponding minimal roman numerals form
let toMinimalRomanNumerals (value:bigint) =
    let rec toMinimalRomanNumeralsRec (value:bigint) (list:char list) =
        if value = 0I then list
        else
            let (list', value') =
                romanNumerals
                |> List.sortBy (fun (l, v) -> -v)
                |> Seq.filter (fun (l, v) -> v <= value)
                |> Seq.head
            toMinimalRomanNumeralsRec (value-value') (list@list')

    toMinimalRomanNumeralsRec value []

let original = File.ReadAllLines(@"C:\TEMP\roman.txt")
let minimal = original |> Array.map toNumeric |> Array.map toMinimalRomanNumerals

let answer =
    let originalLen = original |> Array.sumBy (fun str -> str.Length)
    let minimalLen = minimal |> Array.sumBy (fun str -> str.Length)
    originalLen - minimalLen

Prob­lem

Con­sider qua­dratic Dio­phan­tine equa­tions of the form:

x² – Dy² = 1

For exam­ple, when D=13, the min­i­mal solu­tion in x is 649² – 13x180² = 1.

It can be assumed that there are no solu­tions in pos­i­tive inte­gers when D is square.

By find­ing min­i­mal solu­tions in x for D = {2, 3, 5, 6, 7}, we obtain the following:

3² – 2x2² = 1

2² – 3x1² = 1

9² – 5x4² = 1

5² – 6x2² = 1

8² – 7x3² = 1

Hence, by con­sid­er­ing min­i­mal solu­tions in x for D <= 7, the largest x is obtained when D=5.

Find the value of D <= 1000 in min­i­mal solu­tions of x for which the largest value of x is obtained.

Solu­tion

// define function to get the continued fractions, a0,a1,a2,...an
let continuedFraction D =
    // define functions for working out the nth term of P, Q and a sequence
    let getPn an' qn' pn' = an' * qn' - pn'
    let getQn D pn qn' = (D - pown pn 2) / qn'
    let getAn a0 pn qn = (a0 + pn) / qn

    // work out the initial terms
    let a0 = bigint(sqrt(double(D)))
    let p1, q1 = a0, D-a0*a0
    let a1 = getAn a0 p1 q1
    let initial = (p1, q1, a1)

    Seq.unfold (fun (pn', qn', an') ->
        let pn = getPn an' qn' pn'
        let qn = getQn D pn qn'
        let an = getAn a0 pn qn
        Some((pn', qn', an'), (pn, qn, an))) initial
    |> Seq.map (fun (pn, qn, an) -> an)
    |> Seq.append [a0]

// define function to get the continued fraction convergents
// e.g. for D = 7: 2/1, 3/1, 5/2, 8/3, ...
let continuedFractionConvergents D =
    let getN an n' n'' = an * n' + n''

    // work out the initial terms
    let fractions = continuedFraction D
    let a0 = Seq.head fractions
    let p0, p1 = a0, a0 * (Seq.nth 1 fractions) + 1I
    let q0, q1 = 1I, Seq.nth 1 fractions
    let initial = (p1, q1, p0, q0)

    Seq.scan (fun (pn', qn', pn'', qn'') an ->
        let pn = getN an pn' pn''
        let qn = getN an qn' qn''
        (pn, qn, pn', qn')) initial (fractions |> Seq.skip 2)
    |> Seq.map (fun (pn, qn, pn', qn') -> (pn, qn))
    |> Seq.append [(p0, q0)]

let answer =
    [1I..1000I]
    |> List.filter (fun d -> sqrt(double(d)) % 1.0 <> 0.0)
    |> List.maxBy (fun d ->
        continuedFractionConvergents d
        |> Seq.filter (fun (x, y) -> x*x - d*y*y = 1I)
        |> Seq.map fst
        |> Seq.head)

After spend­ing much time read­ing the infor­ma­tion on Pell’s equa­tion on math­world and wikipedia, it turns out that the best way to solve the equa­tion for a given D is to work out the con­tin­ued frac­tion con­ver­gents to the square root of D.

For exam­ple, for D = 7, the equa­tion becomes:

The fun­da­men­tal solu­tion (the first pair of x, y which sat­is­fies the equa­tion) can be obtained by going through the sequence of con­ver­gents for the square root of 7:

So how do we work­out the val­ues of the con­ver­gents? The con­tin­ued frac­tion for a num­ber is usu­ally writ­ten as

The first ten val­ues gen­er­ated by the con­tin­ued frac­tion for the square root of 2 are:

1, 3/2, 7/5, 17/12, 41/29, 99/70, 239/169, 577/408, 1393/985, 3363/2378, …

These val­ues are called con­tin­ued frac­tion con­ver­gents, get­ting closer to the true value of square root 2 with each step..

So, to find the con­ver­gents to the square root of D, we first need to find the val­ues of a:

Once we have the sequence of val­ues for a, we can then find out the con­ver­gent values:

The rest is sim­ple, for each value of D between 1 and 1000, go through the con­ver­gents to find the fun­da­men­tal solu­tion and return the max value of x in all the fun­da­men­tal solutions.