1
$\begingroup$

I try to get the following determinant product result,

 nn = 5;
 Unprotect[Times];
 s1[k1_, x1_] s2[k2_, x1_] := 
 If[k1 == k2 || Abs[k1 - k2] == 4, g[k1, k2, x1], 0];
 res = 
  Det[Table[s1[i1, i2], {i1, 1, nn}, {i2, 1, nn}]]*
   Det[Table[s2[i1, i2], {i1, 1, nn}, {i2, 1, nn}]] // ExpandAll;
 res 

If $nn\leq 6$, it is easy to get the result. Now, I want to know, is it possible to find a way to increase nn to $12$ or larger ? The final expression should be ExpandAll.

Update:

Now I realized that $nn=12$ is really too large. It is very difficult if we cannot use some effective arithmetic. So, is it possible for $nn=8$ ?

$\endgroup$
  • $\begingroup$ Can you explain what you think you are doing when you Unprotect[Times];? $\endgroup$ – bill s Sep 30 '15 at 12:38
  • $\begingroup$ @bill s just to define the product s1[k1_, x1_] s2[k2_, x1_] . Times is Protected. Of course, this is not a safe method. $\endgroup$ – Orders Sep 30 '15 at 12:48
  • 6
    $\begingroup$ You can use TagSetDelayed instead and that is vastly preferable to changing Times. s1 /: s1[k1_, x1_] s2[k2_, x1_] := If[k1 == k2 || Abs[k1 - k2] == 4, g[k1, k2, x1], 0]; $\endgroup$ – Daniel Lichtblau Sep 30 '15 at 14:27
  • 1
    $\begingroup$ Also, to handle dimension of 12 you will need to figure out a way that avoids the intermediate determinant computations. The intermediate swell from those will be quite large (that might be an understatement). $\endgroup$ – Daniel Lichtblau Sep 30 '15 at 14:29
  • $\begingroup$ @Daniel Lichtblau Yes, nn=12 is really too difficult. Can I ask you to have a try for nn=8 for this problem ? $\endgroup$ – Orders Oct 5 '15 at 13:44
1
$\begingroup$

At the moment, this is just some random thoughts and observations. I will try to morph it into a coherent answer, soon.

First, a determinant can be reasonably calculated using LUDecomposition, e.g.

Clear[ludet];
ludet[nn_] := ludet[nn] = 
 Block[{u, s1},
  u = First@LUDecomposition@Table[s1[i1, i2], {i1, 1, nn}, {i2, 1, nn}];
  Times @@ Diagonal[u SparseArray[{i_, j_} /; j >= i -> 1, Dimensions@u]]
 ]

On my computer, nn == 11 took 40 s, so nn == 12 might be in reach.

Examining the results from the lower orders, you quickly note that the determinant is recursive, e.g.

ludet[n] = ludet[n - 1] nterm

So, you can build up to n == 8 or n == 12 by examining the determinants for the lower n values. My thought is to convert those lower order terms into patterns for use on the higher order terms, i.e. pre-generating the conversion rules to speed things along. This is roughly

origconversion = s1[k1_, x1_] s2[k2_, x1_] :> If[
   k1 == k2 || Abs[k1 - k2] == 4, g[k1, k2, x1], 0];
newconversions = {};

Block[{term = #, eterm, res},
  eterm = # (# /. s1 -> s2)& @ term;
  res = eterm /. newconversions;
  If[ !FreeQ[res, s1|s2],
    res = res /. origconversion;
    newconversions = {makePattern[eterm, res]}~Join~newconversions
  ];
  res
]& /@ ludet[n] (* run for each n *)

with makePattern the missing piece.

$\endgroup$
  • $\begingroup$ Seems promising! Thanks for your try for this problem. Looking forward to your final answer. $\endgroup$ – Orders Oct 6 '15 at 21:14
  • $\begingroup$ @Orders it will be at least another day until I can get back to this. $\endgroup$ – rcollyer Oct 7 '15 at 22:26

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.