Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Задача о вероятности

Автор: Zxzc 6.05.2006 22:33

Помогите решить задачу:
Мальчик накапливал в копилке деньги. Однажды он увидел в магазине некий товар стоимостью S.
Дело в том что копилка заполнена не до конца, а разбивать ее можно лишь при 100% уверенности,
что количества денег будет достаточно. Но он не помнит сколько монет какого достоинства клал в копилку. Также известна масса пустой копилки и, конечно, текущая масса.
Известны соотношения Номинал <--> Масса монеты. Нужно определить минимальную вероятность и если она равна 100% вывести:"Вперед!!!!!!!!!!!" smile.gif
Я решил задачу, получилось что количество вложенных циклов равно количеству разновидностей монет.
Проблема в том, что заранее не известно число разновидностей
монет. blink.gif Также важно, что монеты, номинал которых больше, не всегда тяжелее. Но это не проблема...
Препод предложил идти через двумерный массив(M,N его - большие числа). И каким-то замысловатым способом из 2-х массивов(в первом - номиналы, во втором - массы) получаем массив [m,n]-й элемент к-рого - минимальное кол-во денег... Потом он сам запутался... wacko.gif
Мда.. blink.gif Давно я так не попадался...

Автор: volvo 6.05.2006 23:06

Цитата(Zxzc @ 6.05.2006 22:33)
Я решил задачу, получилось что количество вложенных циклов равно количеству разновидностей монет. Проблема в том, что заранее не известно число разновидностей монет.

Про рекурсию не слышал никогда? По-моему это как раз то, что ты описываешь... Неплохо было бы твой код посмотреть, конечно, чтобы быть полностью уверенным...

Автор: Zxzc 7.05.2006 22:51

no1.gif , рекурсия не причем.
Вот моё, абсолютно не массовое, решение:
Пусть имеются три вида монет массами m1, m2 и m3 и достоинством d1,d2,d3.
MaxAvail - "максимальное число переборов" - найдем по формуле (P/Вес самой дешевой).
P - вес монет, S - стоимость товара.
Тогда все сводится к

For i:=1 to MaxAvail do
For j:=1 to MaxAvail do
For k:=1 to MaxAvail do
If m1*i+m2*j+m3*k = P then
If d1**i+d2*j+d3*k<S then
begin
Write('Может не хватить!');
readln;
exit;
end;
Write('Разбивай');
end.


Но это решение не верно т.к.
1. Число разновидностей не известно заранее.
2. Если бы меньшей монете соответствовал меньший вес, то задача решалась бы в 2 строчки:
If P/Massa_min>S/Dostoinstvo_min then Write('Может не хватить!')
Else Write('Разбивай');


Может мы что-то сможем получить, развивая второе рассуждение... dry.gif

P.S. На дискете у меня есть 2 варианта решения препода. Но вот незадача: "DISK NOT FORMATED. DO YOU WANT FORMAT IT NOW?" Если у меня получится таки достать файлы с исходниками я сразу же их выложу. А иначе до конца выходных...

Автор: volvo 7.05.2006 23:39

Цитата(Zxzc @ 7.05.2006 22:51)
no1.gif , рекурсия не причем.

Уверен? Я - нет... Смотри сюда (если твое, "не массовое решение", верно):
const
max_size = 100; { Работаем до 100 разных номиналов максимум }

type
arrType = array[1 .. max_size] of integer;

var
m, d: arrType;
coin_count, MaxAvail: integer;

P, s: integer;


procedure check(level: integer; var a: arrType);
var i, j, s_m, s_d: integer;
begin
if level > coin_count then exit
else
if level = coin_count then
for i := 1 to MaxAvail do begin
a[level] := i;
s_m := 0; s_d := 0;
for j := 1 to level do begin
s_m := s_m + m[j] * a[j];
s_d := s_d + d[j] * a[j];
end;
if (s_m = P) and (s_d < s) then begin
writeln('not enough possibly...');
readln; halt;
end

(*
{ Checking }
for j := 1 to level do
write(a[j]:4);
writeln;
*)

end

else
for i := 1 to MaxAvail do begin
a[level] := i;
check(succ(level), a); { Я тебе обещал рекурсию? }
end;
end;


var
counters: arrType;

begin
MaxAvail := 3; { Считай по своей формуле }

coin_count := 3;
{
+ заполни массивы m, d нужными значениями,
и в coin_count занеси КОЛИЧЕСТВО монет
}

check(1, counters);
Writeln('Do it !!!');

end.

Автор: мисс_граффити 8.05.2006 9:23

Цитата(Zxzc @ 7.05.2006 22:51) *


2. Если бы меньшей монете соответствовал меньший вес, то задача решалась бы в 2 строчки:
If P/Massa_min>S/Dostoinstvo_min then Write('Может не хватить!')
Else Write('Разбивай');

Если такое решение допустимо, кто нам мешает аналогично посчитать для каждого вида монет?
количество видов известно, запускаем цикл
и хранить результат, например, в переменной типа boolean (наверняка хватает/не хватает).

только, по-моему, со знаком промахнулся.

Автор: zZz 8.05.2006 10:25

а не судьба определить удельное достоинство каждой монеты(достоинство/масса), это как раз то, насколько я понимаю, что имел в виду препод, говоря о массивах, и если минимальное удельное достоинство * массу монет внутри >= необходимой сумме то точно хватит, аналогично можно проверить на точно не хватит...

Автор: Zxzc 8.05.2006 21:28

volvo, MaxAvail в моем решении найден не верно. Говорю же "не массовое"
zZz dry.gif Решение похоже на правильное... Тогда задача решается с одним массивом array[1..100,1..2] - первое число достоинство, второе - масса. В цикле вычисляем по твоей формуле и, на лету, ищем минимальное...
Отлично! good.gif

Автор: zZz 8.05.2006 21:53

одно маленькое дополнение: может получиться так что монет с этим миниальным удельным достоинством нельзя набрать целое количество так чтобы они полностью покрыли массу монет в копилке... так что надо придумать как делать проверку еще на этот фактор и учитывать и возможность нахождения в копилке других монет... такая вот неприятность... сам уже заинтересовался как сделать эту проверку, жаль времени нет, к экзаменам готовлюсь... а так бы обязательно...

Автор: Zxzc 8.05.2006 22:23

Цитата
вот такая вот неприятность...

Да вся эта задача сплошная неприятность!!! mad.gif
Продолжаем в двух направлениях:
1. Нахождение MaxAvail.
2. Неприятность ZzZ'та.
Хотя, на мой взгляд обе неприятности имеют одни корни - несоответствие "меньшая масса <--> меньшее достоинство". wacko.gif

Нужно это как-то себе представить. Вот. 5 копеек весят 10 грамм, 10 копеек - 8. Ээээ...
У нас в копилке 40 грамм. Наскребем ли мы 50 копеек? Нет, т.к. 40/10*5=20 копеек. blink.gif Как я получил эту формулу?!! АГА!!! min_money=P/P_mon*D_mon --> Минимальная сумма, набираемая монетами данного типа. Дальше: В цикле, для каждого типа монет.

Теорема: Сумма, набираемая монетами типа с минимальным удельным достоинством, всегда меньше суммы, набираемая монетами этого типа и любого другого типа.

Автор: zZz 8.05.2006 22:50

предлагаю найти число монет мин удельного достоинства, которое может поместиться в копилку не переполняя массу, обозначим это кол-во за N, тогда можно найти массу которую необходимо добрать, тут следует ввести перебор(других вариантов у меня пока нет) в котором мы можем прибавлять любое количество монет большего уд достоинства и отнимать от 0 до N минимального до момента когда оставшаяся масса компенсируется... вот так сказать эскизный вариант... ничего кроме как удачи пожелать не могу...

Автор: Zxzc 8.05.2006 22:51

blink.gif !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5 копеек, имея БОЛЬШИЙ вес, "поглотят" БОЛЬШЕ от общего веса, а значит их сумма будет меньше!!!!
И ЭТО уже ИХ проблема - а нам лучше - мы же ищем минимальную сумму. Но пусть все нормально - 5 копеек имеют МЕНЬШИЙ вес и если и][...
ТАК! Попустительством назовем ситуацию, при которой одинаковая по весу масса монет младшего разряда ценнее чем старшего... Т.Е. В 10 граммах 10-копеечных монет, массой 10 грамм каждая находится 10 копеек.
В 10 граммах 5-копеечных монет массой по 8 грамм находится ~7 копеек. А что если масса не 8, а 3 грамма.
Тогда ~16 копеек, а значит 10 копеек попустительствуют 5-ти.
Предложение: Берем меньшую по достоинству монету[1] и смотрим попустительствует ли ей монета[2] если
да то смотрим попустительствует ли ей (первой) [3] и до тех пор, пока не найдем монету которая не попустительствует. Последнюю монету, которая попустительствовала, назовем активной.
Если ни одна ни п.(я запарился писать это слово) первой то первая - активная.
Для активной монеты act:
Минимальная сумма=P/P_act*D_act.
Хм.. dry.gif Я что, РЕШИЛ ЗАДАЧУ?!!!!

Автор: zZz 8.05.2006 23:25

по-моему это все то нахождение монеты с наименьшей удельной массой/достоинством только в более сложной форме, и все равно встаёт та загвоздка dry.gif ... всё больше убеждаюсь что задачу эту без перебора не решить(хотя может я и не прав)

Автор: Zxzc 9.05.2006 10:31

Цитата
монет с этим миниальным удельным достоинством нельзя набрать целое количество так чтобы они полностью покрыли массу монет в копилке

А нам это надо? Удельное достоинство изначально подразумевает не целые числа.
Мы ищем не минимальное количество медяшек, а их сумму!
Или я не прав? dry.gif
А! Я наконец-то понял суть проблемы. Раньше я трактовал ее несколько иначе!

Автор: lapp 9.05.2006 14:52

Заинтересовала меня эта задачка тоже.. Мужики, вы зря не слушаете volvo - рекурсия тут решает все проблемы в несколько строчек. План примерно такой:

1. Подбираем удобную шкалу, чтоб удельные стоимости (УС) были целыми.
2. Упорядочиваем все типы монет в порядке возрастания УС.
3. Убираем лишние монеты (все, что можно набрать 2-ками весом в 2г, можно набрать и копейками весом 1г - значит, двушки не нужны)
4. Делим полный вес на вес монеты с наименьшей УС (№1). Если их количество вышло нецелым, вычитаем их массу из начальной массы, убираем монету №1 из расмотрения и повторяем то же самое с новой массой и новым набором монет. Если неудачно - убираем одну монету №1 и повторяем. И так до тех пор, пока не будет достигнуто соответствие либо не будет безрезультатно перебрано все.

Ниже даю код. Ошибок, вроде, нет, но проверял не очень тщательно. Если есть вопросы - пишите..

const
M=6; {Vsego tipov monet}
S=31; {Ves vseh monet v kopilke}

type
Int=integer;
tCoin=record
v,w:Int; {Value and Weight of a coin}
end;
tCoins=array[1..M]of tCoin;

var
Coin:tCoin;
i,j,x,y:Int;

const
N:Int=M;
{All known coin kinds}
Coins:tCoins=(
(v:1;w:4),
(v:2;w:8),
(v:5;w:20),
(v:10;w:3),
(v:20;w:6),
(v:50;w:23));
Scale:Int=1;
L:Int=0;
Total:Int=0;

function MinFill(c,R:Int):boolean;
{c - coin number as it appeares in Coins array}
{R - remaining coins total weight}
var
a:Int;

function CountDown:boolean;
begin
{Postepenno umenjshaem koli4estvo melkih monet}
while (a>=0)and not MinFill(c+1,R-a*Coins[c].w) do Dec(a);
CountDown:=a>=0
end;

begin
with Coins[c] do begin
a:=R div w;
MinFill:=(R mod w=0)or(c<N)and CountDown;
Inc(Total,a*v)
end
end;


begin
{Podbiraem shkalu, 4toby udelnye stoimosti byly celymi}
for i:=1 to N do with Coins[i] do
if ((v*Scale) mod w)>0 then Scale:=Scale*w;

{Uporyado4ivaem}
for i:=1 to N-1 do with Coins[i] do begin
x:=v*Scale div w;
y:=v;
for j:=i+1 to N do with Coins[j] do if x>v*Scale div w then begin
Coin:=Coins[i];
Coins[i]:=Coins[j];
Coins[j]:=Coin
end
end;

{Ubiraem lishie (c odinkovymi udelnymi stoimostyami)}
i:=1;
while i<N do with Coins[i+1] do begin
while (i<N)and(Coins[i].v*Scale div Coins[i].w=v*Scale div w) do begin
if Coins[i].v<v then x:=i+1 else x:=i;
for j:=x to N-1 do Coins[j]:=Coins[j+1];
Dec(N)
end;
Inc(i)
end;

{Vpered!}
if MinFill(1,S) then WriteLn('Minimal Total : ',Total) else WriteLn('No match found');
end.

Автор: lapp 10.05.2006 4:18

Цитата(Zxzc @ 9.05.2006 10:31) *

А! Я наконец-то понял суть проблемы. Раньше я трактовал ее несколько иначе!
Лучше поздно, чем никогда! smile.gif

Сейчас я перечитал свой пост - не очень-то ясно написано.. sad.gif. Переписывать (без специальных запросов), пожалуй, не буду, но немного добавлю.

Общий вес монет задается константой S.
Набор монет задается в типизированной константе Coins. В каждой записи указываются номинал монеты (v, от слова value) и вес (w, от слова weight). Число записей (число различных типов монет) задается константой M (в моем примере 6 разичных монет достоинством 1, 2, 5, 10, 20 и 50 единиц (копеек smile.gif ), соответственно весом 4, 8, 20, 3, 6 и 2 единицы (грамм). Монеты могут идти в любом порядке.

Если невозможно подобрать комбинацию монет с заданным весом S, то программа выдает фразу "No match found" (совпадение не найдено).
Если найдена искомая комбинация монет (согласно логике поиска, она обязательно минимальная [см. P.S.]), то выводится соответствующая сумма в единцах (копейках).

Я думаю, было бы полезно выводить и способ, которым набрана данная сумма. Для этого нужно добавить одну строчку, что я сейчас и сделаю...
[в течение некоторого времени ожесточенно колотит по клаве, чешет репу и наливает чай]
...сделал! В результате получилась фактически новая версия smile.gif.

Кроме прочего, старая версия странным образом глючила.. Я так и не смог разобраться, в чем дело, поскольку после добавления определенных переменных и операторов для отладки она глючить перестала, вроде. Если кто-то заметит глюки, прошу сказать мне о них.

Еще добавлю, что результаты (зависимость минимально возможной суммы от веса) выглядят довольно забавно smile.gif. Радостные предвкушения от ощущения тяжести руках может смениться разочарованием (например, при весе 100), а легкость (вес 5) может дать неплохой навар!
Распределение монет по весам я взял чисто от балды, оно не имеет к обычной реальности никакого отношения (думаю, это и не требовалось). Рекомендую поиграться с ним, чтобы понять суть проблемы.. smile.gif

И последнее: хочу обратить внимание на пользу рекурсии. Фактически, все решение укладывается в функцию MinFill. Все остальное - подготовка ряда значений и весов монет. Если принять, что он уже упорядоченный и без лишних значений - прога уменьшится драматически smile.gif.

Итак, вот новая версия. Кстати, она запрашивает вес монет с клавиатуры..

const
M=6; {Vsego tipov monet}

type
Int=integer;
tCoin=record
v,w:Int; {Value and Weight of a coin}
end;
tCoins=array[1..M]of tCoin;

var
S:Int; {Ves vseh monet v kopilke}
Coin:tCoin;
i,j,x,y:Int;

const
N:Int=M;
{All known coin kinds}
Coins:tCoins=(
(v:1;w:4),
(v:2;w:8),
(v:5;w:20),
(v:10;w:3),
(v:20;w:6),
(v:50;w:2));
Scale:Int=1;
L:Int=0;
Total:Int=0;

function MinFill(c,R:Int):boolean;
{c - coin number as it appeares in Coins array}
{R - remaining coins total weight}
var
a:Int;
b:boolean;

function CountDown:boolean;
begin
{Postepenno umenjshaem koli4estvo melkih monet}
while (a>=0)and not MinFill(c+1,R-a*Coins[c].w) do Dec(a);
CountDown:=a>=0
end;

begin
with Coins[c] do begin
a:=R div w;
b:=(R mod w=0)or(c<N)and CountDown;
MinFill:=b;
if b then begin
Inc(Total,a*v);
WriteLn(a:3,' coins of value=',v:3,', (total value=',v*a:5,')',', weight=',w:3,', (total weight=',w*a:5,')')
end
end
end;

begin
{Podbiraem shkalu, 4toby udelnye stoimosti byly celymi}
for i:=1 to N do with Coins[i] do
if ((v*Scale) mod w)>0 then Scale:=Scale*w;

{Uporyado4ivaem}
for i:=1 to N-1 do with Coins[i] do begin
x:=v*Scale div w;
y:=v;
for j:=i+1 to N do with Coins[j] do if x>v*Scale div w then begin
Coin:=Coins[i];
Coins[i]:=Coins[j];
Coins[j]:=Coin
end
end;

{Ubiraem lishie (c odinkovymi udelnymi stoimostyami)}
i:=1;
while i<N do with Coins[i+1] do begin
while (i<N)and(Coins[i].v*Scale div Coins[i].w=v*Scale div w) do begin
if Coins[i].v<v then x:=i+1 else x:=i;
for j:=x to N-1 do Coins[j]:=Coins[j+1];
Dec(N)
end;
Inc(i)
end;
Write(#13,#10,'Type in the total coins weight: '); ReadLn(S);

{Vpered!}
if MinFill(1,S) then WriteLn('Minimal Total : ',Total) else WriteLn('No match found');
ReadLn
end.


P.S.
Моя фраза об обязательной минимальности резульата на самом деле нуждается в доказательстве. Я уверен в этом довольно сильно, но руку на отсечение пока не дам... Кто это докажет/опровергнет?

Автор: Zxzc 12.05.2006 6:28

Я понял ход твоих мыслей! yes2.gif Т.е. если не будет найдено соответствия - масса введена не верно...

Цитата
P.S.Моя фраза об обязательной минимальности резульата на самом деле нуждается в доказательстве. Я уверен в этом довольно сильно, но руку на отсечение пока не дам... Кто это докажет/опровергнет?


Это выглядит довольно правдоподобно, но с доказательством труднее. Я сделал несколько набросков доказательства, но пока ничего не выходит. no1.gif
Вчера предложил эту задачу одногрупнику, и если я - лучший в группе, то он из отстающих. За 20 секунд он решил задачу методом zZz, еще через 10 столкнулся с проблемой... Я, конечно, описывал ему задачу в упрощенном варианте, но все-таки...где после этого логика и справедливость? Наверное я загнался... Выспаться бы...

Автор: lapp 12.05.2006 6:42

> Я понял ход твоих мыслей! yes2.gif
> Т.е. если не будет найдено соответствия - масса введена не верно...
Именно так. Не все массы можно скомбинировать из монет. Например, масса 1 в моем наборе не получится никогда..

> Это выглядит довольно правдоподобно, но с доказательством труднее.
> Я сделал несколько набросков доказательства, но пока ничего не выходит. no1.gif
А нужно ли здесь строгое доказательство? Это же не комбинаторика, а программирование.. smile.gif
Нет, я не имею в виду, что допустимы неверные решения, но строгость доказательства... кхм.. smile.gif
Ладно, я попробую сделать доказательство, если нужно..

Глюков в моей проге пока не заметил?

Автор: Zxzc 12.05.2006 21:52

Я сейчас готовлюсь к экзаменам и у меня даже нет времени провести несколько тестов для твоей программы и программы volvo, чтобы сравнить результаты... sad.gif И решения все просматриваю только поверхностно... Надеюсь, в выходные выкрою время...
P.S. Почему в основной панели смайликов нет sad.gif ? Это же основа...

Автор: Zxzc 13.05.2006 12:10

Внимание! Я достал-таки исходники!
1:

const Len=100;
var e,f,n,i,j:integer;
P, W:array[1..Len] of integer;
D:array[0..Len, 0..Len] of integer;
function min(a,b:integer):integer;
begin
if (a<b) then min:=a else min:=b;
if (b<0) then min:=a;
end;
begin
writeln('‚ўҐвЁвҐ ўҐб Їгбв®© Ё Ї®«­®© Є®ЇЁ«ЄЁ зҐаҐ§ Їа®ЎҐ«');
readln(e, f); f:=f-e;
writeln('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў®вЁЇ®ў ¬®­Ґв');
readln(n);
writeln('‚ўҐ¤ЁвҐ ¤®бв®Ё­бвў® Ё ўҐб ¬®­Ґв зҐаҐ§ Їа®ЎҐ«');
for i:=1 to n do
begin
write(i,' ¬®­Ґвл: ');
readln(P[i], W[i]);
end;
for i:=0 to n do
for j:=1 to f do
D[j, i]:=maxint;

for i:=1 to n do
for j:=W[i] to f do
D[j, i]:=min(D[j,i-1], D[j-W[i],i]+P[i]);

for j:=1 to f do
begin
for i:=1 to n do
write(D[j, i]:5,' ');
writeln;
end;
writeln('ЊЁ­Ё¬ «м­ п б㬬 а ў­ : ',D[f, n],' ',f);
readln;
end.

В чем суть этого решения?

Это,(
var e,f,n,i,j:integer;
m:longint;
P, W:array[1..500] of integer;
d:array[0..10000] of longint;

begin
writeln('‚ўҐвЁвҐ ўҐб Їгбв®© Ё Ї®«­®© Є®ЇЁ«ЄЁ зҐаҐ§ Їа®ЎҐ«');
readln(e, f); f:=f-e;
writeln('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў®вЁЇ®ў ¬®­Ґв');
readln(n);
writeln('‚ўҐ¤ЁвҐ ¤®бв®Ё­бвў® Ё ўҐб ¬®­Ґв зҐаҐ§ Їа®ЎҐ«');
for i:=1 to n do
begin
write(i,' ¬®­Ґвл: ');
readln(P[i], W[i]);
end;
D[0]:=0; for i:=1 to f do D[i]:=maxlongint;
for i:=1 to n do
begin
j:=W[i];
while j<=f do
begin
m:=D[j-W[i]];
if m<maxlongint then m:=m+P[i];
if m<D[j] then D[j]:=m;
j:=j+1;
end;
end;
if D[f]=maxlongint then writeln('No')
else writeln('ЊЁ­Ё¬ «м­ п б㬬 а ў­ : ',D[f]);
readln;
end.

) решение являлется усовершенствованной версией предыдущего, более оптимальное, но и более запутанное.

Автор: lapp 13.05.2006 14:12

Цитата(Zxzc @ 13.05.2006 13:10) *

Внимание! Я достал-таки исходники!

Первое решение у меня так и не заработало - там явная ошибка в реализации алгоритма, я не стал возиться исправлять.
А второе - работает лучше моего. Мое дает неминимальный набор. Слишком рано лезет в область дорогих монет. В принципе понятно, где у меня ошибка, но не знаю, стоит ли исправлять..

Автор: Zxzc 13.05.2006 21:41

yahoo!.gif Вы-ход-ной! Наконец-то провел все тесты и просмотрел листинги! 100% совпадений. Долго гонял по разным вариантам. Ошибок не обнаружено. На основе программы {2} исправил ошибки в {1}, однако считаю программу {2} более рациональной и оптимальной. Всем спасибо за участие!