Задача про рыбалку

[Dj Troy]

Помогите решить задачу. Формулировка. Два друга собрались идти на рыбалку. Нужно написать чтобы программа высчитывала равное количество вещей. Например я ввожу 5 3 3 в ответе программы должно вывести у одного 5 у второго 3 3. Кто знает как е1 решить. У меня идейка есть но реализовать как её не знаю

[TOR]

хм.5 <>3+3 или я что то не так понимаю?

[Dj Troy]

Я там правильно написал. Суть в том что есть у тебя три вещи вот такими массами 5 3 3. Ты несешь 5 кг друг 6 кг. Если тупо забить в цикл то программа выдаст такое что одному 5 3 а другому 3 но это уже неверно

[Dj Troy]

Равное количесвто возможно и не получишь но чтобы получить максимально равное

[Dj Troy]

Народ помогите решить пожалуйста

[unbanned]

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

[val_nnm]

Вот вам решение

Const MaxCount = 30;
Type
  Weights = record
    W:array[0..(MaxCount-1)] of Real;
    Count:integer;
  end;

Procedure ClearWeights(var p:Weights);
Begin
  p.Count := 0;
End;

Procedure AddWeight(var p:Weights; Weight:Real);
Begin
  p.W[p.Count] := Weight;
  p.Count := p.Count+1;
End;

Function GetNumberOfVariants(const p:Weights):Longint;
var temp:longint;
Begin
  temp := 1;
  GetNumberOfVariants := temp shl p.Count;
End;

Procedure SplitByVariant(const input:Weights; var out1:Weights; var out2:Weights; variant:Longint);
var i:integer;
Begin
  ClearWeights(out1);
  ClearWeights(out2);
  For i := 0 to input.Count-1 do
  Begin
    if (((variant shr i) and 1)=1) then
      AddWeight(out1,input.W[i])
    else
      AddWeight(out2,input.W[i])    
  End;
End;

Procedure WritelnWeights(var p:Weights);
var i:integer;
Begin
  for i := 0 to p.Count-1 do
    Writeln(p.W[i]:5:0);
End;

function GetSumWeights(const p:Weights):real;
var s:real;
    i:integer;
Begin
  s := 0;
  for i := 0 to p.Count-1 do
    s := s+p.W[i];
  GetSumWeights := s;
End;

var V:real;
    Source:Weights;
    i:longint;
    NumVariants:Longint;
    BestVariant:Longint;
    BestVariantValue:real;
    
    w1,w2:Weights;
    Temp:real;
Begin
  Writeln('Веедите веса (0 для окончания ввода, -1 для оканчания ввода показа промежуточных значений)');
  Repeat
    Readln(V);
    if (V>0) then AddWeight(Source,V);
  until (V<=0) or (Source.Count>=MaxCount) ;
  WritelnWeights(Source);
  NumVariants := GetNumberOfVariants(Source);
  Writeln('количество вариантов =',NumVariants);


  SplitByVariant(Source,w1,w2,0);
  BestVariantValue := abs(GetSumWeights(w1)-GetSumWeights(w2));
  BestVariant := 0;

    if (V<=-1) then Begin
      Writeln('---------------------------');
      WritelnWeights(w1);
      writeln('---');
      WritelnWeights(w2);
      Writeln('Вариант ',0,'  Суммы ',GetSumWeights(w1):5:0,
              ' и ',GetSumWeights(w2):5:0,' разница между ними ',BestVariantValue:5:0);
    End;


  for i := 1 to NumVariants-1 do Begin

    SplitByVariant(Source,w1,w2,i);

    Temp := abs(GetSumWeights(w1)-GetSumWeights(w2));
    if (Temp<BestVariantValue) then Begin
      BestVariantValue := Temp;
      BestVariant := i;
    End;
    if (V<=-1) then Begin
      Writeln('---------------------------');
      WritelnWeights(w1);
      writeln('---');
      WritelnWeights(w2);
      Writeln('Вариант ',i,'  Суммы ',GetSumWeights(w1):5:0,' и ',GetSumWeights(w2):5:0,' разница между ними ',Temp:5:0);
    End;
  End;


  SplitByVariant(Source,w1,w2,BestVariant);
  writeln;
  writeln;
  Writeln('Лучший вариант №',BestVariant);
  Writeln('---------------------------');
  WritelnWeights(w1);
  writeln('---');
  WritelnWeights(w2);
  Writeln('Суммы ',GetSumWeights(w1):5:0,' и ',GetSumWeights(w2):5:0,' разница между ними ',BestVariantValue:5:0);
End.

Конечно не самый быстрый алгоритм. Да и даже этот алгоритм проверяет несколько лишних вариантов. (если нужна скорость то нужно применать чтото вроде алгоритма ветвей и границ.)

Но даже на написание этого алгоритма потратил много времени.
Да и такие однодневные акаунты часто забывают даже спасибо сказать.

НЕМНОГО ПОДУМАВ
можно заменить

 for i := 1 to NumVariants-1 do Begin

на

 for i := 1 to (NumVariants div 2)-1 do Begin

что уменьшит количество перебераемых вариантов в 2 раза. (потому как половина вариантов заркальное отображение уже перебранных. т.е. что мы давали первоому рыбаку теперь даём второму рыбаку)

[Dj Troy]

Спасибо большое

[Serge_Bliznykov]

кстати, очень качественный (и простой!) алгоритм предложил Smitt&Wesson
в этой теме:
Разделение предметов по весу


Добавлено
Только хочу предупредить - алгоритм очень простой,
но, именно поэтому, он моежт вернуть не лучший вариант.
Лучший можно получить - только полным перебором!
впрочем, об этом можно почитать на страницах упомянутой выше темы!