FloodFillExtractTile[gt_, {sr_, sc_}] :=
 Module[{r, c, toExplore, visited = {}},
  toExplore = {{sr, sc}};
  While[Length@toExplore > 0,
   (* Pop *)
   {r, c} = Last@toExplore;
   toExplore = Most[toExplore];
   AppendTo[visited, {r, c}];
   (* Down-left *)

   If[c > 1 && r < h &&
     gt[[r + 1, c - 1]] == gt[[r, c]] && !
      MemberQ[visited, {r + 1, c - 1}],
    AppendTo[toExplore, {r + 1, c - 1}];
    ];
   (* Down-right *)

   If[ r < h &&
     gt[[r + 1, c]] == gt[[r, c]] && ! MemberQ[visited, {r + 1, c}],
    AppendTo[toExplore, {r + 1, c}];
    ];
   (* Up-right *)

   If[r > 1 && c < w &&
     gt[[r - 1, c + 1]] == gt[[r, c]] && !
      MemberQ[visited, {r - 1, c + 1}],
    AppendTo[toExplore, {r - 1, c + 1}];
    ];
   (* Up-left *)

   If[ r > 1 &&
     gt[[r - 1, c]] == gt[[r, c]] && ! MemberQ[visited, {r - 1, c}],
    AppendTo[toExplore, {r - 1, c}];
    ];
   ];
  Return@visited;
];

GetGTTiles[gtp_] :=
  Module[{testSame, testEdge, h, w, pts, sameClusters, getEdges,
    tiles},
   {h, w} = Dimensions[gtp];
   pts = Join @@ Table[{r, c}, {r, h}, {c, w}];
   testSame[{r1_, c1_}, {r2_, c2_}] := (gtp[[r1, c1]] ==
      gtp[[r2, c2]]);
   testEdge[{r1_, c1_}, {r2_,
      c2_}] := (gtp[[r1, c1]] ==
       gtp[[r2, c2]]) &&
     ((c1 == c2 &&
         Abs[r1 - r2] <= 1) || (c1 == c2 - 1 &&
         r1 == r2 + 1) || (c1 == c2 + 1 && r1 == r2 - 1));
   sameClusters = Gather[pts, testSame];
   getEdges[clust_] :=
    Join @@ Outer[If[testEdge[#1, #2], #1 -> #2, Sequence @@ {}] &,
      clust, clust, 1];
   tiles =
    Join @@ (ConnectedComponents[Graph@getEdges[#]] & /@ sameClusters);
   Return@tiles;
   ];

{{{1, 1}}, {{1, 2}, {2, 1}},
{{1, 3}, {2, 3}, {3, 2}, {4, 1}, {3, 1}, {2, 2}},
{{1, 4}},
{{2, 4}, {3, 4}, {4, 4}, {5, 4}, {5, 3}, {4,3}},
{{3, 3}, {4, 2}, {5, 2}, {5, 1}}}

GTTiles[gtp_List] := Module[{fromEuclidean, toEuclidean,
    getOneTile, elements, elmPos, pts, tile, tiles},

   (* This is used to changefrom different coordinate systems. *)

   fromEuclidean[{r_, c_}] := {r, (c - r)/2 + 1};
   toEuclidean[{r_, c_}] := {r, 2 c + r - 2};

   getOneTile[pts_List, maxDist_?NumericQ] := Module[{f},
     f = Nearest[pts];
     FixedPoint[
      Union@Flatten[f[#, {Infinity, maxDist}] & /@ #, 1] &, {First@
        pts}]];

   elements = Union @@ gtp;
   elmPos = (toEuclidean /@ Position[gtp, #]) & /@ elements;
   (* This is really strange code. *)
   tiles = Flatten[Flatten[
        Reap[NestWhile[Complement[#,
             Sow@getOneTile[#, N@Sqrt@2]] &, #, # != {} &]][[2]],
        1] & /@ elmPos, 1];
   tiles = Map[fromEuclidean, tiles, {2}];
   Return@tiles;
   ];

l1 = {{6, 3, 2, 1}, {3, 2, 2, 0}, {2, 2, 1, 0}, {2, 1, 0, 0}, {1, 1, 0, 0}};
l = Riffle[#, ""] & /@ l1;
els = Union @@ l;
par = MapIndexed[PadRight[PadLeft[#1, #2[[1]] + Length@#1 - 1, ""],
                          Length@l + Length@#1 - 1, ""] &, l];
eachElm = Position[par, #] & /@ els;
getOneCluster[pts_List, maxDist_?NumericQ] :=
  Module[{f},
   f = Nearest[pts];
   FixedPoint[Union@Flatten[f[#, {Infinity, maxDist}] & /@ #, 1] &, {First@pts}]];
clusters =
  Flatten[Flatten[
      Reap[NestWhile[
         Complement[#,
           Sow@getOneCluster[#, N@Sqrt@2]] &, #, # != {} &]][[2]], 1] & /@ eachElm, 1];
Grid[par,
 ItemStyle -> {Automatic, Automatic, Flatten@MapIndexed[#1 -> Hue[#2[[1]]/3] &,
                                                       clusters, {2}]}]

weirdNeighbors3[array_, output_: "components"] :=

 Module[{t = 0, cnt = 1, dims = Dimensions[array],
   lt = Rest[array][[All, ;; -2]], rt = Most[array][[All, 2 ;;]],
   check, a, ruls, clusts},

  clusts =
   Transpose[Flatten /@ MapAt[Replace[#, _ -> cnt++, 1] &,
      Split /@ Transpose[array], {All, All}]];

  check = Boole[MapThread[SameQ, {lt, rt}, 2]];

  While[t =!= {},

   t = DeleteCases[
     Transpose[{Flatten[Pick[Rest[clusts][[All, ;; -2]], check, 1]],
       Flatten[Pick[Most[clusts][[All, 2 ;;]], check, 1]]}], {} | {a_,
        a_}, 1];

   If[(t =
       DeleteDuplicates[Flatten[ReplacePart[#, {a_, 1} /;
              a > 1 && a <= Length[#] :> #[[a - 1, 2]]] & /@
          GatherBy[t, First], 1]]) === {}, Continue[]];

   clusts =
    clusts //. Dispatch[
      Rule @@@ (Module[{f, g}, g[_] = True; f[{x_, _}] := (g[x] = False; True);
         Cases[t, {_, _?g}?f]])];

   ];
  Switch[output, "tuples",
   GatherBy[Flatten[Array[{##} &, dims], 1], Extract[clusts, #] &],
   "raw", clusts, "components", ArrayComponents[clusts]]
  ]

makearrayD[dims_] := Module[{toprow = RandomInteger[dims[[1]]*5, dims[[2]]]},
  Table[toprow - 2 row, {row, 1, dims[[1]]}]]

weirdNeighbors5[arg_] := Module[{dims = Dimensions[arg], cd, dd, p},

  cd = {#, # + {1, 0}} & /@ SparseArray[Unitize[Most[arg] - Rest[arg]], Automatic, 1][
     "NonzeroPositions"];

  dd = {# + {0, 1}, # + {1, 0}} & /@
    SparseArray[Unitize[Most[arg][[All, 2 ;;]] - Rest[arg][[All, ;; -2]]],
      Automatic, 1]["NonzeroPositions"];

  Switch[Length[p = Join[cd, dd]],
      0, {{}, Flatten[Array[{##} &, dims], 1]},
      Times @@ dims, {p, {}}, _,
   {ConnectedComponents@Graph[UndirectedEdge @@@ p],
    Complement[Flatten[Array[{##} &, dims], 1], Flatten[p, 1]]}]]

ClearAll[neighs, trace, weirdNeighbors]

(* get possible "neighbors" helper function *)
neighs[arr_, place_] := Module[{dims = Dimensions[arr], n},
   n = DeleteCases[place + # & /@ {{1, 0}, {-1, 0}, {1, -1}, {-1, 1}},
     {a_, b_} /; a == 0 || b == 0 || a > dims[[1]] || b > dims[[2]]]];

(* trace potential "neighbor" paths helper funtion *)
trace[list_, ele_] := Module[{results = {ele}},
   If[MemberQ[list, ele + {1, 0}], results = Join[results, trace[list, ele + {1, 0}]]];
   If[MemberQ[list, ele + {1, -1}], results = Join[results, trace[list, ele + {1, -1}]]];
   DeleteDuplicates[results]];

(* do the work function *)
weirdNeighbors[array_] :=
 Module[{local, td = Dimensions[array], ta, localc, prelim, tu, got, ss, fu, sets, f},

  local = array /. (0 -> Max[array] + 1);
  ta = Flatten[Array[{##} &, td], 1];
  localc = ArrayComponents[local];
  prelim = GatherBy[ta, localc[[Sequence @@ #]] &];
  tu = Union @@ localc;

  got = {ss = Select[prelim[[#]],
        Function[arg, MemberQ[Extract[localc, neighs[localc, arg]],
          Extract[localc, arg]]]], Complement[prelim[[#]], ss]} & /@ tu;

  fu = Function[arg, trace[got[[arg, 1]], #] & /@ got[[arg, 1]]] /@ tu;

  sets = Function[arg, Union @@@ Gather[arg, Intersection[#1, #2] != {} &]] /@ fu;

  Transpose[{tu, Flatten[array] // DeleteDuplicates, got[[All, 2]], sets}]]

test = RandomInteger[{0, 5}, {5, 5}];

{time, result} = Timing[weirdNeighbors[test]];

Column[{time, test // MatrixForm, result}, Left, 2]