Plansza2Graf

wolne[plansza_, {i_, j_}] := (plansza[[j]][[i]] == 1);
izolowany[plansza_, {i_, j_}] := (wolne[plansza, {i, j}]) && ! (wolne[plansza, {i + 1, j}] || wolne[plansza, {i, j + 1}] || wolne[plansza, {i - 1, j}] || wolne[plansza, {i, j - 1}]);
wymiary[plansza_] := Dimensions[Transpose[plansza]];
ponumeruj[plansza_] := Module[{i, j, w, h, lista, n}, lista = {}; n = 1; {w, h} = wymiary[plansza];
   For[i = 1, i <= w, i++,
    For[j = 1, j <= h, j++,
     If[wolne[plansza, {i, j}], AppendTo[lista, {i, j} -> n]; n++]]];
   Return[lista];];
zgrafuj[plansza_] := Module[{lista, i, j, w, h, numeracja}, numeracja = ponumeruj[plansza];  lista = {}; {w, h} = wymiary[plansza];
   For[i = 1, i < w, i++,
    For[j = 1, j < h, j++,
     If[izolowany[plansza, {i, j}],
      AppendTo[lista, {i, j} \[UndirectedEdge] {i, j}],
      If[wolne[plansza, {i, j}],
       If[wolne[plansza, {i + 1, j}],
        AppendTo[lista, {i, j} \[UndirectedEdge] {i + 1, j}]];
       If[wolne[plansza, {i, j + 1}],
        AppendTo[lista, {i, j} \[UndirectedEdge] {i, j + 1}]]]]]];
   Return[Graph[lista //. numeracja]];];
wezly[graf_] := Module[{i, lista, dane}, lista = {{}, {}, {}, {}}; dane = VertexList[graf];
   For[i = 1, i <= Length[dane], i++,
    AppendTo[lista[[VertexDegree[graf, dane[[i]]]]], dane[[i]]]];
   Return[lista]];
odleglosci[graf_, wez_, stopnie_, n_] := Return[Table[GraphDistance[graf, wez, stopnie[[n]][[i]]], {i, 1, Length[stopnie[[n]]]}]];
sciezka[graf_, wez_, ord_] := Module[{i, lista, temp, o, s, l, tab}, o = Max[1, ord]; s = wez; lista = {s}; l = 2;
   While[l == 2, tab = Complement[VertexComponent[graf, s, 1], lista];
     If[Length[tab] > 0, temp = tab[[Min[o, Length[tab]]]];
     AppendTo[lista, temp]; s = temp; l = VertexDegree[graf, s],
     If[Length[lista] > 2 && GraphDistance[graf, s, wez] == 1,
      AppendTo[lista, wez]]; Return[lista]]]; Return[lista];];
usun[graf_, wez_, order_] := Module[{g, sc, ost, kol, e1, e2}, g = graf; sc = sciezka[g, wez, order];
   If[Length[sc] > 2, ost = sc[[Length[sc]]];
    If[GraphDistance[g, wez, ost] > 1,
     g = EdgeAdd[g, wez \[UndirectedEdge] ost]; sc = sc[[2 ;; -2]];
     g = VertexDelete[g, sc],
     If[wez == ost, e2 = sc[[2]]; e1 = sc[[-2]]; sc = sc[[3 ;; -2]];
      g = VertexDelete[g, sc];
      g = EdgeAdd[g, e1 \[UndirectedEdge] e2];
      g = EdgeAdd[g, e1 \[UndirectedEdge] wez];]];]; Return[g]];
uprosc[graf_] := Module[{stopnie, wez, ost, kol, g, sc, i, j, order}, g = graf; stopnie = wezly[g];
   For[j = 1, j <= 4, j++,
    For[i = 1, i <= Length[stopnie[[j]]], i++, wez = stopnie[[j]][[i]];
     For[order = 1, order <= j, order++, g = usun[g, wez, order];
      stopnie = wezly[g];]]]; Return[g]];
charakterystyka[graf_] := Drop[Map[Length, wezly[graf1]], {2}];
porownaj[graf1_, graf2_] := If[IsomorphicGraphQ[uprosc[graf1], uprosc[graf2]],
   "Plansze są izomorficzne.", "Plansze nie są izomorficzne"];