Управление лифтами: решение на языке Haskell

в 8:52, , рубрики: haskell, автоматическое управление, метки: ,

Управление лифтами: решение на языке HaskellТрадиционный конкурс по функциональному программированию состоялся в июле. Судя по количеству участников, большинство апологетов программирования на этот раз убыли на отдых, либо не стали участвовать в конкурсе, экономя силы и готовясь к ICFPC, который в этом году состоялся через неделю после моего мероприятия. Тем не менее, в конкурсе на этот раз приняли участие девять человек, из которых семеро дали в той или иной степени правильные ответы. Распределение по языкам программирования: Haskell — 4 решения, из которых 2 некорректные; C++, Clean, F#, Java и Perl — по одному решению.

Задача на этот раз была из области автоматического управления. Конечно, она всё также сводилась к поиску на графе, для чего всяко можно использовать алгоритм A*. Тем не менее, большинство участников выбрали реализацию ad hoc, в том числе и победитель. Вот примерное условие:

На улице генерала Белова стоит четырнадцатиэтажный дом.

На первом этаже живет Митя. На втором — Петя, Тёма и Саша. На третьем — Витя, а на четвёртом — Маша и Паша. Кто живёт выше — никто не знает.

Митя и Витя собираются в гости к своему однокласснику Тёме. Паша позвонил Пете и попросил его вернуть конспект по ОБЖ. Сашина кошка снова улизнула из квартиры и наверняка греется у батареи на третьем этаже. Саша полон решимости вернуть её домой. Маша, тем временем, хочет сходить в магазин за новым велосипедным звонком.

В начальный момент времени лифт находится на первом этаже. Одновременно в лифте может находится не более двух человек, а пользоваться лестницей нельзя из-за ремонта. «Шагом» считается перемещение лифта между парой соседних этажей. В начале каждого шага ученики могут свободно перемещаться между лифтом и лестничной площадкой.

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

Надо отметить, что на этот раз готовил конкурс наш замечательный коллега afiskon, в связи с чем мы выражаем ему категорическую благодарность и всяческую похвалу. Так что и исходный код решения — это всё его заслуга. Моё участие в кодировании заключалось лишь в мелкой доводке кода, его стиля, а также комментирования модулей. И тут надо отметить, что коллега afiskon самостоятельно реализовал алгоритм поиска по графу A*, о чём ранее писал в своей заметке на эту тему (и, кстати, как видно, он использовал свою реализацию в том числе и для решения задачи апрельского конкурса).

Главный модуль

Начнём с главной функции. Она должна принимать на вход описание задачи, считать оптимальное движение лифтов, после чего выводить на экран описание программы такого движения. Это выразить довольно просто:

main :: BuildingState -> IO ()
main = putStrLn . concatMap (x -> show x ++ "nn") . graphSearch

Тип BuildingState мы опишем позднее. Сейчас просто надо понять, что в этом типе будет формализованное описание начального состояния здания. Ну и функция graphSearch является сутью данной работы — именно в ней будет определён алгоритм A*. Её определение также рассмотрим ниже в этой статье. Остальные функции в соответствии с принципом разработки сверху вниз всё так же определяются ниже, в том числе и в других модулях.

Теперь имеет смысл озаботиться примером. Сразу закодируем условие конкурсной задачи. Это будет выглядеть примерно так:

task1 = BuildingState
        { 
          elevators = [ElevatorState {personsInTheElevator = [],
                                      maxPersons           = 2,
                                      currentFloor         = 0 }],
          floors = [FloorState {personsOnTheFloor = [Person {targetFloor = 1}]},
                    FloorState {personsOnTheFloor = [Person {targetFloor = 2},
                                                     Person {targetFloor = 3}]},
                    FloorState {personsOnTheFloor = [Person {targetFloor = 1}]},
                    FloorState {personsOnTheFloor = [Person {targetFloor = 0}]}]
        }

Теперь можно перейти к плотному рассмотрению всех программных сущностей, которые описывают формализованное описание условий задачи.

Модуль с описанием программных сущностей для описания задач

Поверхностный взгляд на задачу даёт ответ на вопрос о сущностях — в этой задаче выделяется четыре сущности: человек (ну или субъект), лифт, этаж и здание. Вот их-то мы сейчас и выразим при помощи алгебраических типов данных. Поехали…

data Person = Person
              {
                targetFloor :: Int
              }
  deriving (Eq, Ord)

Как видно, в отношении субъекта перемещения нам интересно только одно свойство — тот этаж, на который суьбъекты необходимо попасть. Единственное, что надо здесь отметить, — нумерация этажей будет производиться с 0, в лучших традициях программистов.

data ElevatorState = ElevatorState
                     {
                       personsInTheElevator :: [Person],
                       maxPersons           :: Int,
                       currentFloor         :: Int
                     }
  deriving (Eq, Ord)

Далее — описание состояни лифта. В каждый момент времени каждый лифт находится в состоянии, которое определяется перечнем находящихся в лифте субъектов, максимальным количеством людей в лифте (его грузоподъёмностью) и текущим этажом. Нумерация этажей, как полагается, тоже ведётся с 0. И вот здесь, кстати, есть одна фишка, которая может напрячь людей, привыкших к таким языкам, как C++ или Java. Поле maxPersons, вообще говоря, может изменяться. А хотелось бы, чтобы это поле было неизменным. В функциональных языках, честно говоря, вообще всё неизменно. Но здесь придётся самостоятельно следить за тем, что изменять данное поле после инициализации нельзя.

data FloorState = FloorState
                  {
                    personsOnTheFloor :: [Person]
                  }
  deriving (Eq, Ord)

Ну и состояние этажа. Определяется только перечнем субъектов, находящихся на нём в каждый момент времени.

Как видно, для всех этих АТД автоматически определены экземпляры классов Eq и Ord. А вот экземпляры класса Show определим вручную:

instance Show Person where
  show p = "Person(" ++ show (targetFloor p) ++ ")"

instance Show ElevatorState where
  show es = "Elevator{ floor = " ++ show (currentFloor es) ++
                    ", max = " ++ show (maxPersons es) ++
                    ", persons = " ++ show (personsInTheElevator es) ++ " }"

instance Show FloorState where
  show fs = "Floor(" ++ show (personsOnTheFloor fs) ++ ")"

Тут нет ничего странного и сложного — просто выводим информацию о наших АТД в удобной для понимания форме.

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

data BuildingState = BuildingState
     {
       elevators :: [ElevatorState],
       floors    :: [FloorState]
     }
  deriving (Eq, Ord, Show)

Чуть позже мы определим класс, который предоставляет функцию для вычисления близлежащих состояний и других нужных для поиска методов. Этот класс будет полезен при описании эвристик для алгоритма A*. А поскольку поиск в нашей задаче будет осуществляться по состояниям здания, то как раз для этого класса надо определить экземпляр для типа BuildingState. Этим и займёмся:

instance Graph BuildingState where
  nearbyStates = step3 . step2 . step1
    where
    
      step1 :: BuildingState -> BuildingState
      step1 st = BuildingState {elevators = map (es -> es { 
        personsInTheElevator = filter (p -> targetFloor p /= currentFloor es) 
                                      (personsInTheElevator es)})
                                                (elevators st),
                                floors = map ((fn, fs) -> fs { 
        personsOnTheFloor = filter (p -> targetFloor p /= fn)
                                   (personsOnTheFloor fs)}) $ zip [0..] (floors st)}

      step2 :: BuildingState -> [BuildingState]
      step2 st = step2' (length (floors st) - 1) st
      step2' fn st | fn < 0    = [st]
                   | otherwise = concat [step2' (fn - 1) $
                                   st {elevators = map ((persons, es) -> es {
                                         personsInTheElevator = sort persons})
                                         (zip pl elevatorsOnTheFloor) ++ otherElevators,
                                       floors = map ((n, x) ->
                                           if n == fn
                                             then x { personsOnTheFloor = sort $ last pl }
                                             else x) $ zip [0..] $ floors st} |
                                         pl <- placements allPersonsOnTheFloor $
                                               map maxPersons elevatorsOnTheFloor]
        where 
          (elevatorsOnTheFloor, otherElevators) = partition (es -> currentFloor es == fn) (elevators st)
          personsInTheElevators = concatMap personsInTheElevator elevatorsOnTheFloor
          allPersonsOnTheFloor = personsInTheElevators ++ personsOnTheFloor (floors st !! fn)

      step3 :: [BuildingState] -> [BuildingState]
      step3 lst = filter (st -> all (e -> (currentFloor e >= 0) &&
                                            (length (floors st) > currentFloor e)) $ elevators st) $
                         map ((st, deltas) -> st {elevators = sort $
                           map ((es, delta) -> es {currentFloor = currentFloor es + delta}) $
                           zip (elevators st) deltas})
                             [(st, deltas) | st <- lst, 
                                             deltas <- replicateM (length $ elevators st) [-1, 1]]

Как видно, здесь мы имеем довольно значительный кусок кода на языке Haskell, что довольно-таки необычно для этого лаконичного языка. Давайте же разберём более или менее подробно, что здесь описано.

Итак, вычисление близлежащих состояний здания вычисляется в три шага. Эти шаги (функции step1, step2 и step3) последовательно применяются к состоянию, для которого необходимо вернуть список близлежащих состояний. Метод nearbyStates получает на вход состояние и возвращает список состояний, а бесточечная нотация скрывает его единственный аргумент.

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

А вот на втором шаге (step2) производится преобразование состояния здания с уже удалёнными людьми, достигшими своего целевого этажа, в список таких состояний. На данном шаге производится составление различных комбинаций людей, которые входят или выходят не на своём этаже. На этом шаге могут генерироваться состояния с повторами, но все они удаляются в функции graphSearch, реализующей алгоритм A*. Надо отметить, что у этой локальной функции в свою очередь определены четыре замыкания (два из них в виде пары), что, конечно, является несколько дурным тоном при программировании на языке Haskell. Тем не менее, так здесь сделать проще, а эти замыкания вычисляют: списки лифтов на текущем этаже и лифтов на остальных этажах, список людей из лифтов на текущем этаже, а также список всех людей на текущем этаже — в лифтах и на площадке.

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

В данном классе есть ещё два метода:

  isTargetNode st = elevatorsAreEmpty (elevators st) &&
                    personsAreArrived (floors st)
    where
      elevatorsAreEmpty = all (null . personsInTheElevator)
      personsAreArrived = all (null . personsOnTheFloor)

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

  heuristic st p = length p - 1 + h
    where
      h                      = ceiling (totalPersons / totalElevatorsCapacity)
      totalElevatorsCapacity = fromIntegral $ foldl (s e -> s + maxPersons e) 0 (elevators st)
      totalPersons           = fromIntegral $ personsOnFloors + personsInElevators
      personsOnFloors        = foldl (s f -> s + length (personsOnTheFloor f)) 0 (floors st)
      personsInElevators     = foldl (s e -> s + length (personsInTheElevator e)) 0 (elevators st)

Этот метод класса Graph определяет эвристическую функцию, задающую порядок обхода вершин. Она определяет значение «расстояние + стоимость». Ну вот здесь это значение вычисляется довольно непростым образом, полученным в результатах экспериментов при подготовке конкурса. Думаю, что каждый заинтересовавшийся сможет задать вопрос непосредственно автору. А мы пойдём дальше.

Модуль с описанием алгоритма поиска

Теперь перейдём непосредственно к описанию функции, реализующей алгоритм поиска A*. Для этого нам надо определить класс, предоставляющий интерфейс того самого графа, на котором осуществляется поиск. Как уже многие догадались, этот класс содержит три метода:

class (Eq a, Ord a) => Graph a where
  nearbyNodes  :: a -> [a]
  isTargetNode :: a -> Bool
  heuristic    :: a -> [a] -> Int

Как должно было быть понятно из предыдущего раздела, метод nearbyNodes возвращает смежные вершины графа от заданной. Предикат isTargetNode возвращает значение True для всех целевых вершин графа. Ну а метод heuristic определяет эвристику для выбора следующих для просмотра вершин. Ранее мы уже определили экземпляр этого класса для типа BuildingState.

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

data TaskStateAndPath a = TaskStateAndPath
                          {
                            state :: a,
                            path :: [a]
                          }

instance Eq a => Eq (TaskStateAndPath a) where
  (==) = (==) `on` state

instance Ord a => Ord (TaskStateAndPath a) where
  compare = compare `on` state

instance Show a => Show (TaskStateAndPath a) where
  show = show . path

Как видно, здесь также определены экземпляры основных классов. Хорошим тоном является использование стандартной функции on из модуля Data.Function, и именно здесь видно, что её название полностью отражает её предназначение.

Ну и, наконец, функции поиска:

graphSearch :: (Graph g) => g -> [g]
graphSearch st = graphSearch' (Q.insert (TaskStateAndPath st [st]) 0 empty) S.empty
  where
    empty = Q.empty :: (Ord a) => Q.PSQ (TaskStateAndPath a) Int

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

graphSearch' :: Graph g => Q.PSQ (TaskStateAndPath g) Int -> S.Set g -> [g]
graphSearch' open closed = case Q.findMin open of
                             Nothing -> []
                             Just b  -> let f = Q.key b
                                        in  if isTargetNode $ state f
                                              then reverse $ path f
                                              else nextStep (state f) (path f)
  where
    nextStep st p = graphSearch' newOpen newClosed
      where
        newClosed = S.insert st closed
        newOpen   = foldl (q s -> insertNode s p q)
                          (Q.deleteMin open)
                          (filter (x -> not $ S.member x newClosed) $ nub $ nearbyNodes st)

Что у нас здесь? Среди всех вершин во множестве открытых для поиска вершин выбирается та, у которой минимальный приоритет. Если она входит в множество целевых вершин графа, то поиск останавливается. Если же нет, то происходит построение следующего уровня открытых и закрытых вершин. Во множество закрытых вершин просто вносится текущая, а множество открытых вершин собирается при помощи функции insertNode:

insertNode :: Graph g => g -> [g] -> Q.PSQ (TaskStateAndPath g) Int -> Q.PSQ (TaskStateAndPath g) Int
insertNode s p q = case Q.lookup stp q of
                     Nothing -> ins q
                     Just f  -> if heuristic s p >= f
                                  then q 
                                  else ins $ Q.delete stp q
  where
    ins = Q.insert stp (heuristic s p)
    stp = TaskStateAndPath s (s:p)

Для расчёта приоритетов вершин, вновь добавляемых во множество открытых вершин, как раз и используется функция эвристики.

Служебный модуль с функцией вычисления размещений

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

placements :: Eq a => [a] -> [Int] -> [[[a]]]
placements itemsList [] = [[itemsList]]
placements itemsList (maxItems:maxItemsTail) = [(s:t) | s <- seqList,
                                                        t <- allTails s] 
  where
    seqList = filter (s -> length s <= maxItems) $ subsequences itemsList
    allTails s = placements (itemsList \ s) maxItemsTail

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

Проще всего показать на примере:

> placements [1..3] [1]

[[[ ], [1, 2, 3]],
 [[1], [2, 3]],
 [[2], [1, 3]],
 [[3], [1, 2]]]

> placements [1..3] [2]

[[[ ], [1, 2, 3]],
 [[1], [2, 3]],
 [[2], [1, 3]],
 [[1, 2], [3]],
 [[3], [1, 2]],
 [[1, 3], [2]],
 [[2, 3], [1]]]

> placements [1..3] [3]

[[[ ], [1, 2, 3]],
 [[1], [2, 3]],
 [[2], [1, 3]],
 [[1, 2], [3]],
 [[3], [1, 2]],
 [[1, 3], [2]],
 [[2, 3], [1]],
 [[1, 2, 3],[ ]]]

Вот как-то так…

Заключение

Решатель для поставленной задачи реализован. Он вполне решает более общие задачи, чем была выставлена на конкурс. Например, в нём нет ограничений на высотность здания, на количество лифтов или на грузоподъёмность лифтов. Само собой разумеется, что нет ограничений и на количество пассажиров, которые необходимо перевести. Вот, к примеру, ещё пара задач, которые могут быть с лёгкостью решены посредством разработанной программы:

task2 = BuildingState
        { 
          elevators = [ElevatorState {personsInTheElevator = [],
                                      maxPersons           = 1,
                                      currentFloor         = 2},
                       ElevatorState {personsInTheElevator = [],
                                      maxPersons           = 2,
                                      currentFloor         = 4}],
          floors = [FloorState {personsOnTheFloor = []},
                    FloorState {personsOnTheFloor = [pup]},
                    FloorState {personsOnTheFloor = []},
                    FloorState {personsOnTheFloor = [pdown, pdown]},
                    FloorState {personsOnTheFloor = []}]
        }
  where
    pup   = Person {targetFloor = 4}
    pdown = Person {targetFloor = 0}

task3 = BuildingState
        { 
          elevators = [ElevatorState {personsInTheElevator = [],
                                      maxPersons           = 1,
                                      currentFloor         = 2},
                       ElevatorState {personsInTheElevator = [],
                                      maxPersons           = 2,
                                      currentFloor         = 4}],
          floors = [FloorState {personsOnTheFloor = []} ,
                    FloorState {personsOnTheFloor = [Person {targetFloor = 7}]},
                    FloorState {personsOnTheFloor = []},
                    FloorState {personsOnTheFloor = []},
                    FloorState {personsOnTheFloor = [Person {targetFloor = 2},
                                                     Person {targetFloor = 5}]},
                    FloorState {personsOnTheFloor = []},
                    FloorState {personsOnTheFloor = [Person {targetFloor = 0}]},
                    FloorState {personsOnTheFloor = [Person {targetFloor = 1}]}]
  }
  where
    pup   = Person {targetFloor = 7}
    pdown = Person {targetFloor = 0}

К слову, задача task3 была представлена участникам конкурса в качестве задачи на проверку общности реализованных алгоритмов. Не все справились, но большинство вполне. Естественноязыковое описание задачи смотрите по адресу конкурса (дополнение № 3), здесь я его приводить не буду ради экономии пространства.

Ну и вот здесь можно скачать все представленные в статье модули:

  1. Модуль Elevators
  2. Модуль ElevatorTask
  3. Модуль Heuristic
  4. Модуль Placements

В общем, вот как-то так. Конструктивная критика, замечания и предложения всегда принимаются. Ну и всем, кто прочитал до конца, — низкий поклон и благодарность.

Мои предыдущие статьи о конкурсах по ФП на Хаброхабре:

Автор: Darkus

* - обязательные к заполнению поля


https://ajax.googleapis.com/ajax/libs/jquery/3.4.1/jquery.min.js