Программа подсчета калорий еды в пакетах — Pascal(Паскаль)

Например, рассмотрим лимит в 40 калорий и 6 пакетов с пищей с калорийностью 7, 13, 17, 19, 29, 31. Бесси может съесть 7 + 31 = 38 калорий, но она может съесть и больше, используя 3 пакета с пищей:
7 + 13 + 19 = 39 калорий. Не существует лучшей комбинации. Если не понятно то вот задача :
Бесси — на диете, в соответствии с которой она может есть не более чем C (10 <= C <= 35,000) калорий в день. Фермер Джон кормит ее поставляя B (1 <= B <= 21) пакетов с пищей, каждый с некоторым
(в общем случае неуникальным) числом калорий (в диапазоне 1..35000). У Бесси отсутствует самоконтроль, если она начинает кушать пакет с пищей, она съедает его до конца. Бесси не сильна в комбинаторике. Определите оптимальную комбинацию пакетов с пищей, которая даст Бесси максимальное
количество калорий без превышения лимита C. Например, рассмотрим лимит в 40 калорий и 6 пакетов с пищей с
калорийностью 7, 13, 17, 19, 29, 31. Бесси может съесть 7 + 31 = 38 калорий, но она может съесть и больше, используя 3 пакета с пищей: 7 + 13 + 19 = 39 калорий. 

{$R-}
Program Kalorii;
uses
  crt;
Type
  Tmas=array[1..1] of integer;
var
  ColCalorie,
  ColMatr,
  ColFood,
  i,max:integer;
  Mas:^Tmas;
  s:string;
 
procedure razbienie_mnozhestva(n:byte);
var
  i,j,k:byte;
  wper:array[1..255] of boolean;
  sled,pred,blok:array[1..255] of byte;
 
procedure write_razbienie;
var
 i,j:byte;
 tmps,tmpscol:string;
 sum:integer;
begin
 j:=1;
 repeat
  tmps:='';
  sum:=0;
  for i:=j to n do
    if blok[i]=j then
    begin
      str(i,tmpscol);
      tmps:=tmps+tmpscol+' ';
      sum:=sum+mas^[i];
    end;
  if (sum>max) and (sum<=ColCalorie) then
  begin
    s:=tmps;
    max:=sum;
    if (max=ColCalorie) then
      exit;
  end;
  j:=sled[j];
 until j=0
end;
 
begin
 for i:=1 to n do
 begin
  blok[i]:=1;
  wper[i]:=true
 end;
 sled[1]:=0;
 write_razbienie;
 j:=n;
 while j>1 do
 begin
  k:=blok[j];
  if wper[j] then
  begin
   if sled[k]=0 then
   begin
    sled[k]:=j;
    pred[j]:=k;
    sled[j]:=0
   end;
   if sled[k]>j then
   begin
    pred[j]:=k;
    sled[j]:=sled[k];
    pred[sled[j]]:=j;
    sled[k]:=j
   end;
   blok[j]:=sled[k]
  end
  else begin
   blok[j]:=pred[k];
   if k=j then if sled[k]=0 then sled[pred[k]]:=0 else
   begin
    sled[pred[k]]:=sled[k];
    pred[sled[k]]:=pred[k]
   end
  end;
  write_razbienie;
  j:=n;
  while(j>1)and
   ((wper[j]and(blok[j]=j))or(not wper[j]and(blok[j]=1))) do
  begin
   wper[j]:=not wper[j];
   dec(j)
  end
 end
end;
 
begin
  repeat
    clrscr;
    Writeln('VVedite Maximal''noe koli4ectvo kolorui');
    readln(ColCalorie);
  until (ColCalorie>=10) and (ColCalorie<=35000);
  repeat
    clrscr;
    Writeln('VVedute kolu4estvo paketov c nuLL/ei');
    readln(ColFood);
  until (ColFood>=1) and (ColFood<=21);
  GetMem(Mas,SizeOf(integer)*ColFood);
  clrscr;
  Writeln('VVedite koloruinoct'' paketov c edou');
  for i:=1 to ColFood do
  begin
    Write('Kaloruinoct''' ,i, '-go paketa= ');
    readln(mas^[i]);
  end;
  clrscr;
  Writeln('Ojudaute, programma npos4utivaet yclovuia...');
  razbienie_mnozhestva(ColFood);
  FreeMem(Mas,Sizeof(integer)*ColFood);
  clrscr;
  Writeln('Cymma makcimal''nogo nabopa = ' ,max);
  Writeln;
  Writeln('Takoi Habor coctout u3 paketov pod cledyI-OLL/umu nomepamu');
  Write(s);
  readkey;
end.
{$R+}

Вариант 2

{$R-}
Program Kalorii;
uses
  crt;
Type
  Tmas=array[1..1] of integer;
var
  ColCalorie,
  ColMatr,
  ColFood,
  i,max:integer;
  Mas:^Tmas;
  s:string;
 
procedure razbienie_mnozhestva(n:byte);
var
  i,j,k:byte;
  wper:array[1..255] of boolean;
  sled,pred,blok:array[1..255] of byte;
 
procedure write_razbienie;
var
 i,j:byte;
 tmps,tmpscol:string;
 sum:integer;
begin
 j:=1;
 repeat
  tmps:='';
  sum:=0;
  for i:=j to n do
    if blok[i]=j then
    begin
      str(i,tmpscol);
      tmps:=tmps+tmpscol+' ';
      sum:=sum+mas^[i];
    end;
  if (sum>max) and (sum<=ColCalorie) then
  begin
    s:=tmps;
    max:=sum;
    if (max=ColCalorie) then
      exit;
  end;
  j:=sled[j];
 until j=0
end;
 
begin
 for i:=1 to n do
 begin
  blok[i]:=1;
  wper[i]:=true
 end;
 sled[1]:=0;
 write_razbienie;
 j:=n;
 while j>1 do
 begin
  k:=blok[j];
  if wper[j] then
  begin
   if sled[k]=0 then
   begin
    sled[k]:=j;
    pred[j]:=k;
    sled[j]:=0
   end;
   if sled[k]>j then
   begin
    pred[j]:=k;
    sled[j]:=sled[k];
    pred[sled[j]]:=j;
    sled[k]:=j
   end;
   blok[j]:=sled[k]
  end
  else begin
   blok[j]:=pred[k];
   if k=j then if sled[k]=0 then sled[pred[k]]:=0 else
   begin
    sled[pred[k]]:=sled[k];
    pred[sled[k]]:=pred[k]
   end
  end;
  write_razbienie;
  j:=n;
  while(j>1)and
   ((wper[j]and(blok[j]=j))or(not wper[j]and(blok[j]=1))) do
  begin
   wper[j]:=not wper[j];
   dec(j)
  end
 end
end;
 
begin
  repeat
    clrscr;
    Writeln('VVedite Maximal''noe koli4ectvo kolorui');
    readln(ColCalorie);
  until (ColCalorie>=10) and (ColCalorie<=35000);
  repeat
    clrscr;
    Writeln('VVedute kolu4estvo paketov c nuLL/ei');
    readln(ColFood);
  until (ColFood>=1) and (ColFood<=21);
  GetMem(Mas,SizeOf(integer)*ColFood);
  clrscr;
  Writeln('VVedite koloruinoct'' paketov c edou');
  for i:=1 to ColFood do
  begin
    Write('Kaloruinoct''' ,i, '-go paketa= ');
    readln(mas^[i]);
  end;
  clrscr;
  Writeln('Ojudaute, programma npos4utivaet yclovuia...');
  razbienie_mnozhestva(ColFood);
  FreeMem(Mas,Sizeof(integer)*ColFood);
  clrscr;
  Writeln('Cymma makcimal''nogo nabopa = ' ,max);
  Writeln;
  Writeln('Takoi Habor coctout u3 paketov pod cledyI-OLL/umu nomepamu');
  Write(s);
  readkey;
end.
{$R+}

Похожие записи/страницы:

Leave a Comment

− 4 = 6