Как закрыть приложение, которое находится в процессе выполнения алгоритма?

@vino0s · Регистрация: 26.03.2014

Студворк — интернет-сервис помощи студентам

Привет!

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

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

Если можно без "многопоточности" или скажите что это не так страшно и как делать)

DenNik · 31.08.2017, 13:01

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

Когда нажимаю кнопку выйти во время выполнения алгоритма,

ты должен завести флаг "нажата кнопка" и присвоить ему true

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

алгоритм продолжает выполняться.

должен периодически проверять флаг "нажата кнопка" (если это цикл, то в каждой итерации цикла) и если он равен true, прерывать работу

@vino0s · 31.08.2017, 13:06 **[ТС]**

Ага всё шикарно, только у меня процедура не принадлежит TForm: тогда с флагом не получится, я полагаю. Есть ли решение для таких случаев?

Ну я конечно просто изменю процедуру на TForm. Спасибо!

DenNik · 31.08.2017, 13:17

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

Ну я конечно просто изменю процедуру на TForm

зачем? что мешает проверку делать в нынешнем виде?

@vino0s · 31.08.2017, 13:51 **[ТС]**

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

что мешает проверку делать в нынешнем виде?

Хз, разве я смогу обратиться к глобальной переменной в "не глобальной функции"?

Delphi
1
procedure WordReplaceP (M, Memo, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer; closebool: boolean);

А если описать так

Delphi
1
2
3
4
5
closebool: boolean
procedure WordReplaceP (M, Memo, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer);
begin
   if closebool then
end;

то проблем не вижу.
Или как тут можно сделать?

Добавлено через 1 минуту
ну вот к слову эта функция вызывается один раз, и дальше погружается в процесс. Если бы я ее к примеру вызывал часто, тогда можно было бы передавать параметром closebool.

Добавлено через 15 минут

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

в нынешнем виде?

Может я просто не понимаю алгоритм работы функций/процедур.

Скажем если я передал параметр глобальной (Формы) переменной, то во время выполнения работы я могу на них повлиять, Если сами функции не описаны в классе Формы?

DenNik · 31.08.2017, 13:55

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

ну вот к слову эта функция вызывается один раз,

а в функции есть цикл? в цикле проверяй (глобальную переменную-флаг)

@vino0s · 31.08.2017, 13:55 **[ТС]**

Чет не получилось)

Delphi
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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
TForm1 = class(TForm)
  procedure WordReplaceP (M, Memo, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer);
 
procedure TForm1.ExitBClick(Sender: TObject);
begin
  Closebool := true;
  Application.Terminate;
end;
 
procedure TForm1.WordReplaceP (M, Memo, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer);
var
  sl, sl2{, sl3}: TStringList;
  i, j:integer;
  vr: string;
begin
  Sl2 := TStringList.Create;
  Sl2.Text := Memo.Text;
  //Sl3 := TStringList.Create;
  //Sl3.Text := Mr.Text;
  Sl := TStringList.Create;
  //SL.Sorted := true;
  SL2.Duplicates := dupIgnore;
  Sl.Text := M.Text;
  T.Max := Sl.Count -1;
  Mr.Clear;
  Mr.Lines.Add(SL[0]);
  for i := i_n to Sl.Count-2 do
  begin
    if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i<sl.Count-2) then
      Mr.Lines.Add(SL[i+1])
    else if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i=sl.Count-2) then
    begin
      Mr.Lines.Add(SL[i+1]);
      vr:=Mr.Lines.Strings[0];
      Mr.Lines.Delete(0);
      T2.Max := Sl2.Count-1;
      for j := 0 to Sl2.Count-1 do
      begin
        T2.Position := j;
        SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
        if j mod 10 = 0 then
        begin
          Memo.Text := SL2.Text;
          Application.ProcessMessages;
        end;
      end;
      Mr.Lines.Clear;
    end
    else
    begin
      if Mr.Lines.Count > 1 then
      begin
        vr:=Mr.Lines.Strings[0];
        Mr.Lines.Delete(0);
        T2.Max := Sl2.Count-1;
        for j := 0 to Sl2.Count-1 do
        begin
          T2.Position := j;
          SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
          if j mod 10 = 0 then
          begin
            Memo.Text := SL2.Text;
            Application.ProcessMessages;
          end;
        end;
        if closebool then
          break;
      end;
      Mr.Lines.Clear;
      Mr.Lines.Add(SL[i+1]);
    end;
    T.Position := i;
    if closebool then
      break;
  end;
 
  Memo.Text := SL.Text;
  FreeAndNil(SL2);
  //FreeAndNil(Sl3);
  FreeAndNil(SL);
    if closebool then
      Application.Terminate;
end;

DenNik · 31.08.2017, 13:58

говорю же - в цикле!

Delphi
1
2
3
4
5
6
7
8
9
10
var
  ForceExit: boolean;
 
procedure proc;
begin
  while not ForceExit do
  begin
    // do smt.
  end;
end;

Добавлено через 51 секунду
это один из многих вариантов

@vino0s · 31.08.2017, 16:16 **[ТС]**

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

говорю же - в цикле!

Я спорить не буду, но вроде тот пример что выше предложил имеет такую же силу)
Сейчас проверю, тут просто каждый внешний цикл занимает около 5 минут. А вложенный достаточно быстр (сек 5-10).
Хотелось бы прерываться на вложенном.

Добавлено через 5 минут
В общем для начала о самом "выходе" - ваша реализация работает. Но если убрать те строчки, что добавил я - то не работает.

А теперь о самом сочном, о самой процедуре - она теперь не выполняет свою работу... =)

Добавлено через 2 минуты

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

не выполняет свою работу

тот процесс который выполнялся 5 минут выполняется за 5 секунд))

Добавлено через 1 минуту

Delphi
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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
procedure TForm1.WordReplaceP (M, Memo, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer);
var
  sl, sl2{, sl3}: TStringList;
  i, j:integer;
  vr: string;
begin
  Sl2 := TStringList.Create;
  Sl2.Text := Memo.Text;
  //Sl3 := TStringList.Create;
  //Sl3.Text := Mr.Text;
  Sl := TStringList.Create;
  //SL.Sorted := true;
  SL2.Duplicates := dupIgnore;
  Sl.Text := M.Text;
  T.Max := Sl.Count -1;
  Mr.Clear;
  Mr.Lines.Add(SL[0]);
  while not Closebool do
  begin
    for i := i_n to Sl.Count-2 do
    begin
      if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i<sl.Count-2) then
        Mr.Lines.Add(SL[i+1])
      else if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i=sl.Count-2) then
      begin
        Mr.Lines.Add(SL[i+1]);
        vr:=Mr.Lines.Strings[0];
        Mr.Lines.Delete(0);
        T2.Max := Sl2.Count-1;
        for j := 0 to Sl2.Count-1 do
        begin
          T2.Position := j;
          SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
          if j mod 10 = 0 then
          begin
            Memo.Text := SL2.Text;
            Application.ProcessMessages;
          end;
          if closebool then
            break;
        end;
        Mr.Lines.Clear;
      end
      else
      begin
        if Mr.Lines.Count > 1 then
        begin
          vr:=Mr.Lines.Strings[0];
          Mr.Lines.Delete(0);
          T2.Max := Sl2.Count-1;
          for j := 0 to Sl2.Count-1 do
          begin
            T2.Position := j;
            SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
            if j mod 10 = 0 then
            begin
              Memo.Text := SL2.Text;
              Application.ProcessMessages;
            end;
          end;
          if closebool then
            break;
        end;
        Mr.Lines.Clear;
        Mr.Lines.Add(SL[i+1]);
      end;
      T.Position := i;
      if closebool then
        break;
    end;
  end;
 
  Memo.Text := SL.Text;
  FreeAndNil(SL2);
  //FreeAndNil(Sl3);
  FreeAndNil(SL);
  {  if closebool then
      Application.Terminate;  }
end;

Добавлено через 1 час 5 минут
Вопрос открытый. Реализация выхода решена, в ущерб самой функции) Что естественно не радует)
Почему он стал пропускать выполнение "долгой" обработки и начал строчить как с пулемета?

Добавлено через 58 минут
да не и сама муть даже эта не верно выстроена.

Надо добавлять еще один флаг на окончание работы функции.

Добавлено через 1 минуту

Delphi
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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
procedure TForm1.WordReplaceP (M, Memo, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer);
var
  sl, sl2{, sl3}: TStringList;
  i, j:integer;
  vr: string;
  b: boolean;
begin
  Sl2 := TStringList.Create;
  Sl2.Text := Memo.Text;
  //Sl3 := TStringList.Create;
  //Sl3.Text := Mr.Text;
  Sl := TStringList.Create;
  //SL.Sorted := true;
  SL2.Duplicates := dupIgnore;
  Sl.Text := M.Text;
  T.Max := Sl.Count -1;
  Mr.Clear;
  Mr.Lines.Add(SL[0]);
  b := false;
  while (not Closebool) and (not b) do
  begin
    for i := i_n to Sl.Count-2 do
    begin
      if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i<sl.Count-2) then
        Mr.Lines.Add(SL[i+1])
      else if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i=sl.Count-2) then
      begin
        Mr.Lines.Add(SL[i+1]);
        vr:=Mr.Lines.Strings[0];
        Mr.Lines.Delete(0);
        T2.Max := Sl2.Count-1;
        for j := 0 to Sl2.Count-1 do
        begin
          T2.Position := j;
          SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
          if j mod 10 = 0 then
          begin
            Memo.Text := SL2.Text;
            Application.ProcessMessages;
          end;
          if closebool then
            break;
        end;
        b:=true;
        Mr.Lines.Clear;
      end
      else
      begin
        if Mr.Lines.Count > 1 then
        begin
          vr:=Mr.Lines.Strings[0];
          Mr.Lines.Delete(0);
          T2.Max := Sl2.Count-1;
          for j := 0 to Sl2.Count-1 do
          begin
            T2.Position := j;
            SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
            if j mod 10 = 0 then
            begin
              Memo.Text := SL2.Text;
              Application.ProcessMessages;
            end;
          end;
          if closebool then
            break;
        end;
        Mr.Lines.Clear;
        Mr.Lines.Add(SL[i+1]);
      end;
      T.Position := i;
      if closebool then
        break;
    end;
  end;
 
  Memo.Text := SL.Text;
  FreeAndNil(SL2);
  //FreeAndNil(Sl3);
  FreeAndNil(SL);
  {  if closebool then
      Application.Terminate;  }
end;

DenNik · 31.08.2017, 16:39

отладчик, брекпоинты, трассировку применяй и смотри, что выполняется, а что нет

@krapotkin · 31.08.2017, 17:09

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

@vino0s · 31.08.2017, 18:36 **[ТС]**

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

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

Очень ценный совет) Но пока я не добавил while do все работало и без правильных названий переменных, и логических блоков. Если я отвяжу интерфейс, то 2 суток смотреть и думать происходит что то, верно ли все происходит или все уже законченно не айс...

Там у меня большой список заменился на малый, поэтому все стало летать быстро

Добавлено через 8 минут

Delphi
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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
procedure TForm1.WordReplaceP (M, M2, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar; i_n: integer);
var
  sl, sl2{, sl3}: TStringList;
  i, j:integer;
  vr: string;
  b: boolean;
begin
  Sl2 := TStringList.Create;
  Sl2.Text := M2.Text;
  //Sl3 := TStringList.Create;
  //Sl3.Text := Mr.Text;
  Sl := TStringList.Create;
  //SL.Sorted := true;
  SL2.Duplicates := dupIgnore;
  Sl.Text := M.Text;
  T.Max := Sl.Count -1;
  Mr.Clear;
  Mr.Lines.Add(SL[0]);
  b := false;
  while (not Closebool) or (not b) do
  begin
    for i := i_n to Sl.Count-2 do
    begin
      if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i<sl.Count-2) then
        Mr.Lines.Add(SL[i+1])
      else if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i=sl.Count-2) then
      begin
        Mr.Lines.Add(SL[i+1]);
        vr:=Mr.Lines.Strings[0];
        Mr.Lines.Delete(0);
        T2.Max := Sl2.Count-1;
        for j := 0 to Sl2.Count-1 do
        begin
          T2.Position := j;
          SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
          if j mod 10 = 0 then
          begin
            M2.Text := SL2.Text;
            Application.ProcessMessages;
          end;
          if closebool then
            break;
        end;
        b:=true;
        Mr.Lines.Clear;
      end
      else
      begin
        if Mr.Lines.Count > 1 then
        begin
          vr:=Mr.Lines.Strings[0];
          Mr.Lines.Delete(0);
          T2.Max := Sl2.Count-1;
          for j := 0 to Sl2.Count-1 do
          begin
            T2.Position := j;
            SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
            if j mod 10 = 0 then
            begin
              M2.Text := SL2.Text;
              Application.ProcessMessages;
            end;
          end;
          if closebool then
            break;
        end;
        Mr.Lines.Clear;
        Mr.Lines.Add(SL[i+1]);
      end;
      T.Position := i;
      if closebool then
        break;
    end;
  end;
 
  M2.Text := SL.Text;
  FreeAndNil(SL2);
  //FreeAndNil(Sl3);
  FreeAndNil(SL);
  {  if closebool then
      Application.Terminate;  }
end;

Условие исправил в WHILE на OR

Добавлено через 4 минуты

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

Условие исправил в WHILE на OR

наверное правильное было все таки) Крч снова не закрывается)

Добавлено через 8 минут

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

Крч снова не закрывается)

закрывается через несколько итераций

Добавлено через 48 минут

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

через несколько итераций

на этой же итерации, но вложенный доходит до конца (5 мин)

Добавлено через 1 минуту
ага, увидел косяк, условие не в цикле for.

Добавлено через 10 минут
Вот рабочий вариант, для моего случая.

Delphi
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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
procedure TForm1.WordReplaceP (M, M2, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar);
var
  sl, sl2: TStringList;
  i, j, k, l, n:integer;
  vr: string;
  b: boolean;
begin
  Sl2 := TStringList.Create;
  Sl2.Text := M2.Text;
  Sl := TStringList.Create;
  SL2.Duplicates := dupIgnore;
  Sl.Text := M.Text;
  T.Max := Sl.Count -1;
  Mr.Clear;
  Mr.Lines.Add(SL[0]);
  b := false;
  n := i_sin;
  while (not Closebool) and (not b) do
  begin
    for i := n to Sl.Count-2 do
    begin
      if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i<sl.Count-2) then
        Mr.Lines.Add(SL[i+1])
      else if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i=sl.Count-2) then
      begin
        Mr.Lines.Add(SL[i+1]);
        vr:=Mr.Lines.Strings[0];
        Mr.Lines.Delete(0);
        T2.Max := Sl2.Count-1;
        for j := 0 to Sl2.Count-1 do
        begin
          T2.Position := j;
          SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
          if j mod 10 = 0 then
          begin
            M2.Text := SL2.Text;
            Application.ProcessMessages;
          end;
          if closebool then
            break;
        end;
        b:=true;
        l:=0;
        for k := 0 to Mr.Lines.Count-1 do
          for j := l to M.Lines.Count-1 do
            if AnsiCompareText(M.Lines.Strings[j], Mr.Lines.Strings[k])=0 then
            begin
              M.Lines.Delete(j);
              l:=j;
              break;
            end;
        Mr.Lines.Clear;
      end
      else
      begin
        if Mr.Lines.Count > 1 then
        begin
          vr:=Mr.Lines.Strings[0];
          Mr.Lines.Delete(0);
          T2.Max := Sl2.Count-1;
          for j := 0 to Sl2.Count-1 do
          begin
            T2.Position := j;
            SL2.Strings[j] := WordReplaceS(SL2.Strings[j], vr, Mr);
            if j mod 10 = 0 then
            begin
              M2.Text := SL2.Text;
              Application.ProcessMessages;
            end;
            if closebool then
              break;
          end;
        end;
        l:=0;
        for k := 0 to Mr.Lines.Count-1 do
          for j := l to M.Lines.Count-1 do
            if AnsiCompareText(M.Lines.Strings[j], Mr.Lines.Strings[k])=0 then
            begin
              M.Lines.Delete(j);
              l:=j;
              break;
            end;
        Mr.Lines.Clear;
        Mr.Lines.Add(SL[i+1]);
      end;
      T.Position := i;
      i_sin := i;
      if closebool then
        break;
    end;
  end;
 
  M2.Text := SL2.Text;
  FreeAndNil(SL2);
  FreeAndNil(SL);
end;

Теперь можно поговорить о философии кода)

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

отвязку интерфейса от логики и выделение логических блоков кода в отдельные процедуры

Вот конкретно на эту тему. Что вы имели ввиду? Имена я естественно менять не буду, ибо они уже в голове пропечатаны.
А вот про MVC модель и логические блоки, по подробнее, пожалуйста)) Конкретно для этого кода.

@Animalia · 31.08.2017, 19:01

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

тот процесс который выполнялся 5 минут выполняется за 5 секунд))

Подозреваю что суть в том, что Break прерывает выполнение короткого цикла, а на длинном куске break теряется в ветвлениях.
Как вариант переделать на безальтернативный вариант как уже предложили

Delphi
1
2
3
4
5
6
7
8
for index := x to y do
begin
  if closebool then
    break;
 
// и только потом тело цикла.
 
end;

Или использовать Exit, но тут косяк в том, что завершается не цикл, а вообще вся процедура. Тоесть хвост после циклов не выполнится.

Ну или (прям уже чую как прицельным огнем полетели тапки) использовать Goto, тут все вообще может быть прекрасно. Завели отдельный кусок кода который сохранит все что надо и переходите на него вместо break'а

Delphi
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
label
  BreakRoutines, EndRoutines, ProcedureEnd;
var
  sl, sl2{, sl3}: TStringList;
  i, j:integer;
  vr: string;
  closebool,b: boolean;
begin
  // туча кода и циклов
          if closebool then
            goto BreakRoutines;
  // туча кода и циклов
 
EndRoutines:
  M2.Text := SL.Text;
  FreeAndNil(SL2);
  //FreeAndNil(Sl3);
  FreeAndNil(SL);
  {  if closebool then
      Application.Terminate;  }
 
  goto ProcedureEnd;
 
BreakRoutines:
// сохраняем все что под руку попадется 
  goto EndRoutines; // ну нам ведь надо и обьекты уничтожить :)
 
ProcedureEnd:
end;

Добавлено через 12 минут
Хинт: кусок кода с 22 строки

Delphi
1
2
3
4
5
    begin
      if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i<sl.Count-2) then
        Mr.Lines.Add(SL[i+1])
      else if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i=sl.Count-2) then
      begin

Лучше заменить на

Delphi
1
2
3
4
5
6
    begin
      if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) then
        if (i<sl.Count-2) then
          Mr.Lines.Add(SL[i+1])
        else if (i=sl.Count-2) then
          begin

иначе функция Pohozhest вызывается два раза подряд с одинаковыми аргументами, и тут ситуация "за пять минут существенно ниче не изменилось".

@krapotkin · 31.08.2017, 19:17

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

Но пока я не добавил while do все работало

когда "все работало", не возникает 2 страницы на форуме ))

@vino0s · 31.08.2017, 19:43 **[ТС]**

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

иначе функция Pohozhest вызывается два раза подряд

Да вроде не вызывается, второе условие вообще один раз за все время процедуры выполнится, а именно в конце. И похожесть она моментальная можно сказать, там просто 2 "слова" сравнивается по алгоритму N-грамм.

Вся попа (5 мин) начинается когда идет обработка списка 80к строк: каждая строка состоит от 2-х до 7-ми слов, каждую строку разбиваем на слова, ищем совпадение по списку замены ( от 1 до 4-х слов), и если есть совпадение заменяем слово, затем собираем строку. и идем дальше.

Ну можно тут задачку на подумать написать)) Если есть желание у кого-то решить, я буду рад))

Начальные параметры: Список фраз ( отсортирован по количеству слов в строке: от 2-х до 7-ми, слова в каждой строке отсортированы по алфавиту a-z,а-я) = в коде М2, Список различных слов, которые могут встретиться в М2 ( по одному слову в строке, отсортированы по алфавиту ) = в коде М, Список слов замены (формируется через функцию Pohozhest) = в коде Mr.
Задача: Заменить похожие слова в Списке фраз М2.
Алгоритм:
1) Выявляем различные слова из списка М2 => М (это уже сделано заранее, процесс тоже довольно длительный, есть оптимизация, к задаче не относится)
2) Проходим по Списку различных слов М и заполняем Список замен Mr, пока выполняется Pohozhest (здесь все таки придется изменить на полный обход списка различных слов, но пока так...) Первое "слово" является словом для замены, фиксируем его в переменную vr и удаляем из Списка замен.
3) Проходим по Списку фраз
3.а) каждую строку разбиваем на слова (НУЖНО чтобы не заменялось слово "БЕЗДНА" на слово "БЕЗ" к примеру, если не понятно, в общем на слова разбиваться нужно! )
3.б) сравниваем каждое слово на совпадению по Списку замен
3.в) если находим заменяем

Идея: Сортировка по количеству слов, достаточно быстрая ( в сравнении с двумя сутками

) можно сократить время сокращая количество строк в списке фраз, Если список фраз отсортировать по алфавиту, а каждая строка также отсортирована по алфавиту, тогда, к примеру, проходя слово на букву М, будем проходить список фраз от А до буквы Н, конечно при букве Я придется пройти весь список, но для буквы А, все кончится довольно скоро (До Б)

Если есть Идеи пишите)

Добавлено через 1 минуту

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

когда "все работало", не возникает 2 страницы на форуме ))

Они возникли когда я захотел выходить из программы во время выполнения этих долгих (2 суток) алгоритмов, и чтоб сохранялся уровень прохода, а то когда через диспетчер отрубаешь, сохранение уровня прохода не происходит)

Добавлено через 4 минуты
Так а по поводу Goto: у меня таких функций и процедур, которые могут длиться от часа до нескольких суток, несколько)
Их я уже привел к TForm, было бы не плохо путем "вставления" небольшого когда добиваться результата (т.е. не несколько строчек вставлять в начало, конец и середину, а небольшой блок, в конец например)

Вот у меня чутьё что это Goto может помочь))) Хотелось бы узнать о подводных камнях с этим оператором, по части памяти, ну и вообще.

Добавлено через 2 минуты
да и вообще может есть готовый быстрый велик по описанной задаче?

Добавлено через 7 минут
вообще в голове зародилась таблица из 7 столбиков, вот я код находил:

Delphi
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
44
45
46
47
procedure NoDuplicateT(aSg: TStringGrid; const aCol: integer);
var
  SlSort, SlRow: TStringList;
  i, j: integer;
begin
  // Сортируемый список.
  SlSort := TStringList.Create;
 
  // Добавляем в сортируемый список пары: "строка - объект".
  // В качестве строки будем записывать значения ячеек того
  // столбца, по которому надо провести сортировку. Будем брать те ячейки, которые
  // не принадлежат фиксированным строкам - чтобы не подвергнуть сортировке
  // шапку таблицы, если она есть.
  // А в качестве объекта будем присоединять копии соответствующих строк таблицы.
  for i := aSg.FixedRows to aSg.RowCount - 1 do
  begin
    // Создаём контейнер для копии строки таблицы.
    SlRow := TStringList.Create;
    // Копируем строку таблицы в контейнер.
    SlRow.Assign(aSg.Rows[i]);
    // Добавляем в сортируемый список пару:
    // строка: строка из ячейки целевого столбца;
    // объект: контейнер, содержащий копию строки таблицы.
    SlSort.AddObject(aSg.Cells[aCol, i], SlRow);
  end;
 
  // Сортируем столбец.
  SlSort.Sort;
  // SlSort.Duplicates := dupIgnore;
 
  // Возвращаем в таблицу строки, отсортированные по столбцу с номером aCol.
  j := 0;
  for i := aSg.FixedRows to aSg.RowCount - 1 do
  begin
    // Берём очередной контейнер.
    SlRow := Pointer(SlSort.Objects[j]);
    // Записываем содержимое контейнера в строку таблицы.
    aSg.Rows[i].Assign(SlRow);
    // Уничтожаем контейнер.
    SlRow.Free;
    // Следующий индекс списка.
    inc(j);
  end;
 
  // Уничтожаем сортируемый список.
  FreeAndNil(SlSort);
end;

Важно из этого кода "Связанные строки", так вот если 80к строк залить в таблицу, строки связать, сортирую первый столбец, делаю обход по столбцу = заменяю, сортирую следующий столбец. Фишка в том что по первой букве можно (наверное) быстрее обходить (к примеру через поисковые алгоритмы: метод золотого сечения, с сохранением найденной позиции и обходом вверх и вниз (вдруг найденная строка находится по середине, интересующей буквы)).

@Animalia · 31.08.2017, 23:31

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

А вот про MVC модель и логические блоки, по подробнее, пожалуйста)) Конкретно для этого кода.

Каждый кусок кода выполняет свою работу, даже в пределах одной процедуры можно выделить несколько блоков. Например подготовка данных, непосредственно работа с ними, вывод результатов и т.д.
По мере роста обьема кода вполне логично разделить процедуру на другие, более мелкие, процедуры, которые выполняют только свою определенную роль. Это проще как в написании кода, так и в отладке - найти ошибку в 3 строках кода, легче чем найти ошибку на 3 страницах.

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

Кликните здесь для просмотра всего текста

Delphi
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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
procedure TForm1.WordReplaceP (M, M2, Mr: TMemo; sov, dlsl: integer; T, T2: TProgressBar);  
label
  BreakRoutines, EndRoutines, ProcedureEnd;  
  
var
  sl, sl2: TStringList;
  i, n: integer;
  vr: string;
  b: boolean;
  
  procedure LocalProcedure_1;
  var
    StartFrom, M_Index, Mr_Index: integer;
  begin
    StartFrom:=0; 
    // k и j можно запилить локальными по отношению к основной процедуре
    // в остальном коде они не используются, поэтому их можно заодно обозвать понятнее
    for Mr_Index := 0 to Mr.Lines.Count-1 do
      for M_Index := StartFrom to M.Lines.Count-1 do
        if AnsiCompareText(M.Lines.Strings[M_Index], Mr.Lines.Strings[Mr_Index])=0 then
        // или если все слова приведены к одному регистру, думаю быстрее будет
        // if (M.Lines.Strings[M_Index] = Mr.Lines.Strings[Mr_Index]) then
        begin
          M.Lines.Delete(M_Index);
          StartFrom := M_Index;
          break;
        end;
    Mr.Lines.Clear;
  end;   
 
  procedure LocalProcedure_2
  var
    index: integer;
  begin
    // T2.Max := Sl2.Count-1; выкинул эту строку в область инициализации переменных
    // число строк в Sl2 у нас по ходу процедуры не изменяется
    // ну и j в index превратили
    for index := 0 to Sl2.Count-1 do
    begin
      if closebool then
        //break;
        Goto BreakRoutines;
      T2.Position := index;
      SL2.Strings[index] := WordReplaceS(SL2.Strings[index], vr, Mr);
      if index mod 10 = 0 then
      begin
        M2.Text := SL2.Text;
        Application.ProcessMessages;
      end;
    end;
  end; 
  
  procedure SaveAllWork;
  begin
    // работаем над сохранением
  end;
  
begin
  Sl := TStringList.Create;
  Sl2 := TStringList.Create;
  Sl.Text := M.Text;
  Sl2.Text := M2.Text;
  SL2.Duplicates := dupIgnore;
  T.Max := Sl.Count -1;
  T2.Max := Sl2.Count-1; 
  Mr.Clear;
  Mr.Lines.Add(SL[0]);
  //b := false;
  n := i_sin;
 
  for i := n to Sl.Count-2 do
  begin
    if closebool then
      //break;
    Goto BreakRoutines;
 
    if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i < SL.Count-2) then
      Mr.Lines.Add(SL[i+1])
    else 
      if (Pohozhest(SL[i], SL[i+1], sov, dlsl)) AND (i = SL.Count-2) then
      begin
        Mr.Lines.Add(SL[i+1]);
        vr:=Mr.Lines.Strings[0];
        Mr.Lines.Delete(0);
        LocalProcedure_2
        //b:=true;
        LocalProcedure_1;
      end;
      {else // смысл этой ветки от меня ускользает
      // т.к. она будет выполнена только при (i > sl.Count-2)
      // тоесть никогда
      begin
        if Mr.Lines.Count > 1 then
        begin
          vr:=Mr.Lines.Strings[0];
          Mr.Lines.Delete(0);
          LocalProcedure_2
        end;
        LocalProcedure_1;
        Mr.Lines.Add(SL[i+1]);
      end;}
    T.Position := i;
    i_sin := i;
  end;
 
EndRoutines:
  
  M2.Text := SL2.Text;
  FreeAndNil(SL2);
  FreeAndNil(SL);  
  goto ProcedureEnd;
  
BreakRoutines:
  SaveAllWork;
  goto EndRoutines;
  
ProcedureEnd:  
  
end;

Да вроде не вызывается, второе условие вообще один раз за все время процедуры выполнится

~~Так в том и прикол, что вызывается.~~ Ступил

не обратил внимания, то второй if за else стоит.
По поводу оптимизации алгоритма вопрос есть. Как обрабатываются варианты склонений? Тоесть "бездна" и "бездной" это разные или одинаковые слова?
Как вариант (который с вероятностью 99% будет отброшен):

Кликните здесь для просмотра всего текста

1. создать базу слов: одно слово = одно число. База может быть общей и пополняемой это ее несомненный плюс - нет необходимости создавать ее при каждом запуске и т.д.
2. Входной текст преобразуем в массив чисел соответствующим словам в базе.
3. Всю работу что вы описали для слов производим для массива чисел.
4. Преобразуем числа в слова.
Не смотря на ужас от обьема работы есть один несомненный плюс - поиск, сравнение, замена числа в массиве происходит в сотни раз быстрее чем работа со строками.
Если верить гуглу в русскоя языке 131 257 общеупотребимых слов, поэтому поиск по базе обещает быть очень быстрым. Но вопрос в том, сумеем ли привести слова в тексте к начальной форме?

С Goto есть только одна проблема - с памятью. Памятью программиста

Мы можем выйти из середины всех циклов, не удалить обьекты или наоборот удалить, а затем вернуться в место где они (обьекты) используются. Все это надо помнить при работе с Goto.
Некоторые критикуют за использование Goto. Но что бы не говорили, большинство кода это линейные куски которые выполняются строчка за строчкой. Циклы и условные операции вносят разнообразие давая 'вторую координату'. Процедуры и функции только заменяют несколько строк одной, но опять на линейность не особо влияют.
Goto рвет шаблон, лихо заворачивая простыню кода, соединяя ее "червоточинами". И вот с этой "мятой простыней" и придется иметь дело. Готовы вы на этот подвиг/безумство или нет решать только вам.
IMHO.

@northener · 01.09.2017, 01:50

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

С Goto есть только одна проблема - с памятью. Памятью программиста Мы можем выйти из середины всех циклов, не удалить обьекты или наоборот удалить, а затем вернуться в место где они (обьекты) используются. Все это надо помнить при работе с Goto.

Ну не совсем так. Мы можем вполне грамотно выйти из "середины" любого цикла из без GoTo точно также позабыв освободить память. Но мы никак, кроме GoTo не можем войти внутрь любого цикла. А войдя в него таким наглым образом мы уже никак не можем ничего контролировать, ни память, ни значения переменной цикла.
Ну в общем и целом ответ такой - использовать GoTo никем не запрещено. А иногда его использование позволяет сделать исходник наиболее компактным и следовательно более понятным на взгляд. Но в этом случае нужно твердо помнить, что компилятор Дельфи(Паскаля) нам тут ничем не может помочь в плане подсказки о неверных переходах. Так что всё должны контролировать мы сами.

@Animalia · 01.09.2017, 06:17

Не по теме:

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

А войдя в него таким наглым образом мы уже никак не можем ничего контролировать, ни память, ни значения переменной цикла.

Очень даже можем. Главное 'грамотно' войти, а в остальном согласен.

Кликните здесь для просмотра всего текста

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm1.Button1Click(Sender: TObject);
label
  cuclecenter;
var
  i: integer;
begin
  i:=-5;
  goto cuclecenter;
  for i:= 0 to 10 do
  begin
    cuclecenter:
    memo1.Lines.Add(inttostr(i));
    // внезапно пробежим по циклу от -5 до 10
  end;
end;

Помнится в юнности (молодой был, дурак был) сделал два пересекающихся цикла, долго я искал что не так :)

@vino0s · 01.09.2017, 07:55 **[ТС]**

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

T2.Max := Sl2.Count-1; выкинул эту строку в область инициализации переменных

Есть еще 9 процедур, таких же долгих, и для них используется тот же TProgressBar, в этом случае выкидывать не нужно?

Добавлено через 1 минуту

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

Delphi
1
StartFrom := M_Index;

и вот в подпроцедуре, я не особо понял, мы же StartFrom ни как не возвращаем или я чего-то не понимаю?)

Добавлено через 1 минуту

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

в этом случае выкидывать не нужно

Это ладно понял, нашел ниже)

Добавлено через 1 минуту

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

смысл этой ветки от меня ускользает

нет она используется когда Pohozhest не True

Добавлено через 1 минуту
Но в целом понял конечно) Любой повторяющийся код надо приводить к функции/процедуре. Только со СтартФром подробнее) По-моему оно не сработает

Добавлено через 2 минуты

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

Тоесть "бездна" и "бездной" это разные или одинаковые слова

Ну как Pohozhest решит) смотря какие параметры в нее передать) Процент совпадения Sov, и минимальная длина слова DlSl.
На установленных - да, одинаковые.

Добавлено через 16 минут

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

сумеем ли привести слова в тексте к начальной форме?

Ну если заморочиться можно через Яндекс.Словарь начальную форму выцыганить) Или с Pohozhest`ю поколдовать, что в принципе как задача висит. Ваш способ вроде "Хешированием" называется. Читал такое.

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

Не смотря на ужас от обьема работы есть один несомненный плюс

А что ужасного-то? )

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

Входной текст преобразуем в массив чисел соответствующим словам в базе.

А вот это преобразование не будет ли долгим? В дальнейшей работе конечно огонь! Сколько бит на фразу под число выделить... (17бит +1 запасом 18^2= 262144) т.е. числа будут 123456789123456789 вот такой длины. И как строка с предложением будет выглядеть? "Доброе утро" если слова "Доброе" = 123456789123456788, "утро" = 123456789123456789 имеют такие значения. Тут вот я не понял крч. Если конечно как сам писал заливать Список фраз в таблицу с 7-мью столбцами, то и каждое число будет в своей ячейке, тогда все будет летать. А в другом случае, как мне кажется, строка останется строкой только вид ее будет из чисел)

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

И вот с этой "мятой простыней" и придется иметь дело

Да и так 10к строчек в голове держу, какая разница, если добавить БыстрыеПереходы) Тут тогда такой вопрос:

Delphi
1
function Opa (s:string):string;

Если я не дойдя до возврата значения выйду с помощью GoTo (вообще смогу ли, или надо чтобы функция была от TForm? ) то что будет с программой)) Она же рихнется)

Добавлено через 2 минуты

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

внезапно пробежим по циклу от -5 до 10

на второй итерации все равно будет -4? или 0? или 1? )))

@krapotkin · 01.09.2017, 09:06

а есть словесное описание процесса?
чаще всего оно является достаточным для проектирования "сверху вниз"
сначала описываем большие куски - процедуры
потом в каждой процедуре более конкретно и так до конца. получается нормальная стройная структура

а вместо любого goto отлично работает Exception
причем есть "тихие" exception типа EAbort

Новые блоги и статьи Все статьи Все блоги /
Символьное дифференцирование igorrr37 13.02.2026 / * Логарифм записывается как: (x-2)log(x^2+2) - означает логарифм (x^2+2) по основанию (x-2). Унарный минус обозначается как ! */ #include <iostream> #include <stack> #include <cctype>. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»
SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL3_image 8Observer8 10.02.2026 Содержание блога Библиотека SDL3_image содержит инструменты для расширенной работы с изображениями. Пошагово создадим проект для загрузки изображения формата PNG с альфа-каналом (с прозрачным. . .	Установка Qt-версии Lazarus IDE в Debian Trixie Xfce volvo 10.02.2026 В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .

@vino0s 11 / 11 / 8 Регистрация: 26.03.2014 Сообщений: 400

	Как закрыть приложение, которое находится в процессе выполнения алгоритма? 31.08.2017, 12:12. Показов 2689. Ответов 30 Метки нет (Все метки) Привет! В программе используется алгоритм преобразования строковых данных. Этот процесс может длиться пару суток. В Процедуру которая выполняет этот алгоритм передается переменная, с помощью которой можно продолжить работу с последнего места. Данные автоматически сохраняются каждые 10 минут и при выходе из программы. Когда нажимаю кнопку выйти во время выполнения алгоритма, выход из программы не происходит, алгоритм продолжает выполняться. Как сделать чтобы можно было выйти из программы в любой момент времени? Если можно без "многопоточности" или скажите что это не так страшно и как делать) 0

@vino0s 11 / 11 / 8 Регистрация: 26.03.2014 Сообщений: 400
	31.08.2017, 13:06 [ТС]
	Ага всё шикарно, только у меня процедура не принадлежит TForm: тогда с флагом не получится, я полагаю. Есть ли решение для таких случаев? Ну я конечно просто изменю процедуру на TForm. Спасибо! 0

DenNik Житель Земли 3004 / 3026 / 390 Регистрация: 26.07.2011 Сообщений: 11,465 Записей в блоге: 1
	31.08.2017, 16:39
	отладчик, брекпоинты, трассировку применяй и смотри, что выполняется, а что нет 0

@krapotkin 6849 / 4676 / 1464 Регистрация: 14.04.2014 Сообщений: 20,664 Записей в блоге: 21
	31.08.2017, 17:09
	вот конкретно в этом коде нужно применять правильные названия переменных, отвязку интерфейса от логики и выделение логических блоков кода в отдельные процедуры после этого прямо все станет ясно 0

@krapotkin 6849 / 4676 / 1464 Регистрация: 14.04.2014 Сообщений: 20,664 Записей в блоге: 21
	01.09.2017, 09:06
	а есть словесное описание процесса? чаще всего оно является достаточным для проектирования "сверху вниз" сначала описываем большие куски - процедуры потом в каждой процедуре более конкретно и так до конца. получается нормальная стройная структура а вместо любого goto отлично работает Exception причем есть "тихие" exception типа EAbort 0

Как закрыть приложение, которое находится в процессе выполнения алгоритма?

Решение