2013-06-19 07:42

'------------------------------------------------------------------------------------------'
'    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 ??)
'    7- add routine to identify data set type and size during file load (load matrix, load coeff vs.
'       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
       AddTabs "Solver","Least Squares Regression"
       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
        AddOptions(goEditing, goThumbTracking)
        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
        AddOptions(goEditing, goThumbTracking)
        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
                'AddOptions(goEditing, goThumbTracking)
        AddOptions(10)
        Separator=","
        ColCount = 4
        RowCount = 4
        Col = 0
        Row = 0
        DefaultColWidth = 90
        DefaultRowHeight = 14
        FixedCols = 0
        FixedRows = 0
       END CREATE
       CREATE Coef AS QSTRINGGRID
        AddOptions(goEditing, goThumbTracking)
        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
       CREATE LoadMatrix AS QBUTTON
        CAPTION = "LoadMatrix"
        Left = 16
        Top = (ph/2) - 68
        Width = 120
        OnClick = LoadMatrixFile
       END CREATE
       CREATE SaveMatrix AS QBUTTON
        CAPTION = "SaveMatrix"
        Left = 140
        Top = (ph/2) - 68
        Width = 120
        OnClick = SaveMatrixFile
       END CREATE
       CREATE LoadCoef AS QBUTTON
        CAPTION = "Load Coef"
        Left = 16
        Top = (ph/2) - 68
        Width = 60
        OnClick = LoadCoefFile
       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
        AddOptions(goEditing, goThumbTracking)
        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
       CREATE ButtonPOLoadData AS QBUTTON
        CAPTION = "Load Data"
        Left = 16
        Top = 300
        Width = 64
        OnClick = LoadData
       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
       CREATE Polynomial AS QRADIOBUTTON
        CAPTION = "Polynomial"
        Left = 18
        Top = ph - 195
        TabOrder = 1
        checked = true
       END CREATE
       CREATE Exponential AS QRADIOBUTTON
        CAPTION = "Exp:  y=ae^(bx)"
        Left = 18
        Top = ph - 255
        TabOrder = 10
        Width = 140
        visible = false
       END CREATE
       CREATE Power AS QRADIOBUTTON
        CAPTION = "Pow: y=ax^b"
        Left = 18
        Top = ph - 230
        TabOrder = 11
        visible = false
       END CREATE
       CREATE Logarithmic AS QRADIOBUTTON
        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

     SUB LoadData (sender AS QBUTTON)
      OpenDialog.InitialDir = CURDIR$
      OpenDialog.Filter = "Text files|*.txt|csv files|*.csv|All Files|*.*"
      OpenDialog.FilterIndex = 1
      IF OpenDialog.EXECUTE THEN
       FileName = OpenDialog.FileName
       StringGridPO.LoadFromFile(FileName,0,0,10000)
      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

     SUB LoadMatrixFile (sender AS QBUTTON)
      OpenDialog.InitialDir = CURDIR$
      OpenDialog.Filter = "Text files|*.txt|csv files|*.csv|All Files|*.*"
      OpenDialog.FilterIndex = 1
      IF OpenDialog.EXECUTE THEN
       FileName = OpenDialog.FileName
       Matrix.LoadFromFile(FileName,0,0,10000)
      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

     SUB LoadCoefFile (sender AS QBUTTON)
      OpenDialog.InitialDir = CURDIR$
      OpenDialog.Filter = "Text files|*.txt|csv files|*.csv|All Files|*.*"
      OpenDialog.FilterIndex = 1
      IF OpenDialog.EXECUTE THEN
       FileName = OpenDialog.FileName
       Coef.LoadFromFile(FileName,0,0,100)
      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
      LoadMatrix.top = (ph/2) - 58
      SaveCoef.top = (ph/2) - 58
      LoadCoef.top = (ph/2) - 58
      SaveCoef.left = pw - 158
      LoadCoef.left = pw - 220
'
      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
      ButtonPOLoadData.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

2013-06-19 07:42