使用Mathematica绘制随机多项式的根

分形数据2025-05-28 20:23

使用ListPlot和NSolve直接绘制：

复制代码

(*返回系数为r和s之间整数的n次随机多项式*) 
eq[n_, r_, s_] := RandomInteger[{r, s}, {n}] . Array[Power[x, # - 1] &, n] 
(*返回给定随机多项式的根所对应的笛卡尔坐标*) 
sol[n_, r_, s_] := {Re[#], Im[#]} & /@ (x /. NSolve[eq[n, r, s] == 0, x]) ListPlot[sol[400, 1, 6], PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}}, AspectRatio -> Automatic, PlotStyle -> {PointSize[Medium], Opacity[0.2], Black}]

使用Image和Fourier：

复制代码

SetSystemOptions["SparseArrayOptions" -> {"TreatRepeatedEntries" -> 1}];
\[Gamma] = 0.12;
\[Beta] = 1.0;
fLor = Compile[{{x, _Integer}, {y, _Integer}}, (\[Gamma]/(\[Gamma] + 
        x^2 + y^2))^\[Beta], RuntimeAttributes -> {Listable}(*,
   CompilationTarget->"C"*)];
<< Developer`
$PlotComplexPoints[list_, magnification_, paddingX_, paddingY_, 
  brightness_] := 
 Module[{RePos = 
    paddingX + 1 + Round[magnification (# - Min[#])] &[Re[list]], 
   ImPos = paddingY + 1 + Round[magnification (# - Min[#])] &[Im[list]],
    sparse, lor, dimX, dimY}, dimX = paddingX + Max[RePos];
  dimY = paddingY + Max[ImPos];
  Image[(brightness Sqrt[dimX dimY] Abs[
       InverseFourier[
        Fourier[SparseArray[
           Thread[{ImPos, RePos}\[Transpose] -> 
             ConstantArray[1, Length[list]]], {dimY, dimX}]] Fourier[
          RotateRight[
           fLor[#[[All, All, 1]], #[[All, All, 2]]] &@
            Outer[List, Range[-Floor[dimY/2], Floor[(dimY - 1)/2]], 
             Range[-Floor[dimX/2], Floor[(dimX - 1)/2]]], {Floor[
             dimY/2], 
            Floor[dimX/2]}]]]])\[TensorProduct]ToPackedArray[{1.0, 
      0.3, 0.1}], Magnification -> 1]]

直接绘制10000个随机的复平面点图：

复制代码

$PlotComplexPoints[ RandomComplex[{-1 - I, 1 + I}, 10000], 300, 20, 20, 10]

随机的150阶多项式的根的分布图：

复制代码

expr = Evaluate@Sum[RandomInteger[{1, 10}] #^k, {k, 150}] &; 
list = Table[N@Root[expr, k], {k, 150}]; 
$PlotComplexPoints[list, 320, 20, 20, 140]