powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Помогите придумать алгоритм
11 сообщений из 11, страница 1 из 1
Помогите придумать алгоритм
    #39726050
Здравствуйте! Помогите придумать алгоритм, может быть есть какая-то "умная" формула!

Есть такая задача, существует какое то кол-во N групп, у каждой группы есть стоимость (в моем случае группы - это разные программы страхования, где на каждой есть какая-то сумма денег). Необходимо уменьшить сумму этих групп на число S. Причем уменьшить равномерно, вычитая из из каждой примерно одинаковое число. Но в минус уходить нельзя.

Например,
p1 - 0 руб.
p2- 40 руб.
p3- 100 руб
P4- 5 руб.

Надо вычесть 60 рублей.

т.е. в итоге должно быть

p1 - 0 руб.
p2- 12,5 руб.
p3- 72,5 руб
P4- 0 руб.

Вычитать по 1 копейке с каждой пока не получится уменьшить на нужную сумму - слишком долгий алгоритм. Может можно как-то проще?
...
Рейтинг: 0 / 0
Помогите придумать алгоритм
    #39726057
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
31.10.2018 17:37, Кареглазая_зая пишет:
> слишком долгий алгоритм.

компьютер железный.
ему пофиг.
работает - не трожь!
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Помогите придумать алгоритм
    #39726061
AWSVladimir
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Кареглазая_зая Необходимо уменьшить сумму этих групп на число S. Причем уменьшить равномерно, вычитая из из каждой примерно одинаковое число. Но в минус уходить нельзя.
...
Вычитать по 1 копейке с каждой пока не получится уменьшить на нужную сумму - слишком долгий алгоритм. Может можно как-то проще?

S:=ФормулаРасчета_S
for i:=low(МаcсивP) to High(МаcсивP) do begin
МаcсивP[i]:=МаcсивP[i]-S;
if МаcсивP[i]<0 then МаcсивP[i]:=0;
end;
...
Рейтинг: 0 / 0
Помогите придумать алгоритм
    #39726062
Dimitry Sibiryakov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Кареглазая_заяМожет можно как-то проще?
Можно: вычитать по (оставшаяся сумма скидки/количество оставшихся групп)
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Помогите придумать алгоритм
    #39726075
Гаджимурадов Рустам
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Кареглазая_зая> Необходимо уменьшить сумму этих групп на число S.
Кареглазая_зая> Причем уменьшить равномерно, вычитая из из каждой
Кареглазая_зая> примерно одинаковое число.

Стандартный алгоритм веса объекта в группе
(соотв. уменьшать по удельному весу).

Кареглазая_зая> т.е. в итоге должно быть
>
> p1 - 0 руб.
> p2- 12,5 руб.
> p3- 72,5 руб
> P4- 0 руб.

По какому алгоритму получен данный ответ? Это - не "равномерно".
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Помогите придумать алгоритм
    #39726093
Фотография Dimonka
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Алгоритм примерно такой - вычислить сумму всех элементов, а затем пропорционально разделить между элементами с суммой > 0

Например,
p1 - 0 руб.
p2- 40 руб.
p3- 100 руб
P4- 5 руб.

Сумма = 145

p1 - 0 руб.
p2- 40 - 40 * 60 / 145
p3- 100 - 100 * 60 / 145
P4- 5 - 5 * 60 / 145

Единственная небольшая проблемка будет красиво раскидать дробные части копеек, чтобы получилось ровно 60 рублей. Поскольку подозреваю, что дробные числа меньше копейки тебя не интересуют.
...
Рейтинг: 0 / 0
Помогите придумать алгоритм
    #39726118
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Кареглазая_заявычитая из из каждой примерно одинаковое число
1. Делим число на количество ненулевых групп
2. Вычитаем из каждой группы полученное среднее
3. Если в группе меньше, чем нужно, вычитаем в 0, а невучтенный остаток запоминаем
4. Складываем все остатки и переходим к шагу 1

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
procedure Sub(var AData: array of Integer; ASub: Integer);
var
  Li: Integer;
  LCnt: Integer;
  LRest: Integer;
  LDelta: Integer;
begin
  if ASub <= 0 then
    Exit;
  LCnt := 0;
  for Li := 0 to Length(AData) - 1 do begin
    if AData[Li] > 0 then
      Inc(LCnt);
  end;
  if LCnt = 0 then
    raise Exception.Create('Groups not found');

  if ASub < LCnt then begin
    for Li := 0 to Length(AData) - 1 do begin
      if AData[Li] > 0 then begin
        Dec(AData[Li]);
        Dec(ASub);
        if ASub = 0 then
          Exit;
      end;
    end;
  end;

  LDelta := ASub div LCnt;
  LRest := ASub mod LCnt;
  for Li := 0 to Length(AData) - 1 do begin
    if AData[Li] > 0 then begin
      Dec(AData[Li], LDelta);
      if AData[Li] < 0 then begin
        Dec(LRest, AData[Li]);
        AData[Li] := 0;
      end;
    end;
  end;

  if LRest > 0 then
    Sub(AData, LRest);
end;

...
Рейтинг: 0 / 0
Помогите придумать алгоритм
    #39726119
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

Все дробные числа переводим в целые, путем умножения на 100
...
Рейтинг: 0 / 0
Помогите придумать алгоритм
    #39726322
_Vasilisk_,

Спасибо большое. То что нужно)
...
Рейтинг: 0 / 0
Помогите придумать алгоритм
    #39726345
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Кареглазая_зая,

как вариант, чтобы делать меньше вычитаний, на промежуточных проходах цикла (когда есть элементы ниже среднего) можно не трогать те, которые выше среднего
...
Рейтинг: 0 / 0
Помогите придумать алгоритм
    #39726428
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Кареглазая_зая,

в принципе, все вычитания можно сделать за один последний проход по массиву:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
function DecrementArray(var a: array of integer; val: integer= 1): boolean;
var
  i, d, m, len, sum, cnt, old: integer;
begin;
  if val<=0 then begin;
    Result:=(val=0);
    exit;
    end;

  len:=Length(a);
  sum:=0;
  for i:=0 to len-1 do sum:=sum+a[i];
  Result:=(val<=sum);
  if not Result then exit;
  if val=sum then begin;
    for i:=0 to len-1 do a[i]:=0;
    exit;
    end;

  cnt:=0; sum:=0;
  repeat;
    d:=(val-sum) div (len-cnt); m:=(val-sum)-d*(len-cnt);
    old:=cnt; cnt:=0; sum:=0;
    for i:=0 to len-1 do if a[i]<=d then begin;
      sum:=sum+a[i];
      inc(cnt);
      end;
    until (old=cnt) and (len-cnt>=m);

  for i:=0 to len-1 do begin;
    if a[i]<=d then a[i]:=0
    else if m>0 then begin;
      dec(m);
      a[i]:=a[i]-(d+1);
      end
    else a[i]:=a[i]-d;
    end;
  end;



особо не отлаживал, проверял работу этим:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
procedure TForm1.Button1Click(Sender: TObject);
var
  a: array of integer;
  i: integer;
begin;
  SetLength(a, 4);
  a[0]:=0;
  a[1]:=40;
  a[2]:=100;
  a[3]:=5;

  DecrementArray(a, 60);
  for i:=0 to Length(a)-1 do Memo1.Lines.Add(IntToStr(a[i]));
  end;

...
Рейтинг: 0 / 0
11 сообщений из 11, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Помогите придумать алгоритм
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]