JakimPL

Plansza2Graf

Feb 12th, 2016
111
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. wolne[plansza_, {i_, j_}] := (plansza[[j]][[i]] == 1);
  2. 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}]);
  3. wymiary[plansza_] := Dimensions[Transpose[plansza]];
  4. ponumeruj[plansza_] := Module[{i, j, w, h, lista, n}, lista = {}; n = 1; {w, h} = wymiary[plansza];
  5. For[i = 1, i <= w, i++,
  6. For[j = 1, j <= h, j++,
  7. If[wolne[plansza, {i, j}], AppendTo[lista, {i, j} -> n]; n++]]];
  8. Return[lista];];
  9. zgrafuj[plansza_] := Module[{lista, i, j, w, h, numeracja}, numeracja = ponumeruj[plansza]; lista = {}; {w, h} = wymiary[plansza];
  10. For[i = 1, i < w, i++,
  11. For[j = 1, j < h, j++,
  12. If[izolowany[plansza, {i, j}],
  13. AppendTo[lista, {i, j} \[UndirectedEdge] {i, j}],
  14. If[wolne[plansza, {i, j}],
  15. If[wolne[plansza, {i + 1, j}],
  16. AppendTo[lista, {i, j} \[UndirectedEdge] {i + 1, j}]];
  17. If[wolne[plansza, {i, j + 1}],
  18. AppendTo[lista, {i, j} \[UndirectedEdge] {i, j + 1}]]]]]];
  19. Return[Graph[lista //. numeracja]];];
  20. wezly[graf_] := Module[{i, lista, dane}, lista = {{}, {}, {}, {}}; dane = VertexList[graf];
  21. For[i = 1, i <= Length[dane], i++,
  22. AppendTo[lista[[VertexDegree[graf, dane[[i]]]]], dane[[i]]]];
  23. Return[lista]];
  24. odleglosci[graf_, wez_, stopnie_, n_] := Return[Table[GraphDistance[graf, wez, stopnie[[n]][[i]]], {i, 1, Length[stopnie[[n]]]}]];
  25. sciezka[graf_, wez_, ord_] := Module[{i, lista, temp, o, s, l, tab}, o = Max[1, ord]; s = wez; lista = {s}; l = 2;
  26. While[l == 2, tab = Complement[VertexComponent[graf, s, 1], lista];
  27. If[Length[tab] > 0, temp = tab[[Min[o, Length[tab]]]];
  28. AppendTo[lista, temp]; s = temp; l = VertexDegree[graf, s],
  29. If[Length[lista] > 2 && GraphDistance[graf, s, wez] == 1,
  30. AppendTo[lista, wez]]; Return[lista]]]; Return[lista];];
  31. usun[graf_, wez_, order_] := Module[{g, sc, ost, kol, e1, e2}, g = graf; sc = sciezka[g, wez, order];
  32. If[Length[sc] > 2, ost = sc[[Length[sc]]];
  33. If[GraphDistance[g, wez, ost] > 1,
  34. g = EdgeAdd[g, wez \[UndirectedEdge] ost]; sc = sc[[2 ;; -2]];
  35. g = VertexDelete[g, sc],
  36. If[wez == ost, e2 = sc[[2]]; e1 = sc[[-2]]; sc = sc[[3 ;; -2]];
  37. g = VertexDelete[g, sc];
  38. g = EdgeAdd[g, e1 \[UndirectedEdge] e2];
  39. g = EdgeAdd[g, e1 \[UndirectedEdge] wez];]];]; Return[g]];
  40. uprosc[graf_] := Module[{stopnie, wez, ost, kol, g, sc, i, j, order}, g = graf; stopnie = wezly[g];
  41. For[j = 1, j <= 4, j++,
  42. For[i = 1, i <= Length[stopnie[[j]]], i++, wez = stopnie[[j]][[i]];
  43. For[order = 1, order <= j, order++, g = usun[g, wez, order];
  44. stopnie = wezly[g];]]]; Return[g]];
  45. charakterystyka[graf_] := Drop[Map[Length, wezly[graf1]], {2}];
  46. porownaj[graf1_, graf2_] := If[IsomorphicGraphQ[uprosc[graf1], uprosc[graf2]],
  47. "Plansze są izomorficzne.", "Plansze nie są izomorficzne"];
RAW Paste Data