Multiple regression: Difference between revisions
m
→{{header|Wren}}: Minor tidy
Thundergnat (talk | contribs) m (syntax highlighting fixup automation) |
m (→{{header|Wren}}: Minor tidy) |
||
| (10 intermediate revisions by 5 users not shown) | |||
Line 358:
-1.51161E+02
6.43514E+01</pre>
=={{header|ALGOL 68}}==
{{Trans|Visual Basic .NET}}...but using the "to reduced echelon form" routine from [[Reduced row echelon form#ALGOL_68]].
Algol 68 doesn't have classes, though it does have structures.
<br>Other than that, the main differences between this and the VB.NET sample are that Algol 68 has array slicing built in and generally uses a lower bound of 1 rather than 0 for arrays.
<br>Also, although <code>( ( 1, 2, 3 ), ( 6, 5, 4 ) )</code> is a 2x3 array, <code>( ( 1, 2, 3 ) )</code> is a 3x1 array (because <code>( x )</code> is not an array, so the outer brackets are superfluous, leaving <code>( 1, 2, 3 )</code> - i.e. a 1-dimensoional array - as the context requires a two-dimensional array, each value is coerced to an array resulting in a 3x1 two-dimensional array).
<syntaxhighlight lang="algol68">
BEGIN # Multiple Regression - trnslation of the VB.NET sample but using the #
# "to reduced row echelon form" routine from the Reduced row echelon Task #
PROC require = ( BOOL condition, STRING message )VOID:
IF NOT condition THEN
print( ( message, newline ) );
stop
FI # requiree # ;
MODE MATRIX = STRUCT( REF[,]REAL data
, INT row count
, INT col count
);
PRIO NEWMATRIX = 1;
OP NEWMATRIX = ( INT rows, INT cols )MATRIX:
BEGIN
MATRIX result;
require( rows > 0, "Need at least one row" );
row count OF result := rows;
require( cols > 0, "Need at least one column" );
col count OF result := cols;
data OF result := HEAP[ 1 : rows, 1 : cols ]REAL;
FOR r TO rows DO FOR c TO cols DO ( data OF result )[ r, c ] := 0 OD OD;
result
END # NEWMATRIX # ;
OP NEWMATRIX = ( [,]REAL source )MATRIX:
BEGIN
MATRIX result;
INT rows = 1 + ( 1 UPB source - 1 LWB source );
require( rows > 0, "Need at least one row" );
row count OF result := rows;
INT cols = 1 + ( 2 UPB source - 2 LWB source );
require( cols > 0, "Need at least one column" );
col count OF result := cols;
data OF result := HEAP[ 1 : rows, 1 : cols ]REAL := source[ AT 1, AT 1 ];
result
END # NEWMATRIX # ;
OP NEWMATRIX = ( []REAL source )MATRIX: # New Matrix(ConvertArray(source)) #
BEGIN
INT len = 1 + ( UPB source - LWB source );
[ 1 : 1, 1 : len ]REAL dest;
dest[ 1, : ] := source;
NEWMATRIX dest
END # NEWMATRIX # ;
OP * = ( MATRIX m1, m2 )MATRIX:
BEGIN
INT rc1 = row count OF m1;
INT cc1 = col count OF m1;
INT rc2 = row count OF m2;
INT cc2 = col count OF m2;
require( cc1 = rc2, "Cannot multiply if the first columns does not equal the second rows" );
MATRIX result := rc1 NEWMATRIX cc2;
FOR i TO rc1 DO
FOR j TO cc2 DO
FOR k TO rc2 DO
( data OF result ) [ i, j ] +:= ( data OF m1 )[ i, k ]
* ( data OF m2 )[ k, j ]
OD
OD
OD;
result
END # * # ;
PROC transpose = ( MATRIX m )MATRIX:
BEGIN
INT rc = row count OF m;
INT cc = col count OF m;
MATRIX trans := cc NEWMATRIX rc;
FOR i TO cc DO
FOR j TO rc DO
( data OF trans )[ i, j ] := ( data OF m )[ j, i ]
OD
OD;
trans
END # transpose # ;
# BEGIN code from the Reduced row echelon form task #
MODE FIELD = REAL; # FIELD can be REAL, LONG REAL etc, or COMPL, FRAC etc #
MODE VEC = [0]FIELD;
MODE MAT = [0,0]FIELD;
PROC to reduced row echelon form = (REF MAT m)VOID: (
INT lead col := 2 LWB m;
FOR this row FROM LWB m TO UPB m DO
IF lead col > 2 UPB m THEN return FI;
INT other row := this row;
WHILE m[other row,lead col] = 0 DO
other row +:= 1;
IF other row > UPB m THEN
other row := this row;
lead col +:= 1;
IF lead col > 2 UPB m THEN return FI
FI
OD;
IF this row /= other row THEN
VEC swap = m[this row,lead col:];
m[this row,lead col:] := m[other row,lead col:];
m[other row,lead col:] := swap
FI;
FIELD scale = 1/m[this row,lead col];
IF scale /= 1 THEN
m[this row,lead col] := 1;
FOR col FROM lead col+1 TO 2 UPB m DO m[this row,col] *:= scale OD
FI;
FOR other row FROM LWB m TO UPB m DO
IF this row /= other row THEN
REAL scale = m[other row,lead col];
m[other row,lead col]:=0;
FOR col FROM lead col+1 TO 2 UPB m DO m[other row,col] -:= scale*m[this row,col] OD
FI
OD;
lead col +:= 1
OD;
return: EMPTY
);
# END code from the Reduced row echelon form task #
PROC inverse = ( MATRIX m )MATRIX:
BEGIN
require( row count OF m = col count OF m, "Not a square matrix" );
INT len = row count OF m;
MATRIX aug := len NEWMATRIX ( 2 * len );
FOR i TO len DO
FOR j TO len DO
( data OF aug )[ i, j ] := ( data OF m )[ i, j ];
( data OF aug )[ i, j + len ] := 0
OD;
# augment identity matrix to right #
( data OF aug )[ i, i + len ] := 1.0
OD;
to reduced row echelon form( data OF aug );
MATRIX inv := len NEWMATRIX len;
FOR i TO len DO
FOR j FROM len + 1 TO 2 * len DO
( data OF inv)[ i, j - len ] := ( data OF aug )[ i, j ]
OD
OD;
inv
END # inverse # ;
PROC multiple regression = ( []REAL y, MATRIX x )[]REAL:
BEGIN
MATRIX tm := NEWMATRIX y;
MATRIX cy := NEWMATRIX data OF transpose( tm );
MATRIX cx := NEWMATRIX data OF transpose( x );
( data OF transpose( inverse( x * cx ) * x * cy ) )[ 1, : ]
END # multiple regression # ;
OP PRINTARRAY = ( []REAL list )VOID:
BEGIN
print( ( "[" ) );
FOR i FROM LWB list TO UPB list DO
# convert list[ i ] to a string, remove trailing 0s and leading spaces #
STRING v := fixed( list[ i ], -20, 15 )[ AT 1 ];
WHILE v[ UPB v ] = "0" DO v := v[ : UPB v - 1 ] OD;
IF v[ UPB v ] = "." THEN v := v[ : UPB v - 1 ] FI;
WHILE v[ 1 ] = " " DO v := v[ 2 : ] OD;
print( ( IF i > LWB list THEN ", " ELSE "" FI, v ) )
OD;
print( ( "]" ) )
END # PRINTARRAY # ;
BEGIN
[]REAL y = ( 1.0, 2.0, 3.0, 4.0, 5.0 );
MATRIX x := NEWMATRIX []REAL( 2.0, 1.0, 3.0, 4.0, 5.0 );
[]REAL v = multiple regression( y, x );
PRINTARRAY v;
print( ( newline ) )
END;
BEGIN
[]REAL y = ( 3.0, 4.0, 5.0 );
MATRIX x := NEWMATRIX [,]REAL( ( 1.0, 2.0, 1.0 )
, ( 1.0, 1.0, 2.0 )
);
[]REAL v = multiple regression( y, x );
PRINTARRAY v;
print( ( newline ) )
END;
BEGIN
[]REAL y = ( 52.21, 53.12, 54.48, 55.84, 57.2, 58.57, 59.93
, 61.29, 63.11, 64.47, 66.28, 68.1, 69.92, 72.19, 74.46
);
[]REAL a = ( 1.47, 1.5, 1.52, 1.55, 1.57, 1.6, 1.63, 1.65
, 1.68, 1.7, 1.73, 1.75, 1.78, 1.8, 1.83
);
[ 1 : 3, 1 : 1 + ( UPB a - LWB a ) ]REAL xs;
FOR i FROM LWB a TO UPB a DO
xs[ 1, i ] := 1.0;
xs[ 2, i ] := a[ i ];
xs[ 3, i ] := a[ i ] * a[ i ]
OD;
MATRIX x := NEWMATRIX xs;
[]REAL v = multiple regression( y, x );
PRINTARRAY v;
print( ( newline ) )
END
END
</syntaxhighlight>
{{out}}
<pre>
[0.981818181818182]
[1, 2]
[128.812803581374, -143.162022866676, 61.9603254433538]
</pre>
=={{header|BBC BASIC}}==
Line 1,188 ⟶ 1,404:
STOP program complete
</pre>
=={{header|FreeBASIC}}==
{{trans|ERRE}}
<syntaxhighlight lang="vb">Const N = 14, M = 2, Q = 3 ' number of points and M.R. polynom degree
Dim As Double X(0 to N) = {1.47,1.50,1.52,1.55,1.57, _
1.60,1.63,1.65,1.68,1.70,1.73,1.75,1.78,1.80,1.83} ' data points
Dim As Double Y(0 to N) = {52.21,53.12,54.48,55.84,57.20, _
58.57,59.93,61.29,63.11,64.47,66.28,68.10,69.92,72.19,74.46} ' data points
Dim As Double S(N), T(N) ' linear system coefficient
Dim As Double A(M, Q) ' sistem to be solved
Dim As Integer i, k, j, fila, columna
Dim as Double z
For k = 0 To 2*M
S(k) = 0 : T(k) = 0
For i = 0 To N
S(k) += X(i) ^ k
If k <= M Then T(k) += Y(i) * X(i) ^ k
Next i
Next k
' build linear system
For fila = 0 To M
For columna = 0 To M
A(fila, columna) = S(fila+columna)
Next columna
A(fila, columna) = T(fila)
Next fila
Print "Linear system coefficents:"
For i = 0 To M
For j = 0 To M+1
Print Using "######.#"; A(i,j);
Next j
Print
Next i
For j = 0 To M
For i = j To M
If A(i,j) <> 0 Then Exit For
Next i
If i = M+1 Then
Print !"\nSINGULAR MATRIX '"
Sleep: End
End If
For k = 0 To M+1
Swap A(j,k), A(i,k)
Next k
z = 1 / A(j,j)
For k = 0 To M+1
A(j,k) = z * A(j,k)
Next k
For i = 0 To M
If i <> j Then
z = -A(i,j)
For k = 0 To M+1
A(i,k) += z * A(j,k)
Next k
End If
Next i
Next j
Print !"\nSolutions:"
For i = 0 To M
Print Using " #####.#######"; A(i,M+1);
Next i
Sleep</syntaxhighlight>
{{out}}
<pre>Linear system coefficents:
15.0 24.8 41.1 931.2
24.8 41.1 68.4 1548.2
41.1 68.4 114.3 2585.5
Solutions:
128.8128036 -143.1620229 61.9603254</pre>
=={{header|Go}}==
Line 2,249 ⟶ 2,542:
=={{header|Raku}}==
{{broken}}
(formerly Perl 6)
We're going to solve the example on the Wikipedia article using [https://github.com/grondilu/clifford Clifford], a [https://en.wikipedia.org/wiki/Geometric_algebra geometric algebra] module. Optimization for large vector space does not quite work yet, so it's going to take (a lof of) time and a fair amount of memory, but it should work.
Line 2,832 ⟶ 3,126:
{{trans|Kotlin}}
{{libheader|Wren-matrix}}
<syntaxhighlight lang="
var multipleRegression = Fn.new { |y, x|
| |||