[LelikBolik]

Исходник работает так:
-В поле Edit1 вводится произвольное целое число;
-В поле Edit2 вводятся произвольное множество целых чисел через запятую;
-При нажатии на кнопку Button1 в поле Memo1 выводится сумма целых чисел из ряда Edit2 максимально приблеженных к числу введеного в поле Edit2.

Задача
Необходимо переделать под поиск оптимальной суммы вещественных чисел с наименьшей погрешностью, хотябы до 4 знака после запятой?
Помогите решить эту задачу. Заранее спасибо.

Код:

procedure TForm1.Button1Click(Sender: TObject);
VAR
    I, J    :   Integer;
    N, V    :   Cardinal;
    S, Sm   :   AnsiString;
    MaxS    :   Cardinal;
    Variants:   TStringList;
    Current :   Cardinal;
    Original    :   Integer;
    Mas         :   ARRAY OF Integer;
begin
    Memo1.Clear;
    Memo1.Lines.Add('Собираем число: '+Edit1.Text);
    S:= Edit2.Text;
    N:= 1;
    FOR I:= 1 TO Length(S) DO
        IF S[i] = ',' THEN
            Inc(N);
    SetLength(Mas, N);
    N:= 0;
    Memo1.Lines.Add('Из чисел: '+Edit1.Text);
    REPEAT
        I:= Pos(',', S);
        IF I = 0 THEN
            Mas[N]:= StrToInt(S)
        ELSE Begin
            Mas[N]:= StrToInt(Copy(S, 1, I-1));
            S:= Copy(S, I+1,Length(S));
        End;
        Memo1.Lines.Add(IntToStr(Mas[N]));
        Inc(N);
    UNTIL I = 0;
    FOR I:= 0 TO N-1 DO Begin
        V:= I;
        FOR J:= I+1 TO N-1 DO Begin
            IF Mas[J] < Mas[V] THEN
                V:= J;
        End;
        J:= Mas[i];
        Mas[i]:= Mas[V];
        Mas[V]:= J;
    End;
    Memo1.Lines.Add('------------');
    Original:= StrToInt(Edit1.Text);
    FOR I:= 0 TO N-1 DO Begin
        IF Mas[i] > Original THEN Begin
            N:= I;
            break;
        End;
        Memo1.Lines.Add(IntToStr(Mas[i]));
    End;
    Mas:= Copy(Mas, 0, N);
    Memo1.Lines.Add('------------');
    Current:= 0;
    MaxS:= (1 shl N)-1;
    Variants:= TStringList.Create;
    Variants.AddObject('0', TObject(0));
    REPEAT
        Inc(Current);
        J:= 0;
        Sm:= '';
        V:= 1;
        FOR I:= 0 TO N-1 DO Begin
            IF (Current and V) > 0 THEN Begin
                J:= J+Mas[i];
                Sm:= Sm+IntToStr(Mas[i])+' + ';
            End;
            V:= V shl 1;
        End;
        Sm[Length(Sm)-1]:= '=';
        Sm:= Sm+IntToStr(J);
        IF Integer(Variants.Objects[0]) = J THEN
            Variants.AddObject(Sm, TObject(J))
        ELSE IF (J > Integer(Variants.Objects[0])) AND (J <= Original) THEN Begin
            Variants.Clear;
            Variants.AddObject(Sm, TObject(J))
        End;
    UNTIL Current = MaxS;
    Memo1.Lines.AddStrings(Variants);
end;

[angvelem]

Ага, обязательно помогу, как только пойму, что такое максимально приближенные (100<->1000 или нет?) и приведённый код будет упрятан в тэг [code].

[AlexSku]

Вот алгоритм: Задача о ранце
Пункт 4 "Единичный выбор предметов".

[LelikBolik]

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

Вот алгоритм: Задача о ранце
Пункт 4 "Единичный выбор предметов".

Спасибо но это не то нужен код с вводом чисел с плавающей запятой и желательно с сохранением оператора shl который просто сдвигает все биты в переменной влево на указанное количество
позиций (эквивалентно умножению на 2^N, тока быстрее работает).

[U.B.M.]

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

Необходимо переделать под поиск оптимальной суммы вещественных чисел с наименьшей погрешностью, хотябы до 4 знака после запятой?

Число 11 из чисел 2, 4, 6, например, не соберешь... не говоря про первый знак после запятой. Тут как фишка ляжет с числами

А теперь по-существу.

1. Есть число Х0 и числа х1, х2, х3...
2. Для каждого числа х1,х2,х3... рассчитываем число, назовем его, а1,а2,а3,...

Код:

var
  a : array of integer;
  x : array of real;
  X0 : real;
  i : integer;
begin
  ... 
  for i := 1 to length(x) do
    a[i] := X0 div x[i];
  ...

3. Далее считаем выражения х1*b1+x2*b2+..., где 0 <= b1 <= a1 и т.д.. Находим наиболее приближенное.
4. Бурно радуемся по поводу полученного результата

П.С. Пункт 3 конечно можно оптимизировать, но в 2 ночи не хочу насоветовать чего-нить не того

[U.B.M.]

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

Исходник работает так:
-В поле Edit1 вводится произвольное целое число;
-В поле Edit2 вводятся произвольное множество целых чисел через запятую;
-При нажатии на кнопку Button1 в поле Memo1 выводится сумма целых чисел из ряда Edit2 максимально приблеженных к числу введеного в поле Edit2.

Задача
Необходимо переделать под поиск оптимальной суммы вещественных чисел с наименьшей погрешностью, хотябы до 4 знака после запятой?
Помогите решить эту задачу. Заранее спасибо.

Так целое или вещественное? 3,14 - вещественное, но не целое. Откуда вопрос про знак после запятой если числа целые?

Неплохо было бы уточнить условие.

[U.B.M.]

Код:

unit Unit1;

interface

uses
  Windows, SysUtils, Classes, Controls, Forms, StdCtrls, StrUtils, Math;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    Button1: TButton;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//перевод из 10-ной в 2-ную - понадобится в дальнейшем
function dec_to_bin(dec_num : integer) : string;
var
  s : string;
begin
  s := '';
  while dec_num >= 1 do
  begin
    s := IntToStr(dec_num mod 2) + s;
    dec_num := dec_num div 2;
  end;
  dec_to_bin := s;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  dec_view, i, j : integer;
  delta, original, sum, min_sum : real;
  Mas : array of real;
  str : string;
begin
  decimalseparator := '.'; //разделитель после целой части, например, 3.14 (не запятая как обычно)
  Memo1.Clear;
  Memo1.Text := Memo1.Text + AnsiReplaceStr(Edit2.Text, ',', #13#10);

  SetLength(Mas, Memo1.Lines.Count);
  for i := 0 to Memo1.Lines.Count-1 do
    Mas[i]:= StrToFloat(Memo1.Lines.Strings[i]);

  Memo1.Text := 'Собираем число '+ Edit1.Text + #13#10 +
                'Из чисел:' + #13#10 +
                Memo1.Text + #13#10 +
                '--------------------------------' + #13#10;

  original := StrToFloat(Edit1.Text);

  dec_view := trunc(Power(2,Length(Mas))); // кол-во комбинаций при сложении
  delta := original;

  for i := 1 to dec_view - 1 do
  begin
    sum := 0;
    for j := 0 to length(dec_to_bin(i))-1 do
      sum := sum + Mas[j]*StrToFloat(copy(dec_to_bin(i),j+1,1));

    if abs(sum-original) < delta   then
    begin
      delta := abs(sum-original);
      min_sum := sum;
      str := dec_to_bin(i);
    end;
    if sum-original = 0 then
    break;
  end;

  Memo1.Lines.Add('Cкладывались числа:');
  for i := 0 to length(str)-1 do
    if str[i+1] <> '0' then
  Memo1.Lines.Add(FloatToStr(Mas[i]));
  Memo1.Lines.Add('сумма = ' + FloatToStr(min_sum));
  Memo1.Lines.Add('разность = ' + FloatToStr(delta));
end;

end.

Полностью рабочий код, кроме того что разность пишет, например, не 1.2, а 1.999999999999. Надо маленько подрехтовать, но тут сам уже разберешься.

[LelikBolik]

Почему при поиске оптимальной суммы из 30 значений программма зависает?

[LelikBolik]

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

[U.B.M.]

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

Почему при поиске оптимальной суммы из 30 значений программма зависает?

Зависает это долго (скажем, больше 30 секунд/минуты) считает или вылетает с ошибкой?

[LelikBolik]

Зависает и больше не отвечает программа. Может все дело в вместимости поля Memo? Т.к когда я убрал Memo1.Lines.Add........ то программа стала работать быстрее, но до 30 чисел заданых в поле Edit. Есле я вношу в поле Edit больше 30 чисел то программа неотвечает и ошибка не выскакивает.

[angvelem]

"Прошагать" не пробовал?

[LelikBolik]

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

"Прошагать" не пробовал?

Программа работает, вопрос не в этом. Вопрос в оптимизации в скорости вычисления. Может результат и выдаст этак через месяц, т.к на 30 и более значений вариантов очень много. Но до 30 значений считает, а после очень долго считатет, вобщем результата терпения не хватило ждать.

[U.B.M.]

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

Программа работает, вопрос не в этом. Вопрос в оптимизации в скорости вычисления. Может результат и выдаст этак через месяц, т.к на 30 и более значений вариантов очень много. Но до 30 значений считает, а после очень долго считатет, вобщем результата терпения не хватило ждать.

123 число, составляем из 1,2,...,30 - секунд 10 заняло.
С другими как пойдет. Кстати, ты уверен что в сумме все числа-слагаемые могут дать необходимое число?

[U.B.M.]

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

Зависает и больше не отвечает программа. Может все дело в вместимости поля Memo? Т.к когда я убрал Memo1.Lines.Add........

вообще-то этот цикл указывает какие числа использовались для суммы - так что 30 мемоаддов вроде сильно влиять на время работы не должны