Group Abstract

Message Boards

WOLFRAM COMMUNITY

1.5K Views

1 Reply

0 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Managing graphs and roots of polynomials with Manipulate

Pincio Pinci

Posted 1 year ago

Hello to Everyone. My goal is to create a graphical interface with Manipulate in which there is: 1) a slider to vary a parameter k, integer >=1; 2) a graph of a polynomial pk(x) of degree k, represented by a dotted line with dots corresponding to the values pk(x=n) where n is an integer >=1; 3) the writing "for k=k0, n=n0", where k0 is the value of k chosen with the cursor and n0 is the value of n closest to the root of p_k(x)=0. The code I made correctly returns only points 1) and 2) but not 3). Kindly, can you help me solve the problem? ClearAll[calculatePolynomial] calculatePolynomial[k_, x_] := Sum[Binomial[k + i, 2 i] (-4/2^x)^i, {i, 0, k}] Manipulate[ Module[{radiusX = dynamicRadiusX, radiusY = dynamicRadiusY, roots, numericValue},(Calcola le radici del polinomio) roots = x /. NSolve[calculatePolynomial[k, x] == 0, x]; (Calcola il valore numerico) numericValue = Max[1, Round[Min[Abs[roots - k]]]]; (Mostra il grafico dei polinomi e i pallini sotto il cursore k) Column[{Show[ Plot[calculatePolynomial[k, x], {x, 0, 13}, PlotStyle -> Directive[Blue, Dashed, Thickness[thickness]], Ticks -> {Range[0, 13, 1], Range[-2, 2, 1]}, GridLines -> {Range[0, 13, 1], Range[-2, 2, 1]}, GridLinesStyle -> Directive[Gray, AbsoluteDashing[{1, 1}]], PlotRange -> {{0, 13}, {-2, 2}}], Graphics[{Red, Table[Disk[{i, calculatePolynomial[k, i]}, {radiusX, radiusY}], {i, 0, 13}]}]],(Visualizza solo la parte numerica) Row[{"Per k=", k, ": n=", numericValue}],(Aggiungi il valore delle radici) Row[{"Radici: ", StringJoin@ Riffle[Table[ "k=" <> ToString[k] <> ", n=" <> ToString[n], {n, Round[roots]}], ", "]}]}]], {{k, 1, "Parametro k"}, 1, 100, 1, Appearance -> "Labeled"}, {{dynamicRadiusX, 0.06, "Dimensione orizzontale"}, 0.01, 0.2, 0.01, ControlType -> None}, {{dynamicRadiusY, 0.03, "Dimensione verticale"}, 0.01, 0.2, 0.01, ControlType -> None}, {{thickness, 0.005, ""}, 0.001, 0.01, 0.001, ControlType -> None},(Thickness non visibile nell'interfaccia) ControlPlacement -> Left, ContentSize -> {700, 300}]

Hello to Everyone.
My goal is to create a graphical interface with Manipulate in which there is: 1) a slider to vary a parameter k, integer >=1; 2) a graph of a polynomial pk(x) of degree k, represented by a dotted line with dots corresponding to the values pk(x=n) where n is an integer >=1; 3) the writing "for k=k0, n=n0", where k0 is the value of k chosen with the cursor and n0 is the value of n closest to the root of p_k(x)=0. The code I made correctly returns only points 1) and 2) but not 3). Kindly, can you help me solve the problem?

ClearAll[calculatePolynomial]

calculatePolynomial[k_, x_] := 
 Sum[Binomial[k + i, 2 i] (-4/2^x)^i, {i, 0, k}]

Manipulate[
 Module[{radiusX = dynamicRadiusX, radiusY = dynamicRadiusY, roots, 
   numericValue},(*Calcola le radici del polinomio*)
  roots = x /. NSolve[calculatePolynomial[k, x] == 0, x];
  (*Calcola il valore numerico*)
  numericValue = Max[1, Round[Min[Abs[roots - k]]]];
  (*Mostra il grafico dei polinomi e i pallini sotto il cursore k*)
  Column[{Show[
     Plot[calculatePolynomial[k, x], {x, 0, 13}, 
      PlotStyle -> Directive[Blue, Dashed, Thickness[thickness]], 
      Ticks -> {Range[0, 13, 1], Range[-2, 2, 1]}, 
      GridLines -> {Range[0, 13, 1], Range[-2, 2, 1]}, 
      GridLinesStyle -> Directive[Gray, AbsoluteDashing[{1, 1}]], 
      PlotRange -> {{0, 13}, {-2, 2}}], 
     Graphics[{Red, 
       Table[Disk[{i, calculatePolynomial[k, i]}, {radiusX, 
          radiusY}], {i, 0, 
         13}]}]],(*Visualizza solo la parte numerica*)
    Row[{"Per k=", k, ": n=", 
      numericValue}],(*Aggiungi il valore delle radici*)
    Row[{"Radici: ", 
      StringJoin@
       Riffle[Table[
         "k=" <> ToString[k] <> ", n=" <> ToString[n], {n, 
          Round[roots]}], ", "]}]}]], {{k, 1, "Parametro k"}, 1, 100, 
  1, Appearance -> "Labeled"}, {{dynamicRadiusX, 0.06, 
   "Dimensione orizzontale"}, 0.01, 0.2, 0.01, 
  ControlType -> None}, {{dynamicRadiusY, 0.03, 
   "Dimensione verticale"}, 0.01, 0.2, 0.01, 
  ControlType -> None}, {{thickness, 0.005, ""}, 0.001, 0.01, 0.001, 
  ControlType -> None},(*Thickness non visibile nell'interfaccia*)
 ControlPlacement -> Left, ContentSize -> {700, 300}]

POSTED BY: Pincio Pinci

1 Reply

Sort By:

Gianluca Gorni

Gianluca Gorni, University of Udine

Posted 1 year ago

I don't know what it means, but this does not give errors: Clear[calculatePolynomial, roots, numericValue] calculatePolynomial[deg_, x_] := Binomial[deg + 0, 2] + Sum[Binomial[deg + i, 2] x^i, {i, 1, deg}]; roots[deg_] := x /. NSolve[calculatePolynomial[deg, x] == 0, x]; numericValue[deg_] := Max[1, Round[Min[Abs[roots[deg] - deg]]]]; Manipulate[ Column[{Show[ Plot[calculatePolynomial[k, x], {x, 0, 13}, PlotStyle -> Directive[Blue, Dashed, Thickness[thickness]], Ticks -> {Range[0, 13, 1], Range[-2, 2, 1]}, GridLines -> {Range[0, 13, 1], Range[-2, 2, 1]}, GridLinesStyle -> Directive[Gray, AbsoluteDashing[{1, 1}]]], Graphics[{Red, PointSize[pointSize], Table[Point[{i, calculatePolynomial[k, i]}], {i, 0, 13}]}]], Row[{"Per k=", k, ": n=", numericValue[k]}], Row[{"Radici: ", StringJoin@ Riffle[Table[ "k=" <> ToString[k] <> ", n=" <> ToString[n], {n, Round[roots[k]]}], ", "]}]}], {{k, 1, "Parametro k"}, 1, 100, 1, Appearance -> "Labeled"}, {{pointSize, 0.06, "point size"}, 0.01, 0.2}, {{thickness, 0.03}, 0.01, 0.2}]

I don't know what it means, but this does not give errors:

Clear[calculatePolynomial, roots, numericValue]
calculatePolynomial[deg_, x_] := 
  Binomial[deg + 0, 2] + Sum[Binomial[deg + i, 2]  x^i, {i, 1, deg}];
roots[deg_] := x /. NSolve[calculatePolynomial[deg, x] == 0, x];
numericValue[deg_] := 
 Max[1, Round[Min[Abs[roots[deg] - deg]]]]; Manipulate[
 Column[{Show[
    Plot[calculatePolynomial[k, x], {x, 0, 13}, 
     PlotStyle -> Directive[Blue, Dashed, Thickness[thickness]], 
     Ticks -> {Range[0, 13, 1], Range[-2, 2, 1]}, 
     GridLines -> {Range[0, 13, 1], Range[-2, 2, 1]}, 
     GridLinesStyle -> Directive[Gray, AbsoluteDashing[{1, 1}]]], 
    Graphics[{Red, PointSize[pointSize], 
      Table[Point[{i, calculatePolynomial[k, i]}], {i, 0, 13}]}]], 
   Row[{"Per k=", k, ": n=", numericValue[k]}], 
   Row[{"Radici: ", 
     StringJoin@
      Riffle[Table[
        "k=" <> ToString[k] <> ", n=" <> ToString[n], {n, 
         Round[roots[k]]}], ", "]}]}], {{k, 1, "Parametro k"}, 1, 100,
   1, Appearance -> "Labeled"}, {{pointSize, 0.06, "point size"}, 
  0.01, 0.2},
  {{thickness, 0.03}, 0.01, 0.2}]

POSTED BY: Gianluca Gorni

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Feedback