Posted in:

Today’s problem had some similarities to day 17, where we had to work out different combinations of containers whose volume added up to 150. Well today we’re dividing presents into 3 or 4 piles of equal weight and picking out the pile with the fewest presents (and lowest “quantum entanglement”). I got a bit lucky today (as did several others) and got my gold stars for identifying the QE of the first pile of presents without checking that the remaining presents could be divided up equally.

Here’s my C# code

void Main()
{
    var presents = new long[] { 1, 2, 3, 5, 7, 13, 17, 19, 23, 29, 31, 37, 41, 43, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113 };
    FindBestQE(presents, 3).Dump("a"); 
    FindBestQE(presents, 4).Dump("b");
}

long FindBestQE(long[] presents, int groups)
{
    var totalWeight = presents.Sum();
    var weightPerSet = totalWeight / groups;
    bestSoFar = 1 + presents.Length / groups;
    var bestSet = Distribute(new List<long>(), presents.ToList(), (int)weightPerSet)
        .Select(g => new { g.Count, QE = g.Aggregate((a, b) => a * b) })
        .OrderBy(g => g.Count)
        .ThenBy(g => g.QE)
        .First();
    bestSet.Dump();
    return bestSet.QE;
}

int bestSoFar = Int32.MaxValue;
IEnumerable<List<long>> Distribute(List<long> used, List<long> pool, int amount)
{
    if (used.Count >= bestSoFar) yield break;
    
    var remaining = amount - used.Sum();
    for (int n = 0; n < pool.Count; n++)
    {
        var s = pool[n];
        if (pool[n] > remaining) continue;
        var x = used.ToList();
        x.Add(s);
        if (s == remaining)
        {
            if (x.Count < bestSoFar)
                bestSoFar = x.Count;
            yield return x;
        }
        else
        {
            var y = pool.Skip(n+1).ToList();
            foreach (var d in Distribute(x, y, amount))
            {
                yield return d;
            }
        }
    }
}

And my F# version

let mutable bestSoFar = 0
let rec distribute used pool target runningTotal ulen = seq {
    if ulen >= bestSoFar then () else
    match pool with
    | h::tail ->
        if h + runningTotal = target then
            bestSoFar <- min bestSoFar (ulen + 1)
            yield h::used
        elif h + runningTotal < target then
            yield! distribute (h::used) tail target (h + runningTotal) (ulen+1)
        yield! distribute used tail target runningTotal ulen
    | _-> ()
}

let findBestQE presents groups =
    let totalWeight = presents |> List.sum
    let weightPerSet = totalWeight / groups
    bestSoFar <- ((List.length presents) / (int groups)) + 1
    let bestSet = 
        distribute [] presents weightPerSet 0L 0
        |> Seq.map (fun g -> (List.length g), (List.reduce (*) g))
        |> Seq.sortBy id
        |> Seq.head
    bestSet |> Dump
    snd bestSet

let presents = [1;2;3;5;7;13;17;19;23;29;31;37;41;43;53;59;61;67;71;73;79;83;89;97;101;103;107;109;113] |> List.map int64

findBestQE presents 3L |> printfn "a: %d"
findBestQE presents 4L |> printfn "b: %d"

And here’s a really nice Python solution that does properly check that the remainder of presents can be divided up, with some clever use of recursion. It was a bit tricky to convert to F#, and this one relies on the combinations coming out in sorted order in order to get the combination with the minimum QE (and I haven’t checked if this is guaranteed), but it runs really quickly compared to my version. I’ve also borrowed a combinations function from Tomas Petricek, as F# doesn’t have one built-in.

let rec combinations acc size set = seq {
  match size, set with 
  | n, x::xs -> 
      if n > 0 then yield! combinations (x::acc) (n - 1) xs
      if n >= 0 then yield! combinations acc n xs 
  | 0, [] -> yield acc 
  | _, [] -> () }

let comb size set = combinations[] size set

let sum = Seq.sum
let list = Seq.toList

let rec hasSum lst tot parts sub = 
    [1 .. (List.length lst) / sub]
    |> Seq.collect (fun y -> comb y lst)
    |> Seq.pick (fun x -> 
            if sum x = tot && sub = 2 then
                Some 1L
            elif sum x = tot && sub < parts then
                Some (hasSum (list (set lst - set x)) tot parts (sub - 1))
            elif sum x = tot && hasSum (list (set lst - set x)) tot parts (sub - 1) = 1L then
                Some (x |> Seq.map int64 |> Seq.reduce (*))
            else
                None
    )

let getMinQE lst parts =
    let tot = (sum lst) / parts
    hasSum lst tot parts parts

let nums = [1;2;3;5;7;13;17;19;23;29;31;37;41;43;53;59;61;67;71;73;79;83;89;97;101;103;107;109;113]
let parts = 4

getMinQE nums 3 |> printfn "a: %d"
getMinQE nums 4 |> printfn "b: %d"