XProfan

WindowTitle "Linearer Fit, Quadradischer, kubischer, quartischer und quintischer "+\
"Parabel-Fit nach Methode Tandon-Vieta: SCHEINT ZU KLAPPEN!"
'Q: Q5L1 von DrJames Tanton
'(CL) 2016-07 CopyLeft by P.Specht, Wien. No Warranty whatsoever! Ohne jede Gewähr!
WindowStyle 24:Window 0,0-%maxx,%maxy
var xh&=width(%hwnd)\2:var yh&=height(%hwnd)\2
declare x!,y!, x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!,x6!,y6!
var u!=20:var v!=20:var w!=30'Maßstäbe für x,y und Granularity
'Testpunkte (1. bis n+1. Punkt), die von den Polynomen n. Ordnung zu treffen sind:
case 0:goto "TestSet2"
x1!=0:y1!=5
x2!=10:y2!=2
x3!=3:y3!=7
x4!=8:y4!=4
x5!=-10:y5!=4
x6!=-5:y6!=-6
goto "Weiter"
Testset2:
x1!=0:y1!=5
x2!=-10:y2!=2
x3!=-3:y3!=7
x4!=-8:y4!=4
x5!=10:y5!=4
x6!=-5:y6!=-6
Weiter:

proc funk1 :parameters x! ,x1!,y1!,x2!,y2!

    return y1!*(x!-x2!)/(x1!-x2!) \
    + y2!*(x!-x1!)/(x2!-x1!)

endproc

proc funk2 :parameters x! ,x1!,y1!,x2!,y2!,x3!,y3!

    return y1!*(x!-x2!)*(x!-x3!)/((x1!-x2!)*(x1!-x3!)) \
    + y2!*(x!-x1!)*(x!-x3!)/((x2!-x1!)*(x2!-x3!)) \
    + y3!*(x!-x1!)*(x!-x2!)/((x3!-x1!)*(x3!-x2!))

endproc

proc funk3 :parameters x! ,x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!

    return \
    y1!*(x!-x2!)*(x!-x3!)*(x!-x4!)/((x1!-x2!)*(x1!-x3!)*(x1!-x4!)) \
    + y2!*(x!-x1!)*(x!-x3!)*(x!-x4!)/((x2!-x1!)*(x2!-x3!)*(x2!-x4!)) \
    + y3!*(x!-x1!)*(x!-x2!)*(x!-x4!)/((x3!-x1!)*(x3!-x2!)*(x3!-x4!)) \
    + y4!*(x!-x1!)*(x!-x2!)*(x!-x3!)/((x4!-x1!)*(x4!-x2!)*(x4!-x3!))

endproc

proc funk4 :parameters x! ,x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!

    return y1!*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)/((x1!-x2!)*(x1!-x3!)*(x1!-x4!)*(x1!-x5!)) \
    + y2!*(x!-x1!)*(x!-x3!)*(x!-x4!)*(x!-x5!)/((x2!-x1!)*(x2!-x3!)*(x2!-x4!)*(x2!-x5!)) \
    + y3!*(x!-x1!)*(x!-x2!)*(x!-x4!)*(x!-x5!)/((x3!-x1!)*(x3!-x2!)*(x3!-x4!)*(x3!-x5!)) \
    + y4!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x5!)/((x4!-x1!)*(x4!-x2!)*(x4!-x3!)*(x4!-x5!)) \
    + y5!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)/((x5!-x1!)*(x5!-x2!)*(x5!-x3!)*(x5!-x4!))

endproc

proc funk5 :parameters x! ,x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!,x6!,y6!

    return \
    y1!*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x6!)/((x1!-x2!)*(x1!-x3!)*(x1!-x4!)*(x1!-x5!)*(x1!-x6!))\
    +y2!*(x!-x1!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x6!)/((x2!-x1!)*(x2!-x3!)*(x2!-x4!)*(x2!-x5!)*(x2!-x6!))\
    +y3!*(x!-x1!)*(x!-x2!)*(x!-x4!)*(x!-x5!)*(x!-x6!)/((x3!-x1!)*(x3!-x2!)*(x3!-x4!)*(x3!-x5!)*(x3!-x6!))\
    +y4!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x5!)*(x!-x6!)/((x4!-x1!)*(x4!-x2!)*(x4!-x3!)*(x4!-x5!)*(x4!-x6!))\
    +y5!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x6!)/((x5!-x1!)*(x5!-x2!)*(x5!-x3!)*(x5!-x4!)*(x5!-x6!))\
    +y6!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)/((x6!-x1!)*(x6!-x2!)*(x6!-x3!)*(x6!-x4!)*(x6!-x5!))

endproc

'---------------------------------------------------------
Cls
usepen 0,1,0:line 0,yh& - 2*xh&,yh&:line xh&,0 - xh&,2*yh&
usepen 0,6,rgb(0,0,255)
line xh&+u!*x1!,(yh&-v!*y1!) - xh&+u!*x1!+1,(yh&-v!*y1!):drawtext xh&+u!*x1!,yh&-v!*y1!-26,"1"
line xh&+u!*x2!,(yh&-v!*y2!) - xh&+u!*x2!+1,(yh&-v!*y2!):drawtext xh&+u!*x2!,yh&-v!*y2!-26,"2"
line xh&+u!*x3!,(yh&-v!*y3!) - xh&+u!*x3!+1,(yh&-v!*y3!):drawtext xh&+u!*x3!,yh&-v!*y3!-26,"3"
line xh&+u!*x4!,(yh&-v!*y4!) - xh&+u!*x4!+1,(yh&-v!*y4!):drawtext xh&+u!*x4!,yh&-v!*y4!-26,"4"
line xh&+u!*x5!,(yh&-v!*y5!) - xh&+u!*x5!+1,(yh&-v!*y5!):drawtext xh&+u!*x5!,yh&-v!*y5!-26,"5"
line xh&+u!*x6!,(yh&-v!*y6!) - xh&+u!*x6!+1,(yh&-v!*y6!):drawtext xh&+u!*x6!,yh&-v!*y6!-26,"6"
usepen 0,2,rgb(255,0,0)

whileloop -1000,1000:x!=&Loop/w!

    y!=funk1(x!, x1!,y1!,x2!,y2!)
    line xh&+u!*x!,(yh&-v!*y!) - xh&+u!*x!+1,(yh&-v!*y!)

endwhile

usepen 0,2,rgb(255,200,0)

whileloop -1000,1000:x!=&Loop/w!

    y!=funk2(x!, x1!,y1!,x2!,y2!,x3!,y3!)
    line xh&+u!*x!,(yh&-v!*y!) - xh&+u!*x!+1,(yh&-v!*y!)

endwhile

usepen 0,2,rgb(255,0,200)

whileloop -1000,1000:x!=&Loop/w!

    y!=funk3(x!, x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!)
    line xh&+u!*x!,(yh&-v!*y!) - xh&+u!*x!+1,(yh&-v!*y!)

endwhile

usepen 0,2,rgb(0,100,250)

whileloop -1000,1000:x!=&Loop/w!

    y!=funk4(x!, x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!)
    line xh&+u!*x!,(yh&-v!*y!) - xh&+u!*x!+1,(yh&-v!*y!)

endwhile

usepen 0,4,rgb(100,100,100)

whileloop -1000,1000:x!=&Loop/w!

    y!=funk5(x!, x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!,x6!,y6!)
    case &Loop=-1000:moveto xh&+u!*x!,(yh&-v!*y!)
    lineto xh&+u!*x!,(yh&-v!*y!)

endwhile

sound 2000,50
waitinput