Как можно оптимизировать код?

kalapanga, да, всё работает! Спасибо! А вот в рекурсии хватит сохранить решение?

procedure RecursiveSolution(RestoreLastSolution: boolean = false);
var
  i: Integer;
  a: array [1 .. MaxQueensCount] of Boolean;                            // a[j] - на j-й горизонтали ферзя нет
  b: array [2 .. 2 * MaxQueensCount] of Boolean;                        // b[k] - на k-й / диагонали ферзя нет (у всех полей на диагонали / постоянна сумма координат i и j)
  c: array [1 - MaxQueensCount .. MaxQueensCount - 1] of Boolean;       // c[k] - на k-й \ диагонали ферзя нет (у всех полей на диагонали \ постоянна разность координат i и j)
  x: array [1 .. MaxQueensCount] of Integer;                            // x[i] - местоположение ферзя на i-й вертикали

procedure Solve(i: Integer);
var
  j: Integer;
begin
  if not StopPressed then
  for j := 1 to QueensCount do
  begin
    if a[j] and b[i + j] and c[i - j] then
    begin
      x[i] := j;
      a[j] := False;
      b[i + j] := False;
      c[i - j] := False;
      if i < QueensCount then
        Solve(i + 1)
      else
        frmMain.DrawSolution(x);
      a[j] := True;
      b[i + j] := True;
      c[i - j] := True;
    end;
  end;
end;

begin
  for i := 1 to QueensCount do
    a[i] := True;
  for i := 2 to 2 * QueensCount do
    b[i] := True;
  for i := 1 - QueensCount to QueensCount - 1 do
    c[i] := True;
  if RestoreLastSolution then
  begin
    For i := 1 to QueensCount-1 do
    begin
      a[TmpArr[i]] := False;
      b[i + TmpArr[i]] := False;
      c[TmpArr[i] - i] := False;
    end;
  end;
  Solve(1);
end;

Я сохраняю решение последнее, потом снова всё на true, потом восстанавливаю решение, а вот как передать в рекурсию с того же значения?

Как можно оптимизировать код?

kalapanga, я ведь могу сохранить в переменную такого же типа, что и Stack, но как мне тогда передать эту переменную потом? Я хотел примерно таким образом, но, видимо, это иначе делается

if not RestoreLastSolution then
  Begin
    Assignfile(Input, 'D:\Работы по ОАиП\Курсовая работа\Формы(без стека)\Placements.txt');
    Rewrite(Input);
    Stack := TStack<Integer>.Create;
    Solution := TStack<Integer>.Create;
  End;
  if RestoreLastSolution then
  Begin
    //Solution := TStack<Integer>.Create;
    Stack := Solution;
  End;

Могу ли я лучше сделать?

VitalyChaikin, спасибо!

Могу ли я лучше сделать?

Согласен, а то, что у меня индексация сбита, я не могу это подправить?

Как можно оптимизировать код?

kalapanga, точно, только я даже не знаю как записать это...

Как можно оптимизировать код?

kalapanga, даже несмотря на то, что я допустил ещё одну логическую ошибку, то ничего не помогло(он банально даже не заходит где рисуется решение)

Как можно оптимизировать код?

kalapanga, всё равно не помогло, одни и те же ошибки...

Как можно оптимизировать код?

kalapanga, да, чёрт, с массивами беды, там надо индекс добавить ещё один...

Как можно оптимизировать код?

kalapanga, хотя лучше ещё раз проверю массив, может что-то не так

Как можно оптимизировать код?

kalapanga, даже если пишу так:

if RestoreLastSolution then
    Begin
      x := 1;
      Y := 0;
    End;

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

Как можно оптимизировать код?

kalapanga, что ж, попробовал передать x >1, выскакивает эта ошибка - "unbalanced stack or queue operation" , при передаче x = 1 это: при нажатии на кнопку "Продолжить" он ничего не делает, но при последующем разе вылетает другая ошибка "Access violation at address delphi"

Как можно оптимизировать код?

kalapanga, при такой строчке та ошибка вылетает:

if RestoreLastSolution then
    Begin
      x := StrToInt(S[1];
      Y := StrToInt(S[2]);
    End;

Если же прописать это:

if RestoreLastSolution then
    Begin
      x := 1;
      Y := StrToInt(S[2]);
    End;

То при нажатии на кнопку "Продолжить" он ничего не делает, но при последующем разе вылетает другая ошибка "Access violation at address delphi"

Как можно оптимизировать код?

kalapanga, возможно, глупое предположение, но всё же я озвучу, полагаю, что программа каким-то образом считает, что все ферзи расставлены правильно и уже нет смысла дальше что-то делать, это первая мысль, вторая мысль: насчёт x, при передаче он всегда равен 8, то есть QueensCount для общего случая, а вот y меняется, попробовал поменять просто y на 2, тот ферзь, который стоит на первом столбце был уже на 2 строке(или на 6, если относительно шахматной ), бегал в отладчике на 7 Delphi в консоли, всё записывает верно, массивы a, b, c соответствуют своим значениям, кстати, если задать значения массивов на True, то всё работает, поэтому, возможно, моя теория верна, либо всё же можно пофиксить ошибку ту, и как-то всё заработает...

Как можно оптимизировать код?

kalapanga, со стеком что-то...

procedure StackSolution(RestoreLastSolution: boolean);
var
  i, j, Y, x: Integer;
  a: array [1 .. MaxQueensCount] of Boolean;
  b: array [2 .. 2 * MaxQueensCount] of Boolean;
  c: array [1 - MaxQueensCount .. MaxQueensCount - 1] of Boolean;
  Stack: TStack<Integer>;
  SolutionArray: TArray<Integer>;
  s: string;
  flag1, flag2: boolean;

  Function Uspeh: Boolean;
  Var
    usp: Boolean;
  Begin
    usp := False;
    While (Y < QueensCount) And Not usp do
    Begin
      Y := Y + 1;
      usp := a[Y] and b[x + Y] and c[Y - x];
    End;
    Result := usp;
  End;

begin
  if not RestoreLastSolution then
  begin
  For i := 1 to QueensCount do
    a[i] := True;
  For i := 2 to 2 * QueensCount do
    b[i] := True;
  For i := 1 - QueensCount to QueensCount - 1 do
    c[i] := True;
  end;
  if RestoreLastSolution then
  begin
    Assignfile(Input, 'D:\Работы по ОАиП\Курсовая работа\Формы(без стека)\Placements.txt');
    Reset(Input);
    while (not EOF(Input)) do begin
      Readln(Input, s);
    end;
    CloseFile(Input);

  For i := 1 to QueensCount do
    if S[I]='T' then a[i] := True
    else a[i] := False;
  Delete(S,1,QueensCount+1);
  For i := 2 to 2 * QueensCount do
    if S[I]='T' then b[i] := True
    else b[i] := False;
  Delete(S,1,2 * QueensCount);
  For i := 1 - QueensCount to QueensCount - 1 do
    if S[I]='T' then c[i] := True
    else c[i] := False;
  Delete(S,1,QueensCount+QueensCount-1);
  end;

  Assignfile(Input, 'D:\Работы по ОАиП\Курсовая работа\Формы(без стека)\Placements.txt');
  Rewrite(Input);
  Stack := TStack<Integer>.Create;
  try
    if not RestoreLastSolution then
    Begin
      x := 1;
      Y := 0;
    End;
    if RestoreLastSolution then
    Begin
      x := StrToInt(S[1]);
      Y := StrToInt(S[2]);
    End;
    while (x <> 0) and not StopPressed do
    Begin
      If Uspeh Then
      Begin
        Stack.Push(Y);
        If x < QueensCount Then
        Begin
          a[Y] := False;
          b[x + Y] := False;
          c[Y - x] := False;
          x := x + 1;
          Y := 0;
        End
        Else
        begin
        if not RestoreLastSolution then
        Begin
          For I := 1 to QueensCount do
          begin
            if A[I] then
              write(Input, 'T')
            else
              write(Input, 'F')
          End;
          write(Input,'|');
          For i := 2 to 2 * QueensCount do
          begin
            if B[I] then
              write(Input, 'T')
            else
              write(Input, 'F')
          End;
          write(Input,'|');
          For i := 1 - QueensCount to QueensCount - 1 do
          Begin
            if C[I] then
              write(Input, 'T')
            else
              write(Input, 'F')
          End;
          write(Input, X, Y);
          writeln(Input);
          End;
          frmMain.DrawSolution(Stack);
          Stack.Pop;
        end;
      End
      Else
      Begin
        x := x - 1;
        If x > 0 Then
        Begin
          Y := Stack.Pop;
          a[Y] := True;
          b[x + Y] := True;
          c[Y - x] := True;
        End;
      End;
    End;
     Closefile(Input);
  finally
    Stack.Free;
  End;
End;

Выдаёт ошибку "unbalanced stack or queue operation" при Y := Stack.Pop;

Как можно оптимизировать код?

Alertoso, грубо говоря, изменить счётчик, с которого стек будет дальше идти

Как можно оптимизировать код?

kalapanga, не представляю вообще, как можно передать обратно в стек что-то, насчёт решения там понятно как, но обратно...Я бред делал дикий, там даже с индексом натупил, но всё же, у меня в стеке хранится решение, а не в SolutionArray, как я хотел сделать, вот как мне это решение изменить(перезаписать)...

Как можно оптимизировать код?

kalapanga, насчёт 2 кнопки, да, определённо, я сделал кнопку "Продолжить"

Как можно оптимизировать код?

kalapanga, определённо, заставить работать стек с определённой позиции самое сложное, а можно ли сделать это для рекурсии?

Как можно оптимизировать код?

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

Как можно оптимизировать код?

kalapanga, пытаюсь таким образом:

procedure TfrmMain.Button2Click(Sender: TObject);
begin
  StopPressed := False;
  Fla:=False;
  StackSolution();
end;

procedure StackSolution;
var
  i, Y, x: Integer;
  a: array [1 .. MaxQueensCount] of Boolean;
  b: array [2 .. 2 * MaxQueensCount] of Boolean;
  c: array [1 - MaxQueensCount .. MaxQueensCount - 1] of Boolean;
  Stack: TStack<Integer>;
  SolutionArray: TArray<Integer>;
  s: string;

  Function Uspeh: Boolean;
  Var
    usp: Boolean;
  Begin
    usp := False;
    While (Y < QueensCount) And Not usp do
    Begin
      Y := Y + 1;
      usp := a[Y] and b[x + Y] and c[Y - x];
    End;
    Result := usp;
  End;

begin
  Fla:=True;
  For i := 1 to QueensCount do
    a[i] := True;
  For i := 2 to 2 * QueensCount do
    b[i] := True;
  For i := 1 - QueensCount to QueensCount - 1 do
    c[i] := True;
  if not Fla then
  Begin
    Assignfile(Input, 'D:\Работы по ОАиП\Курсовая работа\Формы(без стека)\Placements.txt');
    Reset(Input);
    while (not EOF(Input)) do begin
      Readln(Input, s);
    end;
    CloseFile(Input);
    for I := 1 to QueensCount do
      if s[i] in ['0'..'9'] then SolutionArray[i - 1]:=StrToInt(s[i]);
  End;

  Stack := TStack<Integer>.Create;
  try
    x := 1;
    Y := 0;
    while (x <> 0) and not StopPressed do
    Begin
      If Uspeh Then
      Begin
        Stack.Push(Y);
        If x < QueensCount Then
        Begin
          a[Y] := False;
          b[x + Y] := False;
          c[Y - x] := False;
          x := x + 1;
          Y := 0;
        End
        Else
        begin
          frmMain.DrawSolution(Stack);
          Stack.Pop;
        end;
      End
      Else
      Begin
        x := x - 1;
        If x > 0 Then
        Begin
          Y := Stack.Pop;
          a[Y] := True;
          b[x + Y] := True;
          c[Y - x] := True;
        End;
      End;
    End;
  finally
    Stack.Free;
  End;
End;

Не совсем понимаю, как продолжить..., счётчик-то продолжается, а вот решение...