Advent of Code 2015 - Day 24: It Hangs in the Balance

Part 1

Description

Solution

The packages must be split into three groups of equal weight. The first group should have as few packages as possible, and among those, the smallest product of weights (the puzzle calls it quantum entanglement). 

Setting up

I pasted the weights into A4:A31 and turned them into a row, which is easier for the VBA function to use. I also worked out the size of one group for three groups (Part 1) and for four groups (Part 2):

B3: =SUM(A4:A31)/3
D3: =SUM(A4:A31)/4

Listing every group that has the right weight

I wrote a macro that tries the weights one after another and gives up on a branch as soon as the sum gets too big. Since the weights are sorted, one that is too big means all the later ones are too big too. It collects the results in memory and writes them to a new sheet in chunks of 50,000 rows, which is much faster than writing cell by cell:

Option Explicit
Private nums() As Long
Private target As Long
Private buffer() As String
Private bufCount As Long, outRow As Long
Private outSheet As Worksheet
Private Const BUFFER_SIZE As Long = 50000

Public Sub ListCombinationsPart1()
    ListCombinations ThisWorkbook.Worksheets("2015").Range("B3").Value, "Combinations_Output"
End Sub

Public Sub ListCombinationsPart2()
    ListCombinations ThisWorkbook.Worksheets("2015").Range("D3").Value, "Combinations_Output_2"
End Sub

Private Sub ListCombinations(ByVal t As Long, ByVal sheetName As String)
    Dim src As Worksheet, i As Long, n As Long, startTime As Double
    startTime = Timer
    Set src = ThisWorkbook.Worksheets("2015")
    n = Application.WorksheetFunction.CountA(src.Range("A4:A31"))
    ReDim nums(0 To n - 1)
    For i = 0 To n - 1
        nums(i) = src.Cells(4 + i, 1).Value
    Next i
    target = t
    Set outSheet = ThisWorkbook.Worksheets.Add
    outSheet.Name = sheetName
    ReDim buffer(1 To BUFFER_SIZE, 1 To 1)
    bufCount = 0: outRow = 1
    Application.ScreenUpdating = False
    SearchSheet 0, 0, ""
    Flush
    Application.ScreenUpdating = True
    MsgBox "Done: " & (outRow - 1) & " combinations in " & Round(Timer - startTime, 1) & " s"
End Sub

Private Sub SearchSheet(ByVal startIdx As Long, ByVal total As Long, ByVal chosen As String)
    Dim i As Long
    If total = target Then
        bufCount = bufCount + 1
        buffer(bufCount, 1) = chosen
        If bufCount = BUFFER_SIZE Then Flush
        Exit Sub
    End If
    For i = startIdx To UBound(nums)
        If total + nums(i) > target Then Exit For
        SearchSheet i + 1, total + nums(i), chosen & IIf(Len(chosen) = 0, "", ",") & nums(i)
    Next i
End Sub

Private Sub Flush()
    If bufCount = 0 Then Exit Sub
    outSheet.Cells(outRow, 1).Resize(bufCount, 1).Value = buffer
    outRow = outRow + bufCount
    bufCount = 0
End Sub

I filled C4 and B4 down for every combination.

Can the rest be split too?

A small first group only counts if the other packages can still make the other groups. I tried this on the puzzle’s example in Sheet1 (weights in C2:L2, target 20 in B2). For each first group, the remainder is the weights that aren’t in it, and a function looks for subsets of the remainder that add up to 20:

C4: =LEN(D4)-LEN(SUBSTITUTE(D4,",",""))+1
C3: =MIN(C4:C1048576)
B4: =IF(C4=$C$3,PRODUCT(VALUE(TEXTSPLIT(D4,","))),0)
B2: =MINIFS(B4:B211833,B4:B211833,">0")

I filled F4 down for every candidate.

Can the rest be split?

A small first group only counts if the other packages can still make the other groups. For each candidate, P asks whether the packages that are not in it can make a second group of the same weight. This function stops at the first one it finds, so it is fast:

P3: =VALUE(TEXTSPLIT(B3,","))
C3: =FindCombinationsFromArray2(
        TEXTJOIN(",",,FILTER($C$2:$L$2,IF(COUNTIF(P3#,$C$2:$L$2),0,1))),20)

P3# is the first group as numbers. With three groups, any subset found there is the second group, and what’s left is the third. The example gives 99, as in the puzzle text.

Part 2

Description

Solution

Now there are four groups. I ran the second macro for the new target, pasted the list into G4, and used the same formulas in columns E and F:

F4: =LEN(G4)-LEN(SUBSTITUTE(G4,",",""))+1
F3: =MIN(F4:F1048576)
E4: =IF(F4=$F$3,PRODUCT(VALUE(TEXTSPLIT(G4,","))),0)
D2: =MINIFS(E4:E211833,E4:E211833,">0")

The list is shorter, and the smallest group needs one package fewer. With four groups, a second group isn’t enough in principle, since the rest has to split into three. For my input I checked that it works.