• B правой части каждого сообщения есть стрелки ⇧ и ⇩. Не стесняйтесь оценивать ответы. Чтобы автору вопроса закрыть свой тикет, надо выбрать лучший ответ. Просто нажмите значок ✔ в правой части сообщения.

Повысить Производительность Алгоритма

  • Автор темы darkden
  • Дата начала
D

darkden

Доброго времени суток. Извините, но я не программист, я физик, знаний по програмированию ужасно мало. Несколько недель бъюсь над одной задачкой:
Определить вероятность события.
А точнее, имеется 52 ячейки и 52 шара. Из 52 шаров, 13 красные и 39 белые. В ячейки по очереди кладут по одному шару. Определить вероятность того, что радом окажуться 4 красных шара. Частным случаям явлается ситуация когда первые и последние шары могут обьединятся в комбинацию из 4 красных шаров, что является то же событием(этот частный случай учтён в программе).
Программа расчитывает все возможные ситуации распределения шаров в ячейках(Total combinations) и ситуации в которых произошло событие(X combinations). Затем я сам делю (X combinations) на (Total combinations) и получаю вероятность события.
Математики мне помочь не смогли, были даже кандидаты наук.
Задачу решил решать по средствам паскаля. Алгоритм много раз перерабатывался и дополнялся программистами. В итоге получился следующий алгоритм:

Код: 
{$mode delphi}
program sochets_m;
var
i, n, m, k: integer;
OurComb, AllComb, tmp: Int64;
t, s: string;
fl: boolean;

const
RedOne = '1';
WhiteOne = '2';
Empty = '0';

function C(n, m: byte): Int64;
var
i, j: byte;
begin
result := 1;
if m <> 0 then
begin
j := 2;
for i := m + 1 to n do
begin
result := result * i;
while (j <= n - m) and (result mod j = 0) do
begin
result := result div j;
inc(j);
end;
end;
end;
end;

procedure Permute(p: integer); // использование глобальных переменных для ускорения
var
i, j: byte;
ch: char;
begin
if p = n + 1 then
begin
inc(AllComb);
fl := true;
j := 0;
while fl and (j < k) do
begin
i := 0;
while fl and (i < k) do
begin
if t[(n - k + j + i) mod n + 1] <> RedOne then
fl := false;
inc(i);
end;
inc(OurComb, ord(fl));
fl := not fl;
inc(j);
end;

{if AllComb mod 1000000 = 0 then
writeln(AllComb div 1000000);}
end
else
begin
fl := false;
if p - 1 >= k then
begin
fl := true;
i := p - k;
while fl and (i < p) do
begin
if t[i] <> RedOne then
fl := false;
inc(i);
end;
if fl then
begin
j := 0;
for i := 1 to n do
inc(j, ord(s[i] = RedOne));
tmp := C(n - p + 1, j);
inc(AllComb, tmp);
inc(OurComb, tmp);
end;

{if AllComb mod 1000000 = 0 then
writeln(AllComb div 1000000);}
end;
if fl = false then
for i := 1 to n do
begin
if s[i] = Empty then
continue;
ch := s[i];
j := 1;
while s[j] <> ch do
inc(j);
if j = i then
begin
t[p] := ch;
s[i] := Empty;
Permute(p + 1);
s[i] := ch;
end;
end;
end;
end;

begin
{ cгенерируем S, сначала пойдут красные }
readln(n, m, k);
s := '';
for i := 1 to m do
s := s + RedOne;
for i := m + 1 to n do
s := s + WhiteOne;
t := s;
{ собственно и сами перестановки }
OurComb := 0;
AllComb := 0;
Permute(1);
writeln(AllComb, ' ', OurComb);
readln;
end.
if
(1 in d) and (2 in d) and (3 in d) and (4 in d) or {1}
(2 in d) and (3 in d) and (4 in d) and (5 in d) or {2}
(3 in d) and (4 in d) and (5 in d) and (6 in d) or {3}
(4 in d) and (5 in d) and (6 in d) and (7 in d) or {4}
(5 in d) and (6 in d) and (7 in d) and (8 in d) or {5}
(6 in d) and (7 in d) and (8 in d) and (9 in d) or {6}
(7 in d) and (8 in d) and (9 in d) and (10 in d) or {7}
(8 in d) and (9 in d) and (10 in d) and (11 in d) or {8}
(9 in d) and (10 in d) and (11 in d) and (12 in d) or {9}
(10 in d) and (11 in d) and (12 in d) and (13 in d) or {10}
(11 in d) and (12 in d) and (13 in d) and (14 in d) or {11}
(12 in d) and (13 in d) and (14 in d) and (15 in d) or {12}
(13 in d) and (14 in d) and (15 in d) and (16 in d) or {13}
(14 in d) and (15 in d) and (16 in d) and (17 in d) or {14}
(15 in d) and (16 in d) and (17 in d) and (18 in d) or {15}
(16 in d) and (17 in d) and (18 in d) and (19 in d) or {16}
(17 in d) and (18 in d) and (19 in d) and (20 in d) or {17}
(18 in d) and (19 in d) and (20 in d) and (21 in d) or {18}
(19 in d) and (20 in d) and (21 in d) and (22 in d) or {19}
(20 in d) and (21 in d) and (22 in d) and (23 in d) or {20}
(21 in d) and (22 in d) and (23 in d) and (24 in d) or {21}
(22 in d) and (23 in d) and (24 in d) and (25 in d) or {22}
(23 in d) and (24 in d) and (25 in d) and (26 in d) or {23}
(24 in d) and (25 in d) and (26 in d) and (27 in d) or {24}
(25 in d) and (26 in d) and (27 in d) and (28 in d) or {25}
(26 in d) and (27 in d) and (28 in d) and (29 in d) or {26}
(27 in d) and (28 in d) and (29 in d) and (30 in d) or {27}
(28 in d) and (29 in d) and (30 in d) and (31 in d) or {28}
(29 in d) and (30 in d) and (31 in d) and (32 in d) or {29}
(30 in d) and (31 in d) and (32 in d) and (33 in d) or {30}
(31 in d) and (32 in d) and (33 in d) and (34 in d) or {31}
(32 in d) and (33 in d) and (34 in d) and (35 in d) or {32}
(33 in d) and (34 in d) and (35 in d) and (36 in d) or {33}
(34 in d) and (35 in d) and (36 in d) and (37 in d) or {34}
(35 in d) and (36 in d) and (37 in d) and (38 in d) or {35}
(36 in d) and (37 in d) and (38 in d) and (39 in d) or {36}
(37 in d) and (38 in d) and (39 in d) and (40 in d) or {37}
(38 in d) and (39 in d) and (40 in d) and (41 in d) or {38}
(39 in d) and (40 in d) and (41 in d) and (42 in d) or {39}
(40 in d) and (41 in d) and (42 in d) and (43 in d) or {40}
(41 in d) and (42 in d) and (43 in d) and (44 in d) or {41}
(42 in d) and (43 in d) and (44 in d) and (45 in d) or {42}
(43 in d) and (44 in d) and (45 in d) and (46 in d) or {43}
(44 in d) and (45 in d) and (46 in d) and (47 in d) or {44}
(45 in d) and (46 in d) and (47 in d) and (48 in d) or {45}
(46 in d) and (47 in d) and (48 in d) and (49 in d) or {46}
(47 in d) and (48 in d) and (49 in d) and (50 in d) or {47}
(48 in d) and (49 in d) and (50 in d) and (51 in d) or {48}
(49 in d) and (50 in d) and (51 in d) and (52 in d) or {49}
(50 in d) and (51 in d) and (52 in d) and (1 in d) or {50}
(51 in d) and (52 in d) and (1 in d) and (2 in d) or {51}
(52 in d) and (1 in d) and (2 in d) and (3 in d) {52}
then begin
Inc(k2);
Writeln(k2:10,'	 ',s)
end;
i:=m;
while a[i]=n-m+i do dec(i);
inc(a[i]);
for j:=i+1 to m do a[j]:=a[j-1]+1;
Inc(k1);
until i=0;
Writeln('Total combinations: ',k1);
Writeln('X combinations: ',k2);
end.
end.

Алгоритм считает уже более 6 суток, по расчетам (не только моим) должен считать около 4-5 суток. Проблема в том что загрузка процессора всего около 3% хотя в предыдущих версиях алгоритма была около 25 %, по этому такая работа алгоритма становиться бесполезной. Скорее всего данные не помещаются в оперативную память. Помогите кто знает, как ускорить расчёты алгоритма.
Спасибо
 
Сортировать по дате Сортировать по голосам
I

ikot

darkden сказал(а):
Доброго времени суток. Извините, но я не программист, я физик, знаний по програмированию ужасно мало. Несколько недель бъюсь над одной задачкой:
Определить вероятность события.
А точнее, имеется 52 ячейки и 52 шара. Из 52 шаров, 13 красные и 39 белые. В ячейки по очереди кладут по одному шару. Определить вероятность того, что радом окажуться 4 красных шара. Частным случаям явлается ситуация когда первые и последние шары могут обьединятся в комбинацию из 4 красных шаров, что является то же событием(этот частный случай учтён в программе).
Программа расчитывает все возможные ситуации распределения шаров в ячейках(Total combinations) и ситуации в которых произошло событие(X combinations). Затем я сам делю (X combinations) на (Total combinations) и получаю вероятность события.
Математики мне помочь не смогли, были даже кандидаты наук.
Задачу решил решать по средствам паскаля. Алгоритм много раз перерабатывался и дополнялся программистами. В итоге получился следующий алгоритм:

Код: 
{$mode delphi}
program sochets_m;
var
i, n, m, k: integer;
OurComb, AllComb, tmp: Int64;
t, s: string;
fl: boolean;

const
RedOne = '1';
WhiteOne = '2';
Empty = '0';

function C(n, m: byte): Int64;
var
i, j: byte;
begin
result := 1;
if m <> 0 then
begin
j := 2;
for i := m + 1 to n do
begin
result := result * i;
while (j <= n - m) and (result mod j = 0) do
begin
result := result div j;
inc(j);
end;
end;
end;
end;

procedure Permute(p: integer); // использование глобальных переменных для ускорения
var
i, j: byte;
ch: char;
begin
if p = n + 1 then
begin
inc(AllComb);
fl := true;
j := 0;
while fl and (j < k) do
begin
i := 0;
while fl and (i < k) do
begin
if t[(n - k + j + i) mod n + 1] <> RedOne then
fl := false;
inc(i);
end;
inc(OurComb, ord(fl));
fl := not fl;
inc(j);
end;

{if AllComb mod 1000000 = 0 then
writeln(AllComb div 1000000);}
end
else
begin
fl := false;
if p - 1 >= k then
begin
fl := true;
i := p - k;
while fl and (i < p) do
begin
if t[i] <> RedOne then
fl := false;
inc(i);
end;
if fl then
begin
j := 0;
for i := 1 to n do
inc(j, ord(s[i] = RedOne));
tmp := C(n - p + 1, j);
inc(AllComb, tmp);
inc(OurComb, tmp);
end;

{if AllComb mod 1000000 = 0 then
writeln(AllComb div 1000000);}
end;
if fl = false then
for i := 1 to n do
begin
if s[i] = Empty then
continue;
ch := s[i];
j := 1;
while s[j] <> ch do
inc(j);
if j = i then
begin
t[p] := ch;
s[i] := Empty;
Permute(p + 1);
s[i] := ch;
end;
end;
end;
end;

begin
{ cгенерируем S, сначала пойдут красные }
readln(n, m, k);
s := '';
for i := 1 to m do
s := s + RedOne;
for i := m + 1 to n do
s := s + WhiteOne;
t := s;
{ собственно и сами перестановки }
OurComb := 0;
AllComb := 0;
Permute(1);
writeln(AllComb, ' ', OurComb);
readln;
end.
if
(1 in d) and (2 in d) and (3 in d) and (4 in d) or {1}
(2 in d) and (3 in d) and (4 in d) and (5 in d) or {2}
(3 in d) and (4 in d) and (5 in d) and (6 in d) or {3}
(4 in d) and (5 in d) and (6 in d) and (7 in d) or {4}
(5 in d) and (6 in d) and (7 in d) and (8 in d) or {5}
(6 in d) and (7 in d) and (8 in d) and (9 in d) or {6}
(7 in d) and (8 in d) and (9 in d) and (10 in d) or {7}
(8 in d) and (9 in d) and (10 in d) and (11 in d) or {8}
(9 in d) and (10 in d) and (11 in d) and (12 in d) or {9}
(10 in d) and (11 in d) and (12 in d) and (13 in d) or {10}
(11 in d) and (12 in d) and (13 in d) and (14 in d) or {11}
(12 in d) and (13 in d) and (14 in d) and (15 in d) or {12}
(13 in d) and (14 in d) and (15 in d) and (16 in d) or {13}
(14 in d) and (15 in d) and (16 in d) and (17 in d) or {14}
(15 in d) and (16 in d) and (17 in d) and (18 in d) or {15}
(16 in d) and (17 in d) and (18 in d) and (19 in d) or {16}
(17 in d) and (18 in d) and (19 in d) and (20 in d) or {17}
(18 in d) and (19 in d) and (20 in d) and (21 in d) or {18}
(19 in d) and (20 in d) and (21 in d) and (22 in d) or {19}
(20 in d) and (21 in d) and (22 in d) and (23 in d) or {20}
(21 in d) and (22 in d) and (23 in d) and (24 in d) or {21}
(22 in d) and (23 in d) and (24 in d) and (25 in d) or {22}
(23 in d) and (24 in d) and (25 in d) and (26 in d) or {23}
(24 in d) and (25 in d) and (26 in d) and (27 in d) or {24}
(25 in d) and (26 in d) and (27 in d) and (28 in d) or {25}
(26 in d) and (27 in d) and (28 in d) and (29 in d) or {26}
(27 in d) and (28 in d) and (29 in d) and (30 in d) or {27}
(28 in d) and (29 in d) and (30 in d) and (31 in d) or {28}
(29 in d) and (30 in d) and (31 in d) and (32 in d) or {29}
(30 in d) and (31 in d) and (32 in d) and (33 in d) or {30}
(31 in d) and (32 in d) and (33 in d) and (34 in d) or {31}
(32 in d) and (33 in d) and (34 in d) and (35 in d) or {32}
(33 in d) and (34 in d) and (35 in d) and (36 in d) or {33}
(34 in d) and (35 in d) and (36 in d) and (37 in d) or {34}
(35 in d) and (36 in d) and (37 in d) and (38 in d) or {35}
(36 in d) and (37 in d) and (38 in d) and (39 in d) or {36}
(37 in d) and (38 in d) and (39 in d) and (40 in d) or {37}
(38 in d) and (39 in d) and (40 in d) and (41 in d) or {38}
(39 in d) and (40 in d) and (41 in d) and (42 in d) or {39}
(40 in d) and (41 in d) and (42 in d) and (43 in d) or {40}
(41 in d) and (42 in d) and (43 in d) and (44 in d) or {41}
(42 in d) and (43 in d) and (44 in d) and (45 in d) or {42}
(43 in d) and (44 in d) and (45 in d) and (46 in d) or {43}
(44 in d) and (45 in d) and (46 in d) and (47 in d) or {44}
(45 in d) and (46 in d) and (47 in d) and (48 in d) or {45}
(46 in d) and (47 in d) and (48 in d) and (49 in d) or {46}
(47 in d) and (48 in d) and (49 in d) and (50 in d) or {47}
(48 in d) and (49 in d) and (50 in d) and (51 in d) or {48}
(49 in d) and (50 in d) and (51 in d) and (52 in d) or {49}
(50 in d) and (51 in d) and (52 in d) and (1 in d) or {50}
(51 in d) and (52 in d) and (1 in d) and (2 in d) or {51}
(52 in d) and (1 in d) and (2 in d) and (3 in d) {52}
then begin
Inc(k2);
Writeln(k2:10,'	 ',s)
end;
i:=m;
while a[i]=n-m+i do dec(i);
inc(a[i]);
for j:=i+1 to m do a[j]:=a[j-1]+1;
Inc(k1);
until i=0;
Writeln('Total combinations: ',k1);
Writeln('X combinations: ',k2);
end.
end.

Алгоритм считает уже более 6 суток, по расчетам (не только моим) должен считать около 4-5 суток. Проблема в том что загрузка процессора всего около 3% хотя в предыдущих версиях алгоритма была около 25 %, по этому такая работа алгоритма становиться бесполезной. Скорее всего данные не помещаются в оперативную память. Помогите кто знает, как ускорить расчёты алгоритма.
Спасибо
Нажмите, чтобы раскрыть...

Нужно переписать код полностью с использованием указателей (работа с памятью). Отсюда будет и выше скорость!
А вообще, если ваш алгоритм считает такое длиное время для указанной задачи, то он вообще говоря неэффективный и Вам следует задуматься над логикой программы.
 
За 0 Против
Для ответа нужно войти/зарегистрироваться
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!

Верх Низ