Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2006
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2006

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

Search the Archive

a Quaternion quadratic level Pisot polynomial

  • To: mathgroup at smc.vnet.net
  • Subject: [mg68355] a Quaternion quadratic level Pisot polynomial
  • From: Roger Bagula <rlbagula at sbcglobal.net>
  • Date: Wed, 2 Aug 2006 05:24:15 -0400 (EDT)
  • Organization: SBC http://yahoo.sbc.com
  • References: <eahtq5$p0b$1@smc.vnet.net> <eakd82$qhf$1@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

I tried all kinds of combinations.
q^4-4*q^2-1
is the opposite of a Pisot ( one root inside the Uniot Quaternion and 
the rest outside).

(-1+I+J+K)*q^2-2*q-1==0
solves to give a set of Pisot like roots.
{{-0.34833, 0.385615, -0.34833, -0.15167},
 {-0.15167, -0.885615, -0.15167, -0.34833},
{-0.420313, 0.116972,  0.116972, 0.116972},
 {-0.0796875, -0.616972, -0.616972, -0.616972}}

Abs[]->{0.466594, 0.643716, 0.975528, 1.07159}

As far as I know this is the first reported Quaternion Pisot.
I've sent out emails to experts and haven't gotten any replies,
and my Internet searches by key works came up dry too.

Mathematica:
\!\(<< Algebra`Quaternions`\n
  \(q = Quaternion[t, x, y, z];\)\n
  \(q2 = ExpandAll[q ** q];\)\n
  \(q2x = Quaternion[0, 1, 0, 0] ** ExpandAll[q ** q];\)\n
  \(Quaternion[\(-2\)\ t\ x, t\^2 - x\^2 -
  y\^2 - z\^2, \(-2\)\ t\ z, 2\ t\ y];\)\n
  \(q2y = Quaternion[0, 0, 1, 0] ** ExpandAll[q ** q];\)\n
  \(q2z = Quaternion[0, 0, 0, 1] ** ExpandAll[q ** q];\)\n
  FullSimplify[\(-q2\) + q2x + q2y + q2z - 2*q - Quaternion[1, 0, 0, 0]]\n
  NSolve[{\(-1\) - t\^2 + x\^2 + y\^2 + z\^2 - 2\ t\ \((
    1 + x + y +
      z)\) == 0, t\^2 - 2\ x - x\^2 - y\^2 - 2\ t\ \((x +
        y - z)\) - z\^2 == 0, t\^2 - x\^2 - 2\ y - y\^2 +
  2\ t\ \((x - y -
       z)\) - z\^2 == 0, t\^2 - x\^2 - y\^2 - 2\ z -
         z\^2 - 2\ t\ \((x - y + z)\) == 0}, {t, x, y, z}]\n
  a = Table[{Re[t] - Im[x],
    Re[x] + Im[t], Re[y] - Im[z], Re[z] + Im[y]} /. \ \(NSolve[{\(-1\) -
      t\^2 + x\^2 + y\^2 + z\^2 - 2\ t\ \((1 + x + y + z)\) ==
   0, t\^2 - 2\
    x - x\^2 - y\^2 - 2\ t\ \((x + y -
           z)\) - z\^2 == 0, t\^2 - x\^2 - 2\ y -
              y\^2 + 2\ t\ \((x - y - z)\) - z\^2 == 0, t\^2 - x\^2 -
            y\^2 - 2\ z - z\^2 - 2\ t\ \((x -
                  y + z)\) == 0}, {t, x, y, z}]\)[\([\)\(n\)\(]\)], {n, 1,
            4}]\n
  b = Sort[Table[Sqrt[\((Re[t] - Im[x])\)^2 + \((Re[x] + Im[t])\)^2 + \((Re[
        y] - Im[z])\)^2 + \((Re[
    z] + Im[y])\)^2] /. \ \(NSolve[{\(-1\) - t\^2 + x\^2 + y\^2 + z\^2 - 2\
                t\ \((1 + x + y + z)\) == 0, t\^2 - 2\ x - x\^2 - y\^2 -
              2\ t\ \((x + y - z)\) - z\^2 == 0, t\^2 - x\^2 - 2\
                  y - y\^2 + 2\ t\ \((x - y - z)\) - z\^2 == 0, t\^2 -
           x\^2 - y\^2 - 2\
              z - z\^2 - 2\ t\ \((x - y + z)\) == 0}, {t, x,
                    y, z}]\)[\([\)\(n\)\(]\)], {n, 1, 4}]]\n
  ListPlot[b, PlotJoined -> True]\)


  • Prev by Date: Re: Re: Re: {x},{y} -> {x,y} ?
  • Next by Date: "No more memory available" -- a recurring problem
  • Previous by thread: NMinimize
  • Next by thread: Re: a Quaternion quadratic level Pisot polynomial