Задача о рюкзаке, ПОМОГИТЕ!!!

[Perfilev]

Нужна программа (исходник, желательно на си или паскале) решающая задачу о рюкзаке:
X=(1,2,3,...,N), A принадлежит множеству {0, 1};
sum(X[i]*a[i])=s;
Найти подпоследовательности размерности K (K<=N), сумма которых была бы равной S.

Помогите пожалуйста, а то экзамен завалю!!!

[EvroStandart]

А подробнее можно? Что за задача о рюкзаке?

[LN berf]

Andy1

Может попроще расскажешь?. Размерность это сама одна большая задача
Расскажи детально.

[Perfilev]

Вот по-другому:
Алгоритм решает задачу о рюкзаке, которая формулируется так: дан, упорядоченный по неубыванию, массив A вещественных положительных чисел и некоторое Sum, необходимо найти все подпоследовательности массива A, сумма элементов которых равна в точности Sum.
В результате работы алгоритма получаем переменную L равную количеству найденых последовательностей. Сами последовательности помещаются в масcив строк Results, каждая строка представляет номера элементов массива A, разделенные запятыми.

В нете много ссылок на алгоритмы, а самой проги нет
Вот ссылка, например: http://alglib.manual.ru/combinatorial/backpack.php

Вот ещё кое-что: http://www.isu.ru/~slava/teach/school/comb_ret.htm
Просто сам уже не успеваю прогу написать, теории учить ещё до фига!

Если чё, я в асе: 86835583

Можно, чтобы она(прога) работала по неоптимальному алгоритму, главное, чтобы работала и была не слишком запутана!

[SwiMMeR]

Andy1
Задача о рюкзаке немного отличается от описанной тобой задачи.

Задача о рюкзаке:
Есть некоторое количество предметов, которые можно уложить в рюкзак. Для каждого предмета указан коэффициент полезности и его объем. Собрать рюкзак так, чтобы объем предметов не превышал указанный объем рюкзака и суммарная полезность предметов была максимальной.

[SwiMMeR]

За неимением Pascal'я код на VisualBasic'е ...

 Public Sub Main()
  ' Определение переменных и заполнение массивов
  Dim X(), A() As Byte
  Dim Res() As String
  Dim N, Sum, tSum, I As Byte
  N = 5 ' n - размерность массива (последовательности)
  ReDim X(N) ' X() - массив (последовательность) чисел
  ReDim A(N) ' A() - принимает значени 0 или 1 взависимости от того, входит данный элемент в сумму или нет
  ReDim Res(2 ^ N) ' Res() - результирующие последовательности
  ' заполняем массив произвольным образом
  X(1) = 1 : X(2) = 2 : X(3) = 2 : X(4) = 3 : X(5) = 3
  Sum = 6 ' s - сумма
  ' вводные данные закончились, теперь расчет
  A(1) = 0 : A(2) = 0 : A(3) = 0 : A(4) = 0 : A(5) = 0
  tSum = 0
  If tSum = Sum Then
   Call Save(Res, A, N)
  End If
  For I = 1 To N
   A(I) = 1
   Call Summ(Sum, tSum, I, X, A, Res, N)
   A(1) = 0 : A(2) = 0 : A(3) = 0 : A(4) = 0 : A(5) = 0
  Next
  I = 1
  While Len(Res(I)) > 0 And I <= 2 ^ N
   MsgBox(Res(I))
   I = I + 1
  End While
 End Sub

 Public Sub Main()
  ' Определение переменных и заполнение массивов
  Dim X(), A() As Byte
  Dim Res() As String
  Dim N, Sum, tSum, I, Count As Byte
  N = 5 ' n - размерность массива (последовательности)
  ReDim X(N) ' X() - массив (последовательность) чисел
  ReDim A(N) ' A() - принимает значени 0 или 1 взависимости от того, входит данный элемент в сумму или нет
  ReDim Res(2 ^ N) ' Res() - результирующие последовательности
  ' заполняем массив произвольным образом
  X(1) = 1 : X(2) = 2 : X(3) = 2 : X(4) = 3 : X(5) = 3
  Sum = 6 ' s - сумма
  ' вводные данные закончились, теперь расчет
  Count = 0
  A(1) = 0 : A(2) = 0 : A(3) = 0 : A(4) = 0 : A(5) = 0
  tSum = 0
  If tSum = Sum Then
   Count = Count + 1
   Call Save(Res, A, N)
  End If
  For I = 1 To N
   A(I) = 1
   Call Summ(Sum, tSum, I, X, A, Res, N, Count)
   A(1) = 0 : A(2) = 0 : A(3) = 0 : A(4) = 0 : A(5) = 0
  Next
  MsgBox(Trim(Str(Count)))
  I = 1
  While Len(Res(I)) > 0 And I <= 2 ^ N
   MsgBox(Res(I))
   I = I + 1
  End While
 End Sub

 Public Sub Summ(ByVal Sum As Byte, ByVal tSum As Byte, ByVal tI As Byte, ByVal X() As Byte, ByRef A() As Byte, ByRef Res() As String, ByVal N As Byte, ByRef Count As Byte)
  Dim ttSum As Byte
  Dim sI As Byte
  ttSum = tSum + X(tI)
  If ttSum < Sum Then
   For sI = tI + 1 To N
    A(sI) = 1
    Call Summ(Sum, ttSum, sI, X, A, Res, N, Count)
    A(sI) = 0
   Next
  ElseIf ttSum = Sum Then
   Count = Count + 1
   Call Save(Res, A, N)
  Else
   A(tI) = 0
  End If
 End Sub

 Public Sub Save(ByRef Res() As String, ByVal A() As Byte, ByVal N As Byte)
  Dim Max_I, tI As Byte
  For tI = 1 To 2 ^ N
   If Len(Trim(Res(tI))) = 0 Then
    Max_I = tI
    Exit For
   End If
  Next
  Res(Max_I) = "{"
  For tI = 1 To N
   If A(tI) = 1 Then
    If tI > 1 And Len(Res(Max_I)) > 1 Then
     Res(Max_I) = Res(Max_I) & ","
    End If
    Res(Max_I) = Res(Max_I) & Trim(Str(tI))
   End If
  Next
  Res(Max_I) = Res(Max_I) & "}"
 End Sub

[SwiMMeR]

Pascal последний раз юзал лет 6-7 назад, поэтому не судите строго

uses crt;

 const n=5;
 const nn=32; {nn=2^n}

 function stepen(x,y : integer) : integer;
 begin
  if y=0 then
   stepen:=1
  else
   if y=1 then
    stepen:=x
   else
    begin
     y:=y-1;
     stepen:=x*stepen(x,y);
    end;
 end;

 procedure save(var res : array of string; a : array of integer);
 var max_i, ti : integer;
            zz : string;
 begin
  max_i:=0;
  for ti:=0 to stepen(2,n)-1 do
   if (length(res[ti])=0) and (max_i=0) then
    max_i:=ti;
  res[max_i]:='{';
  for ti:=0 to n-1 do
   if a[ti]=1 then
    begin
     if (ti>0) and (length(res[max_i])>1) then
      res[max_i]:=res[max_i]+',';
     str(ti+1,zz);
     res[max_i]:=res[max_i]+zz;
    end;
  res[max_i]:=res[max_i]+'}';
 end;

 procedure summ(sum,tsum,ti : integer; var count : integer;x:array of integer;var a:array of integer;var res:array of string);
 var ttsum, si : integer;
            zz : string;
 begin
  ttsum:=tsum+x[ti];
  if ttsum<sum then
   for si:=ti+1 to n-1 do
    begin
     a[si]:=1;
     summ(sum,ttsum,si,count,x,a,res);
     a[si]:=0;
    end
  else
   if ttsum=sum then
    begin
     count:=count+1;
     save(res,a);
    end
   else
    a[ti]:=0;
 end;

 var sum, tsum, i, count : integer;
                      zz : string;
                    x, a : array[0..n-1] of integer;
                     res : array[0..nn-1] of string;
begin
 clrscr;
 x[0]:=1; x[1]:=2; x[2]:=2; x[3]:=3; x[4]:=3;
 sum:=6;
 count:=0;
 a[0]:=0; a[1]:=0; a[2]:=0; a[3]:=0; a[4]:=0;
 tsum:=0;
 if tsum=sum then
  begin
   count:=count+1;
   save(res,a);
  end;
 for i:=0 to n-1 do
  begin
   a[i]:=1;
   summ(sum,tsum,i,count,x,a,res);
   a[0]:=0; a[1]:=0; a[2]:=0; a[3]:=0; a[4]:=0;
  end;
 writeln;
 str(count,zz);
 writeln('Count of SubArrays = '+zz);
 i:=1;
 if count>0 then
  writeln;
 for i:=1 to count do
  begin
   writeln(res[i]);
  end;
 readkey;
end.

В архиве сам файл

[Perfilev]

А на паскале прога та же написана, что и на vb?
Какую задачу она решает: твою или вмоей формулировке?

[dex0r]

SwiMMeR, а зачем функция возведения в степень? а через exp (экспонента) слабо?
Andy1, это в твоей формулировке

[SwiMMeR]

dex0r
А через экспоненту это как?

exp(x) = e^x
а мне надо 2^x

[Ghost]

SwiMMeR
Если не ошибаюсь, a^x = e ^ (x * ln(a))

[EvroStandart]

ну вы замудрили! Осталось ещё через силу ветра

Сообщение от Andy1

А на паскале прога та же написана, что и на vb?
Какую задачу она решает: твою или вмоей формулировке?

На Паскале -- судя по всему в твоей формулировке.
Имнсхо, твоя задача NPC. Так что не стесняйся полного
перебора, принципиально лучшего алгоритма нет

[SwiMMeR]

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

упорядоченный по неубыванию

[dex0r]

Ghost, асболютно точно
SwiMMeR, упс... а я не заметил

помогите решить задачу о рюкзаке на Builder желательно с помощью генетического алгоритма, очень нужно!!! если че пишите в аську 631504528

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