Задача о движущихся точках и её решение на языке Haskell

В блогах на сайте free-lance.ru не так давно один человек разместил задачу, условие которой в чуть облагороженном (мной :) виде звучит следующим образом:
===
Имеется N вершин, между ними есть ребра (длину ребер мы задаем сами целым числом). По ребрам ездят точки, которые могут ехать в обе стороны. При нахождении двух точек в одной вершине происходит столкновение. Соответственно, если точки едут по одному ребру навстречу друг другу, тоже произойдет столкновение. Движение точек задано списком вершин, через которые они проходят. Скорости точек равны единице. При
достижении конечной вершины точка исчезает. По заданной конфигурации сети и точек
определить, будет ли столкновение.
===
Попробуем написать решение этой задачи на Haskell.

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

type Vertex = Int
type Path = [Vertex]
type Idx = Int
type Len = Int
type Position = Int
type Timestep = Int

data Direction = Up | Down  deriving (Eq)
data Edge = Edge Vertex Vertex Len deriving (Eq)
     
type State = [(Position, Len, Direction,Edge)] 
type Collision = (Point, Point, Timestep)

data Point = Point Idx Path State 

Разберем их вкратце.
Vertex - это просто целочисленная величина, представляющая собой номер/индекс вершины во входном графе.

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

Idx, Len и Position - числа, представляющие собой, соответственно, номер/индекс перемещающейся точки, целочисленную длину ребра и целочисленное положение точки на этом ребре в некоторый момент времени.

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

Direction - направление перемещения точки по ребру (Up - от первой точки в описании ребра ко второй, Down - в обратном направлении).

Edge - тип описания ребра, который задается двумя вершинами и его длиной.

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

Collision - тип пересечения точек, представляющий собой тройку значений - 2 точки, которые участвуют в коллизии, и временная отметка, на которой эта коллизия произошла.

Теперь опишем некоторые входные данные.

graph :: [Edge]
graph = [
 Edge 2 1 3,
 Edge 2 3 3,
 Edge 2 4 3,
 Edge 2 5 6,
 Edge 2 6 7
 ]

points :: [(Idx, Path)]
points = [
 (1,[1,2,3]),
 (2,[3,2,1]),   
 (3,[4,2,1]),
 (4,[5,2,6]),
 (5,[6,2,5])      
 ] 

У нас есть граф, в котором задано описание его ребер. Каждое ребро представлено парой точек и длиной (фактической). Также имеется список точек, каждая из которых представлена своим индексом/порядковым номером и списком вершин графа, через которые она должна пройти.

Далее, опишем 2 функции, которые по входным данным создают список наших точек.

makePoints :: [(Idx, Path)] -> [Edge] -> [Point]
makePoints l gr =
 map (\(i,vs) -> Point i vs (makeStartState vs gr)) l


makeStartState :: [Vertex] -> [Edge] -> State
makeStartState vs gr =    
 map (\(v1,v2) -> makeEdge (v1,v2) $ eqE (v1,v2))
 $ zip vs $ tail vs
 where
  eqE (v1,v2) = head $ filter (eqVertEdge (v1,v2)) gr
  eqVertEdge (v1,v2) (Edge ev1 ev2 l) 
          | v1 == ev1 && v2 == ev2 = True
          | v2 == ev1 && v1 == ev2 = True          
          | otherwise = False
  makeEdge (v1,v2) e@(Edge ev1 ev2 l)
   | ev1 == v1 = (0,    dblL, Up, e)
   | otherwise = (dblL, dblL, Down, e)
   where dblL = l * 2 

Разберем их подробнее. makePoints генерирует список точек по переданным на вход
данным по точкам и самому графу. Ключевая функция в ней - это генерация начальных состояний каждой точки, которую выполняет функция makeStartState. В ней мы сначала для пути точки генерируем список пар вершин, затем для каждой пары находим соответствующее ребро в описании графа (функция eqE), а затем в makeEdge генерируем для текущего ребра элемент списка состояния точки, включающий определение начальной позиции на ребре (с учетом его удвоенной длины), удвоенную длину ребра, направление движения по нему и, собственно, само ребро).

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

makeStep :: [Point] -> [Point]
makeStep pts = 
 map procP pts
 where 
  procP p@(Point i path (hd:tl)) =
   let (pos, len, dir, edge) = hd in 
   case dir of
    Up ->  Point i path ((pos + 1, len, dir, edge) : tl)
    Down -> Point i path ((pos - 1, len, dir, edge) : tl)

Здесь всё достаточно просто. Если в текущем(первом) элементе состояния точки направление движения вверх (Up), мы увеличиваем на единицу положение точки на ребре.
Если направление движения вниз (Down) - уменьшаем на 1.

Теперь определим основную функцию, которая запускает, собственно, эмуляцию нашего процесса.

emulate :: [Point] -> ([Point],[Collision])
emulate pts  = 
 let emulate' cnt pts colls = 
  let newPts = makeStep pts in
  let newColls = checkCollisions newPts cnt in
   if null pts then (pts,concat $ reverse colls)
  else emulate' (cnt + 1) 
          (processPoints $ delCollPoints newPts newColls) 
         (newColls : colls)
 in 
  emulate' 1 pts []  

На вход она получает список точек в начальном положении, а возвращает конечный список точек (у нас он будет пустым, так как столкнувшиеся точки, а также точки, достигшие своего пункта назначения, мы будем удалять из списка), и список коллизий - то, что нас больше всего интересует). Emulate запускает из-под себя рекурсивно emulate', которая дополнительно принимает в самом начале текущий временной шаг и пустой список для накопления результата. Рассмотрим эту функцию подробнее. Сначала мы выполняем шаг для всех точек, затем формируем по полученному списку точек возможные коллизии и добавляем их к накопителю коллизий, после этого мы удаляем из списка точек те, которые были задействованы в коллизиях на текущем шаге, и обработаем состояния всех точек, удаляя из них первые элементы списка, если они уже перестали быть актуальными, а также сами точки, если у них список состояний пустой (весь путь пройден).
Функция прекращает работать, если полученный список точек пустой (нам нечего обрабатывать дальше). Если же нет - мы запускаем процесс эмуляции для следующего шага.

Теперь напишем функцию генерации коллизий для списка точек в его некотором состоянии.

checkCollisions :: [Point] -> Timestep -> [Collision]  
checkCollisions pts ts = 
    filter isIntersect $ [ (p1,p2,ts) | 
                p1@(Point i1 pt1 st1) <- pts, 
                p2@(Point i2 pt2 st2) <- pts, 
                i1 < i2 ]
    where
 getVert st@(p,l,d, Edge v1 v2 _) 
  | d == Up && p == l = [v2]
  | d == Down && p == 0 = [v1]
  | otherwise = [] 
 chkEdges st1@(p1,l1,d1,e1) st2@(p2,l2,d2,e2)
  | e1 == e2 && p1 == p2 = True
  | otherwise = False
 chkVers st1@(p1,l1,d1,e1) st2@(p2,l2,d2,e2)
  | v1 /= [] && v2 /= [] && head v1 == head v2 = [head v1]
  | otherwise = []
  where
   v1 = getVert st1 
   v2 = getVert st2 
 isIntersect (p1@(Point _ _ (hd1:tl1)), 
       p2@(Point _ _ (hd2:tl2)), _) = 
        (not $ null $ chkVers hd1 hd2) || chkEdges hd1 hd2 

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

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

delCollPoints :: [Point] -> [Collision] -> [Point]
delCollPoints pts colls = filter (not . collPoint) pts
    where
  collPoint (Point i _ _) = 
         elem i 
   $ concatMap 
    (\(Point i1 _ _, Point i2 _ _, _ ) -> [i1,i2]) 
    colls

Для этого нам снова очень удачно пригодился индекс точек.

Следующая функция решает задачу обработки точек для обновления их списков состояний:

processPoints :: [Point] -> [Point]
processPoints pts =
    filter notEmptyState $ map chkPath pts
    where
 chkPath p@(Point i pt (hd:tl))  
  | pos == 0 && dir == Down = Point i pt tl
  | pos == len && dir == Up = Point i pt tl   
  | otherwise = p
  where 
   (pos,len,dir,_) = hd
 notEmptyState (Point _ _ st) = st /= []

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

Ну и заключительная часть: функция сериализации состояния и функция main, запускающая
работу программы.

showCollision :: Collision -> String
showCollision coll@(p1,p2,ts) = 
    "Collision between points " ++ 
    showPoint p1 ++ " and "  ++ showPoint p2 ++
    " at time moment: " ++ show (fromIntegral ts / 2)
    where
 showPoint p@(Point i pt st) = 
             "(Idx = " ++ show i ++ 
             " State = " ++ showState st ++ ")"
        showState (h@(p,l,d,e):t) = 
  "Pos: " ++ show (fromIntegral p / 2) ++
                                    " edge: " ++ showEdge e
        showEdge e@(Edge v1 v2 l) = show v1 ++ "-" ++ show v2

main :: IO ()
main =  mapM_ (putStrLn . showCollision) 
  $ snd $ emulate $ makePoints points graph

Для наших входных данных мы получаем следующий результат:

Collision between points (Idx = 1 State = Pos: 0.0 edge: 2-1) 
and (Idx = 2 State = Pos: 0.0 edge: 2-3) at time moment: 3.0
Collision between points (Idx = 1 State = Pos: 0.0 edge: 2-1) 
and (Idx = 3 State = Pos: 0.0 edge: 2-4) at time moment: 3.0
Collision between points (Idx = 2 State = Pos: 0.0 edge: 2-3) 
and (Idx = 3 State = Pos: 0.0 edge: 2-4) at time moment: 3.0
Collision between points (Idx = 4 State = Pos: 0.5 edge: 2-6) 
and (Idx = 5 State = Pos: 0.5 edge: 2-6) at time moment: 6.5

То есть, первые 3 точки столкнутся на шаге 6 (временнАя отметка 3) в вершине 2,
оставшиеся (4 и 5) столкнутся на шаге 13 (временнАя отметка - 6.5) на ребре 2-6
на расстоянии 0.5 от вершины 2.

Вот, собственно, и всё. Надеюсь, вам было интересно.

В заключение добавлю, что на днях вышла новая версия Haskell Platform - 2011.4.0.0.