1
$\begingroup$

I know how to use a table to create expressions, for example I can create a table of variables $p_{i,j}$ where $i$ runs from 0 to 10 and $j$ runs from 0 to 10 by using the following code

variables=Table[Subscript[p,i,j],{i,0,10},{j,0,10}]

Now, I want to create the following expressions: $p_{i,j}*p_{k,l}$ such that $i+k=6$ and $j+l=4$. I tried the following code:

polynomials = Table[If[i + k == 6 && j + l == 4, 
Subscript[p, i, j]*Subscript[p, k, l]], {i, 0, 10}, {j, 0, 10}, 
{k, 0, 10}, {l, 0, 10}]

And I got the following output

{{{{Null, Null, Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, 
Null, Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}}, {{Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}}, {{Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, 
Subscript[p, 0, 2] Subscript[p, 6, 2]}}}, {{{Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}}, {{Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}}, {{Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Subscript[p, 1, 2] Subscript[p, 5, 2]}, {Null,
 Null, Null}}}, {{{Null, Null, Null}, {Null, Null, Null}, {Null, 
Null, Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}}, {{Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}}, {{Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Subscript[p, 2, 2] Subscript[p, 4, 2]}, {Null,
 Null, Null}, {Null, Null, Null}}}, {{{Null, Null, Null}, {Null, 
Null, Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}}, {{Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}}, {{Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, 
\!\(\*SubsuperscriptBox[\(p\), \(3, 2\), \(2\)]\)}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}}}, {{{Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}}, {{Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}}, {{Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Subscript[p, 2, 2] Subscript[p, 4, 2]}, {Null,
 Null, Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null,
 Null}}}, {{{Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}}, {{Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}}, {{Null, Null, 
Null}, {Null, Null, Subscript[p, 1, 2] Subscript[p, 5, 2]}, {Null,
 Null, Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null,
 Null}, {Null, Null, Null}}}, {{{Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}}, {{Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null, 
Null}}, {{Null, Null, 
Subscript[p, 0, 2] Subscript[p, 6, 2]}, {Null, Null, Null}, {Null,
 Null, Null}, {Null, Null, Null}, {Null, Null, Null}, {Null, Null,
 Null}, {Null, Null, Null}}}}

We can spot some polynomials in this big table of NULL's which satisfy this property.

Question: How do I get rid of all these NULL's and only get the polynomials I want?

$\endgroup$
4
$\begingroup$

There are multiple ways. You can return Nothing instead of the default Null.

polynomials = 
  Table[
    If[i + k == 6 && j + l == 4, 
      Subscript[p, i, j]*Subscript[p, k, l],
      Nothing
    ], 
    {i, 0, 10}, {j, 0, 10}, {k, 0, 10}, {l, 0, 10}]

This preserves the nested structure so you may want to Flatten.

In old versions use Unevaluated@Sequence[] instead of Nothing.

You can also use Sow and Reap.

First@Last@Reap@Do[
  If[i + k == 6 && j + l == 4,
     Sow[Subscript[p, i, j]*Subscript[p, k, l]]
  ], 
  {i, 0, 10}, {j, 0, 10}, {k, 0, 10}, {l, 0, 10}
]

You can also use what you have and polynomials /. Null -> Nothing or DeleteCases[polynomials, Null, Infinity].

$\endgroup$
  • $\begingroup$ If I use your first solution (and use Deletecases and Flatten to get rid of all the {}), I get some polynomials which occur more than once in the list. What should I do to get only 1 of such a polynomial? $\endgroup$ – Badshah Nov 16 '16 at 12:07
  • $\begingroup$ @Badshah DeleteDuplicates or Union. $\endgroup$ – Szabolcs Nov 16 '16 at 12:13
0
$\begingroup$

I may have misunderstood aims, however, if it is to create the desired products you could use MapIndexed strictly at level 2, e.g.

left = DeleteCases[
  Flatten[MapIndexed[Boole[Total@(#2 - {1, 1}) == 6] HoldForm[#1] &, 
    variables, {2}]], 0]
right = DeleteCases[
  Flatten[MapIndexed[Boole[Total@(#2 - {1, 1}) == 4] #1 &, 
    variables, {2}]], 0]
products = Times @@@ Tuples[{left, right}]

Of course you could use Outer and Times or Table with list iterator etc.

Showing the result:

Grid[Partition[products, 7], Frame -> All]

enter image description here

$\endgroup$

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.