PythonChallenge.com in Haskell, уровни 0-4

[dastapov]

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

Just for fun я попробовал сделать ее на Haskell. И вот что получилось...

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

module Main where

import Data.Char
import Data.List
import Network.HTTP
import Network.URI
import Network.Browser
import Data.Maybe

main = print "Doing pythonchallenge.com in Haskell :)"

---------------
-- Уровень 0 --
ch0 = print $ 2^38

-- Результат: 
-- *Main> ch1
-- 274877906944

---------------
-- Уровень 1 --

ch1_text = "g fmnc wms bgblr rpylqjyrc gr zw fylb. 
  rfyrq ufyr amknsrcpq ypc dmp. bmgle gr gl zw fylb gq glcddgagclr ylb rfyr'q ufw rfgq rcvr gq qm jmle.
  sqgle qrpgle.kyicrpylq() gq pcamkkclbcb. lmu ynnjw ml rfc spj."

-- Судя по картинке, прилагающейся к тексту задания, это - простой циклический подстановочный шифр с шагом 2.
-- Проще говоря, каждая буква сдвинута по алфавиту на две позиции назад.
-- Будем декодировать при помощи словаря подстановок:
dict = zip ['a'..'z'] (drop 2 $ cycle ['a'..'z'])

-- Получаем список пар:
-- *Main> take 10 dict
-- [('a','c'),('b','d'),('c','e'),('d','f'),('e','g'),('f','h'),('g','i'),('h','j'),('i','k'),('j','l')]
-- *Main> lookup 'o' dict
-- Just 'q'
-- *Main> lookup ' ' dict
-- Nothing

-- В исходном тексте есть не только буквы, но и точки-запятые, пробелы и т.п. Их декодировать не надо.
-- Сделаем свой аналог 'lookup' для этих целей:
translate c = case lookup c dict of
                Nothing -> c
                Just t  -> t

-- Собственно, результат:
ch1 = map translate ch1_text

-- *Main> ch1
-- "i hope you didnt translate it by hand. thats what computers are for. doing it in by hand is inefficient and 
--  that's why this text is so long. using string.maketrans() is recommended. now apply on the url." 
-- *Main> map translate "map"
-- "ocr"

---------------
-- Уровень 2 --

-- В длинном-длинном тексте, который можно увидеть, сделав 'View page source', надо найти "редкие буквы". 
-- Поначалу я думал, что надо посчитать, какие символы входят в текст реже всего и вывести их, но похоже,
-- что задачка значительно проще: буквы (а не спец. символы) в этом тексте действительно выстречаются крайне
-- редко. И надо найти и вывести именно их. 
ch2 = do
 txt <- readFile "ch2_text.in"
 return $ filter isAlpha txt

-- *Main> ch2
-- "equality"

---------------
-- Уровень 3 --
-- В длинном-длинном тексте необходимо найти все прописные буквы, окруженные с двух сторон ровно тремя строчными.
-- Очевидно, что это задачка на использование regexp-ов. Исключительно хохмы ради я решил ее без регекспов :)

-- Для начала разбиваем текст на последовательности, состоящие из букв одного регистра:
sameRegister x y = isLower x == isLower y
tokenize = groupBy sameRegister

-- *Main> tokenize "AAAAbbbCCdEfffGhIjjj"
-- ["AAAA","bbb","CC","d","E","fff","G","h","I","jjj"]

-- Разбиваем поток токенов на тройки:
triplicate lst = zip3 lst (drop 1 lst) (drop 2 lst)

-- *Main> triplicate $ tokenize "AAAAbbbCCdE"
-- [("AAAA","bbb","CC"),("bbb","CC","d"),("CC","d","E")]

-- Эта функция проверяет, попадает ли конкретная тройка под условия задачи.
guardedLetter (tok1, tok2, tok3) = 
  and [ all isUpper tok1, length tok1 == 3
      , all isUpper tok3, length tok3 == 3
      , all isLower tok2, length tok2 == 1]

-- *Main> guardedLetter ("AAA","b","CCC")
-- True
-- *Main> guardedLetter ("aaa","B","ccc")
-- False

-- Функция-helper, извлекающая средний элемент из тройки
extractLetter (_,l,_) = l

-- Складываем все вместе:
ch3 =
  do txt <- readFile "ch3_text.in"
     return $ concatMap extractLetter $ filter guardedLetter $ triplicate $ tokenize txt

-- *Main> ch3
-- "linkedlist"

---------------
-- Уровень 4 --

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

-- Я до сих пор почти не пользовался модулями Network.*, поэтому наверняка мой код можно переписать в 5 раз короче :)

-- Эта функция вытягивает страницу с указаным адресом и возращает ее тело в виде строки.
slurpPage address = 
  do (Right result) <- simpleHTTP $ defaultGETRequest $ fromJust $ parseURI address
     return $ rspBody result

-- Берем число-параметр, вытаскиваем соотв. страницу, вынимаем из нее ключ, возвращаем его.
getNextKey key =
  do let base = "http://www.pythonchallenge.com/pc/def/linkedlist.php?nothing="
     txt <- slurpPage $ base ++ key
     return $ last $ words txt

-- Берем начальное число-параметр, идем по цепочке страниц до тех пор, пока можем вытаскивать
-- из тела страницы следующее число.
loopTheLoop key =
  do next_k <- getNextKey key
     case (all isDigit next_k) of
          True -> do putStrLn (key ++ " -> " ++ next_k)
                     loopTheLoop next_k
          False -> return next_k

-- Результат: "peak"

---

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

Comments

[tranvi.livejournal.com]

Красиво.

Начинаю думать о том, что надо бы изучить Haskell...

[migmit.livejournal.com]

Первое замечание (текст пока не читал): ссылку поправь.

[http://users.livejournal.com/_adept_/]

Интересно, сколько еще я буду наступать на эти грабли? :)

Re: список

[http://users.livejournal.com/_adept_/]

Это то, что де-сериализуется в пятом задании, так?

[darkk.livejournal.com]

ссылка "очередной сайт" битая (вместо href="pythonchallenge.com" лучше бы href="http://pythonchallenge.com", а то firefox бунтует)

[feb-13.livejournal.com]

сделал всё то же на перле :-) прикольно
не могу вдуплить, что делать дальше с leak help :-/

[feb-13.livejournal.com]

туплю на http://pythonchallenge.com/pc/def/peak.html

[migmit.livejournal.com]

Замечательная иллюстрация того факта, что каждой задаче нужен свой инструмент.
Уровень 1: , выскакивает калькулятор, 2^38
Уровень 2: Хаскель, однострочник с явным разбором двух левых случаев (лень было оптимизировать): \x -> if x `elem` ['a'..'x'] then succ $ succ x else if x == 'y' then 'a' else if x == 'z' then 'b' else x
Уровень 3: Загружаем текст в emacs, регэкспом выкидываем всё, что не буква.
Уровень 4: Загружаем текст в emacs, регэкспом помечаем тегами всё, что удовлетворяет критерию, другим регэкспом удаляем всё, что вне тегов, третьим - заменяем каждое вхождение на соотв. букву.
Уровень 5: bash:

a=12345; while a=`wget -q -O - http://pythonchallenge.com/pc/def/linkedlist.php?nothing=$a | grep -o '[0-9]+'`; do echo $a; done

Пояснения (чтобы в man не заглядывать): "-q" - подавить вывод диагностических сообщений (нафиг они мне), "-O -" - выдавать документы на стандартный вывод, "-o" - выводить только проматчившуюся часть. В двух случаях облома меняем в этой строке начальное значение a и продолжаем. В конце - смотрим последнюю найденную страницу в браузере.

[migmit.livejournal.com]

Блин, теги съелись: Уровень 1 - <NumLock>, выскакивает калькулятор, 2^38 <Enter>

Re: Reply to your comment...

[migmit.livejournal.com]

Ещё раз, для тупых:

В двух случаях облома меняем в этой строке начальное значение a и продолжаем

Уровень с лишними цифрами обнаружился один. На несколько строк мне насрать.

[dendik.livejournal.com]

Уровень 1: bc
Уровень 2: caesar
Уровень 3: tr
Уровень 4: sed
Уровень 5: sh+wget+sed

[migmit.livejournal.com]

Я, в основном, интерактивными инструментами пользуюсь. Чтобы поправить то, что нужно поправить.

[dendik.livejournal.com]

Эээ...

Мысль для меня слишком глубока. А кто мешает подправить выражение в sed или bc?

Re: Reply to your comment...

[migmit.livejournal.com]

Никто. Но делать несколько regexp-преобразований в emacs-е нагляднее, чем в sed'е. Разница примерно та же, что и между обычным компилятором и repl.

[migmit.livejournal.com]

Ы? Задача про zip comments решилась использованием unzip -v с последующим превращением в emacs-е полученного списка в sed-программу.

Re: Reply to your comment...

[migmit.livejournal.com]

Не смотрел ещё, сорри. Работать иногда тоже надо.

[voldmar.livejournal.com]

Я про zip comments вообще понял. В чём там суть?

[http://users.livejournal.com/_adept_/]

Скоро напишу :)

Черт, затягивающая штука. Дошел уже до 20-го уровня ...

[voldmar.livejournal.com]

Да я уже понял суть. Меня сгубило то, что у меня WinRAR zip’ы открывает. Надо всё-таки чисто питоновые решения делать.

С картинкой ещё прикольнее, вечером буду думать. :-)

[jerom.livejournal.com]

Не надо "скоро"! Я не удержусь и прочитаю :-)

А сам пока только на 16м.

[http://users.livejournal.com/_adept_/]

А я уже на 24-м :)

[jerom.livejournal.com]

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

Вот только что вошёл на 18й и сил на сегодня больше нет.

18й пройду, наверное, очень быстро, вроде, простой, но если там далее типа 17го...

PS: называется: доагадайся, как я потерял авторизационную куку lj :-)

[http://users.livejournal.com/_adept_/]

Я просто сейчас в отпуске и у меня много времени :)

Мы с женой уже на 27-ом :)

[jerom.livejournal.com]

И всё на haskell? Неужели более ничего python-specific нет? И сколько на один уровень уходит?

Вообще же задачи очень неровные. Например, 18 (разница в картинках) и 19 (.wav) я прошёл очень быстро и не применяя программирования. 19 вообще издевательство, просто mplayerу параметры подобрал минут за 5 :)

Сейчас на 20м, LiveHTTP Headers от firefox помог понять, где найти private property, но сегодня уже реализовывать идеи не буду.

[jerom.livejournal.com]

Оказалось всё не так просто, потратил почти 50 минут, прочитал readme.txt. Теперь самое сложное: понять, что же там имелось ввиду.

[http://users.livejournal.com/_adept_/]

Есть одна полу-специфик, но гугл мне помог (возможно, просто повезло). За день получалось 2-3-4 уровня (посмотрели, осознали задачу, пошли чем-то заниматься, а оно на фоне крутится и мы его обсуждаем).

Мы дошли до 29-го и опять застряли.

[jerom.livejournal.com]

Я давно на 25м (паззл с водой), думаю, что первый шаг - пилить на куски, но пока лениво. Там более, что, как я понял, 26 потом не пройти так просто, а догадываться я не хочу.

[http://users.livejournal.com/_adept_/]

Пилите, Шура, пилите :)

Посказывать не буду, но с этого места начинается "реальная жесть"(тм). По крайней мере, для меня.

[jerom.livejournal.com]

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

[http://users.livejournal.com/_adept_/]

У меня - строчек 5-10. Подозреваю, что можно ужать и до одной, но спортивного интереса нет :)

[http://users.livejournal.com/_adept_/]

Ну, тут же цель была не вымести плац, а чтобы рядовой задолбался все сделать на Haskell :)

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

[palm-mute.livejournal.com]

sameRegister x y = isLower x == isLower y
tokenize = groupBy sameRegister

[http://users.livejournal.com/_adept_/]

Точно, туплю. Спасибо :)

[tarantul.livejournal.com]

А screencast почему то отвратительного качества...

[http://users.livejournal.com/_adept_/]

Который во flash-е, или который "download original file"?

[tarantul.livejournal.com]

Который во флеше.

[http://users.livejournal.com/_adept_/]

А который "original file"?

[tarantul.livejournal.com]

Не знаю где там original file, но то что дает скачивать по кнопке Download тоже какой-то все неправильное. Нормально не показывается ни vlc'ом, ни mplayer'ом.

[http://users.livejournal.com/_adept_/]

Понятно :(

Учтем на будущее ...

[cacha.livejournal.com]

Так это… как screencast'ы-то делать?