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$
6
  • $\begingroup$ Can you explain what you think you are doing when you Unprotect[Times];? $\endgroup$
    – bill s
    Commented Sep 30, 2015 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
    Commented Sep 30, 2015 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$ Commented Sep 30, 2015 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$ Commented Sep 30, 2015 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
    Commented Oct 5, 2015 at 13:44

1 Answer 1

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$
2
  • $\begingroup$ Seems promising! Thanks for your try for this problem. Looking forward to your final answer. $\endgroup$
    – Orders
    Commented Oct 6, 2015 at 21:14
  • $\begingroup$ @Orders it will be at least another day until I can get back to this. $\endgroup$
    – rcollyer
    Commented Oct 7, 2015 at 22:26

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.