[Date Index]
[Thread Index]
[Author Index]
Re: Re: Determinant problem
*To*: mathgroup at smc.vnet.net
*Subject*: [mg55101] Re: [mg55082] Re: Determinant problem
*From*: DrBob <drbob at bigfoot.com>
*Date*: Sat, 12 Mar 2005 02:36:49 -0500 (EST)
*References*: <d0p7d6$j22$1@smc.vnet.net> <200503110921.EAA02259@smc.vnet.net>
*Reply-to*: drbob at bigfoot.com
*Sender*: owner-wri-mathgroup at wolfram.com
My answer (using LUDecomposition) is the same as yours, but it's amazingly difficult for Mathematica to "see" it.
{m,perm,c}=LUDecomposition@s1;
treat=Signature@perm Simplify@Tr[m,Times]
-(1+t1) (1+t10) (1+t11) (1+t12) (1+t13) (1+t14) (1+t15) (1+t16) (1+t17) \
(1+t18) (1+t19) (1+t2) (1+t20) (1+t21) (1+t22) (-1-t23) (1+t3) (1+t4) (1+t5) (
1+t6) (1+t7) (1+t8) (1+t9)
maxim=Simplify@myDet@s1
-(1+t1) (-1-t10) (-1-t11) (1+t12) (-1-t13) (-1-t14) (-1-t15) (-1-t16) \
(-1-t17) (-1-t18) (-1-t19) (-1-t2) (-1-t20) (-1-t21) (-1-t22) (-1-t23) (1+t3) \
(-1-t4) (-1-t5) (-1-t6) (1+t7) (-1-t8) (-1-t9)
Here's a third version (just a rewrite of the other two):
product = Times @@ (1 + Variables@treat)
(1 + t1) (1 + t10) (1 + t11) (1 + t12) (1 + t13) (1 + t14) (1 +
t15) (1 + t16) (1 + t17) (1 + t18) (1 + t19) (1 + t2) (1 +
t20) (1 + t21) (1 + t22) (1 + t23) (1 + t3) (1 + t4) (1 + t5) (
1 + t6) (1 + t7) (1 + t8) (1 + t9)
You or I could count factors and minus signs to confirm all three answers are the same, but Simplify and FullSimplify take a LOT of time on direct verifications.
But this is an efficient confirmation, I think:
noMinus=ReleaseHold[#/.-1-a_:>Hold[-1](1+a)]&;
maxim == product == treat // noMinus
True
Bobby
On Fri, 11 Mar 2005 04:21:30 -0500 (EST), Maxim <ab_def at prontomail.com> wrote:
> On Thu, 10 Mar 2005 10:26:46 +0000 (UTC), Nodar Shubitidze
> <shubi at nusun.jinr.ru> wrote:
>
>> Hi All !
>>
>> I have a problem with calculation of determinant of 24*24
>> matrix:
>> s1={{1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1},
>> {1,1,1,1,1,1,1,1,1,1,1,1,-t1,-t1,-t1,-t1,-t1,-t1,-t1,-t1,-t1,-t1,-t1,-t1},
>> {1,1,1,1,1,1,-t2,-t2,-t2,-t2,-t2,-t2,0,0,0,0,0,0,0,0,0,0,0,0},
>> {0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,-t3,-t3,-t3,-t3,-t3,-t3},
>> {1,1,1,-t4,-t4,-t4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
>> {0,0,0,0,0,0,1,1,1,-t5,-t5,-t5,0,0,0,0,0,0,0,0,0,0,0,0},
>> {0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,-t6,-t6,-t6,0,0,0,0,0,0},
>> {0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,1,1,1,-t7,-t7,-t7},
>> {1,1,-t8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
>> {0,0,0,1,1,-t9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
>> {0,0,0,0,0,0,1,1,-t10,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
>> {0,0,0,0,0,0,0,0,0,1,1,-t11,0,0,0,0,0,0,0,0,0,0,0,0},
>> {0,0,0,0,0,0,0,0,0,0,0,0,1,1,-t12,0,0,0,0,0,0,0,0,0},
>> {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,-t13,0,0,0,0,0,0},
>> {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,-t14,0,0,0},
>> {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,-t15},
>> {1,-t16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
>> {0,0,0,1,-t17,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
>> {0,0,0,0,0,0,1,-t18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
>> {0,0,0,0,0,0,0,0,0,1,-t19,0,0,0,0,0,0,0,0,0,0,0,0,0},
>> {0,0,0,0,0,0,0,0,0,0,0,0,1,-t20,0,0,0,0,0,0,0,0,0,0},
>> {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,-t21,0,0,0,0,0,0,0},
>> {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,-t22,0,0,0,0},
>> {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,-t23,0}};
>> s2=Det[s1];
>> Mathematica 5.0 on my computer (AMD Atlon XP, 1.4GHz)
>> cannot calculate it after 12 hours.
>> It is strange, therefore I calculate more complicated (with
>> less number of zeros) 68*68 matrix during the seconds.
>> Please help establish the reason.
>> Best regards
>> Nodar Shubitidze
>>
>
> I believe that in this case the elimination process may encounter a hidden
> zero in the denominator (something like 1/(2(t1-1)-2t1+2)), which causes
> Det to lock up, perhaps because numerical approximations are used. But it
> is hardly possible to be certain about it; for example,
> Product[1+t[i],{i,25}]+O[x] appears to lock up too (in version 5.1.0),
> after taking up more than 1Gb of memory -- in that case most likely some
> unnecessary simplification is taking place, and probably the same thing
> happens with Det. Here's a straightforward implementation of Det that
> works for your matrix:
>
> In[2]:=
> Clear[myDet]
> myDet[$A_ /; MatrixQ@ $A && Equal @@ Dimensions@ $A] :=
> Module[{A = $A, n = Length@ $A, s = 1, i},
> Do[
> i = Select[Range[j, n], !TrueQ[Together[A[[#, j]]] == 0]&, 1];
> If[i === {}, Return[0, Module]];
> If[(i = i[[1]]) != j,
> A[[{i, j}]] = A[[{j, i}]]; s = -s];
> A[[#]] -= A[[j]]*A[[#, j]]/A[[j, j]]& /@ Range[j + 1, n],
> {j, n - 1}
> ];
> s*Tr[A, Times]
> ]
>
> In[4]:=
> myDet[s1] // Simplify
>
> Out[4]=
> -((1 + t1)*(-1 - t10)*(-1 - t11)*(1 + t12)*(-1 - t13)*(-1 - t14)*(-1 -
> t15)*(-1 - t16)*(-1 - t17)*(-1 - t18)*(-1 - t19)*(-1 - t2)*(-1 - t20)*(-1
> - t21)*(-1 - t22)*(-1 - t23)*(1 + t3)*(-1 - t4)*(-1 - t5)*(-1 - t6)*(1
> + t7)*(-1 - t8)*(-1 - t9))
>
> This uses Together to avoid the hidden zero problem, but there's no
> guarantee that it'll work for more complicated expressions (alternatively
> we could use a heuristic numerical check instead of Together). The result
> can be simplified a little further:
>
> In[5]:=
> % /. (-1 - x_) -> s*(1 + x) /. s -> -1
>
> Out[5]=
> (1 + t1)*(1 + t10)*(1 + t11)*(1 + t12)*(1 + t13)*(1 + t14)*(1 + t15)*(1
> + t16)*(1 + t17)*(1 + t18)*(1 + t19)*(1 + t2)*(1 + t20)*(1 + t21)*(1
> + t22)*(1 + t23)*(1 + t3)*(1 + t4)*(1 + t5)*(1 + t6)*(1 + t7)*(1 + t8)*(1
> + t9)
>
> Maxim Rytin
> m.r at inbox.ru
>
>
>
>
--
DrBob at bigfoot.com
Prev by Date:
**Re: Ver 4.0 error, "There seems to be ..." corrupts opening a notebook**
Next by Date:
**Re: fourier transform of interpolating function**
Previous by thread:
**Re: Determinant problem**
Next by thread:
**Re: Re: Determinant problem**
| |