چگونگی رگرسیون خطی زدن در ویِژوال بیسیک

[zmirsafi]

سلام دوستان
می‌خواستم بین یه سری داده که در فایل نت پد هستن رگرسیون خطی بزنم.ممنون میشم اگر راهنماییم کنید و کدشو بهم بگید.
بازم ممنون

[m.4.r.m]

' Linear Regression, Y. vs. X (X is considered the indepent variable)
' Assume X and Y are arrays from 1 to N
Dim SX as double, SY as Double, SX2 as Double, SXY as Double, Dim SY as Double
SX=0; SY = 0
For I = 1 to N
SX = SX + X(I)
SX2 = SX2 + X(I) ^ 2
SY = SY + Y(I)
SY2 = SY2 + Y(I) ^ 2
SXY = SXY + X(I) * Y(I)
Next I
NUM = N * SXY - SX * SY
DEN = (N * SX2 - SX ^ 2) * (N * SY2 - SY ^ 2)
R = NUM / Sqr(DEN) ' Correlation Coefficient
b = R * StdY / StdX
a = MY - B * MX
StdErr0 = StdY * Sqr(1 - R ^ 2) ' Simple Standard Error (large N)
StdErr = Sqr((SY2 - SY ^ 2 / N - B * (SXY - SX * SY / N)) / (N - 2))'
Corrected Std Error
' Then equation is
Y = a + b*X

[zmirsafi]

سلام.ممنون از لطفتون
بازم سوال داشتم.میخاستم ببینم حالا من این داده ها رو در فایل نت پد که در دو تا ستون و هر ستون دارای حدود 5000 تا داده هستند رو چجووری باید وارد برنامه کنم؟
یا بهتر بپرسم چطور میتونم و با چه کدی این داده ها رو به ترتیب در برنامه فراخونی کنم.ممنون از کمکتون

[mehran901]

سلام.ممنون از لطفتون
بازم سوال داشتم.میخاستم ببینم حالا من این داده ها رو در فایل نت پد که در دو تا ستون و هر ستون دارای حدود 5000 تا داده هستند رو چجووری باید وارد برنامه کنم؟
یا بهتر بپرسم چطور میتونم و با چه کدی این داده ها رو به ترتیب در برنامه فراخونی کنم.ممنون از کمکتون
شما کلا میتونین ی فایل تکست با دسترسی مستقیم رو به شکل زیر داخل برنامه لود کنین ... البته روش های دیگه ای هم هست

k = freefile
dim z$,zz$
open "c:\t.txt" for input as #k
do until eof(k)
input#k,z
zz = zz & vbcrlf & z
doevents
loop
close #k

[zmirsafi]

سلام.ممنون از کمکتون
ولی من این کد رو واسه رگرسیون گیری از داده هایی که در فایل متنیم وجود داشت نوشتم ولی خطا میده ومن نمیدونم مشکلش کجاست.ممنون میشم راهنماییم کنید..
k = FreeFile
Dim z$, zz$, zzz$
Open "d:\ks.txt" For Input As #k
Do Until EOF(k)
Input #k, z
zz = zz & vbCrLf & z
DoEvents
Loop
Close #k

'linear regression,y,vs,x(x is considerd the indepent variable
' assum x and y are arrays from 1 to n
Dim sx As Double, sy As Double, sx2 As Double, sxy As Double
Dim sy As Double
sx = 0
sy = 0
For i = i To n
sx = sx + x(i)
sx2 = sx2 + x(i) ^ 2
sy = sy + y(i)
sy2 = sy2 + y(i) ^ 2
sxy = sxy + x(i) * y(i)
Next i
num = n * sxy - sx * sy
den = (n * sx2 - sx ^ 2) * (n * sy2 - sy ^ 2)
r = num / Sqr(den) 'Correlation cofficient
b = r * stdy / stdx
a = my - b * mx
stderr0 = stdy * Sqr(1 - r ^ 2) 'Simple Standard Error(large N)
stderr = Sqr((sy2 - sy ^ 2 / n - b * (sxy - sx * sy / n)) / (n - 2))
'corrected std Error
' then equation is
y = a + b * x

[m.4.r.m]

اینو تو ماژول کپی کن :

Public Function LinearRegression(ByRef Values() As Double, _
ByRef ResultsCopyTo() As Double)
Dim x As Integer
Dim y() As Double
Dim intLoop As Integer
Dim n As Integer
Dim q1 As Double
Dim q2 As Double
Dim q3 As Double
Dim XY As Double
Dim XSquared As Double
Dim YSquared As Double
Dim XSum As Double
Dim YSum As Double
Dim XSquaredSum As Double
Dim YSquaredSum As Double
Dim XYSum As Double
x = UBound(Values)
ReDim y(1 To x) As Double
For intLoop = 1 To x
y(intLoop) = Values(intLoop) 'Copy values to X
Next intLoop
For intLoop = 1 To x
XSum = XSum + intLoop
YSum = YSum + y(intLoop)
XSquaredSum = XSquaredSum + (intLoop * intLoop)
YSquaredSum = YSquaredSum + (y(intLoop) * y(intLoop))
XYSum = XYSum + (y(intLoop) * intLoop)
Next intLoop
n = x 'Number of periods in calculation
q1 = (XYSum - ((XSum * YSum) / n))
q2 = (XSquaredSum - ((XSum * XSum) / n))
q3 = (YSquaredSum - ((YSum * YSum) / n))
ResultsCopyTo(1) = (q1 / q2) '= (0.1 * (XYSum - (3 * YSum))) 'Slope
ResultsCopyTo(2) = (YSum - ResultsCopyTo(1) * XSum) / n 'Intercept
ResultsCopyTo(3) = (((n + 1) * ResultsCopyTo(1)) + ResultsCopyTo(2)) 'Forecast
ResultsCopyTo(4) = (q1 * q1) / (q2 * q3) 'Coefficient of determination (R-Squared)
End Function


اینم نمونه کد :

Sub Main()
Dim strResults As String
Dim Test(1 To 4) As Double
Dim Results(1 To 4) As Double
Test(1) = 281.28
Test(2) = 277.44
Test(3) = 269.33
Test(4) = 266.25
Call LinearRegression(Test, Results)
strResults = "Slope: " & Results(1) & vbCrLf & _
"Intercept: " & Results(2) & vbCrLf & _
"Forecast: " & Results(3) & vbCrLf & _
"R-Squared: " & Results(4)
MsgBox strResults, vbInformation, "Linear Regression"
End Sub

Private Sub Command1_Click()
Call Main
End Sub