O este codigo que es Vb para convertirlo a php es la eliminacion de gauss jordan
yo creo a nadie le cairia mal tener este metodo algun dia lo pueden ocupar como yop en estos momentos jamas pense que lo fuera a ocupar.
Código PHP:
/* eliminaición de gauss jordan*/
Public ing As String
Public ne As Integer
Private Sub Command2_Click()
resp = MsgBox("Esta seguro de " & vbCrLf & "borrar la matriz", vbInformation + vbYesNo + vbDefaultButton2, "Eliminación de Gauss")
If resp = 6 Then
answer.Clear
matrix.Clear
ing = 0
ing = InputBox("Ingrese el número de ecuaciones", "Eliminación de Gauss")
If ing = "" Then
txtingreso.SetFocus
Else
txtingreso.SetFocus
txtingreso.Text = Str(ing)
matrix.Cols = ing + 1
matrix.Rows = ing
Call tamaño
End If
Else
Exit Sub
End If
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Form_Activate()
txtingreso.SetFocus
End Sub
Private Sub Command1_Click()
ne = Val(txtingreso.Text)
answer.Rows = ne
' ne: es el número de ecuaciones
ReDim Sistema(1 To ne + 5, 1 To ne + 10) As Double
ReDim Solución(1 To ne) As Double
If matrix.Text = "" Then
MsgBox "Ingrese sus datos ", vbCritical + vbOKOnly, "Menzaje": Exit Sub
Else
For i = 1 To ne
For j = 1 To ne + 1
Sistema(i, j) = matrix.TextMatrix(i - 1, j - 1)
Next j
Next i
ReDim Solución(1 To ne) As Double
If Gauss(Sistema(), Solución()) Then
For i = 0 To ne - 1
answer.TextMatrix(i, 0) = Format(Solución(i + 1), "0.000")
Next i
Else
MsgBox "El sistema de ecuaciones no tiene solución...", vbCritical + vbOKOnly, "Atención"
End If
End If
tamaño
End Sub
Private Sub Form_Load()
matrix.TextMatrix(0, 0) = 1
matrix.TextMatrix(0, 1) = 1
matrix.TextMatrix(0, 2) = 1
matrix.TextMatrix(0, 3) = 6
matrix.TextMatrix(1, 0) = 1
matrix.TextMatrix(1, 1) = 0
matrix.TextMatrix(1, 2) = 1
matrix.TextMatrix(1, 3) = 4
matrix.TextMatrix(2, 0) = 1
matrix.TextMatrix(2, 1) = 1
matrix.TextMatrix(2, 2) = 0
matrix.TextMatrix(2, 3) = 1
tamaño
End Sub
Private Sub matrix_KeyPress(KeyAscii As Integer)
'NUMEROS DE 48-57
'. EL PUNTO "." 46
'LETRAS 65 -90
If KeyAscii >= 46 And KeyAscii <= 57 Then
matrix.Text = matrix.Text & Chr(KeyAscii)
End If
End Sub
Private Sub matrix_KeyUp(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyDelete
matrix.Text = ""
Case vbKeyBack
If Len(matrix.Text) > 0 Then
matrix.Text = Left(matrix.Text, Len(matrix.Text) - 1)
End If
End Select
End Sub
Private Sub txtingreso_KeyPress(KeyAscii As Integer)
n = Val(txtingreso.Text)
ne = n
If KeyAscii = 13 Then
matrix.Cols = n + 1
matrix.Rows = n
tamaño
End If
End Sub
Private Sub txtingreso_LostFocus()
n = Val(txtingreso.Text)
matrix.Cols = n + 1
matrix.Rows = n
End Sub
Esta es una subrutina bajada de Internet
Static Function Gauss(ByRef A() As Double, ByRef C() As Double) As Boolean
Dim Tem As Double, Sum As Double, i, l, j, k, n, m
On Error GoTo Gauss_Err
n = UBound(C)
m = n + 1
For l = 1 To n - 1
j = l
For k = l + 1 To n
If (Abs(A(j, l)) >= Abs(A(k, l))) Then
Else: j = k
End If
Next
If Not (j = l) Then
For i = 1 To m
Tem = A(l, i)
A(l, i) = A(j, i)
A(j, i) = Tem
Next
End If
For j = l + 1 To n
Tem = A(j, l) / A(l, l)
For i = 1 To m
A(j, i) = A(j, i) - Tem * A(l, i)
Next
Next
Next
C(n) = A(n, m) / A(n, n)
For i = 1 To n - 1
j = n - i
Sum = 0
For l = 1 To i
k = j + l
Sum = Sum + A(j, k) * C(k)
Next
C(j) = (A(j, m) - Sum) / A(j, j)
Next
Gauss = True
Exit Function
Gauss_Err: Gauss = False
End Function
Sub tamaño()
ne = Val(txtingreso.Text)
matrix.Height = matrix.RowHeight(1) * (ne + 0.5)
matrix.Width = (matrix.ColWidth(1)) * (ne + 1.12)
answer.Height = answer.RowHeight(1) * (ne + 0.5)
End Sub