Эвристический алгоритм решения задачи о минимальном количестве линий для размещения отрезков

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

Давайте рассмотрим такой алгоритм. Будем действовать максимально просто.


Мы будем случайным образом генерировать всевозможные комбинации расположения
отрезков на линиях и выбирать лучшее решение среди них. Идея такая:
выбираем произвольный отрезок из списка, затем продолжаем на этой же линии добавлять другие, тоже выбранные случайным образом, отрезки из оставшихся, которые не противоречат условию о том, что выбранные отрезки на должны пересекаться. Так действуем до тех пор, пока на текущей линии мы не можем расположить уже ни одного дополнительного отрезка. На этом заполнение этой линии заканчивается.
Если у нас остались еще отрезки, которые не были задействованы в размещении, начинаем заполнять следующую линию. И так действуем до тех пор, пока у нас остались свободные для размещения отрезки. Как видите, генерация одного решения весьма проста
и незатейлива.
Ну а сам алгоритм сводится к генерации некоторого заданного количества решений и выбору их них наиболее оптимального. Для нашей задачи критерием оптимальности будет служить минимальное количество линий, на которых размещаются отрезки. В худшем случае, понятно, это значение будет равно количеству отрезков во входном списке, то есть, когда каждый отрезок лежит на своей отдельной линии.
 
Итак, попробуем записать этот алгоритм на языке Haskell.
Для работы со случайными числами сначала импортируем модуль System.Random и определим тип отрезок (Segment) (я рассматриваю для примера координаты отрезков как целые числа):

====
import System.Random
type Segment = (Int, Int)
====


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


====
-- входные данные (список пар координат отрезков)
input :: [Segment]
input = [(1,6),(5,6),(2,3),(5,6),(4,6),(1,2),(3,4),(1,5),(1,2),(2,5)]

-- количество циклов генерации решения
genCnt = 10000
====


Затем, так как работать мы будем с индексированными списками отрезков,
которые будут выглядеть как [((xLeft, xRight), idx)],  определим необходимые селекторы:


====
-- селекторы для конструкции (Segment, Idx)
getIdx = snd
getXL = fst . fst
getXR = snd . fst
====

Функции для заполнения одной линии отрезками могут выглядеть так:
===
-- заполнение одной линии
oneLine []  acc = return $ reverse acc
oneLine lst acc = do
    el <- getRndElem lst
    oneLine
        (filter (skip el) lst)
        (el : acc)   
 

-- выбор случайного элемента из списка
getRndElem lst = do
    r <- randomRIO (0, length lst - 1)
    return $ lst !! r

-- предикат для "просеивания" элементов списка  
skip skipEl el =
    getIdx el /= getIdx skipEl &&
    (   getXR el <= getXL skipEl ||
        getXL el >= getXR skipEl  )
===
getRndElem возвращает случайный элемент списка, переданного в качестве параметра,
предикат skip используется для "просеивания" элементов при выборе каждого последующего отрезка (пропускаем текущий выбранный отрезок и все, которые пересекаются с ним).

Далее рассмотрим функцию генерации одного решения:
===
-- формирование одного варианта решения        
oneCase []  acc = return $ reverse acc     
oneCase lst acc = do
    line <- oneLine lst []
    let idxs = map getIdx line
    let left = filter (\x -> notElem (getIdx x) idxs) lst
    oneCase left (line : acc)
===

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

Ну и основная функция алгоритма solve.

===
-- основная функция эвристического алгоритма    
solve []  best _ = return best
solve lst best 0 = return best       
solve lst best n = do
    sol <- oneCase lst []
    if length sol  < length best then solve lst sol (n - 1)
    else solve lst best (n - 1)
===

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

Ну и, собственно, функция main:

===
-- стартовая функция программы     
main = do
    let idxs_input = zip input [0..]
    let bad_solution = map (\x -> [x]) idxs_input
    l <- solve idxs_input bad_solution genCnt
    putStrLn $ "Solution's length = "
                ++ show (length l)
                ++ "\n"
                ++ show l
===

Здесь мы сначала создаем индексированный список, с которым будем работать, затем
наихудшее решения для передачи в качестве начального значения best для функции solve.
В конце выводится результат работы функции solve.
Так, например, для значения genCnt = 5 мы уже с очень высокой вероятностью получаем правильное решение задачи - 4 линии:

===
Solution's length = 4
[ [((4,6),4),((2,3),2),((3,4),6),((1,2),8)],
  [((5,6),3),((1,2),5),((2,5),9)],
  [((5,6),1),((1,5),7)],
  [((1,6),0)] ]
===


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


Надеюсь, вам было интересно.
До новых встреч )