The Little Haskeller

Занятные ЖЖ

2008-01-28T18:27:09Z

Просто не могу не пропиарить два ЖЖ, на которые я наткнулся недавно:

Культовый Журнал некоей Корпускулы (Насти)
и
ЖЖ Истинного Учителя Истины Авраама Болеслава Покоя.

Несмотря на такие странные названия эти выдающиеся ЖЖ просто must read! :о)

Побег от Зурга

2007-11-26T18:21:49Z

Я тут как-то на досуге перевёл статью Мартина Эрвига "Побег от Зурга". В этой статье показывается, как на Хаскелле решаются типичные прологовские задачи поиска с возвратом, и рассказывается, что Хаскелл гораздо проще для студентов, чем Пролог...

Побег от Зурга

Упражнение в логическом программировании

Мартин ЭРВИГ

School of EECS, Oregon State University, Corvallis, Oregon 97331, USA
(e-mail: erwig@cs.orst.edu)

Оригинал статьи: http://web.engr.oregonstate.edu/~erwig/papers/Zurg_JFP04.pdf

Аннотация

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

1. Введение

Принято считать, что Пролог - наиболее подходящий язык для решения поисковых задач. Одна из сильных черт Пролога - его встроенный поиск с возвратами (бэктрекинг), который может значительно сократить работу в поисковых задачах. С другой стороны, Хаскелл (Peyton Johnes, 2003) предоставляет мощную систему типов, функции высшего порядка и отложенные (ленивые) вычисления. Мы хотим показать в этой статье, что эти свойства, взятые вместе, позволяют выражать и решать поисковые задачи на Хаскелле так же легко, как и на Прологе (и, возможно, даже легче). Например, отложенные вычисления облегчают краткое описание пространства поиска, поскольку спецификация бесконечной структуры данных - дерева перебора - может быть записана без зацикливания, так как вычисляется только конечная её часть. Эта идея не нова, она была описана раньше Филом Вадлером (Wadler, 1985). Тем не менее, переписывание кода в каждой поисковой задаче из-за малейшей мелочи - скучно, ненадёжно, и может отвлекать от самой реализуемой поисковой задачи. Концепция классов типов (далее просто классов) в Хаскелле предлагает простой способ сформулировать решение один раз и повторно использовать его в разных случаях. К тому же, типы данных Хаскелла позволяют (и в некоторой степени заставляют) формулировать задачу в адекватной форме.

Альтернативный подход - встраивание Пролого-подобного языка в функциональный язык. Это было продемонстрировано для Хаскелла (Seres & Spivey, 1999; Claessen & LjunglЁo, 2000) и Scheme (Haynes, 1987). Однако, наша цель - выразить поисковые задачи функционально, без применения мультипарадигмального подхода.

Пример, который мы рассмотрим - это домашнее задание, которое мы даём в аспирантском курсе языков программирования (Erwig, Fall 2001). Эта задача была одним из нескольких упражнений по практикуму программирования на Прологе. После наблюдений того, как многие студенты испытывают сложности в манипулировании структурами термов в Прологе (уже после изучения использования типов данных в Хаскелле) и тратят много времени на отладку, возник вопрос, насколько сложно разработать решение этой задачи на Хаскелле. Это программистское упражнение получилось успешным, о чём мы и мы сообщаем в этой статье.

В оставшейся части статьи мы опишем требования к обучению программированию поисковых задач на Хаскелле в главе 2. В главе 3 описан пример задачи. В главе 4 мы покажем решение задачи на Прологе. Глава 5 представляет решение задачи Хаскелле. Завершают статью выводы, данные в разделе 6.

2. Обучение поисковому программированию на Хаскелле

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

Во-первых, классы используются для разделения общего описания поисковых задач от частной задачи. В частности, мы используем мультипараметрические классы для параметризации поисковой задачи типом состояний и типом ходов. Нет необходимости углублённо знать мультипараметрические классы. Фактически, класс SearchProblem может служить мотивационным примером для введения в мультипараметрические классы. Сам класс может быть разработан поэтапно. В начале может быть определена версия с одним параметром (переменной типа), которая параметризуется только типом состояний поиска. Затем, обнаружив, что для некоторых поисковых задач, как, для той, например, что обсуждается здесь, состояния решений не так интересны, как предшествовавшие им ходы, может быть произведено обобщение до двух параметров - переменных типов.

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

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

Реализация поисковых задач обсуждалась всего лишь в нескольких книгах по ML и Хаскеллу. Например, Паульсон описал реализацию поискового программирования на ML для доказательства теорем (Paulson, 1996). Раби и Лапальм описывали, как реализовать алгоритмы бектрекинга на Хаскелле (Rabhi & Lapalme, 1999). Они использовали явно определённый алгоритм поиска в глубину и не использовали классы для отделения класса задачи от приложений. В частности, они не выделяли отдельный тип для ходов, который может описать подход независимо от примера задачи, обсуждающейся здесь. Фелляйсен и др. описывали в своей книге (Felleisen et al., 2001) похожий пример, задачу о трёх миссионерах и каннибалах, пересекающих реку. Этот пример был дан как упражнение по программирования с использованием рекурсии и накопительных параметров (аккумуляторов), которые очень подробно обсуждаются как средство хранения контекстной информации в рекурсивных функциях.

3. Пример задачи

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

Базз, Вуди, Рекс и Хэмм убегают от Зурга*. Им осталось только перейти через последний мост, и они будут свободны. Однако, мост очень ветхий и сможет одновременно выдержать только двоих из них. Также, что бы перейти мост и не попасть в ловушки и ямы в нём, нужен фонарик. Проблема в том, что у наших четырёх друзей всего один фонарик и заряда батареи в нём осталось всего лишь на 60 (шестьдесят) минут. Игрушки могут перейти мост в одну сторону за различное время:

Игрушка      Время
Базз        5 минут
Вуди       10 минут
Рекс       20 минут
Хэмм       25 минут

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

Итак, задача такова: в каком порядке эти четыре игрушки должны пересечь мост за время не более 60 минут, что бы спастись от Зурга?

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

* Это персонажи из мультфильма "Игрушечная история 2" (Toy Story 2)

4. Решение на Прологе

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


time(buzz,  5).
time(woody,10).
time(rex,  20).
time(hamm, 25).

toys([buzz,hamm,rex,woody]).

cost([],0) :- !.
cost([X|L],C) :-
     time(X,S),
     cost(L,D),
     C is max(S,D).

split(L,[X,Y],M) :-
     member(X,L),
     member(Y,L),
     compare(<,X,Y),
     subtract(L,[X,Y],M).

move(st(l,L1),st(r,L2),r(M),D) :-
     split(L1,M,L2),
     cost(M,D).

move(st(r,L1),st(l,L2),l(X),D) :-
     toys(T),
     subtract(T,L1,R),
     member(X,R),
     merge_set([X],L1,L2),
     time(X,D).

trans(st(r,[]),st(r,[]),[],0).
trans(S,U,L,D) :-
     move(S,T,M,X),
     trans(T,U,N,Y),
     append([M],N,L),
     D is X + Y.

cross(M,D) :-
     toys(T),
     trans(st(l,T),st(r,[]),M,D0),
     D0=<D.

solution(M) :- cross(M,60).

Врезка 1. Решение головоломки Зурга на Прологе.

Идея программы на Прологе заключается в представлении промежуточных состояний переходов через мост фактами вида st(P,L), где L - список игрушек, находящихся в данный момент на левой стороне моста, а P - признак, показывающий положение фонарика (левая или правая сторона)**.

Предикат move/4 генерирует ходы в своём третьем аргументе; переход направо генерируется в случае, если фонарик находится на левой стороне, и наоборот; ход также связывает старое состояние (первый аргумент) с полученным новым состоянием (второй аргумент). Последний аргумент выдаёт время, необходимое для хода.

В случае перехода направо время определяется дополнительным предикатом cost/2, вычисляющим максимальное время, необходимое группе игрушек. Каждая допустимая группа игрушек, двигающаяся направо, вычисляется предикатом split/3, выдающий списки длины 2, которые отсортированы для избежания избыточности, полученной представлением групп игрушек в списках.

При переходе налево есть смысл посылать назад только одну игрушку. Поэтому определение хода в этом случае использует предопределённый предикат member/2 и вычисляет время, просто просматривая таблицу time/2.

Наконец, предикат trans/4 в основном генерирует все возможные переходы через мост вместе с требуемым временем, тогда как предикат cross/2 формулирует поисковую задачу, задавая начальную и конечную конфигурации пространства поиска.

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

5. Решение на Хаскелле

Решение на Хаскелле мы получаем в два этапа. Во-первых, мы извлекаем общую структуру поисковой задачи и храним её в определении класса. Во-вторых, мы представляем программу решения головоломки как экземпляр этого класса.

Главные элементы задачи - это состояния (представляющие промежуточные стадии переходов через мост) и ходы (представляющие переходы между состояниями, в данном случае - пересечения моста). Поэтому мы определили класс SearchProblem с двумя переменными-типами s и m. Далее, мы обдумаем, какие методы нужны классу SearchProblem.

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

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


trans :: s -> [(m,s)]

Повторяющимся применением функции trans к листьям дерева перебора может быть построено полное пространство поиска. Это пространство поиска представлено элементами типа Space m s и построено функцией space, которая отображает состояние в список всех узлов пространства поиска. Каждый узел образует пару со списком ходов, ведущих к нему.

Так как пространство поиска полностью представляется начальным состоянием и функцией trans, функция space является производным методом класса SearchProblem. Описание space показывает важность использования отложенных вычислений: space ссылается на себя (косвенно через expand) без условия завершения; при строгом вычислении это определение будет, в общем, зацикливающимся. В данном примере это означает, что достаточно учесть всего два случая в определении функции trans (см. врезку 3); дополнительное определение

trans (R,[]) = []

не нужно, хотя это условие необходимо в программе на Прологе (сравните первое предложение в предикате trans).

В общем, решения поисковой задачи даны подмножеством её состояний. Выбор решения производится предикатом от состояний и генерируемых ими ходов:

isSolution :: ([m],s) -> Bool

С этим предикатом может быть определён другой метод - solutions, который имеет тот же тип, что и space, и который просто выдаёт подмножество состояний, удовлетворяющих условию предиката isSolution. Определение класса SearchProblem полностью приведено во врезке 2.

type Space m s = [([m],s)]

class SearchProblem s m where

    trans :: s -> [(m,s)]
    isSolution :: ([m],s) -> Bool
    space, solutions :: s -> Space m s

    space s = step ++ expand step
      where step = [ ([m],t) | (m,t) <- trans s ]
            expand ss = [ (ms++ns,t) | (ms,s) <- ss,
                                       (ns,t) <- space s ]

    solutions = filter isSolution . space

Врезка 2. Класс SearchProblem.

Имея определение схемы решения, программа для решения загадки на Хаскелле нуждается только в моделировании задачи. Самые важные проектные решения - это определения типов BridgePos и Move, так как они определяют экземпляр класса SearchProblem. В BridgePos мы представляем положение фонарика конструкторами L или R и список игрушек, которые находятся на левой стороне моста, точно так же, как и в реализации на Прологе.

Ход - это или переход группы из двух игрушек слева направо, или обратный переход всего одной игрушки справа налево. Оба вида ходов указаны типом Move, который определён через тип данных Either, являющийся предопределённым в Хаскелле, и имеющий конструкторы Left и Right для представления несовместимых комбинаций типов.

data Toy = Buzz | Hamm | Rex | Woody deriving (Eq,Ord,Show)
data Pos = L | R deriving (Eq,Show)
type Group = [Toy]
type BridgePos = (Pos,Group)
type Move = Either Toy Group

toys :: [Toy]
toys = [Buzz,Hamm,Rex,Woody]

time :: Toy -> Int
time Buzz  = 5
time Woody = 10
time Rex   = 20
time Hamm  = 25

duration :: [Move] -> Int
duration = sum . map (either time (maximum . map time))

backw :: Group -> [(Move,BridgePos)]
backw xs = [(Left x, (L, sort (x:(toys \\ xs)))) | x <- xs]

forw :: Group -> [(Move,BridgePos)]
forw xs = [(Right [x,y], (R, delete y ys)) |
              x <- xs, let ys=delete x xs, y <- ys, x < y]

instance SearchProblem BridgePos Move where

    trans (L,l) = forw l
    trans (R,l) = backw (toys \\ l)

    isSolution (ms,s) = s == (R,[]) && duration ms <= 60

solution :: Space Move BridgePos
solution = solutions (L,toys)

Врезка 3. Решение головоломки Зурга на Хаскелле.

Кроме определения типов для представления объектов в программе, важная часть -- это определение экземпляра класса SearchProblem, который предназначен для того, что бы дать определения функций trans и isSolution. И наконец, мы определили три вспомогательные функции: forw и backw для вычисления ходов игрушек и duration для вычисления общего времени перехода, в данном случае, для последовательности ходов. Напомним, что функция (\\) вычисляет разность двух списков. Определение предиката isSolution очевидно. Полный текст решения задачи на Хаскелле приведено во врезке 3.

Мы уже упоминали, что класс SearchProblem во врезке 2 реализует простой поиск в ширину. Можно получить обобщение абстрагированием операции добавления сгенерированных новых состояний в список состояний; для этого мы вводим в определения space и solutions параметр-функцию, контролирующую добавление новых состояний в пространство поиска. Возможная реализация показана во врезке 4.

type Space m s = [([m],s)]
type Strategy m s = Space m s -> Space m s -> Space m s

class SearchProblem s m where

  trans :: s -> [(m,s)]
  isSolution :: ([m],s) -> Bool
  space, solutions :: Strategy m s -> s -> Space m s

  space f s = expand f (step ([],s))
    where expand f [] = []
          expand f (s:ss) = s:expand f (f (step s) ss)
          step (ms,s) = [(ms++[m],t) | (m,t) <- trans s]

  solutions f = filter isSolution . space f

dfs = (++)
bfs = flip dfs

Врезка 4. Обобщённый класс SearchProblem.

Что бы использовать обобщённый класс в нашем примере, нам нужно всего лишь передать экземпляру класса соответствующую поисковую стратегию функции solutions:

solution = solutions bfs (L,toys)

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

Примечание от переводчика:

Так как мультипараметрические классы типов являются расширением стандарта Haskell 98, для выполнения этой программы на GHC или GHCi следует задать в командной строке опцию -fglasgow-exts, а в HUGS – опцию -98.

Так же неплохо бы указать импорт модуля List, который содержит определения нужных программе функций (\\) и sort.

6. Выводы

Давайте сначала просуммируем наш опыт, полученный с приведённым упражнением. Большинство студентов любят задания в виде головоломок, хотя довольно много студентов имеют проблемы при их решении и тратят значительное время на отладку программ. Часть проблем была вызвана неправильным использованием термов, что приводило интерпретатор только к ответу No. Другой ошибкой было смешивание термов и предикатов. В некоторой степени за эту ошибку, возможно, ответственны совершенно разные лексические соглашения в Хаскелле и Прологе: имена переменных начинаются с прописной буквы в Прологе и со строчной в Хаскелле, тогда как имена конструкторов термов начинаются со строчной буквы в Прологе и с прописной - в Хаскелле.

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

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

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

Благодарности

Автор благодарит Маттиаса Фелляйсена за его ценные советы и замечания, которые помогли улучшить эту статью. Также большое спасибо студентам кафедры языков программирования, сообщившим о своём опыте с Хаскеллом, Прологом, типами и т.д.

Ссылки

Claessen, K., & LjunglЁo, P. (2000). Typed Logical Variables in Haskell. Haskell Workshop. Electronic Notes in Theoretical Computer Science, Vol. 41, No. 1.

Erwig, M. (Fall 2001). CS 581: Programming Languages. Graduate Course. Department of Computer Science, Oregon State University. http://www.cs.orst.edu/~erwig/old/cs581.f01.

Felleisen, M., Findler, R. B., Flatt, M., & Krishnamurthi, S. (2001). How to Design Programs—An Introduction to Programming and Computing. Cambridge, MA: MIT Press.

Haynes, C. T. (1987). Logic Continuations. The Journal of Logic Programming, 4, 157–176.

Paulson, L. C. (1996). ML for the Working Programmer (2nd ed.). Cambridge, NY: Cambridge University Press.

Peyton Jones, S. (2003). Haskell 98 Language and Libraries. Cambridge, UK: Cambridge University Press.

Rabhi, F., & Lapalme, G. (1999). Algorithms: A Functional Programming Approach. Harlow, England: Addison-Wesley.

Seres, S., & Spivey, M. (1999). Embedding Prolog in Haskell. Haskell Workshop. Technical Report UU-CS-1999-28, Universiteit Utrecht.

Wadler, P. (1985). How to Replace Failure by a List of Successes. Pages 113–128 of: Conf. on Functional Programming and Computer Architecture. LNCS 201.

Ещё одно решение "Проблемы К" на Хаскелле

2007-11-11T21:08:14Z

Я тоже не смог удержаться, и вслед за Сергеем Зефировым и Булатом Зиганьшиным тоже сделал своё решение этой задачки.

Кратко о задаче:

Необходимо реализовать простую электронную таблицу в виде программы, выполняющейся из командной строки. Она должна уметь обрабатывать ячейки таблицы как и более продвинутые аналоги, только с упрощенным синтаксисом выражений. Каждая ячейка может содержать:
- Ничего
- Неотрицательное целое число
- Текстовые строки, которые начинаются с символа '
- Строки-выражения, которые начинаются с символа '=' и могут содержать неотрицательные целые числа, ссылки на ячейки и простые арифметические выражения. Скобки запрещены, у всех операций одинаковый приоритет. Ссылки на ячейки состоят из одной латинской буквы и следующей за ней цифры.
Читать описание полностью...

Автор задачи, ЖЖ-юзер gaperton, опубликовал предысторию этой задачи: "О дизайне и ФП", а также поделился своим решением задачи на RSDN.ru

Также стало доступно модуляризованное решение на Хаскелле (чего так хотел увидеть Гапертон) от NGGU...

А вот и моё решение:


module Main where

import Char (isAlpha, isAlphaNum, isDigit)
import List (nub, groupBy, sort, (\\), union, intersect)
import Data.Graph (SCC(CyclicSCC), stronglyConnComp, flattenSCCs)

--------------------------------------------------------------------------------
-- | Главная функция: считать со stdin таблицу, вычислить и распечатать в stdout

main = print . calculate =<< getSheet

--------------------------------------------------------------------------------
-- Вспомогательные функции

--------------------------------------------------------------------------------
-- | Перевёрнутый оператор $

x |> f = f x; infixl 0 |>

--------------------------------------------------------------------------------
-- | Считать со stdin таблицу в список табличных строк,
--   каждая из которых в виде списка столбцов (в строковом представлении)

getSheet :: IO (Sheet Integer)
getSheet = getIntegralSheet


getIntegralSheet :: (Integral a, Read a) => IO (Sheet a)
getIntegralSheet = do
    s <- getLine
    let (r:_) = words s
        rows  = read r
    ss <- sequence $ replicate rows $ getLine
    return $ read $ s ++ "\n" ++ unlines ss
  `catch` \_ -> do
    return $ read "1\t1\n'#Error: no data"

--------------------------------------------------------------------------------
-- Типы данных

--------------------------------------------------------------------------------
-- | Класс типов вычислимых объектов

class Calculable a where
    calculate :: a -> a

--------------------------------------------------------------------------------
-- | Бинарные операции

type BinOp a = a -> a -> a
type StrOp   = BinOp String

--------------------------------------------------------------------------------
-- | Результат запроса на вычисление функции Func

data (Num a) => FResult a
    = FRErr String                  -- Ошибка при вычислении
    | FRNum a                       -- Результат: число
    | FRStr String                  -- Результат: строка


instance (Show a, Num a) => Show (FResult a) where
    show (FRErr s) = "#" ++ s
    show (FRNum n) = show n
    show (FRStr s) = s

--------------------------------------------------------------------------------
-- | Бинарные операции

data (Num a) => Func a
    = FNum String (BinOp a)         -- Арифметическая функция
    | FStr String StrOp             -- Строковая функция
    | FErr String                   -- Недопустимая функция
    | FQrN (Func a) a a             -- Запрос на вычисление арифмет. функции
    | FQrS (Func a) String String   -- Запрос на вычисление строковой функции
    | FRes (FResult a)              -- И результат вычисление


instance (Show a, Num a) => Show (Func a) where
    show (FNum s _)            = s
    show (FStr s _)            = s
    show (FQrN (FNum s _) a b) = show a ++ s ++ show b
    show (FQrS (FStr s _) a b) = show a ++ s ++ show b
    show (FRes r)              = show r
    show _                     = "_?_"


instance (Integral a) => Read (Func a) where
    readsPrec _ s = [(case s of
                        "+"  -> FNum s (+)
                        "-"  -> FNum s (-)
                        "*"  -> FNum s (*)
                        "/"  -> FNum s div
                        "^"  -> FNum s (^)
                        "++" -> FStr s (++)
                        "--" -> FStr s (\\)
                        "**" -> FStr s union
                        "//" -> FStr s intersect
                        s    -> FErr s
                    , "")]


instance (Num a) => Calculable (Func a) where
    ----------------------------------------------------------------------------
    -- Безопасное вычисление арифметической операции

    calculate (FQrN (FErr s)     _ _) = FRes $ FRErr $ "Op:" ++ s
    calculate (FQrS (FErr s)     _ _) = FRes $ FRErr $ "Op:" ++ s
    calculate (FQrN (FNum "/" _) a 0) = FRes $ FRErr "Inf"
    calculate (FQrN (FNum  _  f) a b) = FRes $ FRNum $ a `f` b
    calculate (FQrN (FStr  _  _) _ _) = FRes $ FRErr $ "StrOp on Numbers"
    calculate (FQrS (FStr  _  f) a b) = FRes $ FRStr $ a `f` b
    calculate (FQrS (FNum  _  _) _ _) = FRes $ FRErr $ "NumOp on Strings"
    calculate _                       = FRes $ FRErr $ "Query"

--------------------------------------------------------------------------------
-- | Содержимое ячейки таблицы

type IdCell a = (String, Cell a)

data Cell a
    = CNull                               -- Пустая ячейка
    | CNum a                              -- Целочисленная константа
    | CRef String                         -- Ссылка на ячейку
    | CStr String                         -- Строковая константа
    | CErr String                         -- Ячейка с какой-то ошибкой
    | CFun (Func   a) (Cell  a) (Cell a)  -- Формула
    | CQry (IdCell a) (Sheet a)           -- Запрос на вычисление ячейки в контексте таблицы


instance (Show a, Integral a) => Show (Cell a) where
    show  CNull       = " "
    show (CNum n)     = show n
    show (CRef s)     = s
    show (CStr s)     = s
    show (CErr s)     = "#" ++ s
    show (CFun f x y) = show x ++ show f ++ show y
    show (CQry c sh)  = show c ++ show sh


instance (Read a, Integral a) => Read (Cell a) where
    readsPrec _ s = [(parse s, "")]
      where
        -- Разбор ячейки из строкового вида
        parse :: ( Read a, Integral a) => String -> Cell a
        parse ""                     = CNull                             -- Пустая ячейка
        parse str@(s:ss) | isDigit s = readNumb str                      -- Целочисленная константа
                         | s == '\'' = CStr ss                           -- Строковая константа
                         | s == '='  = pars $ reverse $ lines $ items ss -- Формула
                         | otherwise = CErr "Parse"                      -- Что-то не то...

        -- Вставить перенос строки между элементами формулы
        items :: String -> String
        items s = case span isAlphaNum s of
                    ("",   "")       -> ""
                    (left, "")       -> left
                    (left, op'right) -> left ++ "\n" ++ op ++ "\n" ++ items right
                        where (op, right) = break isAlphaNum op'right

        -- Преобразовать перевёрнутый список элементов формулы в саму формулу
        pars :: (Read a, Integral a) => [String] -> Cell a
        pars [x]      = pars' x                           -- Число или ссылка на ячейку
        pars (r:o:xs) = CFun (read o) (pars xs) (pars' r) -- Операция над двумя элементами
        pars xs       = CErr "Expr"                       -- Какая-то ошибка в формуле

        pars' s@(x:xs) | isDigit x = readNumb s
                       | isAlpha x = CRef s
        pars' s                    = CErr s

        -- Попытаться прочесть целое число из строки
        readNumb s | all isDigit s = CNum $ read s
                   | otherwise     = CErr "NaN"           -- Not a Number


instance (Integral a) => Calculable (Cell a) where
    ----------------------------------------------------------------------------
    -- Вычисление ячейки таблицы

    calculate (CQry (cid, cell) (Sheet sh)) = calc cell
      where
        -- Вычислить ячейку
        calc (CFun f x y) = case (x, y) of
                              ((CNum a), (CNum b)) -> res          -- число с числом
                                where
                                  res = case calculate $ FQrN f a b of
                                           (FRes (FRNum n)) -> CNum n
                                           (FRes (FRErr s)) -> CErr s
                                           _                -> CErr "Calc"

                              ((CStr a), (CStr b)) -> res         -- строка со строкой
                                where
                                  res = case calculate $ FQrS f a b of
                                           (FRes (FRStr n)) -> CStr n
                                           (FRes (FRErr s)) -> CErr s
                                           _                -> CErr "Calc"

                              ((CRef _), _)        -> res         -- что-то с ячейкой
                              (_,        (CRef _)) -> res
                              ((CFun _ _ _), _)    -> res         -- что-то с формулой
                              (_,    (CFun _ _ _)) -> res
                              (err@(CErr _), _)    -> err
                              (_, err@(CErr _))    -> err
                              otherwise            -> CErr "Expr" -- ошибка в формуле
                            where
                              res = calc $ CFun f (calc x) (calc y)

        calc (CRef x)     = case lookup x sh of
                               Just z -> calc z                   -- вычислим ячейку
                               _      -> CErr "Cell"              -- нет такой ячейки
        calc x            = x

    calculate c = calculate $ CQry ("A1", c) (Sheet [])

--------------------------------------------------------------------------------
-- | Электронная таблица в виде списка кортежей,
--   первый элемент которых -- идентификатор ячейки (напр., "A1"),
--   а второй -- содержимое ячейки (напр., "=B2*5") в распарсенном виде

data Sheet a = Sheet [IdCell a]


instance (Show a, Integral a) => Show (Sheet a) where
    show (Sheet s) = s
                     -- Разобьём на строки
                  |> groupBy (\(_:a,_) (_:b,_) -> a == b)

                     -- Теперь сформируем столбцы табуляцией
                  |> map (map (\(_, x) -> show x ++ "\t"))

                     -- И превратим всё это в одну длинную строку
                  |> map concat
                  |> unlines


instance (Read a, Integral a) => Read (Sheet a) where
    readsPrec _ s = [(readSh s, "")]
      where
        readSh :: (Integral a, Read a) => String -> Sheet a
        readSh s  =  ss
                     -- Разобъём строки таблицы на кучи ячеек
                  |> map (lines . map (\c -> if c == '\t' then '\n' else c))

                     -- Если введено было меньше столбцов, чем нужно, то добавим пустые (Null)
                  |> map ((take columns) . (++ repeat ""))

                     -- Пронумеруем ячейки таблицы в виде "A1"
                  |> map (zip (['A'..'Z'] ++ ['a'..'z']) . map read)
                  |> zip (map show [1..])
                  |> map (\(n, s) -> map (\(c, f) -> (c:n, f)) s)

                     -- И превратим всё это в таблицу
                  |> concat
                  |> Sheet
          where
            (rc:ss) = lines s -- Разобьём входную строку на строки таблицы
            (_:o:_) = words $ rc ++ " 0"
            columns = read  o


instance (Integral a) => Calculable (Sheet a) where
    ----------------------------------------------------------------------------
    -- Вычисление всей таблицы

    calculate (Sheet sh) = Sheet sh'
      where
        -- Пройтись по всем элементам таблицы, пытаясь их вычислить
        sh' = sh
              -- Пометить зацикленные ячейки
           |> map (\c@(cid,_) -> if isCycled cid then (cid, CErr "Cycle") else c)

              -- Вычислить значения ячеек
           |> map (\c@(cid,_) -> (cid, calculate $ CQry c (Sheet sh')))

        -- Определить, зациклена ли ячейка
        isCycled :: String -> Bool
        isCycled x = x `elem` crefs
          where
            crefs = sh
                 |> map       (\(cid, cell) -> (cid, cid, cids cell))
                 |> stronglyConnComp
                 |> filter    isCyclic
                 |> flattenSCCs
                 |> sort
                 |> nub

            cids (CFun _ a b) = cids a ++ cids b
            cids (CRef cid)   = [cid]
            cids _            = []

            isCyclic (CyclicSCC _) = True
            isCyclic _             = False

У меня на это дело ушло где-то дня три-четыре. Чистого времени - больше суток...
Ох и намучился я с поиском циклических ссылок в ячейках таблицы... ~~Зато обошёлся без библиотеки графов...~~ :o)

На тестовый набор данных:

8	4
12	=C2	3	'Sample
=A1+B1*C1/5	=A2*B1	=B3-C3	'Spread
'Test	=4-3	5	'Sheet
""	=A9	=1/0	=A5
=B5+1	=1+A5+1	=5A	=A1++C1
=1+	x	' 	=D1+D2
=D1++D2	=D1--D2	=D1**D2	=D1//D2
=D1++C6++D2++C6++D3

программа выдаёт результат:

12	-4	3	Sample	
4	-16	-4	Spread	
Test	1	5	Sheet	
#Parse	#Cell	#Inf	#Cycle	
#Cycle	#Cycle	#NaN	#StrOp on Numbers	
#Expr	#Parse	 	#NumOp on Strings	
SampleSpread	ml	Samplerd	Sape	
Sample Spread Sheet

Update. С целью получения максимально идиоматического :о) хаскеллевского решения, радикально редизайнил программу, используя классы типов... ;о)
Update. Расширил набор операций операциями над строками: конкатенация, разность, объединение и пересечение (вообще-то это операции над множествами, но и для строк пойдут)
Update. Таки переделал алгоритм поиска зацикленных ячеек таблицы на графы...

Галерея художника Armodey Moro

2007-09-15T16:54:29Z

Не могу не пропиарить галерею брата моего друга.
Armodey Moro (Артём Плужников) - художник-авангардист, пишет весьма интересные картины, например:

Ну и т.д... :о) Вопщем, их там много... Обязательно посетите!

Задачки из SICP

2007-09-13T20:08:45Z

Группа энтузиастов (пока из двух человек: IvanVeselov aka dying_sphynx и я) решили открыть свой вики-сайтик, посвящённый решению задачек из культового учебника по программированию "Структура и интерпретация компьютерных программ" (SICP).
Решения задач будут на языках Scheme, Haskell, Oberon/Component Pascal, возможно ещё на каких-нибудь...
Приглашаем всех желающих!

Арифметика с IORef

2007-08-24T16:57:06Z

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

Продолжение в ru_declarative

Флешмоб на www.chirchik.ru

2007-06-29T16:28:20Z

Только что поучаствовал на флешмобе на сайте, посвящённому городу, где я живу. Сам сайт российский, но создатели - выходцы из Чирчика, что рядом с Ташкентом, столицей Узбекистана. Веб-мастер сайта - Димка Ковригин - мой бывший сотрудник.

Так это, собственно, акция - попытка попасть в книгу Рекордов Гинесса.

Оказывается, до сих пор ещё нет рекорда по одновременному посещению сайта...
На момент фиксации рекорда (29 июня 2007 г., 20:07 по Москве) на сайте было около сорока человек, около тридцати зашли как пользователи...
Очень мало, учитывая, что есть сайты, на которых одновременно тусуются более миллиона человек. И если рекорд будет таки зафиксирован, его тут же перебьют, причём многократно...

Но тем не менее, если рекорд зафиксируют, то мы будем первыми!!! :-Р

Ой, лол-то какой... :о))

2007-06-28T16:25:32Z

My blog is worth $0.00.
How much is your blog worth?

__________________

Update 24.11.2007 :о)

My blog is worth $564.54.
How much is your blog worth?