Становится уже доброй традицией — все любопытное, что появилось на Хаскеле — повторять на Эликсире.

Первой ласточкой были «Примерно 20 строк для подсчета слов», появившиеся как алаверды на «Побеждая C двадцатью строками Haskell: пишем свой wc» от 0xd34df00d — сегодня же я наткнулся на «Перевозим волка, козу и капусту через реку с эффектами на Haskell» от iokasimov и тоже не устоял.

Итак, встречайте: ленивый полный асинхронный параллельный перебор против алгебраических эффектов.

Постановка задачи (благодарно скопипащщено из оригинальной заметки):

Однажды крестьянину понадобилось перевезти через реку волка, козу и капусту. У крестьянина есть лодка, в которой может поместиться, кроме самого крестьянина, только один объект — или волк, или коза, или капуста. Если крестьянин оставит без присмотра волка с козой, то волк съест козу; если крестьянин оставит без присмотра козу с капустой, коза съест капусту.

Мы будем действовать следующим образом: начнем с состояния «все на левом берегу», и на каждом шаге будем запускать максимум столько эрланг-процессов, сколько на этом берегу живности (+1 для ходки порожняком). При этом мы всегда будем проверять, что остающаяся на берегу живность — друг друга не перегрызет, и эти ветки будем отсекать сразу. Также мы будем хранить историю, и отсекать циклические ветки, возвращающие нас в уже виденное состояние. Это, кстати, не избыточные данные — историю поездок мы будем возвращать в качестве результата.

Итак, начнем с объявлений.

defmodule WolfGoatCabbage.State do
  @moduledoc """
  Текущее состояние нашей микровселенной.

  Берега (`true` > исходный, левый), `ltr` — маркер направления, история поездок.
  """
  defstruct banks: %{true => [], false => []}, ltr: true, history: []
end

defmodule WolfGoatCabbage.Subj do
  @moduledoc """
  Единица живности, с кем конфликтует.
  """
  defstruct [:me, :incompatible]
end

Поскольку парсер Хабра все еще живет в XIX веке, вот вам картинка с начальными значениями.

Что ж, можно и перейти к собственно написанию кода.

Проверка целостности

@spec safe?(bank :: [%Subj{}]) :: boolean()
defp safe?(bank) do
  subjs =
    bank
    |> Enum.map(& &1.me)
    |> MapSet.new()
  incompatibles =
    bank
    |> Enum.flat_map(& &1.incompatible)
    |> MapSet.new()

  MapSet.disjoint?(subjs, incompatibles)
end

Построили множество тех, кто остается, множество тех, с кем они несовместимы, и удостоверились, что пересечений нет. Пока все тривиально.

Ход (лодкой)

Условия для порожней ходки, и ходки с живностью довольно сильно различаются, поэтому удобно их обработку разбить на две функции (nil отлично подходит в качестве «никого»).

@spec move(%State{}, nil | %Subj{}) :: %State{} | false
@doc """
Если в лодке никого, достаточно проверить, что мы не оставляем берег 
в уже виденном состоянии, и напрямую вернуть новое состояние.
"""
defp move(%State{ltr: ltr, banks: banks, history: history} = state, nil) do
  with true <- not ltr, true <- safe?(banks[ltr]) do
    %State{state | ltr: not ltr, history: [length(history) | history]}
  end
end

@doc """
Когда в лодке блеют, тявкают, или выразительно хлопают листьями — 
все немного сложнее.

Мы переносим живность с одного берега на другой, удостоверяемся, что
ходка безопасна (на покидаемом берегу не возникнет внеплановый ужин) и —
что мы еще не видели такого состояния. Если все критерии выполнены —
возвращаем новое состояние, если нет — терминирующий `false`.
"""
defp move(%State{banks: banks, ltr: ltr, history: history}, who) do
  with true <- who in banks[ltr],
        banks = %{ltr => banks[ltr] -- [who], not ltr => [who | banks[not ltr]]},
        bank_state = MapSet.new(banks[true]),
        true <- safe?(banks[ltr]),
        true <- not Enum.member?(history, bank_state) do
    %State{
      banks: banks,
      ltr: not ltr,
      history: [bank_state | history]
    }
  end
end

Собственно партия (многоходовочка)

Осталось, собственно, написать основную часть: рекурсивный запуск процессов. Нет ничего проще.

@initial %State{
            banks: %{true => @subjs, false => []},
            history: [MapSet.new(@subjs)]
         }

@spec go(%State{}) :: [MapSet.t()]
def go(state \\ @initial) do
  case state.banks[true] do
    [] -> # ура!
      Enum.reverse(state.history)

    _some ->
      [nil | @subjs]
      |> Task.async_stream(&move(state, &1))
      |> Stream.map(&elem(&1, 1)) # лениво
      |> Stream.filter(& &1)      # лениво
      |> Stream.flat_map(&go/1)   # лениво и рекурсивно
  end
end

Спасибо Stream, весь этот код ленив, сиречь выполняться не будет, пока не пнут. Мы же тут хаскель пародируем, помните?

Проверяем

Тесты я недолюбливаю и считаю пустой тратой времени: гораздо проще сразу писать рабочий код. Поэтому я просто создам функцию main/0 и выведу результаты на экран.

Тут есть один нюанс: несколько решений вернутся плоским списком из-за Stream.flat_map/2. Но это не страшно: каждое решение заканчивается пустым множеством, поэтому мы легко разобьем этот плоский лист на чанки. Весь код красивого вывода (которого чуть ли не столько же, сколько логики) я тут приводить не буду, вот gist для энтузиастов.

Удачной сельскохозяйственной перевозки!