пятница, 12 февраля 2016 г.

Построение графиков функций сплайнами.

Скрипт писался давно, в основном, для самообучения, поэтому многие моменты очень просто написаны.
Скрипт умеет строить:
- колебательную функцию f(x) = A*sin(X*T+W)
- считать интегралы численным методом (требуется перепроверка)
- строит производные (первую, вторую и третью)
- умеет производить интерполяцию по формуле Тейлора

----------------------------------------------------------------------------
 rollout FuncCreator "FuncCreator" width:400
(
  
    local BIG_NUMBER = 10000000,
            theNewSpline
    group "Parameters"
    (
        label func "f(x) = A*sin(X*T+W)" align:#center
        label lbl0 "-------------------------------------" align:#center
        spinner startX "StartX:  " width:120    range:[-BIG_NUMBER,BIG_NUMBER,0.0] type:#float align:#right across:3
        spinner endX "EndX:" width:120  range:[-BIG_NUMBER,BIG_NUMBER,2.0*pi] type:#float align:#right
        spinner deltaX "dX(step): " width:120 range:[0.01,BIG_NUMBER,0.1] type:#float   align:#right
        label lbl1 "-------------------------------------" align:#center
        spinner amplit "A:" width:120  range:[-BIG_NUMBER,BIG_NUMBER,1.0] type:#float align:#right across:3
        spinner period "T:" width:120  range:[0.01,BIG_NUMBER,1.0] type:#float align:#right
        spinner fasa "W:" width:120  range:[-BIG_NUMBER,BIG_NUMBER,0.0] type:#float align:#right
        label lbl2 "-------------------------------------" align:#center
        spinner gspace "GridSpacing:" width:120  range:[0.1,BIG_NUMBER,1.0] type:#float align:#center across:3
        button theRes "Reset" width:100 align:#center
        button delAll "deleteAll" width:100 align:#center
        label knotCount "knotCount: " align:#left
        label PTS "Processing took  --  seconds" align:#left
        )

    group "Integrals"
    (
    label rungekuta "MonteKarlo calculation: " align:#left
    label simpson "Simpson calculation: " align:#left
    label integralPro "intTrapec calculation: " align:#left
    )  
    group "Proisvodnaya"
    (
    checkbutton pr01 "Pro 1" checked:false width:100 align:#center enabled:false across:3
    checkbutton pr02 "Pro 2" checked:false width:100 align:#center enabled:false
    checkbutton pr03 "Pro 3" checked:false width:100 align:#center enabled:false
    )
    group "Teylor"
    (
    label funcTeylor "g(x) = f(a) + fpro1(a)*(x-a) + fpro2(a)*(x-a)^2/2factorial + fpro3(a)*(x-a)^3/3factorial" align:#center
    label lbl3 "-------------------------------------" align:#center
    spinner theA "a:" width:120  range:[-BIG_NUMBER,BIG_NUMBER,0.0] type:#float align:#left
    )
    group "Interpolation"
    (
    label lbl4a "cub interpolation" align:#center across:3
    label lbl6 "parab interpolation" align:#center
    label lbl6a " " align:#center
    spinner theSP1 "startPointCI:" width:100  range:[-BIG_NUMBER,BIG_NUMBER,0.0] type:#float align:#left across:3
    spinner theSP2 "startPointPI:" width:100  range:[-BIG_NUMBER,BIG_NUMBER,0.0] type:#float align:#left
    spinner theStepSP "dx/step:" width:100  range:[1.0, 5.0,1.0] type:#float align:#left
    label lbl7a "-------------------------------------" align:#center  
    label lbl7 "Mult interpolation" align:#center across:3
    spinner theSP3 "startPointMI:" width:100  range:[-BIG_NUMBER,BIG_NUMBER,0.0] type:#float align:#left
    spinner numI "numSLAU:" width:100  range:[2, 200, 4] type:#integer align:#left
    )
--*********************************************************************************
fn theFunc theX = return (amplit.value*sin (RadToDeg(theX*period.value+fasa.value)))
--*********************************************************************************
fn slauGauss  theSystem =
(
    local a11 = theSystem[1][1], a12 = theSystem[1][2], a13 = theSystem[1][3], a14 = theSystem[1][4], b1 = theSystem[1][5],
            a21 = theSystem[2][1], a22 = theSystem[2][2], a23 = theSystem[2][3], a24 = theSystem[2][4], b2 = theSystem[2][5],
            a31 = theSystem[3][1], a32 = theSystem[3][2], a33 = theSystem[3][3], a34 = theSystem[3][4], b3 = theSystem[3][5],
            a41 = theSystem[4][1], a42 =theSystem[4][2], a43 =theSystem[4][3], a44 = theSystem[4][4], b4 = theSystem[4][5]
  
    local aa12 = a12/a11, aa13 = a13/a11, aa14 = a14/a11, bb1 = b1/a11
    --   x1 = -aa12*x2 - aa13*x3 - aa14*x4 + bb1
    local aa22 = a22 - a21*aa12, aa23 = a23 - a21*aa13, aa24 = a24 - a21*aa14, bb2 = b2 - a21*bb1,
            aa32 = a32 - a31*aa12, aa33 = a33 - a31*aa13, aa34 = a34 - a31*aa14, bb3 = b3 - a31*bb1,
            aa42 = a42 - a41*aa12, aa43 = a43 - a41*aa13, aa44 = a44 - a41*aa14, bb4 = b4 - a41*bb1
    -------------------------------------------
    local aaa23 = aa23/aa22, aaa24 = aa24/aa22, bbb2 = bb2/aa22
    --  x2 = -aaa23*x3 - aaa24*x4 + bbb2
    local aaa33 = aa33 - aa32*aaa23, aaa34 = aa34 - aa32*aaa24, bbb3 = bb3 - aa32*bbb2,
            aaa43 = aa43 - aa42*aaa23, aaa44 = aa44 - aa42*aaa24, bbb4 = bb4 - aa42*bbb2
    --------------------------------------------
    local aaaa34 = aaa34/aaa33, bbbb3 = bbb3/aaa33
    --  x3 = -aaaa34*x4 + bbbb3
    local aaaa44 = aaa44 - aaa43*aaaa34, bbbb4 = bbb4 - aaa43*bbbb3
    -------------------------------------------
    local x4 = bbbb4/aaaa44,
            x3 = -aaaa34*x4 + bbbb3,
            x2 = -aaa23*x3 - aaa24*x4 + bbb2,
            x1 = -aa12*x2 - aa13*x3 - aa14*x4 + bb1
    local theOut = #()
    append theOut x1
    append theOut x2
    append theOut x3
    append theOut x4
    return(theOut)
    )  
--*****************************matrix***********************************************
--*********************************************************************************
fn addGaussGetX A B x4 =
(
    local n = A.count,
            arX = #()
    for i = 1 to n+1 do append arX x4
  
    for i = n to 1 by -1 do
    (
        local sum=0.0
        for j = i to n do    sum += arX[j+1] * A[i][j+1-i]
      
        arX[i] = B[i] - sum
        )
    return arX
    )
--+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
fn slauGaussU  A B num =
(
    local n = A.count
  
    if n == num do global addGaussA = #(), addGaussB = #()
  
    if n == 1 then
    (
        local theXn = B[1]/A[1][1],
                otvet = addGaussGetX addGaussA addGaussB theXn
        return otvet
        )else
        (
            local arrayA = #(),
                     arrayB = #(),
                     arrayA1 = #()
                --***************************
                local b1 = B[1]/A[1][1]
                append addGaussB b1
                -----------------------
                for i = 2 to n do append arrayB (B[i] - A[i][1]*b1)
                --***************************
                for i = 2 to n do append arrayA1 (A[1][i]/A[1][1])
                append addGaussA (deepcopy arrayA1)
                -----------------------
                for i = 2 to n do
                (
                    local arrayA2 = #()
                    for j = 2 to n do append arrayA2 (A[i][j] - A[i][1]*arrayA1[j-1])
                    append arrayA (deepcopy arrayA2)
                    )
                -----------------------
            slauGaussU  arrayA  arrayB num
            )
    )  
--++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
--***********************************************************************************
--+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
fn multMatNumber theM theNum =
(
        local theNewMatrix = #()
        local numStolb = theM[1].count
        local numLines = theM.count
  
        for i = 1 to numLines do (append theNewMatrix  #())
      
        for i = 1 to numLines do
        (
            for j = 1 to numStolb do theNewMatrix[i][j] = theNum*theM[i][j]
            )
        return (theNewMatrix)
    )
--+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
fn multLine A B =
(
    local sumRes = 0, num = A.count
    for i = 1 to num do sumRes += A[i]*B[i]
    return (sumRes)
    )
--+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
fn getMatrixStolb theMatrix num =
(
    local numS = theMatrix[1].count,
             numL = theMatrix.count,
             theNewStolb = #()
    for i = 1 to numL do
    (
        for j = 1 to numS do
            if j == num do append theNewStolb theMatrix[i][j]
        )
    return (theNewStolb)
    )
--+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    fn multMatrix A B =
    (
        local theNewMatrix = #()
        local numStolb = B[1].count
        local numLines = B.count
      
        if A[1].count == B.count then
        (
            for i = 1 to numLines do (append theNewMatrix  #())
          
            for i = 1 to numLines do
            (
                for j = 1 to numStolb do
                    theNewMatrix[i][j] = multLine A[i] (getMatrixStolb B j)
                )
            return (theNewMatrix)
            ) else return (undefined)
        )
--+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
--*****************************end matrix*******************************************
  
--***********************************************************************************************************
fn parabInterpol theColor =
(
    local splinePar = SplineShape name: (uniquename "funcParab")
    addNewSpline splinePar
    local x1 = theSP2.value,
            x2 = theSP2.value+deltaX.value,
            x3 = theSP2.value+2.0*deltaX.value
    local y1 = theFunc x1,
            y2 = theFunc x2,
            y3 = theFunc x3
local sp1 = sphere name: (uniquename "sp") radius:0.02 pos: [x1,0.0, y1],
        sp2 = sphere name: (uniquename "sp") radius:0.02 pos: [x2,0.0, y2],
        sp3 = sphere name: (uniquename "sp") radius:0.02 pos: [x3,0.0, y3]
  
        if startX.value >  endX.value do
        (
            for x = startX.value to endX.value by -deltaX.value/theStepSP.value do
                addKnot splinePar 1 #corner #line [x,0.0, y1 + (x-x1)*(y2-y1)/deltaX.value + (x-x1)*(x-x2)*(y1-2.0*y2+y3)/(2.0*(deltaX.value^2))]
            )
        if startX.value <  endX.value do
        (
            for x = startX.value to endX.value by deltaX.value/theStepSP.value do
                addKnot splinePar 1 #corner #line [x,0.0, y1 + (x-x1)*(y2-y1)/deltaX.value + (x-x1)*(x-x2)*(y1-2.0*y2+y3)/(2.0*(deltaX.value^2))]
            )
    splinePar.wirecolor = theColor  
    updateShape splinePar
    )
--***********************************************************************************************************
fn opred2 A =
(
    local a1 = A[1][1] as float, b1 = A[1][2] as float,
            a2 = A[2][1] as float, b2 = A[2][2] as float
    local opr = a1*b2 - a2*b1
    return (opr)
    )
--***********************************************************************************************************  
fn opred3 A =
(
    local a1 = A[1][1] as float, b1 = A[1][2] as float, c1 = A[1][3] as float,
            a2 = A[2][1] as float, b2 = A[2][2] as float, c2 = A[2][3] as float,
            a3 = A[3][1] as float, b3 = A[3][2] as float, c3 = A[3][3] as float
    local opr1 = opredel2 #(b2, c2) #(b3, c3),
            opr2 = opredel2 #(a2, c2) #(a3, c3),
            opr3 = opredel2 #(a2, b2) #(a3, b3)
    local opr = a1*opr1 - b1*opr2 + c1*opr3
    return (opr)
    )
--***********************************************************************************************************
fn opred4 A =
(
    local a1 = A[1][1] as float, b1 = A[1][2] as float, c1 = A[1][3] as float, d1 = A[1][4] as float,
            a2 = A[2][1] as float, b2 = A[2][2] as float, c2 = A[2][3] as float, d2 = A[2][4] as float,
            a3 = A[3][1] as float, b3 = A[3][2] as float, c3 = A[3][3] as float, d3 = A[3][4] as float,
            a4 = A[4][1] as float, b4 = A[4][2] as float, c4 = A[4][3] as float, d4 = A[4][4] as float
    local opr1 = opredel3 #(b2, c2, d2) #(b3, c3, d3) #(b4, c4, d4),
            opr2 = opredel3 #(a2, c2, d2) #(a3, c3, d3) #(a4, c4, d4),
            opr3 = opredel3 #(a2, b2, d2) #(a3, b3, d3) #(a4, b4, d4),
            opr4 = opredel3 #(a2, b2, c2) #(a3, b3, c3) #(a4, b4, c4)
    local opr = a1*opr1 - b1*opr2 + c1*opr3 - d1*opr4
    return (opr)
    )
--***********************************************************************************************************  
fn kubInterpol theColor =
(
    local splineInterpol = SplineShape name: (uniquename "funcInterpol")
    addNewSpline splineInterpol
    local x1 = theSP1.value ,
            x2 = theSP1.value+deltaX.value,
            x3 = theSP1.value+2.0*deltaX.value,
            x4 = theSP1.value+3.0*deltaX.value
    local y1 = theFunc x1,
            y2 = theFunc x2,
            y3 = theFunc x3,
            y4 = theFunc x4
    local oprM = opred4 #(#(x1^3, x1^2, x1, 1), #(x2^3, x2^2, x2, 1), #(x3^3, x3^2, x3, 1), #(x4^3, x4^2, x4, 1)),
            oprA = opred4 #(#(y1, x1^2, x1, 1), #(y2, x2^2, x2, 1), #(y3, x3^2, x3, 1), #(y4, x4^2, x4, 1)),
            oprB = opred4 #(#(x1^3, y1, x1, 1), #(x2^3, y2, x2, 1), #(x3^3, y3, x3, 1), #(x4^3, y4, x4, 1)),
            oprC = opred4 #(#(x1^3, x1^2, y1, 1), #(x2^3, x2^2, y2, 1), #(x3^3, x3^2, y3, 1), #(x4^3, x4^2, y4, 1)),
            oprD = opred4 #(#(x1^3, x1^2, x1, y1), #(x2^3, x2^2, x2, y2), #(x3^3, x3^2, x3, y3), #(x4^3, x4^2, x4, y4))
    local theA = oprA/oprM,
            theB = oprB/oprM,
            theC = oprC/oprM,
            theD = oprD/oprM
local sp1 = sphere name: (uniquename "sp") radius:0.02 pos: [x1,0.0, y1],
        sp2 = sphere name: (uniquename "sp") radius:0.02 pos: [x2,0.0, y2],
        sp3 = sphere name: (uniquename "sp") radius:0.02 pos: [x3,0.0, y3],
        sp4 = sphere name: (uniquename "sp") radius:0.02 pos: [x4,0.0, y4]
        if startX.value >  endX.value do
        (
            for x = startX.value to endX.value by -deltaX.value/theStepSP.value do
                addKnot splineInterpol 1 #corner #line [x,0.0, theA*(x^3) + theB*(x^2) + theC*x + theD]
            )
        if startX.value <  endX.value do
        (
            for x = startX.value to endX.value by deltaX.value/theStepSP.value do
                addKnot splineInterpol 1 #corner #line [x,0.0, theA*(x^3) + theB*(x^2) + theC*x + theD]
            )
    splineInterpol.wirecolor = theColor  
    updateShape splineInterpol
    )
--***********************************************************************************************************  
fn kubInterpolG theColor =
(
    local splineInterpol = SplineShape name: (uniquename "funcInterpol")
    addNewSpline splineInterpol
    local x1 = theSP1.value ,
            x2 = theSP1.value+deltaX.value,
            x3 = theSP1.value+2.0*deltaX.value,
            x4 = theSP1.value+3.0*deltaX.value
    local y1 = theFunc x1,
            y2 = theFunc x2,
            y3 = theFunc x3,
            y4 = theFunc x4
local InSlau = #(#(x1^3, x1^2, x1, 1, y1), #(x2^3, x2^2, x2, 1, y2), #(x3^3, x3^2, x3, 1, y3), #(x4^3, x4^2, x4, 1, y4))
local OutSlau = slauGauss InSlau
local sp1 = sphere name: (uniquename "sp") radius:0.02 pos: [x1,0.0, y1],
        sp2 = sphere name: (uniquename "sp") radius:0.02 pos: [x2,0.0, y2],
        sp3 = sphere name: (uniquename "sp") radius:0.02 pos: [x3,0.0, y3],
        sp4 = sphere name: (uniquename "sp") radius:0.02 pos: [x4,0.0, y4]

        if startX.value >  endX.value do
        (
            for x = startX.value to endX.value by -deltaX.value/theStepSP.value do
            (
                local tests = 0.0
                for i =1 to 4 do tests += OutSlau[i]*(x^(4-i))
                addKnot splineInterpol 1 #corner #line [x,0.0, tests]
                )
            )
        if startX.value <  endX.value do
        (
            for x = startX.value to endX.value by deltaX.value/theStepSP.value do
            (
                local tests = 0.0
                for i =1 to 4 do tests += OutSlau[i]*(x^(4-i))
                addKnot splineInterpol 1 #corner #line [x,0.0, tests]
                )
            )
    splineInterpol.wirecolor = theColor  
    updateShape splineInterpol
    )
--***********************************************************************************************************
fn kubInterpolGU numInterpol theColor =
(
    local splineInterpol = SplineShape name: (uniquename "funcInterpol")
    addNewSpline splineInterpol
  
    local InSlauA = #()
  
    local arrayX = #(),
            arrayY = #()
  
    for i = 1 to numInterpol do append arrayX (theSP3.value+(i-1)*deltaX.value)
  
    for i = 1 to numInterpol do append arrayY (theFunc arrayX[i])

    for i = 1 to numInterpol do
    (
        local addLineA = #()
        for j = numInterpol-1 to 0 by -1 do append addLineA (arrayX[i]^j)
      
        append InSlauA (deepcopy addLineA)
        )

local OutSlau = slauGaussU InSlauA arrayY numInterpol
      
for i = 1 to numInterpol do local sp1 = sphere name: (uniquename "sp") radius:0.02 pos: [arrayX[i],0.0, arrayY[i]]

        if startX.value >  endX.value do
        (
            for x = startX.value to endX.value by -deltaX.value/theStepSP.value do
            (
                local tests = 0.0
                for i =1 to numInterpol do tests += OutSlau[i]*(x^(numInterpol-i))
                addKnot splineInterpol 1 #corner #line [x,0.0, tests]
                )
            )
        if startX.value <  endX.value do
        (
            for x = startX.value to endX.value by deltaX.value/theStepSP.value do
            (
                local tests = 0.0
                for i =1 to numInterpol do tests += OutSlau[i]*(x^(numInterpol-i))
                addKnot splineInterpol 1 #corner #line [x,0.0, tests]
                )
            )
    splineInterpol.wirecolor = theColor  
    updateShape splineInterpol
    )
--***********************************************************************************************************
fn findPro theSp theColor =
(
    local theNumKnots = numKnots theSp 1
    local splineProOne = SplineShape name: (uniquename "funcPro")
    addNewSpline splineProOne
    for i = 1 to (theNumKnots - 1) do
    (
        local Y1 = (getKnotPoint theSp 1 i).z,
                Y2 = (getKnotPoint theSp 1 (i+1)).z,
                dY = Y2 - Y1,
                X1 = (getKnotPoint theSp 1 i).x,
                X2 = (getKnotPoint theSp 1 (i+1)).x,
                dX = X2-X1

        addKnot splineProOne 1 #corner #line [X1,0.0, dY/dX]
        )
        splineProOne.wirecolor = theColor
        updateShape splineProOne
    )
--***********************************************************************************************************  
fn findTeylor theColor =
(
    local splineTeylor = SplineShape name: (uniquename "funcTeylor")
    addNewSpline splineTeylor
    local fa1 = theFunc theA.value,
            fa2 = theFunc (theA.value+deltaX.value),
            fa3 = theFunc (theA.value+2.0*deltaX.value),
            fa4 = theFunc (theA.value+3.0*deltaX.value)
    local d1 = (fa2 - fa1)/deltaX.value,
            dd1 = (fa3 - 2.0*fa2 + fa1)/(deltaX.value^2),
            ddd = (fa4 - 3.0*fa3 + 3.0*fa2 - fa1)/(deltaX.value^3)
local sp = sphere name: (uniquename "sp") radius:0.03 pos: [theA.value,0.0, fa1]
        if startX.value >  endX.value do
        (
            for x = startX.value to endX.value by -deltaX.value do
                addKnot splineTeylor 1 #corner #line [x,0.0, fa1 + d1*(x - theA.value) +  (dd1*((x - theA.value)^2))/2.0 + (ddd*((x - theA.value)^3))/6.0]
            )
        if startX.value <  endX.value do
        (
            for x = startX.value to endX.value by deltaX.value do
                addKnot splineTeylor 1 #corner #line [x,0.0, fa1 + d1*(x - theA.value) +  (dd1*((x - theA.value)^2))/2.0 + (ddd*((x - theA.value)^3))/6.0]
            )
    splineTeylor.wirecolor = theColor  
    updateShape splineTeylor
    )
--***********************************************************************************************************
-- funkciya garmoniki  
fn createSplineGarm theColor =
(
    theNewSpline = SplineShape name: (uniquename "func") 
      
    addNewSpline theNewSpline
        if startX.value >  endX.value do
        (
            for x = startX.value to endX.value by -deltaX.value do
                addKnot theNewSpline 1 #corner #line [x,0.0, theFunc x]
            )
        if startX.value <  endX.value do
        (
            for x = startX.value to endX.value by deltaX.value do
                addKnot theNewSpline 1 #corner #line [x,0.0, theFunc x]
            )
    theNewSpline.wirecolor = theColor  
    theNewSpline.vertexTicks = on
    updateShape theNewSpline
    )  
--***********************************************************************************************************
--function poiska absolutnigi min u spline
fn theFindMinSpline theSpline =
(
    local theArrayKnotsZ = #()
    local theNumKnots = numKnots theSpline 1
      
    for i = 1 to theNumKnots do append theArrayKnotsZ (getKnotPoint theSpline 1 i).z

    sort theArrayKnotsZ
    return theArrayKnotsZ[1]
    )
--***********************************************************************************************************
--function poiska absolutnigi max u spline
fn theFindMaxSpline theSpline =
(
    local theArrayKnotsZ = #()
    local theNumKnots = numKnots theSpline 1
      
    for i = 1 to theNumKnots do append theArrayKnotsZ (getKnotPoint theSpline 1 i).z

    sort theArrayKnotsZ
    return theArrayKnotsZ[theArrayKnotsZ.count]
    )  
--***********************************************************************************************************
--integrirovanie metodom monteKarlo
fn intMonteCarlo theSp theNumber =
(
    local theMaxF = theFindMaxSpline theSp,
            theMinF = theFindMinSpline theSp,
            theCounter = 0.0,
            theResult = 0.0,
            theSquare = (endX.value - startX.value)*(theMaxF - theMinF)
    for i = 1 to theNumber do
    (
        local theRandXYZ = random [startX.value, 0.0, theMaxF] [endX.value, 0.0, theMinF],
                theFunc2 = theFunc theRandXYZ.x
      
        if (theRandXYZ.z <= theFunc2) and (theRandXYZ.z >= 0.0) do theCounter = theCounter + 1.0
        if (theRandXYZ.z >= theFunc2) and (theRandXYZ.z <= 0.0) do theCounter = theCounter - 1.0
      
        )
   theResult = (theCounter/theNumber)*theSquare
   return(theResult)
    )
--***********************************************************************************************************
--integrirovanie metodom Simpsona
fn intSimpson theSp =
(
    local theNumKnots = numKnots theSp 1,
            theSumm = 0.0
    for i = 1 to (theNumKnots - 2) do
    (
        local Y1 = (getKnotPoint theSp 1 i).z,
                Y2 = (getKnotPoint theSp 1 (i+1)).z,
                Y3 = (getKnotPoint theSp 1 (i+2)).z,
                sumi = (Y1 + 4.0*Y2 + Y3)*deltaX.value/6.0
        theSumm = theSumm + sumi
        )
    return(theSumm)
    )
--***********************************************************************************************************
--integrirovanie metodom proizvodnih
fn intTrapec theSp =
(
    local theNumKnots = numKnots theSp 1,
            theSumm = 0.0
    for i = 1 to (theNumKnots - 1) do
    (
        local Y1 = (getKnotPoint theSp 1 i).z,
                Y2 = (getKnotPoint theSp 1 (i+1)).z,
                dY = Y2 - Y1
        theSumm = theSumm + deltaX.value*(Y1 + dY/2.0)
        )
    return(theSumm)
    )
--***********************************************************************************************************  
fn evaluateAllFn =
(
    local start = timeStamp()
    if sqrt((startX.value - endX.value)^2) > 4.0*deltaX.value do
    (
        try(delete objects) catch()
        createSplineGarm red
        rungekuta.text =  "MonteKarlo calculation: " +  (intMonteCarlo theNewSpline 10000.0) as string
        simpson.text =  "Simpson calculation: " + (intSimpson theNewSpline) as string
        integralPro.text =  "intTrapec calculation: " + (intTrapec theNewSpline) as string
      
        if pr01.state == true do findPro theNewSpline (color 88 144 225)
        if pr02.state == true do findPro $funcPro001 green
        if pr03.state == true do findPro $funcPro002 yellow
        )
    pr01.enabled = true
    local end = timeStamp()
      
    knotCount.text = "knotCount: " +    (numKnots theNewSpline 1) as string
    PTS.text = "Processing took " +    ((end - start) / 1000.0) as string "  seconds"
    max views redraw     
    )
--***********************************************************************************************************
  
on startX changed val do evaluateAllFn()
on endX changed val do evaluateAllFn()  
on deltaX changed val do evaluateAllFn()
on amplit changed val do evaluateAllFn()
on period changed val do evaluateAllFn()
on fasa changed val do evaluateAllFn()
on theA changed val do
(
    evaluateAllFn()
    findTeylor orange
    )
on theSP1 changed val do
(
    evaluateAllFn()
    kubInterpolG orange
    )
on theSP3 changed val do
(
    evaluateAllFn()
    kubInterpolGU numI.value orange
    )
on theSP2 changed val do
(
    evaluateAllFn()
    parabInterpol orange
    )
on theRes pressed do
(
    try(delete objects)catch(false)
        startX.value = 0.0
        endX.value = 2.0*pi
        deltaX.value = 0.1
        amplit.value = 1.0
        period.value = 1.0
        fasa.value = 0.0
        gspace.value = 1.0
        pr01.enabled = true
        evaluateAllFn()
        max tool zoomextents all
    )  
on pr01 changed state do
(
    if state == on do
    (
        pr02.enabled = true
        evaluateAllFn()
    )
    if state == off do
    (
        try(delete $funcPro001)catch()
        try(delete $funcPro002)catch()
        try(delete $funcPro003)catch()
        pr02.state = off
        pr03.state = off
        pr02.enabled = false
        pr03.enabled = false
        )      
)
on pr02 changed state do
(
    if state == on do
    (
        pr03.enabled = true
        evaluateAllFn()
    )
    if state == off do
    (
        try(delete $funcPro002)catch()
        try(delete $funcPro003)catch()
        pr03.state = off
        pr03.enabled = false
        )      
)
on pr03 changed state do
(
    if state == on do    evaluateAllFn()
    if state == off do    delete $funcPro003
  
)
on delAll pressed do    try(delete objects)catch()
on gspace changed val do SetGridSpacing gspace.value
on FuncCreator open do    SetGridSpacing gspace.value
  
)    --end rullout
createDialog FuncCreator
----------------------------------------------------------------------------

Комментариев нет:

Отправить комментарий