5
$\begingroup$

1. Problem statement

I want to replace duplicated elements within a matrix with a placeholder value.

2. Example data

SeedRandom[0];
mat = RandomInteger[{1, 100}, {5, 5}];
mat // MatrixForm

enter image description here

There are several duplicated values between rows and one value, 68, repeated within a row (I use duplicated and repeated as synonyms, meaning more than once).

3. UniqueElements

Since V 13.1 there is UniqueElements which deletes duplicated matrix elements, but results in a ragged list, not showing the positions of the deleted values.

UniqueElements[mat] // MatrixForm

enter image description here

4. The solution found

    PaddedSingles[mat_?MatrixQ, rep_ : 0] :=
     (* intra row replacements *)
     ReplaceRepeated[{h___, a_, m___, a_, t___} :> {h, a, m, rep, t}] /@
      (* between rows replacements *)
      Table[
        mat[[i]] /. Alternatives @@ Union @ Flatten @ Delete[mat, {i}] :> rep,
        {i, Length @ mat}]

5. Expected result

res = PaddedSingles[mat];
res // MatrixForm

enter image description here

Check

DeleteCases[res, 0, {2}] == UniqueElements[mat]

(* True *)

6. Further examples

mat = {{1, 0, 1}, {0, 1, 0}, {0, 0, 2}};
res = PaddedSingles[mat, x]

{{x, x, x}, {x, x, x}, {x, x, 2}}

DeleteCases[res, x, {2}] == UniqueElements[mat]

(* True *)

mat = {{0, 1}, {1, 0}};
res = PaddedSingles[mat, x]

{{x, x}, {x, x}}

DeleteCases[res, x, {2}] == UniqueElements[mat]

(* True *)

7. Question

Maybe I should be happy with this solution, but I always feel a little bad when I have to use Table or iterators. Also, because of the mapped ReplaceRepeated and iterated ReplaceAll, my solution should become very slow when acting on large matrices. Reasons enough to ask for alternative methods.

$\endgroup$

4 Answers 4

6
$\begingroup$
duplicatePositions = 
  Apply[Join] @
  ReplaceAll[p : {{x_, _} ..} :> Rest[p]] @
  Select[Length @ # > 1 &] @
  GatherBy[Tuples @ Range @ Dimensions @ #, 
      $x |-> #[[Apply[Sequence] @ $x]]] &

You can use duplicatePositions with MapAt or with ReplaceAt or with ReplacePart:

paddedSingles = MapAt[#2, duplicatePositions @ #] @ # &;

MatrixForm[paddedSingles[mat, x &]]

enter image description here

paddedSinglesB = ReplaceAt[_ -> #2, duplicatePositions @ #] @ # &;

paddedSinglesC = ReplacePart[#, duplicatePositions[#] -> #2] &;


paddedSingles[mat, x &] == paddedSinglesB[mat, x] ==  paddedSinglesC[mat, x]
True 

An alternative, slower, method to find the desired position list:

duplicatePositions2 = Apply[Join] @
    ReplaceAll[p : {{x_, _} ..} :> Rest[p]] @
    Select[Length[#] >= 2 &] @
    Map[$x |-> Position[#, $x, {2}]] @ 
    Apply[Union] @ # &;

Sort @ duplicatePositions @ mat == Sort @ duplicatePositions2 @ mat
True
$\endgroup$
1
  • $\begingroup$ (+1) It's always a challenge to find alternatives to your answers, but this is how I achieve some training :-) $\endgroup$ Oct 2, 2023 at 20:07
1
$\begingroup$

An alternative using SparseArray:

ClearAll[PaddedSingles];
PaddedSingles[mat_?MatrixQ, rep_ : 0] :=
  (f |-> f -> If[Length@f > 1, rep, First@#])[DeleteDuplicatesBy[Last@#, First]] & /@
   Normal@GroupBy[ArrayRules[SparseArray[mat], rep], Last -> First] //
     Normal@SparseArray[Splice@*Thread /@ #] &

testmat = {
  {{84, 67, 5, 22, 72}, {68, 17, 68, 77, 29}, {22, 44, 18, 47, 54}
                      , {85, 86, 18, 51, 16}, {100, 61, 2, 20, 44}}
, {{1, 0, 1}, {0, 1, 0}, {0, 0, 2}}
, {{0, 1}, {1, 0}}};

PaddedSingles /@ testmat 

(*
{{{84, 67, 5, 0, 72}, {68, 17, 0, 77, 29}, {0, 0, 0, 47, 54}
                    , {85, 86, 0, 51, 16}, {100, 61, 2, 20, 0}}
, {{0, 0, 0}, {0, 0, 0}, {0, 0, 2}}
, {{0, 0}, {0, 0}}}

*)
DeleteCases[PaddedSingles@#, 0, {2}] == UniqueElements[#] & /@ testmat
(*{True, True, True}*)
$\endgroup$
1
$\begingroup$

Using the third argument of GroupBy:

UniqueDuplicatePositions[mat_] := 
Catenate@Keys@GroupBy[Select[Position[mat, #] & /@ DeleteDuplicates@Flatten@mat, 
Length[#] > 1 &], If[Equal @@ #[[All, 1]], Rest@#, #] &]

Then, using ReplacePart:

ReplacePart[#, Thread[UniqueDuplicatePositions[#] -> x]] &@ mat // MatrixForm

enter image description here

@eldo always comes up with the kind of questions that make you rethink the very logic you're familiar with. And @kglr? He's the kind of genius who always seems to have the perfect solution tucked away. Keeping up with these two feels like trying to debug a perfectly written Wolfram code: super intriguing, and always a delightful challenge! 😄

Utilizing a segment from @kglr's code, we observe a quicker alternative as follows:

UniqueDuplicatePositions[mat_] := Catenate[ReplaceAll[
p : {{x_, _} ..} :> Rest[p]]@(Position[mat, #] & /@ 
Select[Tally[Flatten[mat]], #[[2]] > 1 &][[All, 1]])]
$\endgroup$
1
$\begingroup$
Clear[keepLocalDuplicates, dpos];
dpos[k_List] := 
 Position[k, #] & /@ (k // DeleteDuplicates) // Map[Rest] // Flatten
keepLocalDuplicates[mat_?MatrixQ, repl_ : "x"] := 
 Module[{mat2, cfull, pos2},
  mat2 = If[DuplicateFreeQ@#, #, 
      ReplacePart[#, Thread[dpos@# -> repl]]] & /@ mat;
  cfull = Map[Count[Flatten@mat2, #] &, mat2, {2}];
  pos2 = Position[cfull, _?(# > 1 &)];
  ReplacePart[mat2, Thread[pos2 -> repl]]
  ]

testCases = {
   {{84, 67, 5, 22, 72}, {68, 17, 68, 77, 29}, {22, 44, 18, 47, 
     54}, {85, 86, 18, 51, 16}, {100, 61, 2, 20, 44}}
   , {{1, 0, 1}, {0, 1, 0}, {0, 0, 2}}
   , {{0, 1}, {1, 0}}
   };

{ testCases // Map[MatrixForm], 
  keepLocalDuplicates /@ testCases // Map[MatrixForm]} // Column

enter image description here


Addendum

Here is a function based on Fold that marks duplicated elements from a list. This can be used as a building block.

Clear[UniqueElements];
UniqueElements[k_List, repl_ : "x"] := 
 Fold[Append[#1, If[FreeQ[#1, #2], #2, repl]] &, {}, k]

SeedRandom[1];
t1 = RandomInteger[{1, 20}, 20];

{t1, UniqueElements[t1]} // Grid

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.