Форум «Всё о Паскале» > "Greedy" и монеты.

DarkWishmaster

24.03.2011 19:33

Привет.
Вот задача:
В кошельке находятся N монет и их общий вес G:
Каждая монета имеет свою цену и свой вес:
цена: вес:
1 1
5 2
10 3
25 4
50 5
Выяснить минимальную общую стоимость монет которая может находится в кошельке
например:
G=23 N=10
минимальная стоимость =68:
3 монеты по 1
1 монета по 2
и 6 монет по 3
вот мой код:

 
 Program P1; Uses Crt;
 type Matrice=array[1..3,1..5] of byte;
   var A,b:matrice;  R,G,N,i,Nb,j,Suma,max,L:integer;
   Begin  ClrScr;
    CheckEof:=True;
    a[1,1]:=1; a[1,2]:=5; a[1,3]:=10; a[1,4]:=25; a[1,5]:=50;
    a[2,1]:=1; a[2,2]:=2; a[2,3]:=3; a[2,4]:=4; a[2,5]:=5;
      writeln('Nr. monet'); readln(N);
     writeln('Wes'); readln(G);
      if (G div N>5) or (N>G)  then exit;
    Suma:=0;
    for i:=1 to 5 do
       if a[2,i]*N>G then begin Nb:=a[2,i]; break;   end;
     Max:=G div Nb;
      R:=G mod Nb;
        if R=0 then a[3,Nb]:=Max else begin
        i:=1;
        if R<N-Max then Max:=Max-1;
           a[3,Nb]:=Max;
          while (L<N) do  begin
            L:=0;
            if (a[3,i]+a[2,i+1]=G-Nb*max) and (a[3,i]+a[3,Nb]+1=N) then
              begin inc(i); a[3,i]:=a[3,i]+1; end else   a[3,i]:=a[3,i]+1;
             for j:=1 to Nb do
               L:=L+a[3,j];
            end;
          end;
 for i:=1 to 3 do begin
    for j:=1 to 5 do begin
     write(a[i,j],' ');
      if i=3 then Suma:=Suma+a[1,j]*a[3,j];
      end;
       writeln;
       end;
    writeln(Suma);
     readln;
   end.

Он рабочий для параметром 10 23, 10 22, и ещё нескольких, и я уверен что есть способ более легкой для это задачи.

Lapp

25.03.2011 5:41

Цитата(DarkWishmaster @ 24.03.2011 19:33)

Привет.
Вот задача:
В кошельке находятся N монет и их общий вес G:
Каждая монета имеет свою цену и свой вес:
цена: вес:
1 1
5 2
10 3
25 4
50 5
Выяснить минимальную общую стоимость монет которая может находится в кошельке
например:
G=23 N=10
минимальная стоимость =68:
3 монеты по 1
1 монета по 2
и 6 монет по 3
вот мой код:

 
 Program P1; Uses Crt;
 type Matrice=array[1..3,1..5] of byte;
   var A,b:matrice;  R,G,N,i,Nb,j,Suma,max,L:integer;
   Begin  ClrScr;
    CheckEof:=True;
    a[1,1]:=1; a[1,2]:=5; a[1,3]:=10; a[1,4]:=25; a[1,5]:=50;
    a[2,1]:=1; a[2,2]:=2; a[2,3]:=3; a[2,4]:=4; a[2,5]:=5;
      writeln('Nr. monet'); readln(N);
     writeln('Wes'); readln(G);
      if (G div N>5) or (N>G)  then exit;
    Suma:=0;
    for i:=1 to 5 do
       if a[2,i]*N>G then begin Nb:=a[2,i]; break;   end;
     Max:=G div Nb;
      R:=G mod Nb;
        if R=0 then a[3,Nb]:=Max else begin
        i:=1;
        if R<N-Max then Max:=Max-1;
           a[3,Nb]:=Max;
          while (L<N) do  begin
            L:=0;
            if (a[3,i]+a[2,i+1]=G-Nb*max) and (a[3,i]+a[3,Nb]+1=N) then
              begin inc(i); a[3,i]:=a[3,i]+1; end else   a[3,i]:=a[3,i]+1;
             for j:=1 to Nb do
               L:=L+a[3,j];
            end;
          end;
 for i:=1 to 3 do begin
    for j:=1 to 5 do begin
     write(a[i,j],' ');
      if i=3 then Suma:=Suma+a[1,j]*a[3,j];
      end;
       writeln;
       end;
    writeln(Suma);
     readln;
   end.

Он рабочий для параметром 10 23, 10 22, и ещё нескольких, и я уверен что есть способ более легкой для это задачи.

Однако, ответ неверный. Для 23 и 10 верный ответ такой
1 - 0
5 - 7
10 - 3
25 - 0
50 - 0
Что дает минимум суммы 65.

DarkWishmaster

25.03.2011 8:20

Цитата(Lapp @ 25.03.2011 6:41)

Однако, ответ неверный. Для 23 и 10 верный ответ такой
1 - 0
5 - 7
10 - 3
25 - 0
50 - 0
Что дает минимум суммы 65.

Ага, я ошибься. Извините.
Есть идеи как это сделать?

Lapp

25.03.2011 8:26

Ты извини, но в твоем решении я не стал разбираться.. Скажи, какой смысл три разные величины засовывать в один массив? Разве удобно помнить, что у тебя означает строка 2 - вес, цену или количество? Намного удобнее сделать массив записей, например:

coins: array [1..5] of record
  w, v, n: integer  // вес, значение, количество
end;

Но мне кажется просто три массива тут прекрасно справляются с задачей.
И еще - тебе НАДО поработать над форматированием текста.. Ты вот спрашивал в Свободном про то, какой язык выбрать.. Извини, но ДО ТОГО тебе надо освоить ОБЩИЕ ПРИНЦИПЫ. Код форматировать НАДО. Я уже устал всем это доказывать.. Прийми на веру

. НАДО.

Вот, я набросал тут два решения. Первое - некрасивое, я его просто так за пять минут сделал, чтоб проверить, какое же на самом деле минимальное решение (то, которое я привел выше, найдено "устно", без программы). В нем намертво зашито 4 цикла - то есть решение годится только для 5 значений монет, и баста. Разбери его, но учти - так программировать НЕ НАДО!! Второе - на основе рекурсии. Этот метод годится для разных наборов монет (достаточно подправить верхние строчки).

Давай, разбирайся и спрашивай, что неясно. Успехов тебе.

Код без рекурсии (как НЕ НАДО) (Показать/Скрыть)

const
  m = 5;

const
  w: array [1..m] of integer = (1,2,3,4,5);
  p: array [1..m] of integer = (1,5,10,25,50);

var
  n: array [1..m-1] of integer;
  i,i1,i2,i3,i4,t,tw,tn,min: integer;

begin
  Write('введите общий вес и число монет: ');
  ReadLn(tw,tn);
  min:= MaxInt;
  for i1:=0 to tn do
    for i2:=0 to tn-i1 do
      for i3:=0 to tn-i1-i2 do
        for i4:=0 to tn-i1-i2-i3 do
          if i1*w[1] + i2*w[2] + i3*w[3] + i4*w[4] + (tn-i1-i2-i3-i4)*w[5] = tw then begin
            t:= i1*p[1] + i2*p[2] + i3*p[3] + i4*p[4] + (tn-i1-i2-i3-i4)*p[5];
            if t<min then begin
              n[1]:= i1;
              n[2]:= i2;
              n[3]:= i3;
              n[4]:= i4;
              min:= t
            end
          end;
  if min<MaxInt then begin
    t:= tn;
    WriteLn('минимально возможная сумма равна ',min,', она осуществляется набором: ');
    for i:=1 to m-1 do begin
      write(n[i]:4,'(',p[i],')');
      t:= t-n[i]
    end;
    WriteLn(t:4,'(',p[5],')')
  end
  else WriteLn('введенная комбинация веса и числа монет неосуществима');
  readln
end.

Код с рекурсией (Показать/Скрыть)

const
  m = 5;

const
  w: array [1..m] of integer = (1,2,3,4,5);
  p: array [1..m] of integer = (1,5,10,25,50);

var
  n,nmin: array [1..m-1] of integer;
  i,tw,tn,min,cw,cn,t: integer;

procedure Engage(k: integer);
var
  i,v,rn,rw: integer;
begin
  if k=m then begin
    if cw=tw-(tn-cn)*w[m] then begin
      v:=0;
      for i:=1 to m-1 do v:= v+n[i]*p[i];
      v:= v+(tn-cn)*p[m];
      if v<min then begin
        nmin:= n;
        min:= v
      end
    end
  end
  else begin
    rn:= cn;
    rw:= cw;
    for i:=0 to tn-cn do begin
      n[k]:=i;
      Engage(k+1);
      Inc(cn);
      cw:= cw+w[k];
    end;
    cn:= rn;
    cw:= rw
  end
end;


begin
  Write('введите общий вес и число монет: ');
  ReadLn(tw,tn);
  min:= MaxInt;
  cw:= 0;
  cn:= 0;
  Engage(1);
  if min<MaxInt then begin
    t:= tn;
    WriteLn('минимально возможная сумма равна ',min,', она осуществляется набором: ');
    for i:=1 to m-1 do begin
      write(nmin[i]:4,'(',p[i],')');
      t:= t-nmin[i]
    end;
    WriteLn(t:4,'(',p[5],')')
  end
  else WriteLn('введенная комбинация веса и числа монет неосуществима');
  readln
end.

DarkWishmaster

25.03.2011 11:55

Цитата(Lapp @ 25.03.2011 9:26)

Ты извини, но в твоем решении я не стал разбираться.. Скажи, какой смысл три разные величины засовывать в один массив? Разве удобно помнить, что у тебя означает строка 2 - вес, цену или количество? Намного удобнее сделать массив записей, например:

coins: array [1..5] of record
  w, v, n: integer  // вес, значение, количество
end;

Но мне кажется просто три массива тут прекрасно справляются с задачей.
И еще - тебе НАДО поработать над форматированием текста.. Ты вот спрашивал в Свободном про то, какой язык выбрать.. Извини, но ДО ТОГО тебе надо освоить ОБЩИЕ ПРИНЦИПЫ. Код форматировать НАДО. Я уже устал всем это доказывать.. Прийми на веру

. НАДО.

Вот, я набросал тут два решения. Первое - некрасивое, я его просто так за пять минут сделал, чтоб проверить, какое же на самом деле минимальное решение (то, которое я привел выше, найдено "устно", без программы). В нем намертво зашито 4 цикла - то есть решение годится только для 5 значений монет, и баста. Разбери его, но учти - так программировать НЕ НАДО!! Второе - на основе рекурсии. Этот метод годится для разных наборов монет (достаточно подправить верхние строчки).

Давай, разбирайся и спрашивай, что неясно. Успехов тебе.

Код без рекурсии (как НЕ НАДО) (Показать/Скрыть)

const
  m = 5;

const
  w: array [1..m] of integer = (1,2,3,4,5);
  p: array [1..m] of integer = (1,5,10,25,50);

var
  n: array [1..m-1] of integer;
  i,i1,i2,i3,i4,t,tw,tn,min: integer;

begin
  Write('введите общий вес и число монет: ');
  ReadLn(tw,tn);
  min:= MaxInt;
  for i1:=0 to tn do
    for i2:=0 to tn-i1 do
      for i3:=0 to tn-i1-i2 do
        for i4:=0 to tn-i1-i2-i3 do
          if i1*w[1] + i2*w[2] + i3*w[3] + i4*w[4] + (tn-i1-i2-i3-i4)*w[5] = tw then begin
            t:= i1*p[1] + i2*p[2] + i3*p[3] + i4*p[4] + (tn-i1-i2-i3-i4)*p[5];
            if t<min then begin
              n[1]:= i1;
              n[2]:= i2;
              n[3]:= i3;
              n[4]:= i4;
              min:= t
            end
          end;
  if min<MaxInt then begin
    t:= tn;
    WriteLn('минимально возможная сумма равна ',min,', она осуществляется набором: ');
    for i:=1 to m-1 do begin
      write(n[i]:4,'(',p[i],')');
      t:= t-n[i]
    end;
    WriteLn(t:4,'(',p[5],')')
  end
  else WriteLn('введенная комбинация веса и числа монет неосуществима');
  readln
end.

Код с рекурсией (Показать/Скрыть)

const
  m = 5;

const
  w: array [1..m] of integer = (1,2,3,4,5);
  p: array [1..m] of integer = (1,5,10,25,50);

var
  n,nmin: array [1..m-1] of integer;
  i,tw,tn,min,cw,cn,t: integer;

procedure Engage(k: integer);
var
  i,v,rn,rw: integer;
begin
  if k=m then begin
    if cw=tw-(tn-cn)*w[m] then begin
      v:=0;
      for i:=1 to m-1 do v:= v+n[i]*p[i];
      v:= v+(tn-cn)*p[m];
      if v<min then begin
        nmin:= n;
        min:= v
      end
    end
  end
  else begin
    rn:= cn;
    rw:= cw;
    for i:=0 to tn-cn do begin
      n[k]:=i;
      Engage(k+1);
      Inc(cn);
      cw:= cw+w[k];
    end;
    cn:= rn;
    cw:= rw
  end
end;
begin
  Write('введите общий вес и число монет: ');
  ReadLn(tw,tn);
  min:= MaxInt;
  cw:= 0;
  cn:= 0;
  Engage(1);
  if min<MaxInt then begin
    t:= tn;
    WriteLn('минимально возможная сумма равна ',min,', она осуществляется набором: ');
    for i:=1 to m-1 do begin
      write(nmin[i]:4,'(',p[i],')');
      t:= t-nmin[i]
    end;
    WriteLn(t:4,'(',p[5],')')
  end
  else WriteLn('введенная комбинация веса и числа монет неосуществима');
  readln
end.

Спасибо! Буду разбираться.
"Ты вот спрашивал в Свободном про то, какой язык выбрать.. " - ну это я хочу паралельно учить и другой язык, хотя Паскаля и на половину не знаю )

Lapp

25.03.2011 12:11

Цитата(DarkWishmaster @ 25.03.2011 11:55)

хочу паралельно учить и другой язык, хотя Паскаля и на половину не знаю )

Желание что-то делать (в частном случае - учить) всегда похвально. Но второй язык только усилит неразбериху в твоей голове. В результате ты проиграешь на всех фронтах. Решай как можно больше задач на Паскале - это поможет тебе усвоить те самые общие принцмпы, о которых я говорил. После этого раскроешь учебник по другому языку - и тебе покажется, что ты его уже знаешь..