Data update

Task/Polynomial-regression/Ada/polynomial-regression-1.adb

@@ -0,0 +1,12 @@
+with Ada.Numerics.Real_Arrays;  use Ada.Numerics.Real_Arrays;
+
+function Fit (X, Y : Real_Vector; N : Positive) return Real_Vector is
+   A : Real_Matrix (0..N, X'Range);  -- The plane
+begin
+   for I in A'Range (2) loop
+      for J in A'Range (1) loop
+         A (J, I) := X (I)**J;
+      end loop;
+   end loop;
+   return Solve (A * Transpose (A), A * Y);
+end Fit;

Task/Polynomial-regression/Ada/polynomial-regression-2.adb

@@ -0,0 +1,15 @@
+with Fit;
+with Ada.Float_Text_IO;  use Ada.Float_Text_IO;
+
+procedure Fitting is
+   C : constant Real_Vector :=
+          Fit
+          (  (0.0, 1.0,  2.0,  3.0,  4.0,  5.0,   6.0,   7.0,   8.0,   9.0,  10.0),
+             (1.0, 6.0, 17.0, 34.0, 57.0, 86.0, 121.0, 162.0, 209.0, 262.0, 321.0),
+             2
+          );
+begin
+   Put (C (0), Aft => 3, Exp => 0);
+   Put (C (1), Aft => 3, Exp => 0);
+   Put (C (2), Aft => 3, Exp => 0);
+end Fitting;

Task/Polynomial-regression/Emacs-Lisp/polynomial-regression.el

@@ -0,0 +1,3 @@
+(let ((x '(0 1 2 3 4 5 6 7 8 9 10))
+      (y '(1 6 17 34 57 86 121 162 209 262 321)))
+  (calc-eval "fit(a*x^2+b*x+c,[x],[a,b,c],[$1 $2])" nil (cons 'vec x) (cons 'vec y)))

Task/Polynomial-regression/Pluto/polynomial-regression.pluto

@@ -0,0 +1,35 @@
+require "table2"
+local fmt = require "fmt"
+
+local function polynomial_regression(x, y)
+    local xm   = x:mean()
+    local ym   = y:mean()
+    local x2m  = x:mapped(|e| -> e * e):mean()
+    local x3m  = x:mapped(|e| -> e * e * e):mean()
+    local x4m  = x:mapped(|e| -> e * e * e * e):mean()
+    local z    = table.zip(x, y)
+    local xym  = z:mapped(|p| -> p[1] * p[2]):mean()
+    local x2ym = z:mapped(|p| -> p[1] * p[1] * p[2]):mean()
+
+    local sxx   = x2m - xm * xm
+    local sxy   = xym - xm * ym
+    local sxx2  = x3m - xm * x2m
+    local sx2x2 = x4m - x2m * x2m
+    local sx2y  = x2ym - x2m * ym
+
+    local b = (sxy * sx2x2 - sx2y * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
+    local c = (sx2y * sxx - sxy * sxx2) / (sxx * sx2x2 - sxx2 * sxx2)
+    local a = ym - b * xm - c * x2m
+
+    local function abc(xx) return a + b * xx + c * xx * xx end
+
+    fmt.print("y = %g + %gx + %gx%s\n", a, b, c, fmt.super(2))
+    print(" Input  Approximation")
+    print(" x   y     y1")
+    for z as p do fmt.print("%2d %3d  %5.1f", p[1], p[2], abc(p[1])) end
+end
+
+local x = {}
+for i = 1, 11 do x[i] = i - 1 end
+local y = {1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321}
+polynomial_regression(x, y)

Task/Polynomial-regression/PowerShell/polynomial-regression.ps1

@@ -0,0 +1,80 @@
+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 1) {$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)
+"polyfit "
+"X^2 X constant"
+"$(polyfit $x $y 2)"