Решение задачи «кто на ком женат» с помощью Haskell
6 сентября 2011
В рамках серии экспериментов с прокачкой мозгов, я решил принять участие в небольшом программистском конкурсе от Романа Душкина. И я не без удовольствия воспринял новость о том, что вошел в пятерку победителей, полностью решивших задачу (места не пронумерованы, но если бы были, то я бы точно занял не первое и не второе место).
Конкурс состоял в том, чтобы написать программу (на любом языке), решающую следующую задачу:
Трое крестьян — Иван, Петр и Алексей — пришли на рынок с женами — Марией, Екатериной и Анной. Каждый из этих шести человек заплатил за каждый купленный предмет столько копеек, сколько предметов он купил.
Каждый мужчина истратил на 48 копеек больше своей жены.
Кроме того, Иван купил на 9 предметов больше Екатерины, а Петр — на 7 предметов больше Марии.
Кто на ком женат?
Также после решения задачи требовалось ответить на кое-какие дополнительные вопросы, которые заранее были неизвестны.
В первую очередь я решил составить математическую модель задачи. Пусть mi — количество предметов, купленных i-м мужчиной, а wj — количество предметов, купленных j-ой женщиной, где i, j ∈ {0,1,2}. Номер женщины, на которой женат i-ый мужчина, обозначим xi. Дано:
mi2 — wxi2 = 48
m0 — w1 = 9
m1 — w0 = 7
mi, wj ∈ ℕ0
i, j ∈ {0,1,2}
Требуется найти такое множество {xi}, чтобы приведенная система уравнений имела решение для каких-нибудь {mi} и {wj}.
Теперь задачу несложно решить простым перебором, для реализации которого был выбран Haskell:
-- (c) Alexandr A Alexeev 2011 | http://eax.me/
import Data.List
-- для простоты реализации перебираем число покупок "тупым" способом
maxNumbers = 20
itemsNumbersM =
[ [x, y, z] |
x <- [1..maxNumbers], y <- [1..maxNumbers], z <- [1..maxNumbers]]
itemsNumbersW =
[ [x, y, z] |
x <- [1..maxNumbers], y <- [1..maxNumbers], z <- [1..maxNumbers]]
-- заплачено денег в зависимости от числа покупок
paid x = x*x
solve =
[ (x, m, w) |
-- i-ый мужчина женат на Xi-ой женщине
x <- permutations [0..2],
-- все возможные варианты, сколько купилa i-ая женщина
w <- itemsNumbersW,
-- все возможные варианты, сколько купил i-ый мужчина
m <- itemsNumbersM,
-- кроме того:
(m !! 0) - (w !! 1) == 9,
(m !! 1) - (w !! 0) == 7,
paid (m !! 0) - paid (w !! (x !! 0)) == 48,
paid (m !! 1) - paid (w !! (x !! 1)) == 48,
paid (m !! 2) - paid (w !! (x !! 2)) == 48
]
main = do
printPair 0
printPair 1
printPair 2
where
man = ["Ivan", "Petr", "Alexey"]
woman = ["Maria", "Katya", "Anna"]
(solution, _, _) = head solve
printPair n = do
putStrLn $ (man !! n) ++ " -- " ++ (woman !! (solution !! n))
Ответ: Иван (13) женат на Анне (11), Петр (8) на Екатерине (4), а Алексей (7) — на Марии (1). В скобках указанно количество купленных вещей.
С первой частью задания справится было легко. Последующие за этим дополнительные вопросы оказались куда сложнее:
1. Сколько уникальных пар коэффициентов (a, b) даёт уникальное распределение людей по парам для разницы в паре в 48 копеек?
2. Для каких значений коэффициента k, меньших или равных 100, задача имеет решения для каких-либо пар коэффициентов (a, b)?
Коэффициенты (a, b) — это разницы типа (9, 7) в условии. Коэффициент k — это как 48 копеек.
Более того, вопросы эти по ряду причин не совсем корректны. Ответить на них с помощью приведенной ранее программы можно, но займет это очень много времени. В общем, после уточнения вопросов и существенной оптимизации изначальной программы, я получил следующее:
-- (c) Alexandr A Alexeev 2011 | http://eax.me/
import Data.List
-- максимальное число покупок у одного человека
maxItemsNum = 100
-- список возможных чисел покупок у женщин {W}
-- для любого W должен существовать M = sqrt(k + W**2)
possibleItemsNumbersW k =
filter (\x -> manItemsNum k x > 0) [0..maxItemsNum]
-- все возможные пары числа покупок (M, W) : M**2 - W**2 = k
allPossibleItemsNumberMW k =
filter (\(m, w) -> m*m - w*w == k) [
(manItemsNum k w1, w2) |
w1 <- possibleItemsNumbersW k,
w2 <- possibleItemsNumbersW k ]
-- все возможные значения a и b для данного k
allPossibleAB k = nub $ filter (>0) [
manItemsNum k w1 - w2 |
w1 <- possibleItemsNumbersW k,
w2 <- possibleItemsNumbersW k]
-- число покупок мужчины в зависимости от k и числа покупок его жены
manItemsNum k womanItemsNum =
if (not $ null lst) && ((snd $ lastLst) == itemsNumberSquare)
then fst $ lastLst
else -1
where
-- квадрат искомого значения
itemsNumberSquare = k + womanItemsNum*womanItemsNum
-- все квадраты
squares = [ (x, x*x) | x <- [1..] ]
lst = takeWhile (\(_, x) -> x <= itemsNumberSquare) squares
lastLst = last lst
-- все возможные решения задачи для заданных a, b и k
solve a b k =
filter (\(x,[w0,w1,_]) ->
(fst(x!!0) - snd(x!!w1) == a ) &&
fst(x!!1) - snd(x!!w0) == b)
[ ([pair1, pair2, pair3], womanPosList) |
pair1 <- allPossibleItemsNumberMW k,
pair2 <- allPossibleItemsNumberMW k,
pair3 <- allPossibleItemsNumberMW k,
womanPosList <- permutations [0..2]
]
-- существует ли пара (a,b), дающая единственное решиние для данного k?
hasAnySolutionForK k =
not.null $ filter (\x -> length x == 1) [
-- если 2 или больше ответа, то для такого k задача некорректна
take 2 $ solve a b k |
a <- allPossibleAB k, b <- allPossibleAB k
]
-- Сколько уникальных пар коэффициентов (a, b) даёт уникальное
-- распределение людей по парам для разницы в паре в 48 копеек?
task1 =
length $ nub $ filter (\x -> length x == 1) [
take 2 $ solve a b k |
a <- allPossibleAB k, b <- allPossibleAB k
]
where k = 48
-- Для каких значений коэффициента k, меньших или равных 100,
-- задача имеет решения для каких-либо пар коэффициентов (a, b)?
task2 = [ k | k <- [1..100], hasAnySolutionForK k ]
main = do
printPair 0
printPair 1
printPair 2
putStrLn $ "task1: " ++ show task1
putStrLn $ "task2: " ++ show task2
where
man = ["Ivan", "Petr", "Alexey"]
woman = ["Maria", "Katya", "Anna"]
(items, wifeList) = head $ solve 9 7 48
printPair n = do
putStrLn $
(man !! n) ++ " -- "
++ (woman !! (wifeList !! n))
++ " " ++ show (items !! n)
Ответ на первый вопрос — 12. На второй — 45, 48, 63, 64, 72, 75, 80, 81, 96, 99. Больше всего в ходе написания программы мой уровень ЧСВ подняло осознание того, как же круто я оптимизировал код. Если изначальный вариант программы не мог справиться с задачей за целую ночь, то теперь ответ находится где-то за минуту.
В целом от конкурса я получил исключительно положительные эмоции. А еще я наконец-то понял фразу «главное — участие». Потому что свой главный приз я получил не на финише, а именно во время участия.
Дополнение: А вот и обещанный приз:
Если кому-то интересно, это журнал «Потенциал» за август 2009-го года со статьей Романа «Функциональный подход в программировании» и автографом на ней. Приятно, что уж тут :)
Метки: Haskell, Функциональное программирование.
Вы можете прислать свой комментарий мне на почту, или воспользоваться комментариями в Telegram-группе.