Размен 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>>
Перекуём баги на фичи!
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.