Re: Least Squares in Perl

[Brother_Dan]

Hi monks, I know this thread is 6 years old, but i found it when searching for a linear least squares fit function in perl myself. I also owe respect since it was my first visit here and thought I would join the monastery and pay homage. I needed to prototype this alg which I would later need to code in a compact C-like language, so I chose to code it up in perl first. My solution is not elegant, you'll probably find my code amusing. It was intended to be C-like to make the porting easier. It doesn't return anything but prints slope, int, sigma of x, sigma of y, and r-squared coefficient of the lnie fit. These values check out with JMP and excel. I'll leave you grandmasters to customize it or make it more efficient. PM me if you see problems. Dan

@x = (1,2,3,4,5,6,7,8,9,10,11); #x data
@y = (0.06,0.1,0.14,0.21,0.26,0.29,0.35,0.41,0.46,0.5,0.57); #y data
my ($m, $d, $b, @xy, @x2, @xy_res, @x_res_sq, @y_res_sq) = (0); #vars,
+ arrays
$n = $#x + 1; #define number of elements in arrays/ a.k.a. sample size
foreach $i (0..$#x) #need one loop
    {                 
    $x2[$i]=$x[$i]*$x[$i]; #needed for summation of x[i]**2  
    $xy[$i]=$x[$i]*$y[$i]; #needed for summation of x[i]*y[i]
    $xy_res[$i] = abs($y[$i] - (Sum(@y)/$n))*abs($x[$i] - (Sum(@x)/$n)
+); #needed for summation of residuals of x[i]*y[i] in r2
    $y_res_sq[$i] = (abs($y[$i] - (Sum(@y)/$n)))**2; #needed for summa
+tions in y-sigma and r2 calcs
    $x_res_sq[$i] = (abs($x[$i] - (Sum(@x)/$n)))**2; #needed for summa
+tions in x-sigma and r2 calcs
    }       
$y_sigma = sqrt(Sum(@y_res_sq)/($#y)); #calculate the sigma of data in
+ y-array
$x_sigma = sqrt(Sum(@x_res_sq)/($#x)); #calculate the sigma of data in
+ x-array
$d = ($n*Sum(@x2)) - (Sum(@x)*Sum(@x)); #calculate the deviation
$m = (($n*Sum(@xy))-(Sum(@x)*Sum(@y)))/$d; #calculate the slope
$b = ((Sum(@x2)*Sum(@y)) - (Sum(@xy)*Sum(@x)))/$d; #calculate the inte
+rcept
$r2 = (Sum(@xy_res)/sqrt(Sum(@x_res_sq)*Sum(@y_res_sq)))**2; #calculat
+e the r-squared correlation coefficient (goodness of fit)
print "Slope = $m,  Intercept = $b, x-sigma = $x_sigma, y-sigma = $y_s
+igma, r2 = $r2\n"; #print out the goods
sub Sum #quick function for doing summing called many many times above
{   
    $sum = 0;
    $sum += $_ for @_; 
    return $sum;       
}

[Anonymous Monk]

nice code, but:

remove call to sum() out of the loop !

e.g.

my $sum_x = Sum(@x);

$xy_res[$i] = abs($y[$i] - ($sum_y/$n))*abs($x[$i] - ($sum_x/$n));