Конкурс по ФП в августе: поиск подматриц в больших матрицах

Как обычно по чётным месяцам года на первой неделе августа был проведён конкурс по функциональному программированию ^[1]. На этот раз задачу подогнал нам один из корреспондентов, за что ему огроменное спасибо. А сама задача была довольно проста, а потому к конкурсу привлеклось значительное количество участников, небывалое с начала этого года (аж целых 14, да). В качестве использованных языков программирования был целый зоопарк, 14 участников использовали 12 языков (по алфавиту): C, C++, Clojure (победитель в командном зачёте, использовался дважды), D, Erlang, Go, Haskell, LISP, PHP, Python, Racket, Scala (другой победитель среди языков, тоже использовался дважды). К тому же, уже после окончания конкурса были присланы ещё два решения, и, как ни странно, оба на языке программирования Clojure. И это хорошо.

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

Постановка задачи

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

Итак, вот здесь ^[2] лежит сравнительно большая матрица. И надо было найти в ней все вхождения следующих подматриц:

symbol :: Int -> Matrix Int
symbol 0 = [[1, 1, 1],
            [1, 0, 1],
            [1, 0, 1],
            [1, 0, 1],
            [1, 1, 1]]
symbol 1 = [[1, 1, 0],
            [0, 1, 0],
            [0, 1, 0],
            [0, 1, 0],
            [1, 1, 1]]
symbol 2 = [[1, 1, 1],
            [0, 0, 1],
            [1, 1, 1],
            [1, 0, 0],
            [1, 1, 1]]
symbol 3 = [[1, 1, 1],
            [0, 0, 1],
            [1, 1, 1],
            [0, 0, 1],
            [1, 1, 1]]
symbol 4 = [[1, 0, 1],
            [1, 0, 1],
            [1, 1, 1],
            [0, 0, 1],
            [0, 0, 1]]
symbol 5 = [[1, 1, 1],
            [1, 0, 0],
            [1, 1, 1],
            [0, 0, 1],
            [1, 1, 1]]
symbol 6 = [[1, 1, 1],
            [1, 0, 0],
            [1, 1, 1],
            [1, 0, 1],
            [1, 1, 1]]
symbol 7 = [[1, 1, 1],
            [0, 0, 1],
            [0, 1, 1],
            [0, 1, 0],
            [0, 1, 0]]
symbol 8 = [[1, 1, 1],
            [1, 0, 1],
            [1, 1, 1],
            [1, 0, 1],
            [1, 1, 1]]
symbol 9 = [[1, 1, 1],
            [1, 0, 1],
            [1, 1, 1],
            [0, 0, 1],
            [1, 1, 1]]
symbol _ = undefined

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

Решение

Начнём, как это обычно бывает, с определения функции main:

main :: IO ()
main = do putStr "Введите имя файла с матрицей: "
          fn <- getLine
          m  <- loadMatrix fn
          prettyPrint $ zip [0..9] $ map (i -> findSymbol (symbol i) m) [0..9]

Здесь всё просто. Запрашиваем у оператора имя файла, который необходимо обработать, затем загружаем матрицу в память, а затем выводим на экран результат. Последняя операция осуществляется при помощи функции findSymbol, которая вызывается подряд для всех имеющихся в наборе символов (поэтому и отображение на список [0..9]).

Функция loadMatrix достаточно проста:

loadMatrix :: FilePath -> IO (Matrix Int)
loadMatrix = liftM (map (map (c -> read [c])) . lines) . readFile

при помощи стандартной функции readFile читается файл (который должен состоять только из цифр, проверок никаких не делается), текст которого затем разбивается на строки (lines), а затем ко всем символам во всех прочитанных строках применяется функция read, которая переводит строку в число. В итоге получается матрица (список списков), которая возвращается в рамках монады IO.

Теперь посмотрим на определение функции findSymbol. Вот оно:

findSymbol sm m = [(x, y) | x <- [0..mw - sw],
                            y <- [0..mh - sh],
                            sm == subMatrix (x, y) (sw, sh) m]
  where
    (sw, sh) = getMatrixDimension sm
    (mw, mh) = getMatrixDimension m

Это, можно сказать, «ядро» алгоритма. Но в нём нет никакой космической науки. При помощи генератора списка организован двойной цикл, в котором «окошко» размером с искомую подматрицу пробегает по всей заданной матрице, и на каждом шаге этого двойного цикла подматрица в матрице сравнивается с искомой. Всё это очень долго, но зато работает.

Служебная функция getMatrixDimension определена самым простым образом, который не стоит даже и обсуждать:

getMatrixDimension :: Matrix a -> (Int, Int)
getMatrixDimension = (length . head) &&& length

А вот так определена функция вычленения из матрицы подматрицы заданного размера с заданной позиции:

subMatrix :: (Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (x, y) (w, h) = map (take w . drop x) . take h . drop y

Тоже ничего необычного. Поскольку матрица представляет собой список списков (внешний список — это список строк матрицы), то сначала в верхнем списке надо выкинуть все начальные строки (внешний вызов функции drop), а потом взять необходимое количество строк (внешний вызов функции take), после чего применить эту же процедуру по отношению ко всем строкам в получившейся новой матрице (внутренние вызовы в рамках функции map тех же самых функций).

Осталось написать функцию prettyPrint, которая выводит на экран для оператора информацию о всех найденных в большой матрице символах. Вот её определение:

prettyPrint :: [(Integer, [(Int, Int)])] -> IO ()
prettyPrint = mapM_ prettyPrint'
  where
    prettyPrint' (_, [])          = return ()
    prettyPrint' (n, xs@[(_, _)]) = putStrLn ("Символ " ++ show n ++ " обнаружен на позиции  " ++ printCoordinates xs ++ ".")
    prettyPrint' (n, xs)          = putStrLn ("Символ " ++ show n ++ " обнаружен на позициях " ++ printCoordinates xs ++ ".")

    printCoordinates []          = ""
    printCoordinates [(x, y)]    = "(" ++ show x ++ ", " ++ show y ++ ")"
    printCoordinates ((x, y):xs) = "(" ++ show x ++ ", " ++ show y ++ "), " ++ printCoordinates xs

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

Заключение

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

Однако несколько участников конкурса сгенерировали свои матрицы для проверки. Более того, один из постоянных участников конкурсов по ФП Максим Комар сделал репозиторий на Гитхабе, куда можно закачивать свои решения, а он затем проверяет их и добавляет данные в сравнительную таблицу. Репозиторий можно изучить здесь ^[3].

Ну и как обычно всякий желающий может получить исходный код описанного модуля здесь ^[4].

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

• Конкурсы в 2011 году: Альманах конкурсов по ФП за 2011 год ^[5]
• Конкурсы в 2012 году: Альманах конкурсов по ФП за 2012 год ^[6]
• Конкурсы в 2013 году: Альманах конкурсов по ФП за 2013 год ^[7]
• Задача о выкидывании негра за борт ^[8]
• Апрельский конкурс по ФП: поэтический вечер ^[9]
• Поиск закономерностей в последовательности «случайных» событий ^[10]

Автор: Darkus

Источник ^[11]