Здравствуйте, hub, Вы писали: hub>Нужно реализовать итеративную.
По моему итеративная, в терминологии SICP — это использующая концевую рекурсию. Тут я не вижу другого пути, кроме как руками сделать CPS трансформацию (http://en.wikipedia.org/wiki/Continuation-passing_style).
С другой стороны в SICP в примечании предлагают применять мемоизацию — это проще.
P.S. Где вы выкопали эту задачу — в SICP ее нет. Если это ваше домашнее задание, то неэтично просить решить ее за вас.
Здравствуйте, hub, Вы писали:
hub>Здрасте всем, помогите пожалуйста с задачой размена доллара на монеты. В SICP есть реализация рекурсивной процедуры на Scheme:
А можно задачу изложить на человечьем языке? А не на lots of incredibly smart parenthesis?
How many different ways can we make change of $ 1.00, given half-dollars, quarters, dimes, nickels, and pennies? More generally, can we write a procedure to compute the number of ways to change any given amount of money?
Когда-то решал похожую задачу (Project Euler N31). Сейчас переделал на вариант с продолжением и хвостовым вызовом. Т.е., вроде, итеративный.
OCaml:
let coins = [|1;5;10;25;50|];;
let rec ways n sum cursum nways con =
if n=0 then con 1 else
if cursum > sum then con nways else
ways (n-1) (sum - cursum) 0 0 (fun w->ways n sum (cursum + coins.(n)) (w + nways) con);;
ways 4 100 0 0 print_int;;
Z>How many different ways can we make change of $ 1.00, given half-dollars, quarters, dimes, nickels, and pennies? More generally, can we write a procedure to compute the number of ways to change any given amount of money?
Здесь мы кэшируем в глобальном списке, но можем этот список и протащить внутрь:
ways amount = ways_since 0 [1] where
ways_since a ws | a==amount = last ws
| otherwise = ways_since (a+1) ws++[w] where
w = sum [ws !! (a-coin) | coin<-coins, coin<=amount]
Конечно, такое лобовое решение неэффективно, поскольку мы здесь, следуя заветам маляра Шлемюэля, бегаем по списку до конца.
Правильнее завести 5 (по числу номиналов монет) алиасов на элементы списка, отступающих на 1,5,...,50 позиций от конца списка.
Для ленивых языков (хаскелла) это легко, бесконечный список, прирастающий с хвоста и итерируемый вперёд.
Для энергичных — придётся как-то припахать продолжения.
Точно? А какой ответ?
Попробовал запустить в ghci, выдает 0, на amounts 50 и больше задумывается очень надолго..
К>Задача решается мемоизацией.
Точно? Она (в исходной постановке) такая маленькая, что мемоизация и не нужна особо, по крайней мере мой вариант без нее отрабатывает за 0,02 секунды..
И ещё раз слегка нагнал.
При прямой сортировке — летать должно ещё быстрее.
ways a = ways' a coins_sorted_up where
ways' 0 _ = 1
ways' _ [] = 0
ways' a (c:cs) | a<c = 0 -- дальше ковырять список смысла нет
| otherwise = (ways' (a-c) (c:cs)) + (ways' a cs)
Следующие шаги — это:
— переход от вычитания ко взятию остатка
— разворачивание скобок
А итерационный алгоритм — если мы заведём рукодельный стек отложенных заданий.
ways a = ways' 0 [(a,coins_sorted_up)] where
ways' n [] = n
ways' n (0,_):jobs = ways' (n+1) jobs
ways' n (_,[]):jobs = ways' n jobs
ways' (a,(c:cs)):jobs =
if a<c then ways' n jobs
else ways' n ((a-c,c:cs):(a,cs):jobs)
Следующий шаг — превратить всё это добро в fold... Кстати, в который? На этом мысль иссякла.
Здравствуйте, Кодт, Вы писали:
К>И ещё раз слегка нагнал. К>При прямой сортировке — летать должно ещё быстрее. К>
К>ways a = ways' a coins_sorted_up where
К> ways' 0 _ = 1
К> ways' _ [] = 0
К> ways' a (c:cs) | a<c = 0 -- дальше ковырять список смысла нет
К> | otherwise = (ways' (a-c) (c:cs)) + (ways' a cs)
К>
К>Следующие шаги — это: К>- переход от вычитания ко взятию остатка К>- разворачивание скобок
К>А итерационный алгоритм — если мы заведём рукодельный стек отложенных заданий. К>
К>ways a = ways' 0 [(a,coins_sorted_up)] where
К> ways' n [] = n
К> ways' n (0,_):jobs = ways' (n+1) jobs
К> ways' n (_,[]):jobs = ways' n jobs
К> ways' (a,(c:cs)):jobs =
К> if a<c then ways' n jobs
К> else ways' n ((a-c,c:cs):(a,cs):jobs)
К>
К>Следующий шаг — превратить всё это добро в fold... Кстати, в который? На этом мысль иссякла.
Эт конечно все хорошо. Но прога нужна на Scheme, а не на Haskel.
Во-вторых, пример дан в начале SICP (я кстати только начал изучать Scheme)
и следовательно можно реализовать процедуру средствами перечисленными до этой проги
Здравствуйте, hub, Вы писали:
hub>Эт конечно все хорошо. Но прога нужна на Scheme, а не на Haskel. hub>Во-вторых, пример дан в начале SICP (я кстати только начал изучать Scheme) hub>и следовательно можно реализовать процедуру средствами перечисленными до этой проги
У хаскелла синтаксис более прозрачный, чем у лиспов (меньше скобок и есть инфиксные операторы). На нём алгоритмы писать выразительнее.
Так что, — если программа не эксплуатирует ленивость, — можно вкурить в собственно алгоритм и перепереть полечку на любимый язык
Что же касается исходной программы на схеме...
1) Не знаю, почему вместо списка монет использована пара: функция "номинал по индексу" + количество индексов.
Это как-то некрасиво: одна сущность раскидана по двум местам.
2) Чтобы перейти к итерациям, нужно или сделать рукодельный стек (как у меня — очередь jobs), или выполнить какое-то математическое преобразование алгоритма.
О, кстати. Действительно, можно же написать функцию "следующий вектор".
Дано: вектор номиналов coins = [1,...,50]
Также дано: вектор количеств numbers, length numbers == length coins.
По этому вектору получается текущая сумма money = dotproduct coins numbers
Пишем перебор: как из текущего numbers получить лексикографически следующий, удовлетворяющий условию money numbers <= amount.
После чего перебираем и считаем точные соответствия.
Здравствуйте, D. Mon, Вы писали:
DM>Вызов count-change выводит ответ на экран. Как сделать, чтобы ответ возвращался как значение функции — домашнее задание.
D. Mon СПАСИБО!!!!! Но, к сожалению, я только начал изучать лисп. Мне далеко до Вашего уровня (если вообще такой достижим мною). Я безмерно благодарен, но не могли бы Вы предложить реализацию попроще?
hub>D. Mon СПАСИБО!!!!! Но, к сожалению, я только начал изучать лисп. Мне далеко до Вашего уровня (если вообще такой достижим мною). Я безмерно благодарен, но не могли бы Вы предложить реализацию попроще?
На практике процедура товарища D. Mon'a при вычислении 2000 работает медленно (если честно я не долждался результата), в отличии от чуточку улучшенного рекурсивного варианта, приведенного ниже:
И как я понял, данная реализация и есть CPS-трансформация. Но, алгоритм действительно итеративный, ну и конечно насчет изящества мое мнение не изменилось . Но, все таки не должна же итерация работать медленнее древовидной рекурсии.
Приведенный мною вариант на Scheme — просто перевод приведенного ранее варианта на OCaml, который был получен из совсем другого решения. Похоже, там сам алгоритм неоптимальный. Если взять последний твой вариант и сделать CPS трансформацию, получается
let coins = [|1;5;10;25;50|];;
let rec cc amount kinds con =
if kinds = 0 || amount = 0 then con 1 else
if amount < 0 then con 0 else
cc amount (kinds-1) (fun c1 -> cc (amount - coins.(kinds)) kinds (fun c2 -> con (c1+c2)));;
cc 2000 4 print_int;;
Для amount=2000 находит ответ за 0,3 секунды (раз в 30 быстрее DrScheme).
К>Пишем перебор: как из текущего numbers получить лексикографически следующий, удовлетворяющий условию money numbers <= amount. К>После чего перебираем и считаем точные соответствия.
Итак, сам себе этюдник в стиле next_permutation или тому подобного.
-- start a cs = (ns,e) где ns с максимальными значениями в голове, e - признак точного совпадения (1 если совпало, 0 если нет)
start a [] = ([], if a==0 then 1 else 0)
start a (c:cs) = (n:ns,e) where
n = a`div`c
(ns,e) = start (a`mod`c) cs
-- next a cs ns = Just (ns',e) где ns' - лексикографически меньший вектор, e - признак точного совпадения
next a [] [] = Nothing-- действительно, есть единственный пустой вектор, дальше уж некуда
next a (c:cs) (0:ns) = -- текущий разряд уже меньше некудаcase next a cs ns of-- пробуем скрутить дальше
Just (ns',e) -> Just (0:ns',e)
| Nothing -> Nothing-- остальные тоже, видать, скручены
next a (c:cs) (n:ns) =
let (ns',e) = start (a-c*(n-1)) cs -- скрутив текущий разряд, порождаем максимальный хвостin Just ((n-1):ns',e)
-- ну что, побежали!
ways a cs = ways' 0 (start a cs) where
ways' w (ns,e) =
let w' = w+e in
case next a cs ns of
Just nse' -> ways w' nse
| Nothing -> w'
Вот что-то типа такого.
Не компилил ещё... Оставляю как черновой эскиз.
Попробовал напрямую перевести CPS вариант на Хаскелл, получилось так:
coins = [1,5,10,25,50]
ways a con = ways' a coins con where
ways' 0 _ con = con 1
ways' _ [] con = con 0
ways' a (c:cs) con | a<c = con 0
| otherwise = ways' (a-c) (c:cs) (\c1 -> ways' a cs (\c2 -> con (c1+c2)))
main = ways 100 print
Для 100 выводит верный ответ. На 1000 задумался, съел больше гига памяти (сколько было свободно), результата я не дождался.
Здравствуйте, D. Mon, Вы писали:
DM>Попробовал напрямую перевести CPS вариант на Хаскелл, получилось так: DM>
coins = [1,5,10,25,50]
DM>ways a con = ways' a coins con where
DM> ways' 0 _ con = con 1
DM> ways' _ [] con = con 0
DM> ways' a (c:cs) con | a<c = con 0
DM> | otherwise = ways' (a-c) (c:cs) (\c1 -> ways' a cs (\c2 -> con (c1+c2)))
DM>main = ways 100 print
DM>
DM>Для 100 выводит верный ответ. На 1000 задумался, съел больше гига памяти (сколько было свободно), результата я не дождался.
То есть, родили мега-продолжение из 2*1000 лямбд, начали его вычислять...
Первым же делом дописали ещё 2*200...
Но это всё фигня. Главное западло не зависит от CPS.
Смотри: твоё выражение в конечном счёте предстаёт в виде суммы нулей и единиц.
Таким образом, время выполнения — не менее O(ways(a)) (как минимум, надо просуммировать все единицы). Даже без суммирования нулей получается что-то экспоненциальное.
А вот теперь внимание на экран.
Хаскелл — ленивый. Поэтому если ты имеешь дело с формулой, состоящей из крендельона сложений единичек, то сперва эта формула будет развёрнута в пространстве, а уже потом посчитана (в тот момент, когда она потребуется).
Вот и получили отжор памяти. Ну и времени на развёртывание требуется столько же.
Такую же штуку мы можем поймать, если напишем наивную функцию длины списка (рекурсивно или на foldr). Правильное же решение — использовать форсировку вычисления арифметики — seq, $!, foldl'.
Я так и подумал, что дело в ленивости. Чем мне Хаскелл не нравится, так это способностью превращать простые вещи в сложные (хотя обратно он тоже умеет, нельзя не заметить). Отсутствие сайде эффектов имеет свои сайд эффекты.
К>Правильное же решение — использовать форсировку вычисления арифметики — seq, $!, foldl'.
Проставил $! в местах вызова продолжений (кстати, куда еще можно/нужно поставить?).
Теперь работает в constant space (меньше 3 мегов), правильно нашел ответ для 2000, но ужасно медленно: 6 минут при компиляции с -O2. Т.е. примерно в 30 раз медленнее DrScheme и в 1000 раз медленнее ОКамла. Подозреваю, что следующим шагом придется прописывать типы..
Re[13]: Размен 1 доллара
От:
Аноним
Дата:
06.09.08 13:43
Оценка:
Здравствуйте, D. Mon, Вы писали:
DM>Для amount=2000 находит ответ за 0,3 секунды (раз в 30 быстрее DrScheme).
Ради интереса запустил под F#:
let coins = [|1;5;10;25;50|]
let rec cc amount kinds con =
if kinds = 0 || amount = 0 then con 1 else
if amount < 0 then con 0 else
cc amount (kinds-1) (fun c1 -> cc (amount - coins.[kinds]) kinds (fun c2 -> con (c1+c2)))
cc 2000 4 (printfn "%d")
1.5 секунды...
Потом нашел свое решение 31-й задачки (рекурсивное) — попробовал на этом условии — считает, но почти 2 минуты... Не приспособлен J для глубоких рекурсий
v=.0:`1:`(1:`(($:}.)+((-{.)$:]))@.(1:<#@]))@.(1:+*@[)
2000 v 50 25 10 5 1
Здравствуйте, Кодт, Вы писали:
К>Такой код действительно летает.
Решение по-проще:
ways _ 0 = 1
ways [] _ = 0
ways (c:cs) s = sum [ways cs (s-m) | m <- [0, c .. s]]
main = do putStrLn $ show $ ways [1,5,10,25,50] 2000
Выполняется ~9.5 минут
Если учесть, что решением задачи по сути является количество решений линейного диофантова уравнения, можно сделать оптимизацию.
Решение по-быстрее:
ways _ 0 = 1
ways [] _ = 0
ways cs s | noSolve cs s = 0 -- нет смысла копать глубже, решений нет
ways (c:cs) s = sum [ways cs (s-m) | m <- [0, c .. s]]
noSolve cs s = rem s (foldl1 gcd cs) /= 0 -- true, если не существует решений диофантова уравнения с коэффициентами cs и свободным членом s
main = do putStrLn $ show $ ways [1,5,10,25,50] 2000
Здравствуйте, Beam, Вы писали:
B>Если учесть, что решением задачи по сути является количество решений линейного диофантова уравнения, можно сделать оптимизацию. B>Выполняется ~12 секунд
Да, на моей машине тоже. Аналогичный вариант на OCaml работает 4 секунды:
let foldl1 f lst = match lst with
| [] -> failwith "empty list in foldl1"
| x::xs -> List.fold_left f x xs;;
let rec gcd a b = if b = 0 then a else gcd b (a mod b);;
let nosolve cs s = s mod (foldl1 gcd cs) <> 0;;
let rec ways s coins =
if s = 0 then 1 else
match coins with
| [] -> 0
| cs when nosolve cs s -> 0
| c::cs -> Enum.fold (+) 0 (Enum.init (s/c + 1) (fun i-> ways (s-i*c) cs));;
print_int (ways 2000 [1;5;10;25;50]);;
Здравствуйте, D. Mon, Вы писали:
DM>Здравствуйте, Beam, Вы писали:
B>>Если учесть, что решением задачи по сути является количество решений линейного диофантова уравнения, можно сделать оптимизацию. B>>Выполняется ~12 секунд
Здравствуйте, hub, Вы писали:
hub>Здравствуйте, D. Mon, Вы писали:
DM>>Здравствуйте, Beam, Вы писали:
B>>>Если учесть, что решением задачи по сути является количество решений линейного диофантова уравнения, можно сделать оптимизацию. B>>>Выполняется ~12 секунд
hub>Теперь если не трудно то же на Scheme
Эти решения являются рекурсивными, а Вам, как я понял, нужно итеративное (с хвостовой рекурсией?)
Сами решения не сильно отличаются от представленного Вами в первональном посте.
Вроде бы итеративный, т.е. рекурсия хвостовая. Без продолжений. Состояние процесса в каждый момент описывается одинаковым числом переменных. Другое дело, что эти переменные списки, а один из списков, к тому же растет (но не сильно).
Код объемный, но по сравнению с рекурсивным вариантов жутко быстрый — 50 000 разменивает за 14 сек.
Написан на Common Lisp.
(defun cc-5 (amount coins)
(labels ((make-tagged-amount (kinds amount)
(cons kinds amount))
(get-kinds (tagged-amount)
(car tagged-amount))
(get-amount (tagged-amount)
(cdr tagged-amount))
(merge-tagged-amount-lists (a b result)
(if (and a b)
(let ((amount-a (get-amount (car a)))
(amount-b (get-amount (car b))))
(cond ((< amount-a amount-b) (merge-tagged-amount-lists (cdr a) b (cons (car a) result)))
((> amount-a amount-b) (merge-tagged-amount-lists a (cdr b) (cons (car b) result)))
((= amount-a amount-b)
(merge-tagged-amount-lists (cdr a)
(cdr b)
(cons (make-tagged-amount (+ (get-kinds (car a))
(get-kinds (car b)))
amount-a)
result)))))
(if (or a b)
(append (nreverse result) (or a b))
(nreverse result))))
(get-tagged-amount-list (kinds amount coin result)
(cond ((> amount 0) (get-tagged-amount-list kinds
(- amount coin)
coin
(cons (make-tagged-amount kinds amount)
result)))
((= amount 0) (cons (make-tagged-amount kinds amount)
result))
(t result)))
(sum (tagged-amount-list coin cur-sum result)
(if tagged-amount-list
(let ((tagged-amount (car tagged-amount-list)))
(cond ((= (get-amount tagged-amount) cur-sum) (sum tagged-amount-list
coin
(+ cur-sum coin)
(+ result (get-kinds tagged-amount))))
((< (get-amount tagged-amount) cur-sum) (sum (cdr tagged-amount-list)
coin
cur-sum
result))
((> (get-amount tagged-amount) cur-sum) (sum tagged-amount-list
coin
(+ cur-sum coin)
result))))
result))
(process-coin (tagged-amount-list coins)
(if (cdr coins)
(process-coin (reduce #'(lambda (a b)
(merge-tagged-amount-lists a
(get-tagged-amount-list (get-kinds b)
(get-amount b)
(car coins)
nil)
nil))
(cdr tagged-amount-list)
:initial-value (get-tagged-amount-list (get-kinds (car tagged-amount-list))
(get-amount (car tagged-amount-list))
(car coins)
nil))
(cdr coins))
(sum tagged-amount-list (car coins) 0 0))))
(if coins
(process-coin (list (make-tagged-amount 1 amount)) coins)
0)))
;; CL-USER> (time (cc-5 50000 '(50 25 10 5 1)))
;; Evaluation took:
;; 14.433 seconds of real time
;; 14.068879 seconds of user run time
;; 0.396025 seconds of system run time
;; [Run times include 2.192 seconds GC run time.]
;; 0 calls to %EVAL
;; 0 page faults and
;; 2,790,509,272 bytes consed.
;; 4182519842501
В SICP на момент, в который была дана эта задача, списки еще рассматривались.
Поэтому мне непонятно какое решение у авторов SICP. Может и в самом деле вариант с продолжениями.
Здравствуйте, Pirsig, Вы писали:
P>В SICP на момент, в который была дана эта задача, списки еще рассматривались. P>Поэтому мне непонятно какое решение у авторов SICP. Может и в самом деле вариант с продолжениями.
В SICP на момент, в который была дана эта задача, списки еще НЕ рассматривались.
Поэтому мне непонятно какое решение у авторов SICP. Может и в самом деле вариант с продолжениями.
Впрочем, lambda тоже вводится позже...
Родил итерационный алгоритм.
На С++, поскольку с лиспом не шибко дружен. Сами перепирайте эту полечку.
#include <iostream>
// немножко чистоты типов - просто чтоб различать, кто есть хуtypedef int money_t; // суммы денегtypedef int count_t; // количество монет
// номиналы монет
money_t const coins[] =
#if 0
{ 1, 5, 10, 25, 50 };
#else
{ 50, 25, 10, 5, 1 }; // удобнее, когда крупными монетами вперёд - меньше промахов (а с учётом 1-копейки, их вообще нет)#endif
size_t const num_coins = _countof(coins);
// сумма, которую будем разменивать
money_t const target = 1000;
// переменная цикла состоит из
count_t amount[num_coins]; // кошелька (сколько монет каждого номинала?)bool exact; // и признака, что в кошельке точная сумма
// процедура заполнения кошелька, начиная с монет номинала номер kvoid complete(money_t sum, size_t const k)
{
for(size_t i = k; i != num_coins; ++i)
{
money_t const coin = coins[i];
amount[i] = sum / coin; // процедура детерминированная: заполняем данным номиналом по максимуму
sum %= coin;
}
exact = sum==0;
}
// функция нахождения хвоста из нулей
size_t find_tail_zeros()
{
// возвращает k : для всех i таких, что k<=i<n-1, a[i]==0
size_t k = num_coins-1; // маленькая хитрость: не учитываем последний номинал (см.ниже)while(k > 0 && amount[k-1] == 0)
--k;
return k;
}
money_t sum_head(size_t const k)
{
money_t sum = 0;
for(size_t i = 0; i != k; ++i)
sum += amount[i] * coins[i];
return sum;
}
//////////////////
// первая итерацияvoid init()
{
complete(target, 0); // просто заполняем кошелёк, получая лексикографический максимум
}
/////////////////////
// следующая итерацияbool next() // возвращает признак того, что итерация удалась
{
// наша задача - получить лексикографического соседа (следующий по убыванию)
size_t const k = find_tail();
if(k==0)
return false; // весь кошелёк состоит из нулей, скручивать нечего
// скручиваем a[k] - даём хвосту шанс измениться
--amount[k-1];
// считаем, сколько у нас денег осталось на заполнение хвоста - и заполняем его
complete(target - sum_head(k), k);
return true;
}
int main()
{
// ведём статистику: сколько всего итераций, и сколько из них успешныхint attempts = 0, success = 0;
for(bool go = (init(),true); go; go = next())
{
++attempts;
if(exact)
++success;
// чтобы юзер не скучал...#if 0
std::cout << "попытка " << attempts << ": ";
for(size_t i = 0; i != num_coins; ++i)
std::cout << coins[i] << "*" << amount[i] << " ";
if(exact)
std::cout << "попал! " << success;
std::cout << std::endl;
#else
if(attempts % 100 == 0)
std::cout << attempts << " попыток, " << success << " попаданий ...\r";
#endif
}
std::cout << std::endl;
std::cout << attempts << " попыток, " << success << " попаданий" << std::endl;
}
Здесь используются глобальные переменные — это я сделал сознательно, чтобы не тратиться на протаскивание их внутрь всех функций и, тем самым, замусоривать восприятие кода.
Превратить все циклы в концевые рекурсии, надеюсь, труда не составит.
Для незнакомых с С/С++ — массивы нумеруются с 0, поэтому обычно при нумерации используются полуоткрытые интервалы. Это очень удобно.
Здравствуйте, hub, Вы писали:
hub>Здрасте всем, помогите пожалуйста с задачой размена доллара на монеты. В SICP есть реализация рекурсивной процедуры на Scheme: hub>