RosettaCodeData/Task/Reduced-row-echelon-form/Visual-FoxPro/reduced-row-echelon-form.fvp

91 lines
2.0 KiB
Plaintext

CLOSE DATABASES ALL
LOCAL lnRows As Integer, lnCols As Integer, lcSafety As String
LOCAL ARRAY matrix[1]
lcSafety = SET("Safety")
SET SAFETY OFF
CLEAR
CREATE CURSOR results (c1 B(6), c2 B(6), c3 B(6), c4 B(6))
CREATE CURSOR curs1(c1 I, c2 I, c3 I, c4 I)
INSERT INTO curs1 VALUES (1,2,-1,-4)
INSERT INTO curs1 VALUES (2,3,-1,-11)
INSERT INTO curs1 VALUES (-2,0,-3,22)
lnRows = RECCOUNT() && 3
lnCols = FCOUNT() && 4
SELECT * FROM curs1 INTO ARRAY matrix
IF RREF(@matrix, lnRows, lnCols)
SELECT results
APPEND FROM ARRAY matrix
BROWSE NORMAL IN SCREEN
ENDIF
SET SAFETY &lcSafety
FUNCTION RREF(mat, tnRows As Integer, tnCols As Integer) As Boolean
LOCAL lnPivot As Integer, i As Integer, r As Integer, j As Integer, ;
p As Double. llResult As Boolean, llExit As Boolean
llResult = .T.
llExit = .F.
lnPivot = 1
FOR r = 1 TO tnRows
IF lnPivot > tnCols
EXIT
ENDIF
i = r
DO WHILE mat[i,lnPivot] = 0
i = i + 1
IF i = tnRows
i = r
lnPivot = lnPivot + 1
IF lnPivot > tnCols
llExit = .T.
EXIT
ENDIF
ENDIF
ENDDO
IF llExit
EXIT
ENDIF
ASwapRows(@mat, i, r)
p = mat[r,lnPivot]
IF p # 0
FOR j = 1 TO tnCols
mat[r,j] = mat[r,j]/p
ENDFOR
ELSE
? "Divison by zero."
llResult = .F.
EXIT
ENDIF
FOR i = 1 TO tnRows
IF i # r
p = mat[i,lnPivot]
FOR j = 1 TO tnCols
mat[i,j] = mat[i,j] - mat[r,j]*p
ENDFOR
ENDIF
ENDFOR
lnPivot = lnPivot + 1
ENDFOR
RETURN llResult
ENDFUNC
PROCEDURE ASwapRows(arr, tnRow1 As Integer, tnRow2 As Integer)
*!* Interchange rows tnRow1 and tnRow2 of array arr.
LOCAL n As Integer
n = ALEN(arr,2)
LOCAL ARRAY tmp[1,n]
STORE 0 TO tmp
ACPY2(@arr, @tmp, tnRow1, 1)
ACPY2(@arr, @arr, tnRow2, tnRow1)
ACPY2(@tmp, @arr, 1, tnRow2)
ENDPROC
PROCEDURE ACPY2(m1, m2, tnSrcRow As Integer, tnDestRow As Integer)
*!* Copy m1[tnSrcRow,*] to m2[tnDestRow,*]
*!* m1 and m2 must have the same number of columns.
LOCAL n As Integer, e1 As Integer, e2 As Integer
n = ALEN(m1,2)
e1 = AELEMENT(m1,tnSrcRow,1)
e2 = AELEMENT(m2,tnDestRow,1)
ACOPY(m1, m2, e1, n, e2)
ENDPROC