I have a task to find all latin squares of size N with Depth-first search. I need to check all possible variants of squares size N whether they are latin. It can be done with N * N nested cycles 'for' from 1 to N (first cycle for the position(0,0), second nested for position (0,1) and so on). Obviously, it'll work only for some particular N₀. I need a more general solution, which could work for a random N, so I want to write a recursive procedure imitating these N * N cycles depending on N inputted.
Now I believe, I have a solution.
Ok, seems working. Hope someone'll find it useful.
Upd: removed useless 1-dimensional array, seems to work faster now (as I calculated (but not checked experimentally), the previous way would take ≈218.07 hours for N=4).
Upd2: moved from using flag and 'if' in LS check to label, seems even faster(271.172 seconds average of two experiments to find LS of size 4(checks 4294967296 variants) vs 4041.453 seconds for the previous update).
procedure filling(str, col: Integer);
var
I, I1, J1, a, b, fl: Integer;
label
skip;
begin
for I := 1 to N do begin
lat_sq[str, col]:=I;
if (col<N-1) then filling(str, col+1)
else if (str<N-1) then filling(str+1, 0)
else if (str=N-1) and (col=N-1) then begin
for I1 := 0 to N-1 do
for J1 := 0 to N-1 do begin
for a := 0 to N-1 do
if (a<>I1) and (lat_sq[I1, J1]=lat_sq[a, J1]) then goto skip;
for b := 0 to N-1 do
if (b<>J1) and (lat_sq[I1, J1]=lat_sq[I1, b]) then goto skip;
end;
for I1 := 0 to N-1 do begin
for J1 := 0 to N-1 do
write(lat_sq[I1, J1]);
writeln;
end;
writeln;
skip:
end;
end;
end;
upd3: decided to keep previous code as this new has another method of LS checking: if it's not possible to fill the cell examined, it moves to another cycle for I iteration. Finds LSs for N=4 for less then 1 millisecond, found for N=6 for 1468.687 seconds, higher N require senseless time. N_1 means N-1.
upd4: removed useless additional check in if, found LSs for N=6 for 1410.719 seconds.
procedure filling(str, col: Integer);
var
I, I1, J1, a, b, fl: Integer;
label
skip;
begin
for I := 1 to N do begin
lat_sq[str, col]:=I;
fl:=1;
for I1 := 0 to str-1 do
if (lat_sq[I1, col]=lat_sq[str, col]) then goto skip;
for J1 := 0 to col-1 do
if (lat_sq[str, J1]=lat_sq[str, col]) then goto skip;
if (col<n_1) then filling(str, col+1)
else if (str<n_1) then filling(str+1, 0)
else begin
for I1 := 0 to N-1 do begin
for J1 := 0 to N-1 do
write(lat_sq[I1, J1]);
writeln;
end;
writeln;
inc(count);
end;
skip:
end;
end;