Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2008

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Re: Solve[] doesn't

  • To: mathgroup at smc.vnet.net
  • Subject: [mg90655] Re: [mg90636] Re: Solve[] doesn't
  • From: DrMajorBob <drmajorbob at att.net>
  • Date: Fri, 18 Jul 2008 04:00:46 -0400 (EDT)
  • References: <g5kil1$8lf$1@smc.vnet.net>
  • Reply-to: drmajorbob at longhorns.com

> (* Now solve for sijkl - if you dare! *)

In what equation(s)?

In terms of what other variables or constants?

Bobby

On Thu, 17 Jul 2008 04:34:27 -0500, Hauke Reddmann  
<fc3a501 at uni-hamburg.de> wrote:

> Addendum - "Faked Example" of course means exactly that -
> my problem looks *like* the one I gave (of course
> Mathematica solves THAT :-) in general structure.
> It's hard to come up with actual code because I work
> "on the fly" and so I won't exclude sheer stupidity
> or a typo on my side.
>
> I can give my basic code, though, it's just state model
> knot theory work:
>
> ClearAll["Global`*"];
> (*Set Dimension*) n=3;fl=Floor[n/2];ce=Floor[(n-1)/2];
> (*Define Closure*) cl[x_]:=Simplify[pc.x.qc/oo];
> (*Define Convert1*) mt[x_]:=Nest[Partition[#,n]&,Flatten[x],3];
> (*Define Convert2*) tm[x_]:=Partition[Flatten[x],n*n];
> (*Define Rotation*) ro[x_]:=tm[Transpose[p.mt[x].q,{3,1,4,2}]];
> (*Define Tidy Up*)  
> ti[x_]:=x//Flatten//Together//Numerator//Factor//Sort//Union;
>
> (*Actual Example*)
> (*Set Cup and Cap*) q={{1/2,1,1},{-1,-1,0},{1,0,0}};
> p=Inverse[q];
> (*Set S Matrix *) s={
> {s1111,s1112,s1113,s1121,s1122,s1123,s1131,s1132,s1133},
> {s1211,s1212,s1213,s1221,s1222,s1223,s1231,s1232,s1233},
> {s1311,s1312,s1313,s1321,s1322,s1323,s1331,s1332,s1333},
> {s2111,s2112,s2113,s2121,s2122,s2123,s2131,s2132,s2133},
> {s2211,s2212,s2213,s2221,s2222,s2223,s2231,s2232,s2233},
> {s2311,s2312,s2313,s2321,s2322,s2323,s2331,s2332,s2333},
> {s3111,s3112,s3113,s3121,s3122,s3123,s3131,s3132,s3133},
> {s3211,s3212,s3213,s3221,s3222,s3223,s3231,s3232,s3233},
> {s3311,s3312,s3313,s3321,s3322,s3323,s3331,s3332,s3333}};
>
> (*Define R Matrix via Whirl 1*) r=ro[s];
> (*Whirl 2*) nul1=Flatten[s-ro[r]];
> (*Cap as Vector*) pc=Flatten[p];
> (*Cup as Vector*) qc=Flatten[q];
> (*Twist*) nul2a=Flatten[pc.s-pc*f];
> (*Twist*) nul2b=Flatten[pc.r-pc/f];
> (*Id*) kr=IdentityMatrix[n^2];
> (*Poke*) nul3=Flatten[s.r-kr];
> (*Id*) id=IdentityMatrix[n];
> (*S x Id*)  
> s1=Partition[Flatten[Transpose[Outer[Times,s,id],{1,3,2,4}]],n^3];
> (*Id x S*)  
> s2=Partition[Flatten[Transpose[Outer[Times,id,s],{1,3,2,4}]],n^3];
> (*Slide*) nul4=Flatten[s1.s2.s1-s2.s1.s2];
>
> (* Now solve for sijkl - if you dare! *)
> (* nul1 and nul2a/b are linear, try them first. *)
>
> g=(Sqrt[5]+1)/2;
> f=I*(2*g+1);
> S=I*{
> {g-1,0,-g/2,0,g/2,g/2,-g/2,-g/2,-g/4},
> {0,g-1,-g,0,g,g,-g,-g,-g/2},
> {0,0,-1,0,g,g,-g,-g,-g/2},
> {0,0,g,g-1,-g,-g,g,g,g/2},
> {0,0,g,0,-1,-g,g,g,g/2},
> {0,0,0,0,0,g-1,0,0,0},
> {0,0,-g,0,g,g,-1,-g,-g/2},
> {0,0,0,0,0,0,0,g-1,0},
> {0,0,0,0,0,0,0,0,g-1}};
> (* s=S is a solution I know but sometimes not find. *)
>
> HTH.
> --
> Hauke Reddmann <:-EX8    fc3a501 at uni-hamburg.de
>     Er-a svo gott     sem gott kveða
>     öl alda sonum,     því að færra veit
>     er fleira drekkur     síns til geðs gumi.
>
>



-- 
DrMajorBob at longhorns.com


  • Prev by Date: Re: parametric plot extremely slow
  • Next by Date: Re: What does FullForm[ ] actually do?
  • Previous by thread: Re: Solve[] doesn't
  • Next by thread: Conditional Table Formatting