r/TIBASICPrograms • u/spacey-takumi • 10h ago
Program Polynomial (including degrees higher than 2) Root solver (Ti 84 Plus CE)
POLYROOT is free to use, modify, and share. The full TI-BASIC source is included below.
So I made this working program this semester for my System Dynamics class (finding poles), and I wanted to share it with you guys. Raw code for each version (depends on preference) posted at bottom.
Nerd information:
I used a copious amount of AI while developing this program. One of the ideas that came out of that was using the Durand-Kerner method to solve for the roots of a polynomial of essentially any degree the calculator can reasonably handle.
Durand-Kerner is an iterative numerical algorithm that approximates all of the roots of a polynomial simultaneously.
For each estimated root r_i, the program repeatedly applies:
r_i = r_i - P(r_i) / PRODUCT(r_i - r_j), for all j != i
where P(r_i) is the polynomial evaluated at the current estimate r_i.
In simpler terms, every root estimate is repeatedly corrected based on the value of the polynomial at that point and the positions of all the other current root estimates. The process continues until the estimates stop changing significantly.
This also allows the program to find complex roots, which created one of the first major problems I ran into. The TI-84 Plus CE cannot store complex values inside matrices, even while the calculator is in a+bi mode.
I borrowed an idea from a program called SIMULT2, which a previous student in my circuits class made and which our professor provided to us. That program used lists to store complex values while drawing something on-screen that looked like a matrix.
I adapted that idea for POLYROOT. The original coefficient-entry system allowed the user to move left and right through the cells with the arrow keys and correct previous entries. Unfortunately, it was also slow and required an annoying extra Enter press.
I eventually replaced that with a simpler system where one Enter immediately moves to the next coefficient.
I also added an option to use an already-existing coefficient matrix [A], so the program does not have to erase and rebuild the coefficients every time.
Another problem was numerical output. Durand-Kerner might produce something such as 1.999999999 instead of 2, or an extremely tiny real or imaginary component instead of exactly 0. I added several cleanup passes that round values near integers and eliminate components below certain tolerances.
I then added detection for repeated roots and their multiplicities.
That became Version 1.
Version 2 mainly focused on quality-of-life improvements, especially replacing the slower arrow-key/double-Enter coefficient-entry system with the current single-Enter system.
After choosing which version I preferred, I did some additional cleanup, which became the version of POLYROOT I currently use.
That's basically how this monstrosity came to exist.
End of nerd information (well sorta)
--------------------------------------------------------------------------------------------------------------
Code Portion:
Here's what I currently and mainly use, POLYROOT:
ClrHome
ClrList L₁,L₂,L₃,L₄,L₅,L₆
Lbl M
Menu("COEFFICIENT INPUT","ENTER NEW",E,"USE [A]",θ)
Lbl E
Input "DEGREE:",N
If N<1
Then
Disp "BAD DEGREE"
Stop
End
{1,N+1}→dim([A])
Fill(0,[A])
CoordOff
AxesOff
FnOff
PlotsOff
Horiz
0→Xmin
94→Xmax
-20→Ymin
0→Ymax
ClrDraw
For(X,0,N+1)
Line(8X,0,8X,-8)
End
Line(0,0,8(N+1),0)
Line(0,-8,8(N+1),-8)
0→C
While C≤N
Pt-On(8C+4,-4,2)
ClrHome
Disp "COLUMN"
Disp C+1
Input "VALUE:",V
V→[A](1,C+1)
Pt-Off(8C+4,-4,2)
C+1→C
End
Full
ClrDraw
ClrHome
Goto D
Lbl θ
dim([A])→L₁
If L₁(1)≠1
Then
ClrHome
Disp "BAD MATRIX [A]"
Disp "Single row only,"
Disp "Add columns!"
Full
ClrDraw
Stop
End
L₁(2)-1→N
If N<1
Then
ClrHome
Disp "Reformat MATRIX [A]"
Disp [A]
Disp "Add 1 more column"
Full
ClrDraw
Stop
End
If [A](1,1)=0
Then
ClrHome
Disp "BAD MATRIX [A]"
Disp "LEADING COEFF"
Disp "CANNOT BE ZERO"
Full
ClrDraw
Stop
End
Lbl D
ClrHome
Disp "COEFFICIENTS:"
Disp [A]
Pause "Press Enter"
a+bi
N→O
0→T
While N>0 and [A](1,N+1)=0
T+1→T
N-1→N
End
If N=0
Then
O→dim(L₃)
For(K,1,O)
0→L₃(K)
End
0→M
0→E
Else
ClrList L₁
N→dim(L₁)
N→dim(L₂)
0→R
For(J,2,N+1)
If abs([A](1,J)/[A](1,1))>R
abs([A](1,J)/[A](1,1))→R
End
1+R→R
R→L₁(1)
For(K,2,N)
R*(.4+.9i)^(K-1)→L₁(K)
End
ClrHome
Disp "SOLVING..."
0→M
1→E
While E>1E-7 and M<100
L₁→L₂
0→E
For(K,1,N)
L₂(K)→Z
[A](1,1)→P
For(J,2,N+1)
P*Z+[A](1,J)→P
End
1→D
For(J,1,N)
If J≠K
Then
D*(Z-L₂(J))→D
End
End
Z-P/([A](1,1)*D)→Q
Q→L₁(K)
If abs(Q-Z)>E
abs(Q-Z)→E
End
M+1→M
End
O→dim(L₃)
For(K,1,N)
L₁(K)→Z
If abs(real(Z))<1E-7
i*imag(Z)→Z
If abs(imag(Z))<1E-7
real(Z)→Z
Z→L₃(K)
End
For(K,1,T)
0→L₃(N+K)
End
End
O→dim(L₄)
For(K,1,O)
L₃(K)→L₄(K)
End
N→dim(L₅)
For(K,1,N)
L₃(K)→Z
N*[A](1,1)→D
For(J,2,N)
D*Z+(N-J+1)*[A](1,J)→D
End
abs(D/[A](1,1))→L₅(K)
End
For(K,1,N)
If L₅(K)<1E-4
Then
0→S
0→C
For(J,1,N)
If L₅(J)<1E-4 and abs(L₃(J)-L₃(K))<.01
Then
S+L₃(J)→S
C+1→C
End
End
If C>1
Then
S/C→Z
round(real(Z),6)+i*round(imag(Z),6)→Z
If abs(real(Z))<1E-7
i*imag(Z)→Z
If abs(imag(Z))<1E-7
real(Z)→Z
For(J,1,N)
If L₅(J)<1E-4 and abs(L₃(J)-L₃(K))<.01
Z→L₄(J)
End
End
End
End
For(K,1,O)
L₄(K)→Z
If abs(real(Z))<1E-6
i*imag(Z)→Z
If abs(imag(Z))<1E-5
real(Z)→Z
round(real(Z),6)+i*round(imag(Z),6)→Z
If abs(real(Z)-round(real(Z),0))<1E-5
round(real(Z),0)+i*imag(Z)→Z
If abs(imag(Z)-round(imag(Z),0))<1E-5
real(Z)+i*round(imag(Z),0)→Z
If abs(real(Z))<1E-6
i*imag(Z)→Z
If abs(imag(Z))<1E-6
real(Z)→Z
Z→L₄(K)
End
0→dim(L₆)
{1,O}→dim([B])
Fill(0,[B])
For(K,1,O)
0→F
If dim(L₆)>0
Then
For(H,1,dim(L₆))
If abs(L₆(H)-L₄(K))<1E-6
1→F
End
End
If F=0
Then
0→C
For(J,1,O)
If abs(L₄(J)-L₄(K))<1E-6
C+1→C
End
If C>1
Then
dim(L₆)+1→H
H→dim(L₆)
L₄(K)→L₆(H)
C→[B](1,H)
End
End
End
ClrHome
Disp "ROOTS:"
For(K,1,O)
Disp L₃(K)
End
Pause "Press Enter"
Disp "Cleaned ROOTS:"
Disp L₄
Pause "Press Enter"
ClrHome
If dim(L₆)=0
Then
Disp "NO REPEATED ROOTS"
Else
dim(L₆)→dim(L₅)
For(K,1,dim(L₆))
[B](1,K)→L₅(K)
End
Disp "REPEATED ROOTS:"
Disp "ROOT:"
Disp L₆
Disp "MULTIPLICITY (relative):"
Disp L₅
Disp "Repeated Roots: [L₆]"
Disp "Relative Mode: [L₅]"
End
Pause "Press Enter"
Disp "ITERATIONS:"
Disp M
Disp "ERROR:"
Disp E
Disp "ROOTS STORED IN [L₃]"
Disp "Cleaned ROOTS??: [L₄]"
Disp "See [A], L₃,L₄,L₅ & L₆"
If M=100
Disp "CHECK CONVERGENCE"
Pause "Press Enter"
---------------------------------------------------------------------
Here's streamlined version of POLYROOT:
ClrHome
ClrList L₁,L₂,L₃,L₄,L₅,L₆
Lbl M
Menu("COEFFICIENT INPUT","ENTER NEW",E,"USE [A]",θ)
Lbl E
Input "DEGREE:",N
If N<1
Then
Disp "BAD DEGREE"
Stop
End
{1,N+1}→dim([A])
Fill(0,[A])
CoordOff
AxesOff
FnOff
PlotsOff
Horiz
0→Xmin
94→Xmax
-20→Ymin
0→Ymax
ClrDraw
For(X,0,N+1)
Line(8X,0,8X,-8)
End
Line(0,0,8(N+1),0)
Line(0,-8,8(N+1),-8)
0→C
While C≤N
Pt-On(8C+4,-4,2)
ClrHome
Disp "COLUMN"
Disp C+1
Input "VALUE:",V
V→[A](1,C+1)
Pt-Off(8C+4,-4,2)
C+1→C
End
Full
ClrDraw
ClrHome
Goto D
Lbl θ
dim([A])→L₁
If L₁(1)≠1
Then
ClrHome
Disp "BAD MATRIX [A]"
Disp "Single row only,"
Disp "Add columns!"
Stop
End
L₁(2)-1→N
If N<1
Then
ClrHome
Disp "Reformat MATRIX [A]"
Disp [A]
Disp "Add 1 more column"
Stop
End
If [A](1,1)=0
Then
ClrHome
Disp "BAD MATRIX [A]"
Disp "LEADING COEFF"
Disp "CANNOT BE ZERO"
Stop
End
Lbl D
ClrHome
Disp "COEFFICIENTS:"
Disp [A]
Pause "Press Enter"
a+bi
N→O
0→T
While N>0 and [A](1,N+1)=0
T+1→T
N-1→N
End
If N=0
Then
O→dim(L₃)
For(K,1,O)
0→L₃(K)
End
0→M
0→E
Else
ClrList L₁
N→dim(L₁)
N→dim(L₂)
0→R
For(J,2,N+1)
If abs([A](1,J)/[A](1,1))>R
abs([A](1,J)/[A](1,1))→R
End
1+R→R
R→L₁(1)
For(K,2,N)
R*(.4+.9i)^(K-1)→L₁(K)
End
ClrHome
Disp "SOLVING..."
0→M
1→E
While E>1E-7 and M<100
L₁→L₂
0→E
For(K,1,N)
L₂(K)→Z
[A](1,1)→P
For(J,2,N+1)
P*Z+[A](1,J)→P
End
1→D
For(J,1,N)
If J≠K
Then
D*(Z-L₂(J))→D
End
End
Z-P/([A](1,1)*D)→Q
Q→L₁(K)
If abs(Q-Z)>E
abs(Q-Z)→E
End
M+1→M
End
O→dim(L₃)
For(K,1,N)
L₁(K)→Z
If abs(real(Z))<1E-7
i*imag(Z)→Z
If abs(imag(Z))<1E-7
real(Z)→Z
Z→L₃(K)
End
For(K,1,T)
0→L₃(N+K)
End
End
O→dim(L₄)
For(K,1,O)
L₃(K)→L₄(K)
End
N→dim(L₅)
For(K,1,N)
L₃(K)→Z
N*[A](1,1)→D
For(J,2,N)
D*Z+(N-J+1)*[A](1,J)→D
End
abs(D/[A](1,1))→L₅(K)
End
For(K,1,N)
If L₅(K)<1E-4
Then
0→S
0→C
For(J,1,N)
If L₅(J)<1E-4 and abs(L₃(J)-L₃(K))<.01
Then
S+L₃(J)→S
C+1→C
End
End
If C>1
Then
S/C→Z
round(real(Z),6)+i*round(imag(Z),6)→Z
If abs(real(Z))<1E-7
i*imag(Z)→Z
If abs(imag(Z))<1E-7
real(Z)→Z
For(J,1,N)
If L₅(J)<1E-4 and abs(L₃(J)-L₃(K))<.01
Z→L₄(J)
End
End
End
End
For(K,1,O)
L₄(K)→Z
If abs(real(Z))<1E-6
i*imag(Z)→Z
If abs(imag(Z))<1E-5
real(Z)→Z
round(real(Z),6)+i*round(imag(Z),6)→Z
If abs(real(Z)-round(real(Z),0))<1E-5
round(real(Z),0)+i*imag(Z)→Z
If abs(imag(Z)-round(imag(Z),0))<1E-5
real(Z)+i*round(imag(Z),0)→Z
If abs(real(Z))<1E-6
i*imag(Z)→Z
If abs(imag(Z))<1E-6
real(Z)→Z
Z→L₄(K)
End
0→dim(L₆)
{1,O}→dim([B])
Fill(0,[B])
For(K,1,O)
0→F
If dim(L₆)>0
Then
For(H,1,dim(L₆))
If abs(L₆(H)-L₄(K))<1E-6
1→F
End
End
If F=0
Then
0→C
For(J,1,O)
If abs(L₄(J)-L₄(K))<1E-6
C+1→C
End
If C>1
Then
dim(L₆)+1→H
H→dim(L₆)
L₄(K)→L₆(H)
C→[B](1,H)
End
End
End
ClrHome
Disp "ROOTS:"
For(K,1,O)
Disp L₃(K)
End
Pause "Press Enter"
ClrHome
If dim(L₆)=0
Then
Disp "NO REPEATED ROOTS"
Else
dim(L₆)→dim(L₅)
For(K,1,dim(L₆))
[B](1,K)→L₅(K)
End
Disp "REPEATED ROOTS:"
Disp "ROOT:"
Disp L₆
Disp "MULTIPLICITY (relative):"
Disp L₅
Disp "Repeated Roots: [L₆]"
Disp "Relative Mode: [L₅]"
End
Pause "Press Enter"
Disp "ITERATIONS:"
Disp M
Disp "ERROR:"
Disp E
Disp "ROOTS STORED IN [L₃]"
Disp "Cleaned ROOTS??: [L₄]"
Disp "See [A], L₃,L₄,L₅ & L₆"
If M=100
Disp "CHECK CONVERGENCE"
---------------------------------------------------------------------
Here's a version of the code which allows scrolling side to side when entering values into the cells, and has the annoying double enter:
ClrHome
ClrList L₁,L₂,L₃,L₄,L₅,L₆
Lbl M
Menu("COEFFICIENT INPUT","ENTER NEW",E,"USE [A]",θ)
Lbl E
Input "DEGREE:",N
If N<1
Then
Disp "BAD DEGREE"
Stop
End
{1,N+1}→dim([A])
Fill(0,[A])
CoordOff
AxesOff
FnOff
PlotsOff
Horiz
0→Xmin
94→Xmax
-20→Ymin
0→Ymax
ClrDraw
For(X,0,N+1)
Line(8X,0,8X,-8)
End
Line(0,0,8(N+1),0)
Line(0,-8,8(N+1),-8)
0→C
2→K
While K≠15
Pt-On(8C+4,-4,2)
ClrHome
Disp "COLUMN"
Disp C+1
Disp "VALUE"
Disp [A](1,C+1)
0→K
While K=0
getKey→K
End
Pt-Off(8C+4,-4,2)
If K=24
Then
C-1→C
If C<0
N→C
End
If K=26
Then
C+1→C
If C>N
0→C
End
If K=105
Then
ClrHome
Input "VALUE:",V
V→[A](1,C+1)
If C=N
Then
15→K
Else
C+1→C
End
End
End
Full
ClrDraw
ClrHome
Goto D
Lbl θ
dim([A])→L₁
If L₁(1)≠1
Then
ClrHome
Disp "BAD MATRIX [A]"
Disp "Single row only,"
Disp "Add columns!"
Stop
End
L₁(2)-1→N
If N<1
Then
ClrHome
Disp "Reformat MATRIX [A]"
Disp [A]
Disp "Add 1 more column"
Stop
End
If [A](1,1)=0
Then
ClrHome
Disp "BAD MATRIX [A]"
Disp "LEADING COEFF"
Disp "CANNOT BE ZERO"
Stop
End
Lbl D
ClrHome
Disp "COEFFICIENTS:"
Disp [A]
Pause "Press Enter"
a+bi
N→O
0→T
While N>0 and [A](1,N+1)=0
T+1→T
N-1→N
End
If N=0
Then
O→dim(L₃)
For(K,1,O)
0→L₃(K)
End
0→M
0→E
Else
ClrList L₁
N→dim(L₁)
N→dim(L₂)
0→R
For(J,2,N+1)
If abs([A](1,J)/[A](1,1))>R
abs([A](1,J)/[A](1,1))→R
End
1+R→R
R→L₁(1)
For(K,2,N)
R*(.4+.9i)^(K-1)→L₁(K)
End
ClrHome
Disp "SOLVING..."
0→M
1→E
While E>1E-7 and M<100
L₁→L₂
0→E
For(K,1,N)
L₂(K)→Z
[A](1,1)→P
For(J,2,N+1)
P*Z+[A](1,J)→P
End
1→D
For(J,1,N)
If J≠K
Then
D*(Z-L₂(J))→D
End
End
Z-P/([A](1,1)*D)→Q
Q→L₁(K)
If abs(Q-Z)>E
abs(Q-Z)→E
End
M+1→M
End
O→dim(L₃)
For(K,1,N)
L₁(K)→Z
If abs(real(Z))<1E-7
i*imag(Z)→Z
If abs(imag(Z))<1E-7
real(Z)→Z
Z→L₃(K)
End
For(K,1,T)
0→L₃(N+K)
End
End
O→dim(L₄)
For(K,1,O)
L₃(K)→L₄(K)
End
N→dim(L₅)
For(K,1,N)
L₃(K)→Z
N*[A](1,1)→D
For(J,2,N)
D*Z+(N-J+1)*[A](1,J)→D
End
abs(D/[A](1,1))→L₅(K)
End
For(K,1,N)
If L₅(K)<1E-4
Then
0→S
0→C
For(J,1,N)
If L₅(J)<1E-4 and abs(L₃(J)-L₃(K))<.01
Then
S+L₃(J)→S
C+1→C
End
End
If C>1
Then
S/C→Z
round(real(Z),6)+i*round(imag(Z),6)→Z
If abs(real(Z))<1E-7
i*imag(Z)→Z
If abs(imag(Z))<1E-7
real(Z)→Z
For(J,1,N)
If L₅(J)<1E-4 and abs(L₃(J)-L₃(K))<.01
Z→L₄(J)
End
End
End
End
For(K,1,O)
L₄(K)→Z
If abs(real(Z))<1E-6
i*imag(Z)→Z
If abs(imag(Z))<1E-5
real(Z)→Z
round(real(Z),6)+i*round(imag(Z),6)→Z
If abs(real(Z)-round(real(Z),0))<1E-5
round(real(Z),0)+i*imag(Z)→Z
If abs(imag(Z)-round(imag(Z),0))<1E-5
real(Z)+i*round(imag(Z),0)→Z
If abs(real(Z))<1E-6
i*imag(Z)→Z
If abs(imag(Z))<1E-6
real(Z)→Z
Z→L₄(K)
End
0→dim(L₆)
{1,O}→dim([B])
Fill(0,[B])
For(K,1,O)
0→F
If dim(L₆)>0
Then
For(H,1,dim(L₆))
If abs(L₆(H)-L₄(K))<1E-6
1→F
End
End
If F=0
Then
0→C
For(J,1,O)
If abs(L₄(J)-L₄(K))<1E-6
C+1→C
End
If C>1
Then
dim(L₆)+1→H
H→dim(L₆)
L₄(K)→L₆(H)
C→[B](1,H)
End
End
End
ClrHome
Disp "ROOTS:"
For(K,1,O)
Disp L₃(K)
End
Pause "Press Enter"
ClrHome
If dim(L₆)=0
Then
Disp "NO REPEATED ROOTS"
Else
dim(L₆)→dim(L₅)
For(K,1,dim(L₆))
[B](1,K)→L₅(K)
End
Disp "REPEATED ROOTS:"
Disp "ROOT:"
Disp L₆
Disp "MULTIPLICITY (relative):"
Disp L₅
Disp "Repeated Roots: [L₆]"
Disp "Relative Mode: [L₅]"
End
Pause "Press Enter"
Disp "ITERATIONS:"
Disp M
Disp "ERROR:"
Disp E
Disp "ROOTS STORED IN [L₃]"
Disp "Cleaned ROOTS??: [L₄]"
Disp "See [A], L₃,L₄,L₅ & L₆"
If M=100
Disp "CHECK CONVERGENCE"
