Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2008.07.13;
Скачать: [xml.tar.bz2];

Вниз

Как оптимизировать скорость работы кода   Найти похожие ветки 

 
Kaer ©   (2008-06-10 13:08) [0]

При расчете если поставить 5000 очень долго(гдето больше 25 часов) идет проверка одинаковых значеный(выделено жирным), мож как нитьбудь это оптимизировать чтобы побыстрей проверялось?
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, shellapi, ComCtrls;

type
 TForm1 = class(TForm)
   Edit1: TEdit;
   Button1: TButton;
   Memo1: TMemo;
   Edit2: TEdit;
   CheckBox1: TCheckBox;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 x, y, a, b, i: integer;
 a_2, b_2: int64;
 ar: array of array of array of int64;
 f,d,l: TextFile;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 Memo1.Lines.Clear;
 AssignFile(d,"Пов_числа.txt");
 ReWrite(d);
 AssignFile(l,"Лог.txt");
 ReWrite(l);
 i:= StrToInt64(Edit1.Text);
 SetLength(ar,i+1,i+1,3);
 Writeln(l,TimeToStr(Time)+" - Запуск");
 Memo1.Lines.Add(TimeToStr(Time)+" - Запуск");

 //заполняю массив
 for a := 1 to i do
   for b := 1 to a do
   begin
     a_2:=a*a;
     b_2:=b*b;
     ar[b,a,0] := 2*a*b;
     ar[b,a,1] := a_2*a_2-b_2*b_2;
     ar[b,a,2] := a_2*a_2+b_2*b_2;
   end;
 Writeln(l,TimeToStr(Time)+" - Массив заполнен");
 Memo1.Lines.Add(TimeToStr(Time)+" - Массив заполнен");

 //Вывод таблицы
 If CheckBox1.Checked then
 begin
   AssignFile(f,"Таблица.txt");
   ReWrite(f);
   for a:= 1 to i do
   begin
     for b:=1 to a do if b=a then Writeln(f, IntToStr(ar[b,a,0])) else Write(f, IntToStr(ar[b,a,0])+" ");
     for b:=1 to a do if b=a then Writeln(f, IntToStr(ar[b,a,1])) else Write(f, IntToStr(ar[b,a,1])+" ");
     for b:=1 to a do if b=a then Writeln(f, IntToStr(ar[b,a,2])) else Write(f, IntToStr(ar[b,a,2])+" ");
     Writeln(f," ");
   end;
   CloseFile(f);
   Writeln(l,TimeToStr(Time)+" - Таблица сгененирована");
   Memo1.Lines.Add(TimeToStr(Time)+" - Таблица сгененирована");
 end;

 //произвожу сравнение
 Memo1.Lines.Add(TimeToStr(Time)+" - Начало сравнения значений");
 for y := StrToInt(Edit2.Text) to i do
 begin
   for x := 1 to y do
   begin
     Memo1.Lines.Add(TimeToStr(Time)+" - Проверяется "+IntToStr(y)+" строка, "+IntToStr(x)+" столбец");
     for a:= 1 to i do
       for b:= 1 to a do
         if (ar[x,y,1]=ar[b,a,2]) then
         begin
           Writeln(d, IntToStr(ar[x,y,1]));
           Writeln(d,"Строка "+IntToStr(a)+" столбец "+IntToStr(b)+" - 3");
           Writeln(d,"Строка "+IntToStr(y)+" столбец "+IntToStr(x)+" - 2");
           Writeln(d," ");
         end;
   end;
 Memo1.Lines.Add(TimeToStr(Time)+" - "+FloatToStr(100/i*y)+"%");
 end;


 Memo1.Lines.Add(TimeToStr(Time)+" - Раcчет закончен");
 CloseFile(d);
 CloseFile(l);
end;
end.


 
Поросенок Винни-Пух ©   (2008-06-10 13:10) [1]

убрать мемо и преобразования


 
Kaer ©   (2008-06-10 13:39) [2]

ну дык они же вроде срабатывают тока когда есть совпадения, а их по идеи и не должно быть (это какраз и надо проверить на практике), тем более если не будет записи то как еще можно узнать где совпадения?


 
Германн ©   (2008-06-10 13:55) [3]


> Kaer ©   (10.06.08 13:39) [2]

Запись в Мемо в каждой итерации цикла сжирает кучу времени.


 
Правильный_Вася   (2008-06-10 13:58) [4]


> i: integer;
...
>  i:= StrToInt64(Edit1.Text);

А смысл?

> При расчете если поставить 5000

чего 5000?


 
MBo ©   (2008-06-10 14:12) [5]

Про неправильное использование визуального компонента внутри циклов уже сказали (можно использовать TStringList, либо BeginUpdate), а что вообще делает алгоритм? Какое-то странное сравнение непонятно чего непонятно с чем с алгоритмической  сложностью O(N^4), что для N=5000 дает порядка квадриллиона операций!


 
MBo ©   (2008-06-10 14:42) [6]

Кстати, минимальное решение 422481^4 -  95800^4 =  217519^4 +  414560^4
так что пять тыщ - маловато будет ;))


 
Kaer ©   (2008-06-10 17:45) [7]

Прогрмма для одного кандидата(математика) от там весь в науки и ему нужно знать на практике манипуляции данно программы. Смысл программы такой: Строиться таблица примерно такого вида

2
0
2

4 8
15 0
17 32

6 12 18
80 65 0
82 97 162

8 16 24 32
255 240 175 0
257 272 337 512

10 20 30 40 50
624 609 544 369 0
626 641 706 881 1250

Сдесть представлена таблица состоящая из 5 строк (3 подстроки не в счет:-)) и 5 столбцов (введено в Edit1 = 5)

i:= StrToInt64(Edit1.Text);
...
for a := 1 to i do
  for b := 1 to a do
  begin
    a_2:=a*a;
    b_2:=b*b;
    ar[b,a,0] := 2*a*b;
    ar[b,a,1] := a_2*a_2-b_2*b_2;
    ar[b,a,2] := a_2*a_2+b_2*b_2;
  end;

Формулы заполнения
1) с = 2*a*b
2) c = b^4-a^4
3) c = b^4+a^4
Затем нужно найти одинаковые значения во второй и третьих подстроках(!!! - это очень важно, не во второй второй, не в третей третей, а именно чтобы одно итоже значение было во второй подстроке и третей, пофигу каких строк и столбцов) что я и делаю методом перебора

Memo1.Lines.Add(TimeToStr(Time)+" - Начало сравнения значений");
for y := StrToInt(Edit2.Text) to i do
begin
  for x := 1 to y do
  begin
    Memo1.Lines.Add(TimeToStr(Time)+" - Проверяется "+IntToStr(y)+" строка, "+IntToStr(x)+" столбец");
    for a:= 1 to i do
      for b:= 1 to a do
        if (ar[x,y,1]=ar[b,a,2]) then
        begin
          Writeln(d, IntToStr(ar[x,y,1]));
          Writeln(d,"Строка "+IntToStr(a)+" столбец "+IntToStr(b)+" - 3");
          Writeln(d,"Строка "+IntToStr(y)+" столбец "+IntToStr(x)+" - 2");
          Writeln(d," ");
        end;
  end;
Memo1.Lines.Add(TimeToStr(Time)+" - "+FloatToStr(100/i*y)+"%");
end;

Получается что если ввести в Edit1, 5000 (это он тока пока так требоет потом может больше захочет, 10000? 20000? может даже 30000 :-)) то программа будет сжирать гдето 1 gb, и очень долго перебирать знаения.

Мемо я использовал чтобы было видно програ работает или нет :-) а то ана подвисает. Подскажите другой способ какнибудь где она считает, я с удовольсвием его применю:-)

вот пример работы программы с числом 10 тока формула немного другая с 3 степенью а так все тоже самое
1) с = 2*a*b
2) c = b^3-a^3
3) c = b^3+a^3

2
0
2
4  8
7  0
9  16
6  12  18
26  19  0
28  35  54
8  16  24  32
63  56  37  0
65  72  91  128
10  20  30  40  50
124  117  98  61  0
126  133  152  189  250
12  24  36  48  60  72
215  208  189  152  91  0
217  224  243  280  341  432
14  28  42  56  70  84  98
342  335  316  279  218  127  0
344  351  370  407  468  559  686
16  32  48  64  80  96  112  128
511  504  485  448  387  296  169  0
513  520  539  576  637  728  855  1024
18  36  54  72  90  108  126  144  162
728  721  702  665  604  513  386  217  0
730  737  756  793  854  945  1072  1241  1458
20  40  60  80  100  120  140  160  180  200
999  992  973  936  875  784  657  488  271  0
1001  1008  1027  1064  1125  1216  1343  1512  1729  2000

Повторяющиеся числа:

728
Строка 8 столбец 6 - 3
Строка 9 столбец 1 - 2

189
Строка 5 столбец 4 - 3
Строка 6 столбец 3 - 2

152
Строка 5 столбец 3 - 3
Строка 6 столбец 4 - 2

91
Строка 4 столбец 3 - 3
Строка 6 столбец 5 - 2

513
Строка 8 столбец 1 - 3
Строка 9 столбец 6 - 2

217
Строка 6 столбец 1 - 3
Строка 9 столбец 8 - 2

Фух, надеюсь я понятно объеснил


 
Правильный_Вася   (2008-06-10 17:50) [8]


> Мемо я использовал чтобы было видно програ работает или
> нет :-) а то ана подвисает.

вставь в цикл Application.ProcessMessages через 100 итераций


 
Kaer ©   (2008-06-10 17:54) [9]


> вставь в цикл Application.ProcessMessages через 100 итераций

пасибо, так намного лучше))


 
Ega23 ©   (2008-06-10 18:01) [10]


> Фух, надеюсь я понятно объеснил


Зря надеешься.


 
MBo ©   (2008-06-10 18:07) [11]

>Прогрмма для одного кандидата(математика)
мда.... Опять  дедушку Эйлера опровергает, наверно.

Ну ладно, раз хочется попиндюриться, вот алгоритм со сложностью O(N^2*LogN)
Заводятся 2 массива структур Summ и Diff
record
 Res: Int64;
 A, B: Integer;
end
Res - сумма или разность A и B в степенях
Далее сортировка массивов  по полю Res
Затем делается один проход по обоим массивам одновременно. Индексы ставятся в начало.
Если Res больше у очередного элемента первого массива, увеличивается индекс для второго  массива и наборот.


 
Ega23 ©   (2008-06-10 18:09) [12]


> MBo ©   (10.06.08 18:07) [11]


Щас у тебя код попросят.


 
Kaer ©   (2008-06-10 18:12) [13]

ниче я просить не буду, но если честно плохо понял MBo, я не матиматик, я даже не программист :-)


 
MBo ©   (2008-06-10 18:27) [14]

Гипотеза Эйлера - диофантово уравнение 4-й степени a^4+b^4+c^4=d^4 не имеет решений в целых числах (похоже на теорему Ферма)
Лет 30 назад все-таки доказали, что решений бесконечно много, минимальное я привел, и оно уже в Int64 не влазит, а в остальных фигурируют числа еще больше Параметрического уравнения для генерации решений не существует (неизвестно).


 
Kaer ©   (2008-06-10 18:35) [15]

мммм.... ясно :-)


 
Kaer ©   (2008-06-10 18:35) [16]

Удалено модератором


 
MBo ©   (2008-06-11 06:22) [17]

Алгоритм с лучшей вычислительной сложностью O(n^2) ценой увеличения затрат памяти.
Заводим 4 миллиарда файлов, в каждом по 4 миллиарда записей (A;B), позиция пары в этом гипермассиве A,B есть разность их степеней (pigeonhole принцип). Сортировка не требуется. Далее генерируются суммы и проверяется наличие в соотв. ячейке гипермассива.
;)


 
Kaer ©   (2008-06-11 08:29) [18]


> O(n^2)

это вобще что?

> O(N^2*LogN)

и вот это тоже? ;-)


 
MBo ©   (2008-06-11 09:00) [19]

n - размер задачи, максимальное число, возводимое в степень (в твоем коде - i)
O(n^2) означает, что количество операций пропорционально квадрату размер задачи


 
Kaer ©   (2008-06-11 10:18) [20]


> MBo ©

хочу попробывать сделать

>Заводятся 2 массива структур Summ и Diffrecord
>  Res: Int64;  A, B: Integer;endRes - сумма или разность
> A и B в степеняхДалее сортировка массивов  по полю ResЗатем
> делается один проход по обоим массивам одновременно. Индексы
> ставятся в начало.Если Res больше у очередного элемента
> первого массива, увеличивается индекс для второго  массива
> и наборот.

тока не соображу как оперировать с массивом структур


 
Kaer ©   (2008-06-11 10:52) [21]

делаю вот так
 
type
 Data = record
   Res: Int64;
   A, B: Integer;
 end;
...
var
 Form1: TForm1;
 Diff, Summ: array of Data;
 a,b,i: integer;
...
 SetLength(Diff,i+1);
 SetLength(Summ,i+1);
 for a := 1 to i do
   for b := 1 to a do
   begin
     Diff[a].Res:=a*a*a-b*b*b;
     Diff[a].A:=a;
     Diff[a].B:=b;
     Summ[a].Res:=a*a*a+b*b*b;
     Summ[a].A:=a;
     Summ[a].B:=b;
   end;


А дальше не соображу, после сортировки Diff[1].Res и Summ[1].Res должны же быть минимальны, а Diff[5000].Res и Summ[5000].Res максимальны? Если да, то тогда дальше что-то вроде этого?

a:=1;
   b:=1;
   repeat
     if (Diff[a].Res>Summ[b].Res) then
       b:=b+1
     else if (Diff[a].Res<Summ[b].Res) then
         a:=a+1
     else if (Diff[a].Res=Summ[b].Res) then
     begin
       //Вывод
     end;
   until (a=5000) or (b=5000);


 
Правильный_Вася   (2008-06-11 11:03) [22]


> > O(n^2)это вобще что?

мдя
и этот чел что-то там алгоритмизирует... для кандидата...
бедная наша наука...


 
MBo ©   (2008-06-11 12:56) [23]

for a := 1 to i do
  for b := 1 to a do
  begin
    Diff[a].Res:=a*a*a-b*b*b;

для индекса нужна другая переменная, а длина массивов будет i *(i+1)/2


 
Kaer ©   (2008-06-11 13:05) [24]


> > > O(n^2)это вобще что?мдяи этот чел что-то там алгоритмизирует.
> .. для кандидата...бедная наша наука...

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


 
Anatoly Podgoretsky ©   (2008-06-11 13:24) [25]

> Kaer  (11.06.2008 13:05:24)  [24]

Какой кандидат, такая и тетка, такой и "программист", соответственно такая же и наука.


 
Kaer ©   (2008-06-11 13:36) [26]

Нет, не так. Какая наука дала возможности кандидату, такими он и пользуется.


 
MBo ©   (2008-06-11 13:37) [27]

поскольку даже минимальное решение предложенными алгоритмами без привлечения длинной математики (что медленно) или теории чисел (что, возможно, позволило бы найти другие пути) не получить, есть предложение сделать программу, поторая будет неделю нагружать комп, а потом скажет - решений для чисел < 200 000 не имеется
;)


 
Поросенок Винни-Пух ©   (2008-06-11 13:37) [28]

какая наука дала кандидату?


 
Kaer ©   (2008-06-11 13:41) [29]


> поскольку даже минимальное решение предложенными алгоритмами
> без привлечения длинной математики (что медленно) или теории
> чисел (что, возможно, позволило бы найти другие пути) не
> получить, есть предложение сделать программу, поторая будет
> неделю нагружать комп, а потом скажет - решений для чисел
> < 200 000 не имеется;)

эээээ.... чего? :-)


 
Anatoly Podgoretsky ©   (2008-06-11 14:29) [30]

Имя конечно красивая, а мне больше Антенна нравится.


 
Игорь Шевченко ©   (2008-06-11 14:33) [31]


> блин мне 20 лет, у меня нет образования, я вооще практику
> на заводе прохожу, и там мне одна тетька дала мне это задание,
>  которое ей самой надо было сделать для этого кандидата


ну и проходи практику на заводе, больше пользы принесешь


 
Kaer ©   (2008-06-11 17:20) [32]


> ну и проходи практику на заводе, больше пользы принесешь

у меня практика заключается в создании этой программы(по возможности конечно). Я вижу дискуссия пошла в другую сторону от задуманной темой так что наверное, модератор, закройте её пожалуйста, буду сам разбираться. :(


 
Kaer ©   (2008-06-11 17:32) [33]

Забыл сказать, спасибо кто помогал, особенно MBo.



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.07.13;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.56 MB
Время: 0.008 c
15-1212140391
bsna
2008-05-30 13:39
2008.07.13
кодировка dos и win


2-1213341681
Yury
2008-06-13 11:21
2008.07.13
посылка сообщения


15-1211778536
AndreyV
2008-05-26 09:08
2008.07.13
Phoenix приземлился на Марс


2-1213001830
RUYurik
2008-06-09 12:57
2008.07.13
Загрузка ресурсов (BITMAP) в приложение


15-1212020253
PEAKTOP
2008-05-29 04:17
2008.07.13
Delphi2007 и КПК.





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский