Heurystycznie (jedno rozwiązanie, szybsze)

(** FUNKCJE POMOCNICZE **)

Clear[FindSame]
FindSame[p_]:=FindSame[p]=
Total/@Boole@Outer[#==#2&,p,p]-1

Clear[Attackers]
Attackers[p_]:=Attackers[p]=
Module[
{r=Range[Length[p]],
aColumn,aDiag1, aDiag2},
Total[FindSame/@{p,p+r,p-r}]
]

Clear[AttackersRow]
AttackersRow[p_,n_]:=AttackersRow[p,n]=
Module[{l=Range[Length[p]]},
Count[test+#&/@{0,-(l-n),l-n},#,2]-3Boole[p[[n]]==#]&/@l(*triple times it counts self as an attacker*)
]

Clear[SumOfAttackers]
SumOfAttackers[p_]:=SumOfAttackers[p]=
Module[{},
Total[Attackers[p]]
]

(*********************)

(*wrapper dla algorytmu heurystycznego*)
Clear[IterativeWrapper]
IterativeWrapper[f_,p_]:=Module[{ir},
(*If there are no attacked queens return p*)
If[Count[Attackers[p],0]==Length[p],
Return[p],
(*Else, try repair the situation*)
ir=f[p];
(*If repair was successfull*)
If[ir=!=Null,
Return[ir],
(*Else start from random initial conditions*)
Return[Initialize[Length[p]]]
]
];
]

(*generator warunków początkowych, jeśli algorytm heurystyczny utknie*)
Initialize[n_]:=
(*Mod[NestList[#+RandomInteger[{2,3}]&,1,n],n]+1*)
RandomSample[Range[n]]

(*algorytm zachłanny poszukiwania rozwiązania.
spośród wszystkich możliwych ruchów wszystkich hetmanów
 wybieramy taki, który zmniejsza sumę atakujących dla
 wszystkich hetmanów. jeśli istnieją dwa takie ruchy wybierany jest losowy*)
Clear[Greedy]
Greedy[p_List]:=Module[
{n=Length[p],
sa=SumOfAttackers[p],
nsa,aa
},
aa=Array[SumOfAttackers[ReplacePart[p,#1->#2]]&,{n,n}];
nsa=Min[aa];
If[nsa≥sa,Return[Null]];
ReplacePart[p,Rule@@RandomChoice[Position[aa,nsa]]]
]

(*wybiera ciąg prowadzący do rozwiązania*)
SelectConvergent[t_]:=Module[
{a={SumOfAttackers[#],#}&/@t},
Last/@(a//.{___,{n_,__},{m_,a_},rest___}/;n<m:>{{m,a},rest})
]

(*rozwiązuje problem n-hetmanów*)
QueenProblem[n_]:=NestWhileList[IterativeWrapper[Greedy,#]&,Initialize[n],#1=!=#2&,2];

(*generuje rysunek rozmieszczenia hetmanów*)
QueenPlot[p_]:=MatrixPlot[Transpose@SparseArray[Transpose[{p,Range[Length[p]]}]->Attackers[p]+1,{Length[p],Length[p]}],Mesh->All,ColorRules->{0->White,1->Green,n_:>RGBColor[2(n-1)/Length[p],0,0]}]

(*animacja iterowania algorytmu*)
QueenPlotAnimate[t_]:=Module[
{n=Length[t[[1]]],
Plots=QueenPlot/@Most[t],
arrows
},
arrows=First/@
Prepend[Select[#,#[[2]]≠#[[3]]&]&/@(Transpose[Prepend[#,Range[n]]]&/@Partition[Most[t],2,1])/.
{a_Integer,b_Integer,c_Integer}:>
Graphics[{Blue,Thick,Arrow[{{b-1/2,n-(a-1/2)},{c-1/2,n-(a-1/2)}}]}],{{}}];
ListAnimate[Show/@Transpose[{Plots,arrows}]]
]

(*funkcję QueenProblem można wywołać wielokrotnie, heurystyczna natura algorytmu wygeneruje za każdym razem inny wynik *)
t1=QueenProblem[8]
t=SelectConvergent[t1]

(* rozwiązanie *)
QueenPlotAnimate[t]

(* widać, że dla niektórych warunków początkowych algorytm utknął *)
QueenPlotAnimate[t1]

Iteracyjnie (wszystkie rozwiązania)

(*dużo prostszy jest algorytm iteracyjny poprzez wykorzystanie reguły przepisania.
algorytm opiera się na taktyce rekurencji z powrotami opisanej w wikipedii i znajduje
 wszystkie możliwe rozwiązania problemu*)
Clear[Possible,NextQ,sols]
Possible[l_List,n_]:=Complement[Range[n],l,Flatten@Table[l[[-j]]+{-1,1}j,{j,1,Length[l]}]]
NextQ[l_List,n_]:=Append[l,#]&/@Possible[l,n]
sols[n_]:=sols[n]=Nest[Union[Replace[#,l_List:>Sequence@@NextQ[l,n],1]]&,{{}},n];

ListAnimate[QueenPlot[#]&/@sols[8]]

Length[sols[#]]&/@Range[10]