Profile cover photo
Profile photo
Roger Bagula
1,024 followers -
inorganic chemist and math type
inorganic chemist and math type

1,024 followers
About
Roger's posts

Post has attachment

Post has attachment
The PC9 Breast Plate conformal map:
Photo

Post has attachment
2end group based on PC9 root:
p[x_] = x^2 + 0.32968990510380686` - 0.054137451948017924` I
Photo

Post has attachment

Post has attachment

Post has attachment
My Julia renormalization at the PC4 constant:
r[z_}=Exp[I*2*Pi*GoldenRatio]z^2(z^2*(0.379514 +0.334932 I)+1)/(z^2+0.379514 +0.334932 I)
Photo

Post has attachment
PC10 Julia:
Photo

Post has attachment
The PC10 ISphere conformal map:
Photo

Post has attachment
(* mathematica*)
Clear[x, y, a, b, c, d, w, z, c0, s]
(PC10 polynomial with 2 vertex roots)

p[x_] = x^2 + 0.3184722666580299` - 0.041257369922169135` I
st[i_] := {Re[z], Im[z]} /. NSolve[p[z] == 0, z][[i]]
ww = Flatten[
Table[{{a, b}, {c0, d}} /.
Solve[{x + I*y - (a*(x + I*y) + b)/(c0*(x + I*y) + d) == 0,
a + d - 2 == 0, a*d - b*c0 - 1 == 0}, {a, b, c0, d}] /.
x -> st[i][[1]] /. y -> st[i][[2]], {i, 2}], 1]

c0 = Sqrt[2]
s[i_] = ww[[i]]
{a, b} = Table[s[i], {i, 1, 2}]
{A, B} = Table[Inverse[s[i]], {i, 1, 2}] // Chop
Photo

Post has attachment
A program to solve and plot the PC_n roots:
(* mathematica*)
f[z_, c_] = z^2 + c
w[0] = {Re[c], Im[c]} /. NSolve[f[c, c] == 0, c];
w[1] = {Re[c], Im[c]} /. NSolve[f[f[c, c], c] == 0, c];
w[2] = {Re[c], Im[c]} /. NSolve[f[f[f[c, c], c], c] == 0, c];
w[3] = {Re[c], Im[c]} /. NSolve[f[f[f[f[c, c], c], c], c] == 0, c];
w[4] = {Re[c], Im[c]} /.
NSolve[f[f[f[f[f[c, c], c], c], c], c] == 0, c];
w[5] = {Re[c], Im[c]} /.
NSolve[f[f[f[f[f[f[c, c], c], c], c], c], c] == 0, c];
w[6] = {Re[c], Im[c]} /.
NSolve[f[f[f[f[f[f[f[c, c], c], c], c], c], c], c] == 0, c];
w[7] = {Re[c], Im[c]} /.
NSolve[f[f[f[f[f[f[f[f[c, c], c], c], c], c], c], c], c] == 0, c];
w[8] = {Re[c], Im[c]} /.
NSolve[f[f[f[f[f[f[f[f[f[c, c], c], c], c], c], c], c], c], c] ==
0, c];
w[9] = {Re[c], Im[c]} /.
NSolve[f[f[f[f[f[f[f[f[f[f[c, c], c], c], c], c], c], c], c], c],
c] == 0, c];
pts = Table[
ListPlot[w[i], PlotStyle -> {Red, PointSize[0.0075]}], {i, 0, 9}];
Show[pts, PlotRange -> {{-2, 1}, {-1.5, 1.5}}, ImageSize -> 1000]
(* end*)
Photo
Wait while more posts are being loaded