Размен 1 доллара
От: hub  
Дата: 29.08.08 09:08
Оценка:
Здрасте всем, помогите пожалуйста с задачой размена доллара на монеты. В SICP есть реализация рекурсивной процедуры на Scheme:
(define (count-change amount) 
  (cc amount 5)) 
(define (cc amount kinds-of-coins) 
  (cond ((= amount 0) 1) 
        ((or (<; amount 0) (= kinds-of-coins 0)) 0) 
        (else (+ (cc amount (- kinds-of-coins 1)) 
                 (cc (- amount (first-denomination kinds-of-coins)) 
                     kinds-of-coins))))) 
(define (first-denomination kinds-of-coins) 
  (cond ((= kinds-of-coins 1) 1) 
        ((= kinds-of-coins 2) 5) 
        ((= kinds-of-coins 3) 10) 
        ((= kinds-of-coins 4) 25) 
        ((= kinds-of-coins 5) 50)))

Нужно реализовать итеративную.
добавлена разметка — Кодт
Re: Размен 1 доллара
От: lomeo Россия http://lomeo.livejournal.com/
Дата: 29.08.08 09:34
Оценка:
Здравствуйте, hub, Вы писали:

hub>Нужно реализовать итеративную.


Итеративная — это цикл на named-let?
Re: Размен 1 доллара
От: z00n  
Дата: 29.08.08 10:47
Оценка:
Здравствуйте, hub, Вы писали:
hub>Нужно реализовать итеративную.

По моему итеративная, в терминологии SICP — это использующая концевую рекурсию. Тут я не вижу другого пути, кроме как руками сделать CPS трансформацию (http://en.wikipedia.org/wiki/Continuation-passing_style).
С другой стороны в SICP в примечании предлагают применять мемоизацию — это проще.

P.S. Где вы выкопали эту задачу — в SICP ее нет. Если это ваше домашнее задание, то неэтично просить решить ее за вас.
sicp
Re: Размен 1 доллара
От: Кодт Россия  
Дата: 29.08.08 11:05
Оценка:
Здравствуйте, hub, Вы писали:

hub>Здрасте всем, помогите пожалуйста с задачой размена доллара на монеты. В SICP есть реализация рекурсивной процедуры на Scheme:


А можно задачу изложить на человечьем языке? А не на lots of incredibly smart parenthesis?
Перекуём баги на фичи!
Re[2]: Размен 1 доллара
От: z00n  
Дата: 29.08.08 11:18
Оценка:
Здравствуйте, Кодт, Вы писали:

К>А можно задачу изложить на человечьем языке? А не на lots of incredibly smart parenthesis?

http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-11.html#%_sec_1.2.2

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?


Короче — классическая "Coin Changing Problem".
Re: Размен 1 доллара
От: D. Mon Великобритания http://thedeemon.livejournal.com
Дата: 29.08.08 14:04
Оценка:
Когда-то решал похожую задачу (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;;
Re[3]: Размен 1 доллара
От: Кодт Россия  
Дата: 29.08.08 16:19
Оценка:
Здравствуйте, z00n, Вы писали:

Z>

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?


Ага,
coins = [1,5,10,25,50]

ways 0 = 1
ways amount = sum [ ways (amount-coin) | coin <- coins, coin <= amount ]


Задача решается мемоизацией.
ways amount = all_ways !! amount

all_ways = 1 : [ ways' amount | amount <- [1..] ] where
  ways' amount = sum [ ways (amount-coin) | coin <- coins, coin <= amount ]

Здесь мы кэшируем в глобальном списке, но можем этот список и протащить внутрь:
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 позиций от конца списка.
Для ленивых языков (хаскелла) это легко, бесконечный список, прирастающий с хвоста и итерируемый вперёд.
Для энергичных — придётся как-то припахать продолжения.
Перекуём баги на фичи!
Re[4]: Размен 1 доллара
От: D. Mon Великобритания http://thedeemon.livejournal.com
Дата: 29.08.08 17:29
Оценка:
Здравствуйте, Кодт, Вы писали:

К>Ага,

К>
К>coins = [1,5,10,25,50]

К>ways 0 = 1
К>ways amount = sum [ ways (amount-coin) | coin <- coins, coin <= amount ]
К>


Точно? А какой ответ?
Попробовал запустить в ghci, выдает 0, на amounts 50 и больше задумывается очень надолго..

К>Задача решается мемоизацией.


Точно? Она (в исходной постановке) такая маленькая, что мемоизация и не нужна особо, по крайней мере мой вариант без нее отрабатывает за 0,02 секунды..
Re[4]: Размен 1 доллара
От: D. Mon Великобритания http://thedeemon.livejournal.com
Дата: 29.08.08 18:24
Оценка:
Здравствуйте, Кодт, Вы писали:

Второй кусок кода выдает неправильные ответы. Третий не комплируется, проблема с типами на ws++[w].
Re[4]: Размен 1 доллара
От: Кодт Россия  
Дата: 01.09.08 14:33
Оценка:
У... действительно, налажал.

Алгоритм нужно перевернуть с головы на ноги.
coins = [50,25,10,5,1] -- сортируем в обратном порядке

ways a = ways' a coins where
  ways' 0 _ = 1
  ways' _ [] = 0
  ways' a (c:cs) | c>a = ways' a cs
                 | otherwise = (ways' a cs) + (ways' (a-c) (c:cs))

Такой код действительно летает.
Перекуём баги на фичи!
Re[5]: Размен 1 доллара
От: Кодт Россия  
Дата: 02.09.08 15:29
Оценка:
И ещё раз слегка нагнал.
При прямой сортировке — летать должно ещё быстрее.
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... Кстати, в который? На этом мысль иссякла.
Перекуём баги на фичи!
Re[6]: Размен 1 доллара
От: hub  
Дата: 03.09.08 12:03
Оценка:
Здравствуйте, Кодт, Вы писали:

К>И ещё раз слегка нагнал.

К>При прямой сортировке — летать должно ещё быстрее.
К>
К>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)
и следовательно можно реализовать процедуру средствами перечисленными до этой проги
Re[7]: Размен 1 доллара
От: Кодт Россия  
Дата: 03.09.08 14:01
Оценка:
Здравствуйте, 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.
После чего перебираем и считаем точные соответствия.
... << RSDN@Home 1.2.0 alpha 4 rev. 1111>>
Перекуём баги на фичи!
Re[7]: Размен 1 доллара
От: D. Mon Великобритания http://thedeemon.livejournal.com
Дата: 03.09.08 16:17
Оценка:
Здравствуйте, hub, Вы писали:

hub>Эт конечно все хорошо. Но прога нужна на Scheme


(define (count-change amount) 
  (cc amount 5 0 0 (lambda (x) (display x))))

(define (cc amount kinds-of-coins cursum nways con) 
  (cond ((= kinds-of-coins 1) (con 1)) 
        ((<; amount cursum) (con nways))
        (else (cc (- amount cursum) (- kinds-of-coins 1) 0 0
                  (lambda (w) (cc amount kinds-of-coins 
                          (+ cursum (first-denomination kinds-of-coins))
                          (+ w nways) con))))))
                       
(define (first-denomination kinds-of-coins) 
  (cond ((= kinds-of-coins 1) 1) 
        ((= kinds-of-coins 2) 5) 
        ((= kinds-of-coins 3) 10) 
        ((= kinds-of-coins 4) 25) 
        ((= kinds-of-coins 5) 50)))


Вызов count-change выводит ответ на экран. Как сделать, чтобы ответ возвращался как значение функции — домашнее задание.

rsdn почему-то вставляет ; после <.
Re[8]: Размен 1 доллара
От: hub  
Дата: 05.09.08 09:49
Оценка:
Здравствуйте, D. Mon, Вы писали:

DM>Вызов count-change выводит ответ на экран. Как сделать, чтобы ответ возвращался как значение функции — домашнее задание.


D. Mon СПАСИБО!!!!! Но, к сожалению, я только начал изучать лисп. Мне далеко до Вашего уровня (если вообще такой достижим мною). Я безмерно благодарен, но не могли бы Вы предложить реализацию попроще?
Re[9]: Размен 1 доллара
От: hub  
Дата: 05.09.08 12:26
Оценка:
hub>D. Mon СПАСИБО!!!!! Но, к сожалению, я только начал изучать лисп. Мне далеко до Вашего уровня (если вообще такой достижим мною). Я безмерно благодарен, но не могли бы Вы предложить реализацию попроще?

На практике процедура товарища D. Mon'a при вычислении 2000 работает медленно (если честно я не долждался результата), в отличии от чуточку улучшенного рекурсивного варианта, приведенного ниже:

(define (first-denomination kinds-of-coins)
(cond ((= kinds-of-coins 1) 1)
((= kinds-of-coins 2) 5)
((= kinds-of-coins 3) 10)
((= kinds-of-coins 4) 25)
((= kinds-of-coins 5) 50)))
(define (cc amount kinds-of-coins)
(cond ((or (= kinds-of-coins 1) (= amount 0)) 1)
((< amount 0) 0)
(else (+ (cc amount (- kinds-of-coins 1))
(cc (- amount (first-denomination kinds-of-coins))
kinds-of-coins)))))
(define (count-change amount)
(cc amount 5))

И как я понял, данная реализация и есть CPS-трансформация. Но, алгоритм действительно итеративный, ну и конечно насчет изящества мое мнение не изменилось . Но, все таки не должна же итерация работать медленнее древовидной рекурсии.
Re[10]: Размен 1 доллара
От: hub  
Дата: 05.09.08 12:37
Оценка:
В смысле вот так она выглядит (и для удобочитаемости)
(define (first-denomination kinds-of-coins)
  (cond ((= kinds-of-coins 1) 1)
        ((= kinds-of-coins 2) 5)
        ((= kinds-of-coins 3) 10)
        ((= kinds-of-coins 4) 25)
        ((= kinds-of-coins 5) 50)))
(define (cc amount kinds-of-coins)
  (cond ((or (= kinds-of-coins 1) (= amount 0)) 1)        
        ((<; amount 0) 0)
        (else (+ (cc amount (- kinds-of-coins 1))
                 (cc (- amount (first-denomination kinds-of-coins))
                     kinds-of-coins)))))
(define (count-change amount)
  (cc amount 5))
Re[11]: Размен 1 доллара
От: D. Mon Великобритания http://thedeemon.livejournal.com
Дата: 05.09.08 13:42
Оценка:
Приведенный мною вариант на Scheme — просто перевод приведенного ранее варианта на OCaml, который был получен из совсем другого решения. Похоже, там сам алгоритм неоптимальный. Если взять последний твой вариант и сделать CPS трансформацию, получается
(define (first-denomination kinds-of-coins)
  (cond ((= kinds-of-coins 1) 1)
        ((= kinds-of-coins 2) 5)
        ((= kinds-of-coins 3) 10)
        ((= kinds-of-coins 4) 25)
        ((= kinds-of-coins 5) 50)))
(define (cc amount kinds-of-coins con)
  (cond ((or (= kinds-of-coins 1) (= amount 0)) (con 1))        
        ((<; amount 0) (con 0))
        (else 
         (cc amount (- kinds-of-coins 1) 
             (lambda (c1)
                 (cc (- amount (first-denomination kinds-of-coins)) kinds-of-coins
                     (lambda (c2) (con (+ c1 c2))))))         
         )))
(define (count-change amount)
  (cc amount 5 (lambda (x) x)))


По скорости я не заметил разницы с рекурсивным вариантом, хотя теоретически должно быть чуть медленнее за счет создаваемых лямбд.
Re[12]: Размен 1 доллара
От: D. Mon Великобритания http://thedeemon.livejournal.com
Дата: 05.09.08 14:05
Оценка:
Этот же вариант на OCaml:
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).
Re[8]: Размен 1 доллара
От: Кодт Россия  
Дата: 05.09.08 14:19
Оценка:
К>Пишем перебор: как из текущего 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'


Вот что-то типа такого.
Не компилил ещё... Оставляю как черновой эскиз.
... << RSDN@Home 1.2.0 alpha 4 rev. 1111>>
Перекуём баги на фичи!
Re[13]: Размен 1 доллара
От: D. Mon Великобритания http://thedeemon.livejournal.com
Дата: 05.09.08 15:00
Оценка:
Попробовал напрямую перевести 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 задумался, съел больше гига памяти (сколько было свободно), результата я не дождался.
Re[14]: Размен 1 доллара
От: Кодт Россия  
Дата: 05.09.08 21:58
Оценка:
Здравствуйте, 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 задумался, съел больше гига памяти (сколько было свободно), результата я не дождался.

ways' 1000 coins print =
ways' 999 coins (\x1->...print) =
ways' 998 coins (\x2->...(\x1->...print)) =
.....
ways' 0 coins (\x1000->.....(\x2->...(\x1->...print))...) =

То есть, родили мега-продолжение из 2*1000 лямбд, начали его вычислять...
Первым же делом дописали ещё 2*200...

Но это всё фигня. Главное западло не зависит от CPS.
Смотри: твоё выражение в конечном счёте предстаёт в виде суммы нулей и единиц.
Таким образом, время выполнения — не менее O(ways(a)) (как минимум, надо просуммировать все единицы). Даже без суммирования нулей получается что-то экспоненциальное.

А вот теперь внимание на экран.
Хаскелл — ленивый. Поэтому если ты имеешь дело с формулой, состоящей из крендельона сложений единичек, то сперва эта формула будет развёрнута в пространстве, а уже потом посчитана (в тот момент, когда она потребуется).
Вот и получили отжор памяти. Ну и времени на развёртывание требуется столько же.

Такую же штуку мы можем поймать, если напишем наивную функцию длины списка (рекурсивно или на foldr). Правильное же решение — использовать форсировку вычисления арифметики — seq, $!, foldl'.
Перекуём баги на фичи!
Re[15]: Размен 1 доллара
От: D. Mon Великобритания http://thedeemon.livejournal.com
Дата: 06.09.08 10:40
Оценка:
Здравствуйте, Кодт, Вы писали:

Я так и подумал, что дело в ленивости. Чем мне Хаскелл не нравится, так это способностью превращать простые вещи в сложные (хотя обратно он тоже умеет, нельзя не заметить). Отсутствие сайде эффектов имеет свои сайд эффекты.

К>Правильное же решение — использовать форсировку вычисления арифметики — 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
f# j
Re[5]: Размен 1 доллара
От: Beam Россия  
Дата: 07.09.08 22:54
Оценка:
Здравствуйте, Кодт, Вы писали:

К>Такой код действительно летает.


Решение по-проще:
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

Выполняется ~12 секунд
... << RSDN@Home 1.1.4 stable SR1 rev. 568>>
Best regards, Буравчик
Re[8]: Размен 1 доллара
От: hub  
Дата: 08.09.08 10:36
Оценка:
Здравствуйте, D. Mon, Вы писали:

DM>
(define (count-change amount) 
DM>;  (cc amount 5 0 0 (lambda (x) (display x))))

DM>;(define (cc amount kinds-of-coins cursum nways con) 
DM>;  (cond ((= kinds-of-coins 1) (con 1)) 
DM>;        ((< amount cursum) (con nways))
DM>;        (else (cc (- amount cursum) (- kinds-of-coins 1) 0 0
DM>;                  (lambda (w) (cc amount kinds-of-coins 
DM>;                          (+ cursum (first-denomination kinds-of-coins))
DM>;                          (+ w nways) con))))))
                       

Я вроде понял CPS-трансформацию. Оказалось это особой сложности не представляет :-\  привеленная выше процедура без CPS-трансформации будет выглядеть так:
[lisp]
(define (cc amount kinds-of-coins cursum nways) 
  (cond ((= kinds-of-coins 1) 1) 
        ((<; amount cursum) nways)
        (else (cc amount 
                  kinds-of-coins
                  (+ cursum (first-denomination kinds-of-coins))
                  (+ nways (cc (- amount cursum) 
                               (- kinds-of-coins 1)
                               0
                               0))))))
Re[6]: Размен 1 доллара
От: D. Mon Великобритания http://thedeemon.livejournal.com
Дата: 10.09.08 15:12
Оценка:
Здравствуйте, 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]);;
Re[7]: Размен 1 доллара
От: hub  
Дата: 11.09.08 04:48
Оценка:
Здравствуйте, D. Mon, Вы писали:

DM>Здравствуйте, Beam, Вы писали:


B>>Если учесть, что решением задачи по сути является количество решений линейного диофантова уравнения, можно сделать оптимизацию.

B>>Выполняется ~12 секунд

Теперь если не трудно то же на Scheme
Re[8]: Размен 1 доллара
От: Beam Россия  
Дата: 11.09.08 08:08
Оценка:
Здравствуйте, hub, Вы писали:

hub>Здравствуйте, D. Mon, Вы писали:


DM>>Здравствуйте, Beam, Вы писали:


B>>>Если учесть, что решением задачи по сути является количество решений линейного диофантова уравнения, можно сделать оптимизацию.

B>>>Выполняется ~12 секунд

hub>Теперь если не трудно то же на Scheme


Эти решения являются рекурсивными, а Вам, как я понял, нужно итеративное (с хвостовой рекурсией?)
Сами решения не сильно отличаются от представленного Вами в первональном посте.
... << RSDN@Home 1.1.4 stable SR1 rev. 568>>
Best regards, Буравчик
Re: Размен 1 доллара
От: Pirsig  
Дата: 18.09.08 14:28
Оценка:
Вроде бы итеративный, т.е. рекурсия хвостовая. Без продолжений. Состояние процесса в каждый момент описывается одинаковым числом переменных. Другое дело, что эти переменные списки, а один из списков, к тому же растет (но не сильно).

Код объемный, но по сравнению с рекурсивным вариантов жутко быстрый — 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. Может и в самом деле вариант с продолжениями.
Re[2]: Размен 1 доллара
От: Pirsig  
Дата: 18.09.08 14:35
Оценка:
Здравствуйте, Pirsig, Вы писали:

P>В SICP на момент, в который была дана эта задача, списки еще рассматривались.

P>Поэтому мне непонятно какое решение у авторов SICP. Может и в самом деле вариант с продолжениями.

В SICP на момент, в который была дана эта задача, списки еще НЕ рассматривались.
Поэтому мне непонятно какое решение у авторов SICP. Может и в самом деле вариант с продолжениями.
Впрочем, lambda тоже вводится позже...
Re: Размен 1 доллара
От: Кодт Россия  
Дата: 18.09.08 17:56
Оценка:
Здравствуйте, hub, Вы писали:


Родил итерационный алгоритм.
На С++, поскольку с лиспом не шибко дружен. Сами перепирайте эту полечку.
#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; // и признака, что в кошельке точная сумма

// процедура заполнения кошелька, начиная с монет номинала номер k
void 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, поэтому обычно при нумерации используются полуоткрытые интервалы. Это очень удобно.
... << RSDN@Home 1.2.0 alpha 4 rev. 1111>>
Перекуём баги на фичи!
Re[2]: Размен 1 доллара
От: Pirsig  
Дата: 19.09.08 07:48
Оценка:
Поиграл с твоей идеей и вот что получилось.

На С++:

#include <iostream>

const int coins[] = {50, 25, 10, 5, 1};

const size_t num_coins = sizeof(coins)/sizeof(int);

int amounts[num_coins];

int target = 100;

int main()
{
    int i = 0;
    int success = 0;
    amounts[0] = target;
    
    while (amounts[0] > 0)
    {

    if (amounts[i] > 0)
    {
        if (i < num_coins - 1)
        {
        amounts[i+1] = amounts[i];
        i++;
        }
        else
        amounts[i] -= coins[i];
    }
    else
    {
        if (amounts[i] == 0) ++success;
        if (i > 0)
        {
        i--;
        amounts[i] -= coins[i];
        }
    }
    }

    if (amounts[0] == 0)
    success++;

    std::cout << success << std::endl;
}


На Common Lisp:

(defun cc-6 (amount coins)
  (let ((last_coin_index (1- (length coins)))
    (amounts (make-list (length coins) :initial-element 0)))

    (setf (elt amounts 0) amount)
    
    (labels ((iter (i result)
           (if (> (elt amounts i) 0)
           (progn
             (if (< i last_coin_index)
             (progn
               (setf (elt amounts (1+ i)) (elt amounts i)) ; i.e. amounts[i+1]=amounts[i]
               (iter (1+ i) result))
             (progn
               (decf (elt amounts i) (elt coins i))    ; i.e. amounts[i]-=coins[i]
               (iter i result))))
           (let ((dt (if (= (elt amounts i) 0) 1 0)))
             (if (> i 0)
             (progn
               (decf (elt amounts (1- i)) (elt coins (1- i))) ; i.e. amounts[i-1]-=coins[i-1]
               (iter (1- i) (+ result dt)))
             (+ result dt))))))
      (iter 0 0))))

;; CL-USER> (cc-6 1000 '(50 25 10 5 1))
;; 801451
Re: Размен 1 доллара
От: Трурль  
Дата: 26.09.08 10:12
Оценка:
Здравствуйте, hub, Вы писали:

hub>Здрасте всем, помогите пожалуйста с задачой размена доллара на монеты. В SICP есть реализация рекурсивной процедуры на Scheme:

hub>
hub>;(define (cc amount kinds-of-coins) 
hub>;  (cond ((= amount 0) 1) 
hub>;        ((or (< amount 0) (= kinds-of-coins 0)) 0) 
hub>;        (else (+ (cc amount (- kinds-of-coins 1)) 
hub>;                 (cc (- amount (first-denomination kinds-of-coins)) 
hub>;                     kinds-of-coins))))) 
hub>;

hub>Нужно реализовать итеративную.

Здесь у нас две рекурсии: плохая по amount и не столь плохая по kinds-of-coins. Можно просто избавиться от первой.
(define (cc amount kinds-of-coins count) 
   (cond ((= kinds-of-coins 1) 1)
         ((< amount 0) count)
         (else (cc (- amount (first-denomination kinds-of-coins))
                    kinds-of-coins 
                    (+ count (cc amount (- kinds-of-coins 1) 0))))))  

(define (count-change amount) 
   (cc amount 5 0))

> (count-change 1000)
801451
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.