6
$\begingroup$

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

$\endgroup$
9
$\begingroup$

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}]
$\endgroup$
1
  • 4
    $\begingroup$ Came here to post this but with Sequence[] instead. Thanks for Nothing! :) $\endgroup$ Jul 24 '17 at 12:31
8
$\begingroup$

Delete:

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}}}

Benchmark

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.

$\endgroup$
4
$\begingroup$
Partition[#, 3]&@Permutations[Range@4, {2}] // MatrixForm

enter image description here

Or

Select[#, DuplicateFreeQ] & /@ Outer[List, Range@4, Range@4]
$\endgroup$
2
  • $\begingroup$ If the ranges of the two iterators are the same I think this is the best solution. $\endgroup$
    – Mr.Wizard
    Jul 24 '17 at 9:46
  • $\begingroup$ Thanks, but I like yours too :) $\endgroup$
    – eldo
    Jul 24 '17 at 9:49
4
$\begingroup$

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]

enter image description here

$\endgroup$
1
  • $\begingroup$ Nice idea to use IdentityMatrix; I added a variation, with credit of course, to my answer. $\endgroup$
    – Mr.Wizard
    Jul 24 '17 at 13:19
3
$\begingroup$
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}

$\endgroup$
2
  • $\begingroup$ Thanks, it is working fine with independent i & j, but not with functions involving i & j, for eample A = DeleteCases[Table[PE[j] - PE[i], {i, 1, 2}, {j, 1, 2}], {a_, a_}, 2] is giving four elements, not two {{0, -PE[1] + PE[2]}, {PE[1] - PE[2], 0}} AM I doing something wrong here ?? $\endgroup$
    – user49535
    Jul 24 '17 at 10:57
  • $\begingroup$ @user49535, it gives {{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. $\endgroup$
    – Rom38
    Jul 24 '17 at 11:05
3
$\begingroup$

Yet another way:

a = Table[{i, j}, {i, 1, 4}, {j, 1, 4}];
Pick[a, IdentityMatrix[Length[a]], 0]
$\endgroup$
1
  • $\begingroup$ Beat you to it, but +1 nevertheless. :^) $\endgroup$
    – Mr.Wizard
    Jul 24 '17 at 13:22

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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