Advent of Code 2019 D06

Advent of Code — что-то вроде конкурса для программистов. В увлекательной форме даются задачи, которые необходимо (было) решить до определенной даты. В 2019 году эти задачки связаны с Сантой, который летит в космосе, и натыкается на разные приключения — то эльфы забудут подключить кондиционер, то бумажку с паролем от космического заправщика кто-то оторвал от монитора и выкинул.

Я тоже не хотел остаться в стороне от этого развлечения, и дошёл пока с F# до шестого дня.

В Advent of Code задача дня делится на две части, и вторая часть выдаётся после решения первой. Юмор в том, что плохое решение первой половины после выдачи второй часто приходится сильно дорабатывать, если не переделывать полностью.

Первая половина задачи

Задачка первой половины шестого дня следующая: поскольку навигация в космосе часто требует переходов между орбитами тел, вы скачиваете карту местных орбит (входные данные задачи).

За исключением общего центра масс, каждый объект в космосе вращается ровно вокруг одного другого объекта. В карте орбит каждое такое соотношение обозначается как AAA)BBB, что означает что BBB вращается вокруг AAA.

Перед тем как эту карту использовать, нужно убедиться, что она не повреждена при скачивании. Для этого используются контрольные суммы — число прямых и косвенных орбит в карте. То есть, если A вращается вокруг B, а B вращается вокруг C, то A косвенно обращается вокруг C.

После этого даются тестовые данные.

Понятно, что здесь необходимо построение графа, то есть небинарного дерева узлов.

На F# дерево объявляется просто (имя узла и список таких же узлов). Было приятно чуть позже узнать, что Кит Исон (Kit Eason) написал точно так же.

type Tree<'a> =
    | Node of name: 'a * children: Tree<'a> list
    | Empty

Лобовой подход — проход по списку исходных данных — показал, что одним проходом данные не исчерпываются. Связано это было с тем, что функция вставки элемента в дерево изначально не предусматривала «надстройки» дерева, а шла только «вниз». Часть значений в списке была из «верхней» части будущего дерева, и, разумеется, в создаваемое дерево не встраивалась. Поначалу я пошёл в неверном направлении — хотел было создавать несколько параллельных деревьев вплоть до полного исчерпания списка, а потом объединить все эти деревья в одно, но добавление одной строки для надстройки дерева в функцию вставки перевесило все эти нагромождения.

Поскольку мы знаем, что на вход подаются пары элементов, обобщенная функция вставки проста. Мы принимаем на вход список элементов произвольного типа (из которых захватываем пару первых, остальное отбрасываем), а также дерево, куда эту пару (заголовок-хвост) необходимо пристроить.

Если рассматриваемый элемент дерева — это узел, и заголовок узла совпадает с заголовом вставляемой пары, то «хвост» вставляемого добавляется (уже как узел) в список дочерних элементов узла. Если заголовок рассматриваемого узла совпадает с «хвостом» вставляемой пары, то вставляемая пара будет родительской по отношению к рассматриваемому узлу. Если ни того ни другого не происходит, то каждому дочернему элементу рассматриваемого узла применяем такую же попытку вставки. И, наконец, если элемент дерева пуст, то возвращается пара «узел — дочерний элемент».

После где-то пятой функции я решил переделать практически все функции в методы соответствующего типа. Конечно, задача разработать полноценный тип не стояла, да и не готов я пока откладывать решение интересных задач ради обработки крайних случаев.

member this.Insert(data : 'a list) =
    if (this.ExistsPair data) then
        failwith "This pair already exists in this tree"
    else
        let rec Ins d t =
            let a :: b :: _ = d
            match t with
            | Node(value, _) when value = a -> Node(value, t.Tail @ [ Node(b, []) ])
            | Node(value, _) when value = b -> Node(a, [ t ])
            | Node(value, children) -> Node(value, List.map (Ins d) children)
            | Empty -> Node(a, [ Node(b, []) ])
        Ins data this

Если не увлекаться надстройкой дерева, то задачу эта функция вполне решает.

На начальном этапе была написана функция проверки наличия той или иной пары ["AAA";"BBB"] в составе дерева узлов, и она постоянно применялась в составе функции вставки. Однако довольно быстро стало понятно, что с ростом числа узлов это очень тормозит процесс (а в исходных данных задачи узлов около 900). Ранние вспомогательные функции Unwrap и Unwrap' для возвращения заголовка или списка дочерних элементов узла соответственно превратились в два метода типа. Чуть позже понадобилась функция проверки наличия ноды определенного заголовка во всём дереве.

// Заголовок ноды
member this.Head : 'a option =
    match this with
    | Node(value, _) -> Some value
    | Empty -> None

// Список дочерних элементов ноды
member this.Tail : Tree<'a> list =
    match this with
    | Node(_, children) -> children
    | Empty -> []

// Проверка наличия соседней пары нода-дочерняя нода
member this.ExistsPair(data : 'a list) =
    let rec Find (d : 'a list) (i : Tree<'a>) =
        let a :: b :: _ = d
        match i.Head with
        | Some head when head = a ->
            List.fold (fun (acc : bool) (x : Tree<'a>) ->
                match x.Head with
                | Some tail when tail = b -> acc || true
                | _ -> acc || false) false i.Tail
        | Some head -> List.fold (fun (acc : bool) (x : Tree<'a>) -> acc || Find d x) false i.Tail
        | _ -> false
    Find data this

// Проверка наличия ноды с заголовком
member this.Exists(data : 'a) =
    let rec Exist (data : 'a) (tree : Tree<'a>) =
        match tree.Head with
        | Some head when head = data -> true
        | Some head -> List.fold (fun (acc : bool) (x : Tree<'a>) -> acc || Exist data x) false tree.Tail
    Exist data this

Функцию разбивки строки на два элемента по ) не привожу в силу тривиальности.

Поскольку я не знаю, является ли перечень входных данных избыточным (есть ли в нём лишние элементы, которые никогда не попадут в одно дерево — этого нельзя исключать), колхозным способом написана функция, по входному списку возвращающая дерево. Работает просто: вне цикла (знаю что не идиоматично) хранятся мутабельные переменные исходного и актуального размера исходного списка. За один проход цикла происходит свёртывание исходного списка пар вида [["AAA";"BBB"];["BBB";"CCC"]] к одному элементу — дереву, которое помещается в мутабельную переменную. После этого исходный список разбивается на два в соответствии с наличием той или иной пары в дереве (неэффективно), и исходный список заменяется той его частью, элементы которой в дереве отсутствуют. После чего вычисляется размер этого получившегося списка и сравнивается с входным размером — если эти значения совпали, значит дерево больше не надстроить; возвращаем кортеж из полученного дерева и списка «не вписавшихся» элементов.

member this.Builder(data : 'a list list) =
    let mutable t = Empty // всегда начинает строить дерево с нуля
    let mutable data' = data
    let mutable data'' = []
    let mutable initDataLength = 0
    let mutable afterDataLength = 100
    while initDataLength <> afterDataLength do
        initDataLength <- data'.Length
        t <- List.fold (fun (acc : Tree<'a>) (x : 'a list) -> acc.Insert x) t data'
        let _, notInTree = List.partition (fun (x : 'a list) -> t.ExistsPair x) data'
        afterDataLength <- notInTree.Length
        data' <- notInTree
    (t, data')

После построения дерева (оказалось, что все элементы списка в дерево всё-таки встраиваются, и лишних нет) необходимо подсчитать число прямых и косвенных орбит.

На самом деле считать их отдельно бессмысленно, потому что в сумме это просто расстояние от корневого элемента до того или иного узла.

Создадим дерево идентичной структуры, но элементами этого дерева будут числа, отражающие глубину (расстояние) от корневого элемента. Это опять-таки делается рекурсивной функцией, в которой список дочерних элементов заполняется вызовом функции List.map, которая производит отображение одного списка на другой, после чего свёрткой пройдёмся по всему образованному дереву.

member this.DepthTree() =
    let rec Process value data = Node(value, List.map (fun (x : Tree<'a>) ->
                                 Process (value + 1) x) data.Tail)
    Process 0 this

Таким образом, из дерева test:

└── COM
   └── B
      └── C
            └── D
               └── E
                  └── F
                  └── J
                        └── K
                           └── L
               └── I
      └── G
            └── H

вызовом test.DepthTree() получается:

└── 0
    └── 1
        └── 2
            └── 3
                └── 4
                    └── 5
                    └── 5
                        └── 6
                            └── 7
                └── 4
        └── 2
            └── 3

Такие деревья, к слову сказать, строятся путём определения метода ToString():

[<StructuredFormatDisplay("{AsString}")>]
type Tree<'a when 'a : equality> = Node of name : 'a * children : Tree<'a> list | Empty
override this.ToString() =
    let sb = new System.Text.StringBuilder()
    sb.Append("\n") |> ignore
    let rec PrintTree (tree : Tree<'a>) level =
        match tree with
        | Node(value, children) ->
            sb.Append(String.replicate (level * 4) " ").Append(String.replicate 1 "└── ").Append(value).Append("\n") |> ignore
            for item in children do
                PrintTree item (level + 1)
        | Empty ->
            sb.Append("None") |> ignore
            ()
    PrintTree this 0
    sb.ToString()

member this.AsString = this.ToString()

При таких вводных решить задачу просто: на вход функции

let rec PathSum (acc : int) (tree : Tree<int>) =
    List.fold (fun (acc : int) (x : Tree<'a>) ->
                               PathSum (acc + x.Head.Value) x) acc tree.Tail

подаётся построенное дерево глубин, то есть просто обходим всё дерево и суммируем значения узлов.

Вторая половина задачи

Вторая половина задачи состояла в том, чтобы определить количество орбитальных переходов, нужное мне для перехода на объект, вокруг которого вращается Санта. Проще говоря — каково расстояние между объектом, вокруг которого вращаюсь я, и объектом, вокруг которого вращается Санта.

Этим задача немного усложняется, ведь нужно найти первый общий узел, от которого начинаются ветви, ведущие ко мне (YOU) и Санте (SAN).

В ходе работы родились три метода типа. Первый как раз находит ближайший общий узел между двумя объектами и возвращает его. Возвращает он его, естественно, со всеми остальными элементами, которые находятся ниже него. Метод навскидку пришёл достаточно простой: рекурсивная функция принимает исходное дерево и кортеж значений, и возвращает результат свёртки этого дерева к нужному. Свёртка работает следующим образом: мы фильтруем одно и то же дерево на предмет наличия в нём каждого из двух искомых элементов. Если результаты фильтров равны между собой — мы идём по общему «стволу» к этим двум элементам, и просто рекурсивно вызываем ту же функцию с той же парой искомых значений, но на текущей ноде. Как только результаты фильтров начинают между собой отличаться, ясно, что нужные нам элементы находятся в двух разных дочерних узлах, а значит мы находимся на нужном нам общем узле и время возвращать аккумулятор (текущий узел).

member this.Cut (l : 'a) (r : 'a) =
    if not ((this.Exists r) && (this.Exists r)) then
        failwith "One or both target nodes not found in tree"
    else
        let rec Cutter (acc : Tree<'a>) (src : 'a * 'a) =
            List.fold (fun (acc : Tree<'a>) (x : Tree<'a>) ->
                let i, j = src
                let leftMatch :: _ = List.filter (fun (x : Tree<'a>) -> x.Exists i) acc.Tail
                let rightMatch :: _ = List.filter (fun (x : Tree<'a>) -> x.Exists j) acc.Tail
                if (leftMatch = rightMatch) then Cutter leftMatch (i, j) else acc) acc acc.Tail
        Cutter this (l, r)

После этого достаточно подсчитать сумму глубин между искомыми элементами и вычесть из неё два (потому что нас не интересуют переходы к самим крайним элементам).

Хоть после этого я и прошёл уровень, но чего-то недоставало, поэтому я дописал функции, которые возвращают путь до самого элемента, а также функцию слияния деревьев. Слияние производится рекурсивно, то есть если в объединяемых деревьях ниже есть общие элементы, они будут правильно объединены. Эта последняя задачка потратила больше моего времени чем ожидалось, так как я был в затруднении, как мне обойтись со списками дочерних элементов — нужно сначала найти общие элементы, потом рекурсивно слить их между собой, и возвратить как уникальные в каждом из списков, так и результаты объединения.

С подачи хорошего человека в чатике я узнал, что есть .groupBy, которая возвращает список кортежей «ключ»—«список элементов», сгруппированных по результату, возвращаемому лямбдой в .groupBy. С этим дело пошло быстрее: объединяем списки дочерних элементов, группируем по имени (дочернего) узла, после чего все группы длиннее одного элемента объединяем между собой комбинацией из List.collect и List.fold — fold сворачивает группу к одному элементу-узлу (группы из одного элемента просто возвращаем), а collect объединяет все результаты в один список, который и будет списком дочерних элементов для нового объединенного узла.

member this.PathTo(target : 'a) =
    let rec PathFinder (target : 'a) (tree : Tree<'a>) =
        match tree with
        | Node(value, _) when value = target -> Node(value, [])
        | Node(value, children) ->
            Node
                (value,
                 [ List.fold (fun (acc : Tree<'a>) x -> PathFinder target x) Empty
                       (List.filter (fun (x : Tree<'a>) -> x.Exists target) children) ])
    PathFinder target this

member this.InsertNode(node : Tree<'a>) =
    let rec Ins (n : Tree<'a>) (t : Tree<'a>) =
        match t with
        | Node(value, _) when value = n.Head.Value ->
            let (concat : Tree<'a> list) = t.Tail @ n.Tail
            let grouped = List.groupBy (fun (x : Tree<'a>) -> x.Head.Value) concat

            let res =
                List.collect (fun group ->
                    let (key : 'a), (value : Tree<'a> list) = group
                    if value.Length > 1
                    then [ List.fold (fun (acc : Tree<'a>) (elem : Tree<'a>) -> acc.InsertNode elem) Empty value ]
                    else value) grouped
            Node(value, res)
        | Node(value, _) when (n.Exists value) -> Node(n.Head.Value, t :: n.Tail)
        | Node(value, children) -> Node(value, List.map (Ins n) children)
        | Empty -> n
    Ins node this

В целом мне очень понравилось — благодаря такой задаче я, пожалуй, действительно понял как работать с функциями отображения, свёртки, и рекурсивными вызовами. Уверен, что со временем это хозяйство можно будет ещё оптимизировать, но пока я рад, что решил задачу на избранном мною языке.