I want to generate a table with two indices (say, i and j) such that elements with i = j are omitted. How to achieve it ? Following is a simple example of what I want to do.
A = Table[{i, j}, {i, 1, 4}, {j, 1, 4}];
But I do not want the elements like
{1, 1}, {2, 2}, {3, 3} etc
in the table.
Thanks for the help
Playing with Nothing:
1) In-process:
Table[If[i == j, Nothing, {i, j}], {i, 1, 4}, {j, 1, 4}]
2) Post-process:
Replace[Table[{i, j}, {i, 1, 4}, {j, 1, 4}], {i_, i_} -> Nothing, {2}]
a = Array[List, {4, 4}];
Delete[a, Array[{#, #} &, 4]]
{{{1, 2}, {1, 3}, {1, 4}}, {{2, 1}, {2, 3}, {2, 4}}, {{3, 1}, {3, 2}, {3, 4}}, {{4, 1}, {4, 2}, {4, 3}}}
Or, inspired by kglr's answer, with Pick and IdentityMatrix:
Pick[a, IdentityMatrix[4], 0]
{{{1, 2}, {1, 3}, {1, 4}}, {{2, 1}, {2, 3}, {2, 4}}, {{3, 1}, {3, 2}, {3, 4}}, {{4, 1}, {4, 2}, {4, 3}}}
With many methods provided I think it is time for a benchmark. I do not have Nothing in version 10.1 so I shall use my old standby "vanishing function" from How to avoid returning a Null if there is no "else" condition in an If contruct in its place.
n = 1000;
(* for post processing methods this timing must be included in the total *)
a = Array[List, {n, n}]; // RepeatedTiming // First
DeleteCases[a, {a_, a_}, 2] // RepeatedTiming // First
Table[If[i == j, ## &[], {i, j}], {i, n}, {j, n}] // RepeatedTiming // First
Partition[#, n - 1] &@Permutations[Range@n, {2}] // RepeatedTiming // First
Select[#, DuplicateFreeQ] & /@ Outer[List, Range@n, Range@n] //
RepeatedTiming // First
Delete[a, Array[{#, #} &, n]] // RepeatedTiming // First
Partition[SparseArray[ConstantArray[1, {#, #}] - IdentityMatrix[#]][
"NonzeroPositions"], # - 1] &[n] // RepeatedTiming // First
Array[List, {n, n}, {1, 1}, DeleteCases[{##}, {a_, a_}, {2}] &] //
RepeatedTiming // First
Pick[a, IdentityMatrix[n], 0] // RepeatedTiming // First
0.00833
0.419
0.560
0.2670
0.491
0.00460
0.0351
0.412
0.0274
So even including the time to build a my Delete approach is considerably faster than any other method yet proposed. Second fastest is kglr's SparseArray, or Pick inspired by it.
Partition[#, 3]&@Permutations[Range@4, {2}] // MatrixForm
Or
Select[DuplicateFreeQ] /@ Outer[List, Range@4, Range@4]
Update: Two variations on Array (from Mr.Wizard's answer), one using the fourth argument to delete unwanted cases, and the second using a function in the first argument that deletes unwanted cases. Both can handle non-square arrays easily.
ClearAll[pF2, pF3]
pF2 = Array[List, {##}, {1, 1}, DeleteCases[{##}, {a_, a_}, {2}] &] &;
pF3 = Module[{dif}, dif[a_, a_] := ## &[]; dif[a__] := {a}; Array[dif, {##}]] &;
Examples:
And @@ (pF2@## == pF3@## & @@@ {{2, 2}, {2, 3}, {3, 2}, {3, 4}, {4, 4}, {4, 3}})
True
pF2[2, 2]
{{{1, 2}}, {{2, 1}}}
pF2[2, 3]
{{{1, 2}, {1, 3}}, {{2, 1}, {2, 3}}}
pF2[3, 4]
{{{1, 2}, {1, 3}, {1, 4}}, {{2, 1}, {2, 3}, {2, 4}}, {{3, 1}, {3, 2}, {3, 4}}}
Original answer:
ClearAll[pF1]
pF1 = Partition[SparseArray[1 - IdentityMatrix[#]]["NonzeroPositions"], # - 1] &;
Examples:
Grid[Prepend[{#, pF1 @ #} & /@ Range[2, 5], {HoldForm@n,
HoldForm@ pF[n]}], Dividers -> All, Alignment -> Center]
IdentityMatrix; I added a variation, with credit of course, to my answer.
– Mr.Wizard
Jul 24 '17 at 13:19
Yet another way:
a = Table[{i, j}, {i, 1, 4}, {j, 1, 4}];
Pick[a, IdentityMatrix[Length[a]], 0]
A = DeleteCases[Table[{i, j}, {i, 1, 4}, {j, 1, 4}], {a_, a_}, 2]
\begin{array}{ccc} \{1,2\} & \{1,3\} & \{1,4\} \\ \{2,1\} & \{2,3\} & \{2,4\} \\ \{3,1\} & \{3,2\} & \{3,4\} \\ \{4,1\} & \{4,2\} & \{4,3\} \\ \end{array}
{{0, -PE[1] + PE[2]}, {PE[1] - PE[2], 0}} when I run that command string in my computer. May be it will change if you have defined PE-function? Because it is work good if PE is not defined.
– Rom38
Jul 24 '17 at 11:05
Another suggestion is to use KroneckerDelta and a DeleteCases likeso:
DeleteCases[
Table[{i, j} (1 - KroneckerDelta[i, j]), {i, 1, 4}, {j, 1, 4}], {0,
0}, Infinity] // MatrixForm
Another way is to use Delete and Diagonal:
A = Array[List, {4, 4}];
Delete[A, Diagonal[A]] // MatrixForm
n = 4 ;
ArrayReshape[Last[Reap[Do[If[i != j, Sow[{i, j}]], {i, 1, n}, {j, 1, n}]]], {n, n - 1, 2}]
(* {{{1,2},{1,3},{1,4}},{{2,1},{2,3},{2,4}},{{3,1},{3,2},{3,4}},{{4,1},{4,2},{4,3}}} *)
Sequence[]instead. Thanks forNothing! :) – Alex Meiburg Jul 24 '17 at 12:31