Guidance指路人g.yi.org software / rapidq / Examples / Algorithm & Maths / Linear / Linear.bas
 最新 LeonAutoBackup
```'------------------------------------------------------------------------------------------'
'    Linear Solver 26Feb04                                                                 '
'    Linear System of Equations / Polynomial regression                                    '
'    By: puddlduk@yahoo.com                                                                '
'------------------------------------------------------------------------------------------'
'
'    To_Do
'    1- store matrix in an array instead of qstringgrid strings.
'    2- fix plot scaling
'    3- add curve fitting for other equation types
'    4- add fitting routing that minimizes orthagonal error instead of vertical error??
'    5- add itterative solution to matrix to produce selectable accuracy (least squares
'       populated matrix is not diagonally dominant)
'    6- move solver to a C - DLL (will this be faster ??)
'       load augmented matrix, and check matrix size and apply to qstringgrid)
'

\$INCLUDE "RAPIDQ.INC"
\$TYPECHECK ON
\$OPTIMIZE ON
\$ESCAPECHARS ON
\$OPTION ICON "Linear.Ico"
'
DEFINT i,j,k,jmax,n,l,counter,pw,ph, sx, sy
DEFDBL T,m,s,coeff,sm,v,xlow,ylow,xhigh,yhigh,scalex,scaley,xplot,yplot,py,xpoint,ypoint
DEFSTR st,polystr,FileName
DIM OpenDialog AS QOPENDIALOG
DIM SaveDialog AS QSAVEDIALOG
'
DECLARE SUB MatrixSizeChange (Sender AS QEDIT)
DECLARE SUB Solve(Sender AS QBUTTON)
DECLARE SUB TabChange(sender AS QTABCONTROL)
DECLARE SUB FitCurve (sender AS QBUTTON)
DECLARE SUB paint(sender AS QCANVAS)
DECLARE SUB plot(xplot AS DOUBLE, yplot AS DOUBLE)
DECLARE SUB plotpoint(x AS DOUBLE, y AS DOUBLE)
DECLARE SUB LoadData (sender AS QBUTTON)
DECLARE SUB SaveData (sender AS QBUTTON)
DECLARE SUB ClearData (sender AS QBUTTON)
DECLARE SUB Resize (sender AS QFORM)
DECLARE SUB PolyEnter (Key AS WORD, Shift AS LONG, Sender AS QEDIT)
DECLARE SUB LoadMatrixFile (sender AS QBUTTON)
DECLARE SUB SaveMatrixFile (sender AS QBUTTON)
DECLARE SUB SaveCoefFile (sender AS QBUTTON)
DECLARE SUB LoadCoefFile (sender AS QBUTTON)
'------------------------------------------------------------------------------------------'
'
DIM bmp AS QBITMAP
bmp.width = 2048
bmp.height = 1560
bmp.paint(0,0,&H666666,0)
'
pw = 800
ph = 600
'
CREATE Form AS QFORM
CAPTION = "Linear"
Width = pw
Height = ph
Center
CURSOR = 0

CREATE Tab AS QTABCONTROL
OnChange = TabChange
HotTrack = True
align = 5
END CREATE
CREATE GroupBox1 AS QGROUPBOX
CAPTION = "Gauss Solver"
Left = 12
Top = (ph / 2)-12
Width = pw - 24
Height = (ph / 2) - 12
CREATE Label5 AS QLABEL
CAPTION = "Solution - [R]"
Left = pw - 152
Top = 24
Width = 75
END CREATE
CREATE Label7 AS QLABEL
CAPTION = "Augmented Echelon"
Left = 20
Top = 24
Width = 100
END CREATE
CREATE MatrixIM AS QSTRINGGRID
Left = 16
top = 40
Height = (ph / 2) - 96
Width = pw - 186
ColCount = 5
RowCount = 4
Col = 0
Row = 0
DefaultColWidth = 90
DefaultRowHeight = 14
FixedCols = 0
FixedRows = 0
END CREATE
CREATE ResultIM AS QSTRINGGRID
Left = pw - 156
Top = 40
Height = (ph/2)-96
Width = 114
TabOrder = 2
ColCount = 1
RowCount = 4
Col = 0
Row = 0
DefaultColWidth = 90
DefaultRowHeight = 14
FixedCols = 0
FixedRows = 0
END CREATE
CREATE Button1 AS QBUTTON
CAPTION = "Solve"
Left = 16
Top = (ph/2) - 36
Width = pw - 56
OnClick = Solve
END CREATE
END CREATE 'End Solver Panel
'
CREATE GroupBox2 AS QGROUPBOX 'Solver Data Entry Begin
CAPTION = "Data (enter a linear system of equations to solve)"
Left = 12
Top = 24
Width = pw - 48
Height = ph/2 - 48
CREATE Label1 AS QLABEL
CAPTION = "n="
Left = pw - 102
Top = (ph/2)-48
Width = 12
END CREATE
CREATE Labelx AS QLABEL
CAPTION = "x [R]   = "
Left = pw - 250
Top = (ph/4) - 16
Width = 60
END CREATE
CREATE Label2 AS QLABEL
CAPTION = "Coefficients"
Left = pw - 192
Top = 24
Width = 60
END CREATE
CREATE Label3 AS QLABEL
CAPTION = "Matrix"
Left = 24
Top = 24
Width = 28
END CREATE
CREATE Matrix AS QSTRINGGRID
Left = 16
Top = 40
Height = (ph/2)-24
Width = pw - 276
Separator=","
ColCount = 4
RowCount = 4
Col = 0
Row = 0
DefaultColWidth = 90
DefaultRowHeight = 14
FixedCols = 0
FixedRows = 0
END CREATE
CREATE Coef AS QSTRINGGRID
Separator=","
Left = pw - 200
Top = 40
Height = (ph/2)-96
Width = 108
TabOrder = 1
ColCount = 1
RowCount = 4
Col = 0
Row = 0
DefaultColWidth = 90
DefaultRowHeight = 14
FixedCols = 0
FixedRows = 0
END CREATE
CREATE MatrixSize AS QEDIT
Text = "4"
Left = pw-48
Top = (ph / 2) - 64
Width = 33
OnChange = MatrixSizeChange
END CREATE
Left = 16
Top = (ph/2) - 68
Width = 120
END CREATE
CREATE SaveMatrix AS QBUTTON
CAPTION = "SaveMatrix"
Left = 140
Top = (ph/2) - 68
Width = 120
OnClick = SaveMatrixFile
END CREATE
Left = 16
Top = (ph/2) - 68
Width = 60
END CREATE
CREATE SaveCoef AS QBUTTON
CAPTION = "Save Coef"
Left = 140
Top = (ph/2) - 68
Width = 60
OnClick = SaveCoefFile
END CREATE
END CREATE     ' End Solver Data Enter Panel
'
CREATE GroupBoxPO AS QGROUPBOX 'PO Group Box Begin
Width = pw-48
Height = ph-48
'Caption = "Polynomial Regression"
Left = 12
Top = 24
Visible = false
CREATE CanvasPO AS QCANVAS
Left = 162
Top = 7
Width = pw - 196
Height = ph -48
onpaint = paint
END CREATE
CREATE LabelPO AS QLABEL
CAPTION = "Polynomial Order = "
Left = 18
Top = ph - 155
Width = 96
Alignment = 2
END CREATE
CREATE LabelDataPO AS QLABEL
CAPTION = "Enter Data Here"
Left = 20
Top = 18
Width = 77
END CREATE
CREATE StringGridPO AS QSTRINGGRID
Separator=","
Left = 16
Top = 34
Height = ph - 344
Width = 136
ScrollBars = 2
ColCount = 2
RowCount = 100
Col = 0
Row = 0
DefaultColWidth = 48
DefaultRowHeight = 16
FixedCols = 0
FixedRows = 0
END CREATE
CREATE ButtonPOSolve AS QBUTTON
CAPTION = "Fit Curve"
Left = 16
Top = ph - 172
Width = 139
TabOrder = 1
OnClick = FitCurve
END CREATE
Left = 16
Top = 300
Width = 64
END CREATE
CREATE ButtonPOSaveData AS QBUTTON
CAPTION = "Save Data"
Left = 86
Top = 300
Width = 64
OnClick = SaveData
END CREATE
CREATE ButtonPOClearData AS QBUTTON
CAPTION = "Clear Graph"
Left = 16
Top = ph - 142
Width = 139
TabOrder = 2
OnClick = ClearData
END CREATE
CREATE EditPOOrder AS QEDIT
Text = "5"
Left = 116
Top = ph-186
Width = 33
TabOrder = 3
onkeydown=polyenter
END CREATE
CREATE RichEditPO AS QRICHEDIT
Left = 161
Top = ph - 154
Width = pw - 196
Height = 70
ScrollBars = 2
TabOrder = 4
END CREATE
CAPTION = "Polynomial"
Left = 18
Top = ph - 195
TabOrder = 1
checked = true
END CREATE
CAPTION = "Exp:  y=ae^(bx)"
Left = 18
Top = ph - 255
TabOrder = 10
Width = 140
visible = false
END CREATE
CAPTION = "Pow: y=ax^b"
Left = 18
Top = ph - 230
TabOrder = 11
visible = false
END CREATE
CAPTION = "Log:  y=a+bln(x)"
Width = 140
Left = 18
Top = ph - 220
TabOrder = 11
visible = false
END CREATE
END CREATE     'PO Group Box End
OnResize = Resize
SHOWMODAL
END CREATE
' ----------------------------------------------------------------------------------------------'
' Gauss Solver Routine                                                                          '
' ----------------------------------------------------------------------------------------------'
SUB Solve (Sender AS QBUTTON)
screen.cursor = crHourglass
DOEVENTS
n = (VAL(matrixsize.text)-1)
FOR i = 0 TO n                                    'Populates augmented matrix
FOR j = 0 TO n                                'i= column number, j= row number
MatrixIM.cell(i,j) = Matrix.cell(i,j)
NEXT j
MatrixIM.cell(n+1,i) = STR\$(-VAL(Coef.cell(0,i)))
ResultIM.cell(0,i) = 0
NEXT i
MatrixIM.repaint
FOR j= 0 TO n
jmax = j: T=ABS(VAL(MatrixIM.cell(jmax,j)))   ' Search for largest element in this column
FOR l = j+1 TO n
IF t < ABS(VAL(MatrixIM.cell(l,j))) THEN
jmax = l
t = ABS(VAL(MatrixIM.cell(l,jmax)))
END IF
NEXT l
IF j < jmax THEN                              ' Switch rows as needed
FOR k = j TO n+1
st = MatrixIM.cell(k,j)
MatrixIM.cell(k,j) = MatrixIM.cell(k,jmax)
MatrixIM.cell(k,jmax) = st
NEXT k
END IF
FOR l = j+1 TO n                              'construct echelon (through j loop)
t = VAL(MatrixIM.cell(j,l)) / VAL(MatrixIM.cell(j,j))
MatrixIM.cell(j,l)=0
FOR i = j+1 TO n+1
MatrixIM.cell(i,l) = STR\$(VAL(MatrixIM.cell(i,l)) - t * VAL(MatrixIM.cell(i,j)))
NEXT i
NEXT  l
NEXT j
FOR l = n TO 0 STEP -1                           ' Back-substitution to find solution
t = VAL(MatrixIM.cell(n+1,l))
FOR i = (l+1) TO n
t = t + VAL(MatrixIM.cell(i,l))* VAL(ResultIM.cell(0,i))
NEXT i
ResultIM.cell(0,l) = STR\$( -t / VAL(MatrixIM.cell(l,l)))
NEXT l
screen.cursor = crDefault
DOEVENTS
END SUB
'
SUB MatrixSizeChange (Sender AS QEDIT)                ' Loads Gauss solver panel
IF VAL(MatrixSize.text)>1 THEN
ResultIM.RowCount = VAL(MatrixSize.text)
ResultIM.repaint
MatrixIM.RowCount = VAL(MatrixSize.text)
MatrixIM.ColCount = (VAL(MatrixSize.text)+1)
MatrixIM.repaint
Coef.RowCount = VAL(MatrixSize.text)
Coef.repaint
Matrix.RowCount = VAL(MatrixSize.text)
Matrix.ColCount = VAL(MatrixSize.text)
Matrix.repaint
END IF
END SUB
'
SUB FitCurve (sender AS QBUTTON)                        ' Fit Polynomial curve
counter = 0                                         '
xlow = VAL(StringGridPO.cell(0,counter))            ' Find Number of samples
xhigh = xlow                                        '
ylow = VAL(StringGridPO.cell(1,counter))            ' Find plotting scale information
yhigh = ylow
WHILE StringGridPO.cell(0,counter) AND StringGridPO.cell(1,counter) <>""
counter++
IF VAL(StringGridPO.cell(0,counter)) < xlow THEN xlow = VAL(StringGridPO.cell(0,counter))
IF VAL(StringGridPO.cell(1,counter)) < ylow THEN ylow = VAL(StringGridPO.cell(1,counter))
IF VAL(StringGridPO.cell(0,counter)) > xhigh THEN xhigh = VAL(StringGridPO.cell(0,counter))
IF VAL(StringGridPO.cell(1,counter)) > yhigh THEN yhigh = VAL(StringGridPO.cell(1,counter))
WEND
n = (VAL(EditPOOrder.text))+1                        ' Matrix size
m = (VAL(EditPOOrder.text))                          ' Polynomial Order
MatrixSize.text = STR\$(n)
FOR j = 0 TO m
FOR i = 0 TO m
sm = 0                                       ' Matrix cell summation
FOR s = 0 TO (counter-1)
sm = sm + (VAL(StringGridPO.cell(0,s)))^(i+j)
NEXT s
Matrix.cell(i,j) = STR\$(sm)
NEXT i
coeff = 0                                        ' Coefficients cell summation
FOR s = 0 TO (counter-1)
coeff = coeff + (VAL(StringGridPO.cell(1,s))* VAL(StringGridPO.cell(0,s))^j)
NEXT s
Coef.cell(0,j) = STR\$(coeff)
NEXT j
'
Solve (sender)                                       ' Solve the Least Squares Fit Polynomial
'
polystr = "y = "+ResultIM.cell(0,0)+" "              ' String Expression for Polynomial
FOR i = 1 TO n
polystr = polystr + " + ("+ResultIM.cell(0,i)+") "+"x^"+STR\$(i)
NEXT i
'
RichEditPO.AddString = STR\$(polystr)                 ' Print the Polynomial in Richedit
RichEditPO.SelStart = LEN(RichEditPO.Text)           ' auto scrole
SendMessage(RichEditPO.Handle, &HB7, 0, 0)
'
scalex = sx /(xhigh-xlow)
scaley = sy /(yhigh-ylow)
FOR i = 0 TO (counter-1)                              ' plot data
xplot = ((VAL(StringGridPO.cell(0,i)))*scalex)+10
yplot = ((VAL(StringGridPO.cell(1,i)))*scaley)+10
bmp.circle(xplot-2,(sy+31)-yplot-2,xplot+2,(sy+31)-yplot+2,255,255)
CanvasPO.circle(xplot-2,(sy+31)-yplot-2,xplot+2,(sy+31)-yplot+2,255,255)
NEXT i
CanvasPO.draw(0,0,bmp.bmp)
FOR xpoint = 10 TO (form.width-10)STEP .5             ' plot polynomial
ypoint = 0
FOR l = 0 TO n
ypoint = ypoint + VAL(ResultIM.cell(0,l))*(((xpoint-10)/scalex)^l)
NEXT l
ypoint = (ypoint*scaley)+10
bmp.pset(xpoint,(sy+31)-ypoint,&H00FF00)
CanvasPO.pset(xpoint,(sy+31)-ypoint,&H00FF00)
NEXT i
CanvasPO.draw(0,0,bmp.bmp)
END SUB
'
SUB TabChange(sender AS QTABCONTROL)
SELECT CASE Tab.TabIndex
CASE 0
GroupBox1.Visible = True
GroupBox2.Visible = True
GroupBoxPO.Visible = False
CASE 1
GroupBox1.Visible = False
GroupBox2.Visible = False
GroupBoxPO.Visible = True
END SELECT
END SUB
'
SUB paint (sender AS QCANVAS)
canvasPO.draw(0,0,bmp.bmp)
screen.cursor = crDefault
DOEVENTS
END SUB

OpenDialog.InitialDir = CURDIR\$
OpenDialog.Filter = "Text files|*.txt|csv files|*.csv|All Files|*.*"
OpenDialog.FilterIndex = 1
IF OpenDialog.EXECUTE THEN
FileName = OpenDialog.FileName
END IF
END SUB

SUB SaveData (sender AS QBUTTON)
SaveDialog.InitialDir = CURDIR\$
SaveDialog.Filter = "Text files|*.txt|csv files|*.csv|All Files|*.*"
SaveDialog.FilterIndex = 1
IF SaveDialog.EXECUTE THEN
FileName = SaveDialog.FileName + ".txt"
StringGridPO.SaveToFile(FileName,0,0,10000)
END IF
END SUB

OpenDialog.InitialDir = CURDIR\$
OpenDialog.Filter = "Text files|*.txt|csv files|*.csv|All Files|*.*"
OpenDialog.FilterIndex = 1
IF OpenDialog.EXECUTE THEN
FileName = OpenDialog.FileName
END IF
END SUB

SUB SaveMatrixFile (sender AS QBUTTON)
SaveDialog.InitialDir = CURDIR\$
SaveDialog.Filter = "Text files|*.txt|csv files|*.csv|All Files|*.*"
SaveDialog.FilterIndex = 1
IF SaveDialog.EXECUTE THEN
FileName = SaveDialog.FileName + ".txt"
Matrix.SaveToFile(FileName,0,0,10000)
END IF
END SUB

OpenDialog.InitialDir = CURDIR\$
OpenDialog.Filter = "Text files|*.txt|csv files|*.csv|All Files|*.*"
OpenDialog.FilterIndex = 1
IF OpenDialog.EXECUTE THEN
FileName = OpenDialog.FileName
END IF
END SUB

SUB SaveCoefFile (sender AS QBUTTON)
SaveDialog.InitialDir = CURDIR\$
SaveDialog.Filter = "Text files|*.txt|csv files|*.csv|All Files|*.*"
SaveDialog.FilterIndex = 1
IF SaveDialog.EXECUTE THEN
FileName = SaveDialog.FileName + ".txt"
Coef.SaveToFile(FileName,0,0,100)
END IF
END SUB

SUB ClearData (sender AS QBUTTON)
bmp.paint(0,0,&H666666,0)
CanvasPO.paint(0,0,&H666666,0)
END SUB

SUB Resize (sender AS QFORM)
pw = Form.ClientWidth
ph = Form.ClientHeight
'
GroupBox1.top = ph / 2
GroupBox1.Width = pw - 24
GroupBox1.Height = (ph / 2)-12
MatrixIM.Width = pw - 186
MatrixIM.Height = (ph/2)-96
button1.top = (ph / 2) - 48
button1.Width = pw - 56
ResultIM.height = (ph/2)-96
ResultIM.left = pw - 156
Label5.left = pw - 152
'
GroupBox2.Width = pw - 24
GroupBox2.Height = (ph / 2) - 24
Matrix.Width = pw - 276
Matrix.Height = (ph/2) - 104
MatrixSize.Left = pw-64
MatrixSize.top = (ph/2)-52
Coef.Height = (ph/2) - 104
Coef.Left = pw - 200
Label2.Left = pw - 192
Labelx.left =  pw - 250
Labelx.top = (ph/4) - 16
Label1.Top = (ph/2)-49
Label1.Left = pw - 82
SaveMatrix.top = (ph/2) - 58
SaveCoef.top = (ph/2) - 58
SaveCoef.left = pw - 158
'
GroupBoxPO.Width = pw - 24
GroupBoxPO.Height = ph - 48
sx = pw - 189
sy = ph - 136
CanvasPO.Width = sx
CanvasPO.Height = sy
CanvasPO.draw(0,0,bmp.bmp)
RichEditPO.Top = ph - 126
RichEditPO.Width = pw - 190
'
EditPOOrder.top = ph-150
ButtonPOClearData.top = ph - 116
ButtonPOSolve.Top  = ph - 82
LabelPO.Top = ph - 147
Polynomial.top = ph - 175
Exponential.top = ph - 235
Power.top = ph - 215
Logarithmic.top = ph - 195
StringGridPO.Height = ph - 320
ButtonPOSaveData.Top = ph - 280
'
END SUB
'
SUB PolyEnter (Key AS WORD, Shift AS LONG, Sender AS QEDIT)
IF key=13 THEN KillMessage(EditPOOrder.Handle, &H102)
IF Key = 13 THEN
FitCurve (QBUTTON)
END IF
END SUB
```