Задача о вероятности, Задача полностью решена Опции

[Zxzc]

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

Сообщение отредактировано: Zxzc - 14.05.2006 1:44

[volvo]

Я решил задачу, получилось что количество вложенных циклов равно количеству разновидностей монет. Проблема в том, что заранее не известно число разновидностей монет.

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

[Zxzc]

, рекурсия не причем.
Вот моё, абсолютно не массовое, решение:
Пусть имеются три вида монет массами 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('Разбивай');

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

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

[volvo]

, рекурсия не причем.

Уверен? Я - нет... Смотри сюда (если твое, "не массовое решение", верно):

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.

[мисс_граффити]

2. Если бы меньшей монете соответствовал меньший вес, то задача решалась бы в 2 строчки:

If P/Massa_min>S/Dostoinstvo_min then Write('Может не хватить!')
Else Write('Разбивай');

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

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

[zZz]

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

[Zxzc]

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

[zZz]

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

Сообщение отредактировано: zZz - 9.05.2006 2:00

[Zxzc]

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

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

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

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

[zZz]

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

[Zxzc]

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

[zZz]

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

[Zxzc]

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

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

Сообщение отредактировано: Zxzc - 9.05.2006 20:16

[Lapp]

Заинтересовала меня эта задачка тоже.. Мужики, вы зря не слушаете 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]

А! Я наконец-то понял суть проблемы. Раньше я трактовал ее несколько иначе!

Лучше поздно, чем никогда!

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

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

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

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

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

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

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

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

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]

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

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

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

[Lapp]

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

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

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

Сообщение отредактировано: lapp - 12.05.2006 10:42

[Zxzc]

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

[Zxzc]

Внимание! Я достал-таки исходники!
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]

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

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