Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2004
*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 2004

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

Search the Archive

Re: plotting groups of polynomial roots

  • To: mathgroup at smc.vnet.net
  • Subject: [mg51273] Re: plotting groups of polynomial roots
  • From: Roger Bagula <tftn at earthlink.net>
  • Date: Mon, 11 Oct 2004 01:25:32 -0400 (EDT)
  • Organization: tftn/bmftg
  • References: <ckajb5$m4j$1@smc.vnet.net>
  • Reply-to: tftn at earthlink.net
  • Sender: owner-wri-mathgroup at wolfram.com

I've used this same sort of root group finding program on the three 
general types of Pisot
root Polynomials:
1) x^q*(x^2-x-1)+x^2-1==0
2) x^q-(x^(q+1)-1)/(x^2-1)=0
3) x^q-(x^(q-1)-1)/(x-1)=0
The type one is here given a disk to half plane transform
that allows a greatter discrimation between the root values.
(* root group of type one Pisot polynomial*)
(* looked at as real part of a disk to half plane transform*)
s[q_]=x^q*(x^2-x-1)+x^2-1
digits=21
a=Flatten[Table[x/. NSolve[s[n]==0,x],{n,1,digits}]];
Dimensions[a][[1]]
b=Table[{Re[(a[[n]]-1)/(a[[n]]+1)],Im[(a[[n]]-1)/(a[[n]]+1)]},{n,1,Dimensions[a][[1]]}];
ListPlot[b,PlotRange->All]
c=Table[Abs[Floor[Re[(a[[n]]-1)/(a[[n]]+1)]]],{n,1,Dimensions[a][[1]]}]
ListPlot[c]
{1,1,0,11,1,1,0,2,2,1,1,0,12,1,1,1,1,0,3,3,1,1,1,1,0,14,1,1,1,1,1,1,0,4,4,1,1,
  
1,1,1,1,0,16,1,1,1,1,1,1,1,1,0,5,5,1,1,1,1,1,1,1,1,0,18,1,1,1,1,1,1,1,1,1,1,
  
0,6,6,1,1,1,1,1,1,1,1,1,1,0,1,1,19,1,1,1,1,1,1,1,1,1,1,0,7,7,1,1,1,1,1,1,1,
  
1,1,1,1,1,0,1,1,21,1,1,1,1,1,1,1,1,1,1,1,1,0,8,8,1,1,1,1,1,1,1,1,1,1,1,1,1,
  
1,0,2,2,22,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,9,9,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
  
1,0,2,2,24,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,10,10,1,1,1,1,1,1,1,1,1,1,1,1,
  
1,1,1,1,1,1,0,2,2,25,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,11,11,1,1,1,1,1,
  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0}

Roger Bagula wrote:

>If you take the first and last term away from a binomial polynomial and 
>set the result equal to zero,
>you get a number of strange roots.
>This method allows you to plot such roots.
>I didn't know it would work when I wrote it up,
>but I plan to use it in the future
>on some other polynomial root structures.
>
>(* root group where x^q+1=(x+1)^q: binomial expansion without x^q and 1*)
>digits=21
>s[q_]=Sum[(q!/((q-k)!*k!))*x^(q-k),{k,1,q-1}]
>ExpandAll[s[2]]
>ExpandAll[s[3]]
>a=Flatten[Table[x/. NSolve[s[n]==0,x],{n,2,digits}]];
>a0=Floor[Abs[a]]
>Dimensions[a][[1]]
>b=Table[{Re[a[[n]]],Im[a[[n]]]},{n,1,Dimensions[a][[1]]}];
>ListPlot[b,PlotRange->All]
>Respectfully, Roger L. Bagula
>
>tftn at earthlink.net, 11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :
>URL :  http://home.earthlink.net/~tftn
>URL :  http://victorian.fortunecity.com/carmelita/435/ 
>
>  
>

-- 
Respectfully, Roger L. Bagula
tftn at earthlink.net, 11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :
URL :  http://home.earthlink.net/~tftn
URL :  http://victorian.fortunecity.com/carmelita/435/ 



  • Prev by Date: Re: cross-product in cylindrical problem
  • Next by Date: Re: normal distribution random number generation
  • Previous by thread: Re: plotting groups of polynomial roots
  • Next by thread: Re: plotting groups of polynomial roots