PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Polinomic equations resolution (upto 4th degree)

https://www.purebasic.fr/english/viewtopic.php?t=17404

Page 1 of 1

Polinomic equations resolution (upto 4th degree)

Posted: Fri Oct 28, 2005 8:36 pm
by Psychophanta
Code updated For 5.20+

Code: Select all

;Program to solve cuadratic, cubic, squared, and linear polinomic equations:
;By Albert 'Psychophanta' (Oct-2005)
;***************************************************
;-User interface:
Enumeration
  #Window_0
EndEnumeration
Enumeration
  #Text_0
  #String_0
  #String_1
  #String_2
  #String_3
  #String_4
  #Text_1
  #Text_2
  #Text_3
  #Text_4
  #Text_5
  #Button_0
  #Text_6
  #Text_7
  #Text_8
  #Text_9
  #Text_10
  #Text_11
EndEnumeration
Procedure Open_Window_0()
  If OpenWindow(#Window_0, 269, 187, 449, 163, "Cuadratic, cubic, squared and linear equations resolution",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
    ;         If CreateGadgetList(WindowID())
    TextGadget(#Text_0, 55, 5, 245, 20, "Input coefficients and push Solve button", #PB_Text_Center)
    StringGadget(#String_0, 5, 30, 60, 25, "")
    StringGadget(#String_1, 95, 30, 60, 25, "")
    StringGadget(#String_2, 185, 30, 60, 25, "")
    StringGadget(#String_3, 275, 30, 60, 25, "")
    StringGadget(#String_4, 355, 30, 60, 25, "")
    TextGadget(#Text_1, 5, 65, 55, 20, "Solutions:")
    TextGadget(#Text_2, 65, 65, 345, 20, "")
    TextGadget(#Text_3, 65, 90, 345, 20, "")
    TextGadget(#Text_4, 65, 115, 345, 20, "")
    TextGadget(#Text_5, 65, 140, 345, 20, "")
    ButtonGadget(#Button_0, 325, 5, 65, 20, "Solve")
    TextGadget(#Text_6, 65, 40, 30, 15, "x^4 +")
    TextGadget(#Text_7, 155, 40, 30, 15, "x^3 +")
    TextGadget(#Text_8, 245, 40, 30, 15, "x^2 +")
    TextGadget(#Text_9, 335, 40, 20, 15, "x +")
    TextGadget(#Text_10, 420, 40, 25, 15, " = 0")
    TextGadget(#Text_11, 60, -60, 530, 20, "")
    ;         EndIf
  EndIf
EndProcedure
;END User Interface
DefType .f
Open_Window_0()
Repeat
  EventID.l=WaitWindowEvent()
  If EventID=#PB_Event_Gadget:EGID.l=EventGadget():EndIf
  If EGID.l=#Button_0
    a.f=ValF(GetGadgetText(#String_0))
    b.f=ValF(GetGadgetText(#String_1))
    c.f=ValF(GetGadgetText(#String_2))
    d.f=ValF(GetGadgetText(#String_3))
    e.f=ValF(GetGadgetText(#String_4))
    Gosub solve
    SetGadgetText(#Text_2,sol1.s)
    SetGadgetText(#Text_3,sol2.s)
    SetGadgetText(#Text_4,sol3.s)
    SetGadgetText(#Text_5,sol4.s)
  EndIf
Until EventID=#PB_Event_CloseWindow
End
solve:
If a<>0:Gosub cuartic
  sol1.s=StrF(x1.f)
  sol2.s=StrF(x2.f)
  sol3.s=StrF(x3.f)
  sol4.s=StrF(x4.f)
ElseIf b<>0:a=b:b=c:c=d:d=e:Gosub cubic
  sol1.s=StrF(x1)
  sol2.s=StrF(x2)+"+("+StrF(t4.f)+"·i)"
  sol3.s=StrF(x3)+"-("+StrF(t4)+"·i)"
  sol4.s=""
ElseIf c<>0:a=c:b=d:c=e:Gosub square
  sol1.s=StrF(x1)
  sol2.s=StrF(x2)
  sol3.s="":sol4.s=""
ElseIf d<>0:a=d:b=e:Gosub linear
  sol1.s=StrF(x1)
  sol2.s="":sol3.s="":sol4.s=""
ElseIf e<>0
  sol1.s="Impossible!"
  sol2.s="":sol3.s="":sol4.s=""
Else
  sol1.s="0":sol2.s="0":sol3.s="0":sol4.s="0"
EndIf
Return
; Ecuacion lineal  --------------------------------
linear:
x1.f=-b/a
Return
; Ecuacion cuadrada  ------------------------------
square:
x1.f=(-b+Sqr(b*b-4*a*c))/2/a
x2=(-b-Sqr(b*b-4*a*c))/2/a
Return
; Ecuacion cubica  --------------------------------
cubic:
t1.f=Sqr(4*Pow(-b*b+3*a*c,3)+Pow(-2*b*b*b+9*a*b*c-27*a*a*d,2))
t0.f=Pow(-2*b*b*b+9*a*b*c-27*a*a*d+t1.f,1/3)
t2.f=(-b*b+3*a*c)/3/a/Pow(2,2/3)/t0
t3.f=t0/6/a/Pow(2,1/3)
t4=Sqr(3)*t2+Sqr(3)*t3
x1=-b/3/a-Pow(2,1/3)*(-b*b+3*a*c)/3/a/t0+t0/3/a/Pow(2,1/3)
;soluciones complejas:
x2.f=-b/3/a+t2-t3;+t4*i
x3.f=-b/3/a+t2-t3;-t4*i
Return
; Ecuacion cuartica --------------------------------
cuartic:
t4.f=2*c*c*c-9*b*c*d+27*a*d*d+27*b*b*e-72*a*c*e
t0.f=Sqr(-4*Pow(c*c-3*b*d+12*a*e,3)+Pow(t4,2))
t3.f=-b*b*b/a/a/a+4*b*c/a/a-8*d/a
t6.f=Pow(t4+t0.f,1/3)/3/a/Pow(2,1/3)
t7.f=b*b/2/a/a-4*c/3/a
t1.f=Pow(2,1/3)*(c*c-3*b*d+12*a*e)/3/a/Pow(t4+t0.f,1/3)
t2.f=-b/4/a
t5.f=Sqr(b*b/4/a/a-2*c/3/a+t1.f+t6.f)
x1.f=t2.f-1/2*t5.f-1/2*Sqr(t7.f-t1.f-t6.f-t3.f/4/t5.f)
x2.f=t2.f-1/2*t5.f+1/2*Sqr(t7.f-t1.f-t6.f-t3.f/4/t5.f)
x3.f=t2.f+1/2*t5.f-1/2*Sqr(t7.f-t1.f-t6.f+t3.f/4/t5.f)
x4.f=t2.f+1/2*t5.f+1/2*Sqr(t7.f-t1.f-t6.f+t3.f/4/t5.f)
Return
:wink:

Posted: Fri Oct 28, 2005 9:15 pm
by netmaestro
Image

Posted: Fri Oct 28, 2005 9:26 pm
by Psychophanta
Well, that equation has no solution, so then no solutions are the result.
Ok, i'll do it more elegant.
Edit:
That's it:

Code: Select all

;Program to solve cuadratic, cubic, squared, and linear polinomic equations:
;By Albert 'Psychophanta' (Oct-2005)
;***************************************************
Procedure.s FloatToFraction(n.d)
  decimales.d=n-Int(n)
  denominador.d=Pow(10,Len(StrD(decimales))-2)
  numerador.d=Int(n*denominador.d)
  d.l=100
  Repeat
    While numerador/d=Int(numerador/d) And denominador/d=Int(denominador/d)
      numerador/d:denominador/d
    Wend
    d.l-1
  Until d.l=1
  If numerador.d-Int(numerador.d)<0.0001:numerador.d=Int(numerador.d)
  ElseIf numerador.d-Int(numerador.d)>0.9999:If numerador.d<0:numerador.d=Int(numerador.d-1):Else:numerador.d=Int(numerador.d+1):EndIf
  EndIf
  If denominador.d-Int(denominador.d)<0.0001:denominador.d=Int(denominador.d)
  ElseIf denominador.d-Int(denominador.d)>0.9999:If denominador.d<0:denominador.d=Int(denominador.d-1):Else:denominador.d=Int(denominador.d+1):EndIf
  EndIf
  If numerador.d<0.0001 And numerador.d>-0.0001:ProcedureReturn "0"
  ElseIf denominador.d<1.0001 And denominador.d>0.9999:ProcedureReturn Str(numerador.d)
  Else:ProcedureReturn Str(numerador.d)+" / "+Str(denominador.d)
  EndIf
EndProcedure
;-User interface:
Enumeration
  #Window_0
EndEnumeration
Enumeration
  #Text_0
  #String_0
  #String_1
  #String_2
  #String_3
  #String_4
  #Text_1
  #Text_2
  #Text_3
  #Text_4
  #Text_5
  #Button_0
  #Text_6
  #Text_7
  #Text_8
  #Text_9
  #Text_10
  #Text_11
EndEnumeration
Procedure Open_Window_0()
  If OpenWindow(#Window_0, 269, 187, 449, 163,  #PB_Window_SystemMenu | #PB_Window_TitleBar , "Cuadratic, cubic, squared and linear polinomic equations resolution")
    If CreateGadgetList(WindowID(#Window_0))
      TextGadget(#Text_0, 55, 5, 245, 20, "Input coefficients and push Solve button", #PB_Text_Center)
      StringGadget(#String_0, 5, 30, 58, 20, "")
      StringGadget(#String_1, 95, 30, 58, 20, "")
      StringGadget(#String_2, 185, 30, 58, 20, "")
      StringGadget(#String_3, 275, 30, 58, 20, "")
      StringGadget(#String_4, 355, 30, 58, 20, "")
      TextGadget(#Text_1, 5, 60, 50, 20, "Solutions:")
      TextGadget(#Text_2, 54, 70, 340, 20, "")
      TextGadget(#Text_3, 54, 92, 340, 20, "")
      TextGadget(#Text_4, 54, 114, 340, 20, "")
      TextGadget(#Text_5, 54, 136, 340, 20, "")
      ButtonGadget(#Button_0, 400, 60, 40, 95, "Solve")
      TextGadget(#Text_6, 65, 34, 30, 15, "x^4 +")
      TextGadget(#Text_7, 155, 34, 30, 15, "x^3 +")
      TextGadget(#Text_8, 245, 34, 30, 15, "x^2 +")
      TextGadget(#Text_9, 335, 34, 20, 15, "x +")
      TextGadget(#Text_10, 415, 34, 25, 15, " = 0")
      TextGadget(#Text_11, 60, -60, 530, 20, "")
    EndIf
  EndIf
EndProcedure
;END User Interface
Define .d
Open_Window_0()
Repeat
  EventID.l=WaitWindowEvent()
  If EventID=#PB_Event_Gadget:EGID.l=EventGadget():EndIf
  If EGID.l=#Button_0
    a.d=ValF(GetGadgetText(#String_0))
    b.d=ValF(GetGadgetText(#String_1))
    c.d=ValF(GetGadgetText(#String_2))
    d.d=ValF(GetGadgetText(#String_3))
    e.d=ValF(GetGadgetText(#String_4))
    Gosub solve
    SetGadgetText(#Text_2,sol1.s)
    SetGadgetText(#Text_3,sol2.s)
    SetGadgetText(#Text_4,sol3.s)
    SetGadgetText(#Text_5,sol4.s)
  EndIf
Until EventID=#PB_Event_CloseWindow
End
solve:
  sol2.s="":sol3.s="":sol4.s=""
  If a<>0:Gosub cuartic
    sol1.s=FloatToFraction(x1)
    If x1<>x2:sol2.s=FloatToFraction(x2):EndIf
    sol3.s=FloatToFraction(x3)
    If x3<>x4:sol4.s=FloatToFraction(x4):EndIf
  ElseIf b<>0:a=b:b=c:c=d:d=e:Gosub cubic
    sol1.s=FloatToFraction(x1)
    sol2.s=FloatToFraction(x2)+" + ("+FloatToFraction(t4)+"·i)"
    sol3.s=FloatToFraction(x3)+" - ("+FloatToFraction(t4)+"·i)"
  ElseIf c<>0:a=c:b=d:c=e:Gosub square
    sol1.s=FloatToFraction(x1)
    If x1<>x2:sol2.s=FloatToFraction(x2):EndIf
  ElseIf d<>0:a=d:b=e:Gosub linear
    sol1.s=FloatToFraction(x1)
  ElseIf e<>0
    sol1.s="Impossible!"
  Else
    sol1.s="0"
  EndIf
  If x1+1=x1:sol1.s="----":EndIf
  If x2+1=x2:sol2.s="----":EndIf
  If x3+1=x3:sol3.s="----":EndIf
  If x4+1=x4:sol4.s="----":EndIf
Return
; Ecuacion lineal  --------------------------------
linear:
x1.d=-b/a:x2.d=0:x3.d=0:x4.d=0
Return
; Ecuacion cuadrada  ------------------------------
square:
x1.d=(-b+Sqr(b*b-4*a*c))/2/a
x2.d=(-b-Sqr(b*b-4*a*c))/2/a
x3.d=0
x4.d=0
Return
; Ecuacion cubica  --------------------------------
cubic:
  t1.d=Sqr(4*Pow(-b*b+3*a*c,3)+Pow(-2*b*b*b+9*a*b*c-27*a*a*d,2))
  t0.d=Pow(-2*b*b*b+9*a*b*c-27*a*a*d+t1.d,1/3)
  t2.d=(-b*b+3*a*c)/3/a/Pow(2,2/3)/t0
  t3.d=t0/6/a/Pow(2,1/3)
  t4.d=Sqr(3)*t2+Sqr(3)*t3
  x1.d=-b/3/a-Pow(2,1/3)*(-b*b+3*a*c)/3/a/t0+t0/3/a/Pow(2,1/3)
;soluciones complejas:
  x2.d=-b/3/a+t2-t3; +t4*i
  x3.d=-b/3/a+t2-t3; -t4*i
  x4.d=0
Return
; Ecuacion cuartica --------------------------------
cuartic:
  t4.d=2*c*c*c-9*b*c*d+27*a*d*d+27*b*b*e-72*a*c*e
  t0.d=Sqr(-4*Pow(c*c-3*b*d+12*a*e,3)+Pow(t4,2))
  t3.d=-b*b*b/a/a/a+4*b*c/a/a-8*d/a
  t6.d=Pow(t4+t0.d,1/3)/3/a/Pow(2,1/3)
  t7.d=b*b/2/a/a-4*c/3/a
  t1.d=Pow(2,1/3)*(c*c-3*b*d+12*a*e)/3/a/Pow(t4+t0.d,1/3)
  t2.d=-b/4/a
  t5.d=Sqr(b*b/4/a/a-2*c/3/a+t1.d+t6.d)
  x1.d=t2.d-1/2*t5.d-1/2*Sqr(t7.d-t1.d-t6.d-t3.d/4/t5.d)
  x2.d=t2.d-1/2*t5.d+1/2*Sqr(t7.d-t1.d-t6.d-t3.d/4/t5.d)
  x3.d=t2.d+1/2*t5.d-1/2*Sqr(t7.d-t1.d-t6.d+t3.d/4/t5.d)
  x4.d=t2.d+1/2*t5.d+1/2*Sqr(t7.d-t1.d-t6.d+t3.d/4/t5.d)
Return
Not a very elegant in coding aspect, but absolutely efficient :wink:
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited