Большинство из вас этого, конечно, не помнит, но года три-четыре назад в этом блоге приводилась реализация генетического алгоритма на Perl . На меня тут нахлынула ностальгия и я решил переписать этот алгоритм на Haskell, и заодно распараллелить его, используя пакет parallel. Что из всего этого получилось — смотрите под катом.

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

Саму реализацию алгоритма я выложил на GitHub’е . Основная функция, экспортируемая пакетом:

— | Чистая реализация ГА
runGA :: ( RandomGen g , Chromosome a )
=> g — ^ Генератор случайных чисел
-> Int — ^ Размер популяции
-> Double — ^ Вероятность мутации [0, 1]
-> ( g -> ( a , g ) ) — ^ Генератор случайной хромосомы
-> ( a -> Int -> Bool ) — ^ Критерий останова
-> a — ^ Лучшая хромосома

Также в пакете предусмотрена практически такая же IO-функция. Размер популяции фиксирован. Независимо от номера поколения популяция содержит ровно заданное количество особей. Вероятность мутации (mutation) задает вероятность того, что каждая новая особь, полученная в результате кроссовера (crossover), будет подвержена мутации.

Четвертым аргументом функция принимает генератор случайной хромосомы (Chromosome). Это функция, принимающая ГСЧ (экземпляр класса типов RandomGen) и возвращающая случайную хромосому и новый ГСЧ. Генератор используется для создания нулевого поколения. В первоначальной реализации этого аргумента не было, а хромосомы являлись экземплярами класса типов Random. Но я обнаружил, что генерировать случайные хромосомы таким образом неудобно. Дело в том, что функция приспособленности (fitness) может зависеть от данных, полученных, например, из некого файла. В этом случае информацию, необходимую для вычисления приспособленности, было бы удобно хранить в самих хромосомах. Но сделать этого нельзя, если функция генерации случайной хромосомы предопределена. Именно поэтому функция явно передается в runGA. Это позволяет параметризовать ее, используя каррирование или замыкание.

Критерий останова — это функция, принимающая лучшую на данный момент хромосому и номер текущего поколения. Если функция возвращает True, алгоритм останавливается, иначе генерируется новое поколение. Критерий останова может быть разным в зависимости от задачи. Например, требуется минимизировать ошибку. В этом случае критерий останова будет «ошибка меньше ε или номер поколения больше N». В IO-версии функции runGA эта же функция может сообщать о текущем состоянии алгоритма.

Функция runGA возвращает лучшую хромосому.

Класс типов Chromosome определен следующим образом:

— | Интерфейс хромосомы
class NFData a => Chromosome a where
— | Кроссовер
crossover :: RandomGen g => g -> a -> a -> ( [ a ] , g )
— | Мутация
mutation :: RandomGen g => g -> a -> ( a , g )
— | Функция приспособленности.
—   fitness x > fitness y значит, что x приспособлен лучше y
fitness :: a -> Double

В кроссовере всегда участвует ровно две хромосомы. Потомков может быть сколько угодно, в том числе ноль. Функция мутации вызывается только тогда, когда уже точно известно, что хромосома должна быть подвержена мутации. То есть, дополнительно бросать кубик внутри функции не требуется. Наконец, функция приспособленности определяет приспособленность особи (с уважением, ваш К.О.). Чем больше ее значение, тем более приспособлена особь.

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

Как и в реализации на Perl, хромосомы скрещиваются не каждая с каждой:

[ ( x , y ) | x <- xs , y <- xs ]

… а первая — со всеми, кроме первой, вторая — со всеми, кроме первой и второй, и так далее:

[ ( x , y ) | x:ys <- tails xs , y <- ys ]

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

Генетические алгоритмы интересны тем, что они распараллеливаются безо всякого труда. Нетрудно догадаться, что самое «горячее» место в алгоритме — это создание нового поколения, со скрещиваниями, мутациями и вычислениями приспособленности. Это место совершенно естественным образом можно распараллелить по первой хромосоме, принимающей участие в кроссовере. Если вас интересуют подробности, посмотрите на реализацию функции nextGeneration.

Нельзя вновь не восхититься тем, с какой легкостью и непринужденностью происходит распаралелливание кода на Haskell . Подключаем лишний пакет, тратим несколько минут на переписывание небольшого участка кода, и готово! Теперь код работает во столько раз быстрее, во сколько раз больше ядер у вашего процессора. И все это без потери чистоты кода, что, например, не даст вам тот же Erlang , где параллелизм и многопоточность смешены в одно целое.

В качестве примера пакет включает решение уже знакомой нам задачи интерполяции синуса полиномом четвертой степени на отрезке [0; π/2].

Наибольший интерес для нас представляет экземпляр класса типов Chromosome:

data SinInt = SinInt [ Double ]

instance NFData SinInt where
rnf ( SinInt xs ) = rnf xs ` seq ` ( )

instance Chromosome SinInt where
crossover g ( SinInt xs ) ( SinInt ys ) =
( [ SinInt ( L . zipWith ( x y -> ( x + y ) / 2 ) xs ys ) ] , g )

mutation g ( SinInt xs ) =
let ( idx , g’ ) = randomR ( 0 , length xs 1 ) g
( dx , ) = randomR ( 10.0 , 10.0 ) g’
t = xs !! idx
xs’ = take idx xs ++ [ t + t * dx ] ++ drop ( idx + 1 ) xs
in ( SinInt xs’ , )

fitness int =
let max _ err = 1000.0 in
max _ err ( min ( err int ) max _ err )

При скрещивании создается полином, коэффициенты в котором вычислены, как среднее между соответствующими коэффициентами у родителей. При мутации происходит изменение случайного коэффициента, пропорциональное текущему значению коэффициента. Функция приспособленности вычисляется, как некое максимальное значение ошибки минус максимальное отклонение функции от синуса в точках, принадлежащих [0; π/2], с шагом 0.001.

При популяции размером 64 и вероятности мутации 0.1 интерполяция с ошибкой не более 0.0002 находится примерно за 8 поколений. На четырехядерном процессоре Intel Core i7-3770 3.40GHz в один поток программа отрабатывает примерно за 2.6 секунды. При запуске программы с флагами +RTS -N она же отрабатывает примерно за 0.7 секунд, что в 3.7 раза быстрее. Несмотря на то, что тут нельзя сделать точный замер , так как ГА недетерминирован по свой природе, многократное ускорение очевидно и заметно невооруженным взглядом.

На момент написания этой заметки я все еще ждал получения прав на загрузку пакетов на Hackage. В настоящее время их выдают руками после запроса по e-mail. Как только у меня появятся эти права, пакет станет доступен на Hackage. Тем временем, если у вас возникли вопросы или появились какие-то интересные мысли по поводу написанного, не стесняйтесь пользоваться комментариями.

Дополнение: (1) Пакет уже доступен на Hackage, (2) пример решения еще одной интересной задачки при помощи приведенной библиотеки можно найти здесь , (3) если вы интересуетесь алгоритмами ИИ, вас также может заинтересовать моя библиотека для работы с многослойными нейронными сетями .

EnglishRussianUkrainian