相関係数 - abwiki @ ウィキ (ActiveBasic非公式wiki)

/***********************************************************
corrcoef.c -- 相関係数
***********************************************************/
#N88BASIC


Sub corrcoef1(n As Long, x As *Single, y As *Single)
Dim i As Long
Dim sx As Single, sy As Single, sxx As Single, syy As Single, sxy As Single
Dim dx As Single, dy As Single

For i=0 To n-1
sx = sx + x[i]: sy = sy + y[i]
Next

sx = sx / n: sy = sy / n

For i = 0 To n-1
dx = x[i] - sx: dy = y[i] - sy
sxx = sxx + dx * dx: syy = syy + dy * dy: sxy = sxy + dx * dy
Next
sxx = Sqr(sxx / (n - 1))
syy = Sqr(syy / (n - 1))
sxy = sxy / (n - 1) * sxx * syy

Print "標準偏差";sxx;syy, "相関係数";sxy
End Sub

Sub corrcoef2(n As Long, x As *Single, y As *Single)
Dim i As Long
Dim sx As Single, sy As Single, sxx As Single, syy As Single, sxy As Single

For i=0 To n-1
sx += sx +x[i]: sy += sy +y[i]
sxx += sxx +x[i] * x[i]
syy += syy +y[i] * y[i]
sxy += sxy +x[i] * y[i]
Next

sx = sx /n: sxx = (sxx - n * sx * sx) / (n - 1)
sy = sy /n: syy = (syy - n * sy * sy) / (n - 1)
If (sxx > 0) Then sxx = Sqr(sxx) Else sxx = 0
If (syy > 0) Then syy = Sqr(syy) Else syy = 0
sxy = (sxy - n * sx * sy) / ((n - 1) * sxx * syy)
Print "標準偏差";sxx;syy, "相関係数";sxy
End Sub

Sub corrcoef3(n As Long, x As *Single, y As *Single)
Dim i As Long
Dim sx As Single, sy As Single, sxx As Single, syy As Single, sxy As Single
Dim dx As Single, dy As Single

For i=0 To n-1
dx = x[i] - sx: sx = sx + dx / (i + 1)
dy = y[i] - sy: sy = sy + dy / (i + 1)
sxx = sxx +i * dx * dx / (i + 1)
syy = syy +i * dy * dy / (i + 1)
sxy = sxy +i * dx * dy / (i + 1)
Next

sxx = Sqr(sxx / (n - 1))
syy = Sqr(syy / (n - 1))
sxy = sxy / (n - 1) * sxx * syy
Print "標準偏差";sxx;syy, "相関係数";sxy
End Sub

Const NMAX = 1000

main()
Sub main()
Dim s As String
Dim n As Long
Dim t As Single, u As Single

Dim x[NMAX] As Single, y[NMAX] As Single

n = 0
While (1)
If getnum(t) = 0 Then Exit While
If getnum(u) = 0 Then Exit While

If (n >= NMAX) Then
Print("多すぎます")
Exit Sub
End If
x[n] = t: y[n] = u: n=n+1
Wend
Print "データの件数";n
corrcoef1(n, x, y)
corrcoef2(n, x, y)
corrcoef3(n, x, y)
End Sub

Function getnum(ByRef f As Single) As Long
Dim s As String

Input s
If s = "end" Then Exit Function
f = Val(s)
getnum = 1
End Function