Форум программистов, компьютерный форум, киберфорум
Наши страницы
Haskell
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.75/4: Рейтинг темы: голосов - 4, средняя оценка - 4.75
Araneo
643 / 253 / 16
Регистрация: 02.03.2014
Сообщений: 583
1

Элегантное решение

01.02.2018, 00:12. Просмотров 706. Ответов 20
Метки нет (Все метки)

Предлагаю своеобразную игру, назовём её "Элегантное решение". Правила просты.

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

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

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

test "Alex" => True
test "Аlex" => False
test "Саша" => True
test "Cаша" => False
---

Мой вариант решения:
Haskell
1
2
3
4
5
6
7
8
9
10
en, ru :: String
en = ['a'..'z'] ++ ['A'..'Z']
ru = ['а'..'я'] ++ ['А'..'Я'] ++ "ёЁ"
 
-- даже странно, что такой нигде не нашлось...
xor :: Bool -> Bool -> Bool
xor a b = (a && not b) || (not a && b)
 
test :: String -> Bool
test xs = any (`elem`ru) xs `xor` any (`elem`en) xs
P.S. Можно несколько ускорить работу функции сделав en и ru множествами, но тогда мы потеряем в красоте кода.
2
Лучшие ответы (1)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
01.02.2018, 00:12
Ответы с готовыми решениями:

Подскажите элегантное программное решение
Спасибо что зашли ознакомиться с моей проблемой. А состоит она в следующем:...

3 числа по возростанию (элегантное решение vs быдлокод)
Вот задача)) Write a program that prompts the user to enter three integer...

Найти более элегантное решение считывания чисел в двоичном формате из файла
Задача такая: имеется файл, в котором записаны числа в двоичном формате, причем...

Найти решение уравнения, изоклинную и интегральную кривые, решение задачи Коши
Помогите пожалуйста! а) Найти решение вида: x=a,y=b,y=kx+b...

Аналитическое решение решение краевой задачи для ОДУ второго порядка
Здравствуйте! Задача: Аналитически найти частное решение ОДУ. Изначально в...

20
Mysterious Light
Эксперт по математике/физике
3963 / 1935 / 390
Регистрация: 19.07.2009
Сообщений: 2,962
Записей в блоге: 21
01.02.2018, 05:27 2
Цитата Сообщение от Araneo Посмотреть сообщение
xor a b = (a && not b) || (not a && b)
Почему ДНФ?

Моё решение лишь стилистически отличается.
Haskell
1
2
3
4
5
6
7
8
en, ru :: String
en = ['a'..'z'] ++ ['A'..'Z']
ru = ['а'..'я'] ++ ['А'..'Я'] ++ "ёЁ"
 
test :: String -> Bool
test xs = on (/=) isOfLang en ru
  where isOfLang = flip any xs . flip elem
  --    isOfLang lang = any (`elem` lang) xs
По SRP хочется выделить вспомогательную функцию.
При желании лёгким движением руки решение обобщается на произвольное количество непересекающихся алфавитов.

Моя задача:
Написать аналог JS Promise. Это объект, представляющий вычисляемое или запрашиваемое значение, которое может либо за конечное время сформироваться и тогда вызовется функция resolve для дальнейшей обработки, либо завершиться с ошибкой и тогда вызовется функция reject для обработки объекта ошибки.
Предполагаем, что работаем в IO.
- конструктор Promise (аналог new Promise), который функции \resolve reject -> ... resolve(value) ... reject(error) ... сопоставляет промис.
- конструктор valueP (аналог Promise.resolve) промиса, который соответствует заведомо разрешенному значению, которое передано в аргументе.
- функция разрешения resolveP (аналога нет, ибо асинхронные механизмы запускаются в момент определения промиса), которая интерпретирует промис.
- функция разрещения extractP (аналога нет, симулируется then+catch), которая принимает две дополнительные функции, которые вызывают в самом конце в случае успешного разрешения или ошибки, соответственно.
- комбинатор thenP (аналог Promise.prototype.then): promise `thenP` \value -> expr возвращает промис, значение которого есть значение промиса, которое возвращает expr после разрешения promise в value.

Пример:
Haskell
1
2
3
4
5
6
7
8
9
10
11
main =
  let
    len = Promise (\resolve reject -> getLine >>= resolve)
      `thenP` \str ->
        putStrLn str >> return (valueP (length str))
  in
    do
      putStrLn "1. echo"
      resolveP len
      putStrLn "2. echo and length"
      extractP len print (\_ -> return ())
промис в 3-й строке обещает вернуть вводимую пользователем строку, промис len считывает строку, печатает её и возвращает длину.

Мой вариант реализации, минимальный для работы приведённого примера:
Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
data Promise err a = Promise {
  extractP :: (a -> IO ()) -> (err -> IO ()) -> IO ()
}
 
valueP :: a -> Promise err a
valueP val = Promise (\resolve reject -> resolve val)
 
resolveP promise = extractP promise none none where none = \_ -> return ();
 
thenP :: Promise err a -> (a -> IO (Promise err b)) -> Promise err b
thenP promise func = Promise $ \resolve reject ->
  extractP promise
    (\value -> func value >>= \p -> extractP p resolve reject)
    reject
2
XRuZzz
01.02.2018, 08:26
  #3

Не по теме:

Ну всё, Mysterious Light выиграл. Игра окончена - никто лучше решения не придумает :)

0
Araneo
01.02.2018, 09:52  [ТС]
  #4

Не по теме:

Цитата Сообщение от XRuZzz Посмотреть сообщение
Ну всё, Mysterious Light выиграл. Игра окончена - никто лучше решения не придумает
Счас, не дождёшся... так быстро это не закончится, но мне нужно подумать до вечера, а так, наверняка есть более краткое решение! я просто уверен, тут прямо напрашивается использовать что-то из имеющихся библиотек.

0
Mysterious Light
Эксперт по математике/физике
3963 / 1935 / 390
Регистрация: 19.07.2009
Сообщений: 2,962
Записей в блоге: 21
01.02.2018, 13:58 5
Цитата Сообщение от XRuZzz Посмотреть сообщение

Не по теме:

Ну всё, Mysterious Light выиграл. Игра окончена - никто лучше решения не придумает

Не по теме:

Ну что вы, ребята. Я же специально такую задачу выбрал, чтобы каждый мог легко развернуться.
Ладно, краткость пусть будет за мной, но тут есть куда сделать красивее/элегантнее/правильнее/более общее.

0
Curry
2557 / 1722 / 220
Регистрация: 01.06.2013
Сообщений: 3,597
Записей в блоге: 7
01.02.2018, 19:59 6
Лучший ответ Сообщение было отмечено Araneo как решение

Решение

Цитата Сообщение от Araneo Посмотреть сообщение
даже странно, что такой нигде не нашлось...
Возможно потому что
Haskell
1
2
xor :: Bool -> Bool -> Bool
xor = (/=)
2
Araneo
643 / 253 / 16
Регистрация: 02.03.2014
Сообщений: 583
02.02.2018, 00:33  [ТС] 7
Мне кажется, что решение должно быть каким-то таким... Хотя это конечно изюм из булок. Зато более общее и действительно позволяет отлавливать исключения.
Haskell
1
2
3
promise :: Exception e => IO a -> (a -> IO b) -> (e -> IO b) -> IO b
promise a resolve reject = try a >>= \case
    Right a -> resolve a; Left  a -> reject a
---
Моя задачка.

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

Например: послы ~~ ослы

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
substitution :: String -> String -> Bool
substitution w1 w2 = sum (fromEnum <$> zipWith (==) w1 w2) >= length w1 - 1
 
insertPost :: Int -> a -> [a] -> [a]
insertPost i a xs = take i xs ++ [a] ++ drop i xs
 
(~~) :: String -> String -> Bool
(~~) a1 a2
    | length a1 == length a2 = substitution a1 a2
    | otherwise              = any (substitution w2) $ do
        i <- [0..length w2]
        pure $ insertPost i 'a' w1
  where
    [w1, w2] = sortOn length [a1, a2]
2
Mysterious Light
02.02.2018, 04:30
  #8

Не по теме:

Haskell
1
2
\case Right a -> resolve a; Left  a -> reject a
either resolve reject

0
Araneo
02.02.2018, 20:53  [ТС]
  #9

Не по теме:

Что, желающих нет? Печально...

0
dsorokin
52 / 37 / 1
Регистрация: 25.06.2015
Сообщений: 63
02.02.2018, 21:19 10
Если вместо err использовать более общий тип SomeException, то Promise превращается в монаду. Ну, а нужный тип исключения легко заносится в constraint в функции типа catch. По сути, это то, что сделано было Доном Саймом в асинхронных вычислениях Async в F#. Только там еще есть одно продолжение - для экстренной отмены вычисления.

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

Да, интересная тема с продолжениями
0
Curry
2557 / 1722 / 220
Регистрация: 01.06.2013
Сообщений: 3,597
Записей в блоге: 7
02.02.2018, 22:57 11

Не по теме:

Цитата Сообщение от Araneo Посмотреть сообщение
Что, желающих нет? Печально...
Дык, времени совершенно нет. Я бы с радостью предавался порочным радостям Haskell с утра до ночи, но ... :(


Цитата Сообщение от Araneo Посмотреть сообщение
Например: послы ~~ ослы
Haskell
1
2
3
4
5
6
7
8
9
10
11
(~~) :: Eq a => [a] -> [a] -> Bool
(~~) a1 a2 = 
    let tails ax@(x:xs) ay@(y:ys) | x == y = tails xs ys
                                  | otherwise = (ax,ay)  
        tails xs ys = (xs,ys)
        (r1,r2) = tails a1 a2 
    in case tails (reverse r1) (reverse r2) of
        ([_],[]) -> True
        ([],[_]) -> True
        ([_],[_]) -> True
        _ -> False
0
Araneo
02.02.2018, 23:50  [ТС]
  #12

Не по теме:

Цитата Сообщение от KolodeznyDiver Посмотреть сообщение
Дык, времени совершенно нет. Я бы с радостью предавался порочным радостям Haskell с утра до ночи, но ...
Я нашёл работу, где пишу на Хаскель, поэтому предаюсь его порочным радостям с утра до ночи 7 дней в неделю :)

0
Curry
2557 / 1722 / 220
Регистрация: 01.06.2013
Сообщений: 3,597
Записей в блоге: 7
03.02.2018, 21:22 13

Не по теме:

Цитата Сообщение от Araneo Посмотреть сообщение
Я нашёл работу, где пишу на Хаскель
Скрежещу зубами от зависти.


Цитата Сообщение от Mysterious Light Посмотреть сообщение
Написать аналог JS Promise.
Далее я ничего не понял из за своего скудоумия и полез гуглить что такое Promise в js и такой, механический, перенос промисов в Haskell мне решительно не понравился.
Цитата Сообщение от Mysterious Light Посмотреть сообщение
Это объект
От одного этого любого функциональщика должно колотить по диагонали. Но, это, конечно, не конструктивное возражение.
Цитата Сообщение от Mysterious Light Посмотреть сообщение
конструктор Promise (аналог new Promise), который функции \resolve reject -> ... resolve(value) ... reject(error) ... сопоставляет промис.
Для промисов в js предписывается обязательно вызывать в конце либо resolve, либо reject. Это требование библиотеки и не может контролироваться транслятором. В Haskell же строгая статическая типизация и мы можем исключить такое неправильное использование функции переданной в конструктор промиса. Для этого нужно не вызывать resolve или reject, а возвращать разные варианты ADT, например Either. Тогда Left будет возвращаться если нужно вызвать reject, а Right - resolve. Т.к. упоминается что при исключении тоже вызывается reject, то тип под Left должен быть Exception, т.е. тип функции передаваемой для создания промиса будет
Haskell
1
Exception e => IO (Either e a)
Как я понял, основная фишка промисов - это возможность создания цепочек функций с помощью функции then.
Тут следует вспомнить что весь код js выполняется в одном треде с возможностью обрабатывать асинхронные события. На Haskell же мы можем выполнять код в разных тредах, так что необходимость в промисах, вообще то невелика. Но что такое последовательность функций then для Haskell? Да это же просто цепочка функций соединяемых, например, через (>>=)!
Здесь я подразумеваю, что вся цепочка известна заранее на этапе компиляции. Обычно так и будет. Навешивание обработчиков после запуска асинхронного процесса в js, видимо, вынужденная мера. Так лучше бы не делать - процесс может закончится до установки обработчика.
Иными словами, умный конструктор для создания промиса в Haskell должен бы иметь такую сигнатуру
Haskell
1
mkPromise :: Exception e => IO (Either e a) -> (a -> IO ()) -> (e -> IO ()) -> IO ()
Может быть, имело бы смысл возвращать TVar c состоянием промиса. Второй аргумент - цепочка функций, соответствующая then, третий аргумент - обработчик ошибок.
Хотя, повторюсь, необходимости в этом не видно. Всю логику легко реализовать в конкретном случае в функции вызываемой из forkIO.
0
Black Fregat
03.02.2018, 22:27
  #14

Не по теме:

Цитата Сообщение от KolodeznyDiver Посмотреть сообщение
Скрежещу зубами от зависти
Осмелюсь предложить: Haskell
Мне их требования не потянуть..

0
pycture
1173 / 561 / 85
Регистрация: 20.09.2012
Сообщений: 1,815
Завершенные тесты: 3
04.02.2018, 08:34 15
Цитата Сообщение от Araneo Посмотреть сообщение
Нужно сделать проверку не позволяющую использовать одновременно латиницу и кириллицу. То есть
Haskell
1
test text = any (\a -> length text == (length $ filter (`elem` a) text)) [en,ru]
2
Araneo
643 / 253 / 16
Регистрация: 02.03.2014
Сообщений: 583
04.02.2018, 11:02  [ТС] 16
Мне кажется, что это правильнее написать с использованием стандартной функции из модуля работы со списками, по крайней мере идея станет куда как более ясна.

Haskell
1
test text = any (\x -> null $ x `intersect` text) [en, ru]
1
Curry
2557 / 1722 / 220
Регистрация: 01.06.2013
Сообщений: 3,597
Записей в блоге: 7
04.02.2018, 16:38 17
Haskell
1
test text = any (null.(text \\)) [en, ru]
1
pycture
05.02.2018, 06:24
  #18

Не по теме:

Цитата Сообщение от Araneo Посмотреть сообщение
идея станет куда как более ясна.
только для плотно курящих хаскель. я 5 минут смотрел на "null". в приличном обществе это называется "isnull".

0
Curry
05.02.2018, 08:38
  #19

Не по теме:

Цитата Сообщение от pycture Посмотреть сообщение
в приличном обществе это называется "isnull"
Тогда уж isEmpty. А вообще то с названиями в Haskell беда. Класс типов IsString не для проверок строка ли это, а для конвертации строковых литералов. Функция член класса у него fromString. Почему нельзя было назвать класс FromString один SPJ знает.

0
Curry
2557 / 1722 / 220
Регистрация: 01.06.2013
Сообщений: 3,597
Записей в блоге: 7
22.02.2018, 16:33 20
Задачка навеянная случайно попавшим сюда вопросом про с++.

Имеется текст со словами разделяемыми не только пробельными символами, но и указанным списком дополнительных разделителей. Все остальные символы считаются входящими в слова. Написать функцию удаляющую слова по заданному предикату
Haskell
1
2
3
4
delWords :: String ->           -- Дополнительные разделители, кроме пробельных символов. 
            (String -> Bool) -> -- Предикат. Оставлять ли слово?
            String ->           -- Исходный текст
            String              -- Текст с некоторыми удалёнными словами.
Если удаляемое слово стояло между пробельными символами, то оставить только один пробельный что бы их не было два подряд. Так же, если удаляемое слово было вначале и после него пробельный, то удалить пробельный, чтобы с него не начинался текст. Аналогично с удалением последнего слова - текст не должен оказаться оканчивающимся на пробельный символ. Считаем что в исходном тексте пробельные символы не повторяются по несколько подряд.

p.s. Если удаляемое слово стояло между пробелом и, допустим, '\t', то какой символ оставлять не оговаривается.

Добавлено через 11 часов 38 минут
Без претензий на элегантность
Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
import Data.Char
 
delWords :: String ->           -- Дополнительные разделители, кроме пробельных символов. 
            (String -> Bool) -> -- Предикат. Оставлять ли слово?
            String ->           -- Исходный текст
            String              -- Текст с некоторыми удалёнными словами.
delWords extrDelims pr  = reverse . delSpDbls True [] . loop [] . dropWhile isDelim
    where isDelim c = isSpace c || c `elem` extrDelims
          loop d [] = concat $ reverse d
          loop d s  = let (sp,r1) = span isDelim s
                          (w,r2)  = span (not . isDelim) r1
                      in if pr w then loop (w:sp:d) r2 
                                 else loop (sp:d) r2
          delSpDbls True d [] = tail d
          delSpDbls _    d [] = d
          delSpDbls True d (x:xs) | isSpace x = delSpDbls True d xs
                                  | otherwise = delSpDbls False (x:d) xs
          delSpDbls _    d (x:xs) = delSpDbls (isSpace x) (x:d) xs
1
22.02.2018, 16:33
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
22.02.2018, 16:33

Решение нелинейных уравнений методом Ньютона. Не выдает результат, когда решение = 0
Есть программа,Решение нелинейных уравнений методом ньютона,но есть проблема,Не...

Найти общее решение или частное решение уравнения первого порядка
Помогите решить: 2*x*sqrt(1-y^2)=y' * (1+x^2). Я не понимаю как решить это,...

Найти общее решение дифференциального уравнения I порядка и частное решение.
помогите пожалуйста!!!! Найти общее решение дифференциального уравнения I...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru