aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-02-01 16:33:20 -08:00
parent 5150844a7d
commit 4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
Download patch file Download diff file Expand all files Collapse all files

95
Task/QR-decomposition/Ada/qr-decomposition.ada
View file

@ -1,95 +0,0 @@
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Real_Arrays; use Ada.Numerics.Real_Arrays;
with Ada.Numerics.Generic_Elementary_Functions;
procedure QR is
procedure Show (mat : Real_Matrix) is
package FIO is new Ada.Text_IO.Float_IO (Float);
begin
for row in mat'Range (1) loop
for col in mat'Range (2) loop
FIO.Put (mat (row, col), Exp => 0, Aft => 4, Fore => 5);
end loop;
New_Line;
end loop;
end Show;
function GetCol (mat : Real_Matrix; n : Integer) return Real_Matrix is
column : Real_Matrix (mat'Range (1), 1 .. 1);
begin
for row in mat'Range (1) loop
column (row, 1) := mat (row, n);
end loop;
return column;
end GetCol;
function Mag (mat : Real_Matrix) return Float is
sum : Real_Matrix := Transpose (mat) * mat;
package Math is new Ada.Numerics.Generic_Elementary_Functions
(Float);
begin
return Math.Sqrt (sum (1, 1));
end Mag;
function eVect (col : Real_Matrix; n : Integer) return Real_Matrix is
vect : Real_Matrix (col'Range (1), 1 .. 1);
begin
for row in col'Range (1) loop
if row /= n then vect (row, 1) := 0.0;
else vect (row, 1) := 1.0; end if;
end loop;
return vect;
end eVect;
function Identity (n : Integer) return Real_Matrix is
mat : Real_Matrix (1 .. n, 1 .. n) := (1 .. n => (others => 0.0));
begin
for i in Integer range 1 .. n loop mat (i, i) := 1.0; end loop;
return mat;
end Identity;
function Chop (mat : Real_Matrix; n : Integer) return Real_Matrix is
small : Real_Matrix (n .. mat'Length (1), n .. mat'Length (2));
begin
for row in small'Range (1) loop
for col in small'Range (2) loop
small (row, col) := mat (row, col);
end loop;
end loop;
return small;
end Chop;
function H_n (inmat : Real_Matrix; n : Integer)
return Real_Matrix is
mat : Real_Matrix := Chop (inmat, n);
col : Real_Matrix := GetCol (mat, n);
colT : Real_Matrix (1 .. 1, mat'Range (1));
H : Real_Matrix := Identity (mat'Length (1));
Hall : Real_Matrix := Identity (inmat'Length (1));
begin
col := col - Mag (col) * eVect (col, n);
col := col / Mag (col);
colT := Transpose (col);
H := H - 2.0 * (col * colT);
for row in H'Range (1) loop
for col in H'Range (2) loop
Hall (n - 1 + row, n - 1 + col) := H (row, col);
end loop;
end loop;
return Hall;
end H_n;
A : constant Real_Matrix (1 .. 3, 1 .. 3) := (
(12.0, -51.0, 4.0),
(6.0, 167.0, -68.0),
(-4.0, 24.0, -41.0));
Q1, Q2, Q3, Q, R: Real_Matrix (1 .. 3, 1 .. 3);
begin
Q1 := H_n (A, 1);
Q2 := H_n (Q1 * A, 2);
Q3 := H_n (Q2 * Q1* A, 3);
Q := Transpose (Q1) * Transpose (Q2) * TransPose(Q3);
R := Q3 * Q2 * Q1 * A;
Put_Line ("Q:"); Show (Q);
Put_Line ("R:"); Show (R);
end QR;

86
Task/QR-decomposition/PowerShell/qr-decomposition.psh
View file

@ -1,86 +0,0 @@
function qr([double[][]]$A) {
$m,$n = $A.count, $A[0].count
$pm,$pn = ($m-1), ($n-1)
[double[][]]$Q = 0..($m-1) | foreach{$row = @(0) * $m; $row[$_] = 1; ,$row}
[double[][]]$R = $A | foreach{$row = $_; ,@(0..$pn | foreach{$row[$_]})}
foreach ($h in 0..$pn) {
[double[]]$u = $R[$h..$pm] | foreach{$_[$h]}
[double]$nu = $u | foreach {[double]$sq = 0} {$sq += $_*$_} {[Math]::Sqrt($sq)}
$u[0] -= if ($u[0] -lt 0) {$nu} else {-$nu}
[double]$nu = $u | foreach {$sq = 0} {$sq += $_*$_} {[Math]::Sqrt($sq)}
[double[]]$u = $u | foreach { $_/$nu}
[double[][]]$v = 0..($u.Count - 1) | foreach{$i = $_; ,($u | foreach{2*$u[$i]*$_})}
[double[][]]$CR = $R | foreach{$row = $_; ,@(0..$pn | foreach{$row[$_]})}
[double[][]]$CQ = $Q | foreach{$row = $_; ,@(0..$pm | foreach{$row[$_]})}
foreach ($i in $h..$pm) {
foreach ($j in $h..$pn) {
$R[$i][$j] -= $h..$pm | foreach {[double]$sum = 0} {$sum += $v[$i-$h][$_-$h]*$CR[$_][$j]} {$sum}
}
}
if (0 -eq $h) {
foreach ($i in $h..$pm) {
foreach ($j in $h..$pm) {
$Q[$i][$j] -= $h..$pm | foreach {$sum = 0} {$sum += $v[$i][$_]*$CQ[$_][$j]} {$sum}
}
}
} else {
$p = $h-1
foreach ($i in $h..$pm) {
foreach ($j in 0..$p) {
$Q[$i][$j] -= $h..$pm | foreach {$sum = 0} {$sum += $v[$i-$h][$_-$h]*$CQ[$_][$j]} {$sum}
}
foreach ($j in $h..$pm) {
$Q[$i][$j] -= $h..$pm | foreach {$sum = 0} {$sum += $v[$i-$h][$_-$h]*$CQ[$_][$j]} {$sum}
}
}
}
}
foreach ($i in 0..$pm) {
foreach ($j in $i..$pm) {$Q[$i][$j],$Q[$j][$i] = $Q[$j][$i],$Q[$i][$j]}
}
[PSCustomObject]@{"Q" = $Q; "R" = $R}
}
function leastsquares([Double[][]]$A,[Double[]]$y) {
$QR = qr $A
[Double[][]]$Q = $QR.Q
[Double[][]]$R = $QR.R
$m,$n = $A.count, $A[0].count
[Double[]]$z = foreach ($j in 0..($m-1)) {
0..($m-1) | foreach {$sum = 0} {$sum += $Q[$_][$j]*$y[$_]} {$sum}
}
[Double[]]$x = @(0)*$n
for ($i = $n-1; $i -ge 0; $i--) {
for ($j = $i+1; $j -lt $n; $j++) {
$z[$i] -= $x[$j]*$R[$i][$j]
}
$x[$i] = $z[$i]/$R[$i][$i]
}
$x
}
function polyfit([Double[]]$x,[Double[]]$y,$n) {
$m = $x.Count
[Double[][]]$A = 0..($m-1) | foreach{$row = @(1) * ($n+1); ,$row}
for ($i = 0; $i -lt $m; $i++) {
for ($j = $n-1; 0 -le $j; $j--) {
$A[$i][$j] = $A[$i][$j+1]*$x[$i]
}
}
leastsquares $A $y
}
function show($m) {$m | foreach {write-host "$_"}}
$A = @(@(12,-51,4), @(6,167,-68), @(-4,24,-41))
$x = @(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
$y = @(1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321)
$QR = qr $A
$ps = (polyfit $x $y 2)
"Q = "
show $QR.Q
"R = "
show $QR.R
"polyfit "
"X^2 X constant"
"$(polyfit $x $y 2)"