Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.12.2016, 18:24   #1
Camelot_2012
Пользователь
 
Регистрация: 19.12.2011
Сообщений: 90
По умолчанию Сделать ручной ввод

Здравствуйте, помоги пожалуйста сделать ручной ввод, как показано на скриншоте.
Код динамического программирования для задачи о рюкзаке:
Код:
const k=5; ww=15;
    w:array [1..k] of integer=(1,2,4,12,1);
    p:array [1..k] of integer=(2,2,10,4,1);
 
var a:array [0..k,0..ww] of integer;
    s,n:integer;
    
procedure Print(s,n:integer);
begin
  if (A[s,n]<>0) then
    if (A[s-1,n] = A[s,n])
      then Print(s-1,n)
      else begin
        Print(s-1,n-w[s]);
        writeln(s);
      end;
end;
 
begin
 
 for n:=0 to ww do A[0,n]:=0;
 for s:=1 to k do
    for n:=0 to ww do
    begin
        A[s,n]:=A[s-1,n];
        if  (n>=w[s]) and (A[s-1,n-w[s]]+p[s] > A[s,n])
          then A[s,n]:= A[s-1][n-w[s]]+p[s];
    end;
 print(k,ww);
end.
Изображения
Тип файла: jpg Ввод и вывод.JPG (42.0 Кб, 64 просмотров)
Camelot_2012 вне форума Ответить с цитированием
Старый 13.12.2016, 22:26   #2
Camelot_2012
Пользователь
 
Регистрация: 19.12.2011
Сообщений: 90
По умолчанию

Вот алгоритм решения
Изображения
Тип файла: jpg 005.jpg (119.1 Кб, 110 просмотров)
Тип файла: jpg 006.jpg (119.9 Кб, 119 просмотров)
Camelot_2012 вне форума Ответить с цитированием
Старый 13.12.2016, 22:54   #3
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

примерно так:

Код:
var 
    a:array of array of integer;
    k,ww,s,n:integer;
    
    names : array of string;
    w,p : array of integer;
      
procedure Print(s,n:integer);
begin
  if (A[s,n]<>0) then
    if (A[s-1,n] = A[s,n])
      then Print(s-1,n)
      else begin
        Print(s-1,n-w[s]);
        writeln(s,' ', names[s]);
      end;
end;

var i : integer;

begin

 // ввод данных
 Write('Количество товара: ');
 ReadLn(k); 
 SetLength(names, k+1);
 SetLength(w, k+1);
 SetLength(p, k+1);
 
 
 for i:=1 to k do begin
   Write('Название ',i,' товара:'); 
   ReadLn(names[i]);
   Write('Введите вес товара:'); 
   ReadLn(w[i]);
   Write('Введите цену товара:'); 
   ReadLn(p[i]);
 end;
 
 WriteLn;
 Write('Введите размер рюкзака: ');
 ReadLn(ww);
 
 
 SetLength(A, k+1);
 for i:=0 to k do
   SetLength(A[i], ww+1);
 
 
 for n:=0 to ww do A[0,n]:=0;
 for s:=1 to k do
    for n:=0 to ww do
    begin
        A[s,n]:=A[s-1,n];
        if  (n>=w[s]) and (A[s-1,n-w[s]]+p[s] > A[s,n])
          then A[s,n]:= A[s-1][n-w[s]]+p[s];
    end;
 WriteLn;    
 print(k,ww);
end.
ограничения на k и ww введёте самостоятельно (если они нужны, конечно).
Serge_Bliznykov вне форума Ответить с цитированием
Старый 14.12.2016, 09:16   #4
Camelot_2012
Пользователь
 
Регистрация: 19.12.2011
Сообщений: 90
По умолчанию

Я немного изменил код, подскажите почему циклится
Код:
Uses crt;
var 
    a:array of array of integer;
    k,ww,s,n,SumW,SumC:integer;
    
    names : array of string;
    w,p : array of integer;
    
      
procedure Print(s,n:integer);
begin
  if (A[s,n]<>0) then
    if (A[s-1,n] = A[s,n])
      then Print(s-1,n)
      else begin
        Print(s-1,n-w[s]);
        writeln(s,' ', names[s]);
      //writeln(s,' ', names[s], ' ',p[s],' ',w[s]);
      end;
end;

var i : integer;

begin
 SumW:=0;
 SumC:=0;
 Write('Количество товара: ');
 ReadLn(k); 
 Write('Введите размер рюкзака: ');
 ReadLn(ww);
 WriteLn;
 SetLength(names, k+1);
 SetLength(w, k+1);
 SetLength(p, k+1);
 
 
 for i:=1 to k do begin
   Write('Название ',i,'-го товара:'); 
   ReadLn(names[i]);
   Write('Введите вес товара:'); 
   ReadLn(w[i]);
   Write('Введите цену товара:'); 
   ReadLn(p[i]);
 end;
 
 SetLength(A, k+1);
 for i:=0 to k do
   SetLength(A[i], ww+1);
 
 
 for n:=0 to ww do A[0,n]:=0;
 for s:=1 to k do
    for n:=0 to ww do
    begin
        A[s,n]:=A[s-1,n];
        if  (n>=w[s]) and (A[s-1,n-w[s]]+p[s] > A[s,n])
          then A[s,n]:= A[s-1][n-w[s]]+p[s];
          SumW:=SumW+w[s];
          SumC:=SumC+p[s];
    end;
 WriteLn;   
 ReadLn(SumW);
 ReadLn(SumC);
 print(k,ww);
end.
Camelot_2012 вне форума Ответить с цитированием
Старый 14.12.2016, 11:52   #5
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

а так?

Код:

Uses crt;
var 
    a:array of array of integer;
    k,ww,s,n,SumW,SumC:integer;
    
    names : array of string;
    w,p : array of integer;
    
      
procedure Print(s,n:integer);
begin
  if (A[s,n]<>0) then
    if (A[s-1,n] = A[s,n])
      then Print(s-1,n)
      else begin
        Print(s-1,n-w[s]);
        writeln(s,' ', names[s]);
      //writeln(s,' ', names[s], ' ',p[s],' ',w[s]);
        SumW:=SumW+w[s];
        SumC:=SumC+p[s];
      end;
end;

var i : integer;

begin
 SumW:=0;
 SumC:=0;
 Write('Количество товара: ');
 ReadLn(k); 
 Write('Введите размер рюкзака: ');
 ReadLn(ww);
 WriteLn;
 SetLength(names, k+1);
 SetLength(w, k+1);
 SetLength(p, k+1);
 
 
 for i:=1 to k do begin
   Write('Название ',i,'-го товара:'); 
   ReadLn(names[i]);
   Write('Введите вес товара:'); 
   ReadLn(w[i]);
   Write('Введите цену товара:'); 
   ReadLn(p[i]);
 end;
 
 SetLength(A, k+1);
 for i:=0 to k do
   SetLength(A[i], ww+1);
 
 
 for n:=0 to ww do A[0,n]:=0;
 for s:=1 to k do
    for n:=0 to ww do
    begin
        A[s,n]:=A[s-1,n];
        if  (n>=w[s]) and (A[s-1,n-w[s]]+p[s] > A[s,n])
          then A[s,n]:= A[s-1][n-w[s]]+p[s];
    end;
 WriteLn;   
 print(k,ww);

 WriteLn;
 WriteLn('Суммарный вес: ',SumW);
 WriteLn('Суммарная  стоимость: ',SumC);
end.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 14.12.2016, 11:58   #6
Camelot_2012
Пользователь
 
Регистрация: 19.12.2011
Сообщений: 90
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
а так?
Все работает отлично, а можно ли сделать вывод результирующего набора через запятую?
Camelot_2012 вне форума Ответить с цитированием
Старый 14.12.2016, 13:15   #7
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от Camelot_2012 Посмотреть сообщение
Все работает отлично, а можно ли сделать вывод результирующего набора через запятую?
можно, конечно.

Если не заморачиваться с тем, что будет лишняя запятая в конце, тогда вообще просто:
Код:
writeln(names[s],', ');
А если заморачиваться, тогда можно ввести дополнительную переменную и с ёё помощью выводить как надо.
Если хотите, покажу.
Ну или вообще формировать строку в строковой переменной, а потом уже её выводить.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 14.12.2016, 16:56   #8
Camelot_2012
Пользователь
 
Регистрация: 19.12.2011
Сообщений: 90
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
Если хотите, покажу.
Ну или вообще формировать строку в строковой переменной, а потом уже её выводить.
было бы здорово
Camelot_2012 вне форума Ответить с цитированием
Старый 14.12.2016, 17:38   #9
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Код:
var 
    a:array of array of integer;
    k,ww,s,n,SumW,SumC:integer;
    
    names : array of string;
    w,p : array of integer;
    isNoFirst : boolean; 

.....

     else begin
        Print(s-1,n-w[s]);

        if isNoFirst then Write(', ')
        else isNoFirst  := true;
        write(names[s]);

        SumW:=SumW+w[s];
        SumC:=SumC+p[s];
      end;

.....

begin
 SumW:=0;
 SumC:=0;
 isNoFirst := false;
....
Serge_Bliznykov вне форума Ответить с цитированием
Старый 14.12.2016, 18:44   #10
Camelot_2012
Пользователь
 
Регистрация: 19.12.2011
Сообщений: 90
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
var
a:array of array of integer;
k,ww,s,n,SumW,SumC:integer;

names : array of string;
w,p : array of integer;
isNoFirst : boolean;

.....

else begin
Print(s-1,n-w[s]);

if isNoFirst then Write(', ')
else isNoFirst := true;
write(names[s]);

SumW:=SumW+w[s];
SumC:=SumC+p[s];
end;

.....

begin
SumW:=0;
SumC:=0;
isNoFirst := false;
....
выдает только один набор
Camelot_2012 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
dateTimePicker а можно ли сделать беспрерывный ввод? Lord_Jesus_ Windows Forms 1 14.10.2016 14:25
Нахождение детерминанта матрицы и её ручной ввод Chester751 Помощь студентам 1 03.05.2016 10:37
Как реализовать ручной ввод данных? maxim43k Помощь студентам 5 07.09.2011 22:49
как сделать быстрый ввод ??? Alex6474 Microsoft Office Excel 1 27.03.2011 14:48
Можно ли сделать ввод формул в примечании? motorway Microsoft Office Excel 1 11.07.2009 16:55