Option Explicit On Option Strict On Public Class Form1 Private Sub ToolStripButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton1.Click '重回帰分析(multiple regression analysis) Dim a(,) As Double Dim fname1 As String = "" Dim fname2 As String = "" Dim sr As System.IO.StreamReader Dim sw As System.IO.StreamWriter Dim dat As String Dim sbuf() As String Dim delim() As Char = {","c} Dim i As Integer Dim j As Integer Dim k As Integer Dim scom As String 'コメント Dim ndata As Integer 'データ組数−1 Dim mcol As Integer '説明変数の数−1 Dim mm As Integer '説明変数の数−1+1 Dim XD(,) As Double '説明変数入力値用配列 Dim XT(,) As Double '説明変数入力値用配列の転置行列 Dim YD() As Double '目的変数入力値 Dim YE() As Double '回帰推定値 Dim BB() As Double '偏回帰係数 Dim RR As Double '重相関係数 Dim YEmean As Double '回帰推定値の平均 Dim YDmean As Double '目的変数入力値の平均 Dim y1 As Double 'work変数 Dim y2 As Double 'work変数 Dim y3 As Double 'work変数 Dim RS() As Double '目的変数入力値と回帰推定値の差分 Dim std As Double '残差の標準偏差 ListBox1.Items.Clear() 'データ読み込み If OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then fname1 = OpenFileDialog1.FileName sr = New System.IO.StreamReader(fname1, System.Text.Encoding.Default) dat = sr.ReadLine() : sbuf = dat.Split(delim) : scom = sbuf(0) dat = sr.ReadLine() : sbuf = dat.Split(delim) : mcol = CInt(sbuf(0)) - 1 : ndata = CInt(sbuf(1)) - 1 mm = mcol + 1 ReDim XD(ndata, mm) ReDim XT(mm, ndata) ReDim YD(ndata) ReDim a(mm, mm + 1) ReDim BB(mm) ReDim YE(ndata) ReDim RS(ndata) i = 0 Do While sr.Peek() >= 0 dat = sr.ReadLine() : sbuf = dat.Split(delim) XD(i, 0) = 1.0 For j = 0 To mcol XD(i, j + 1) = CDbl(sbuf(j)) Next j YD(i) = CDbl(sbuf(mcol + 1)) i = i + 1 Loop sr.Close() '正規方程式作成 For i = 0 To ndata For j = 0 To mm XT(j, i) = XD(i, j) Next j, i For i = 0 To mm For j = 0 To mm a(i, j) = 0.0 For k = 0 To ndata a(i, j) = a(i, j) + XT(i, k) * XD(k, j) Next k Next j Next i For i = 0 To mm a(i, mm + 1) = 0.0 For k = 0 To ndata a(i, mm + 1) = a(i, mm + 1) + XT(i, k) * YD(k) Next k Next i '連立一次方程式の解 Call MATGJ(mm, a) For i = 0 To mm BB(i) = a(i, mm + 1) Next i '重相関係数算定 YDmean = 0.0 : YEmean = 0.0 For i = 0 To ndata YE(i) = 0.0 For j = 0 To mm YE(i) = YE(i) + XD(i, j) * BB(j) Next j YDmean = YDmean + YD(i) YEmean = YEmean + YE(i) Next i YDmean = YDmean / CDbl(ndata + 1) YEmean = YEmean / CDbl(ndata + 1) y1 = 0.0 : y2 = 0.0 : y3 = 0.0 For i = 0 To ndata y1 = y1 + (YD(i) - YDmean) * (YE(i) - YEmean) y2 = y2 + (YD(i) - YDmean) * (YD(i) - YDmean) y3 = y3 + (YE(i) - YEmean) * (YE(i) - YEmean) Next i RR = y1 / Math.Sqrt(y2 * y3) '残差の標準偏差 y1 = 0.0 For i = 0 To ndata RS(i) = YD(i) - YE(i) y1 = y1 + RS(i) Next i y1 = y1 / CDbl(ndata + 1) '残差の平均 y2 = 0.0 For i = 0 To ndata y2 = y2 + (RS(i) - y1) ^ 2 Next i std = Math.Sqrt(y2 / CDbl(ndata)) '残差の標準偏差 '分析結果の画面(ListBox)への書き出し ListBox1.Items.Add(scom) ListBox1.Items.Add("y=B0+B1*x1+B2*x2+・・・Bm*xm") For i = 0 To mm ListBox1.Items.Add("B" & CStr(i) & "=" & CStr(BB(i))) Next i ListBox1.Items.Add("重相関係数:R=" & RR.ToString("0.000")) ListBox1.Items.Add("データ数:n=" & (ndata + 1).ToString("0")) ListBox1.Items.Add("残差平均:" & y1.ToString) ListBox1.Items.Add("残差標準偏差:" & std.ToString) '分析結果のファイルへの書き出し If SaveFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then fname2 = SaveFileDialog1.FileName sw = New System.IO.StreamWriter(fname2, False, System.Text.Encoding.Default) sw.WriteLine(scom) sw.WriteLine("y=B0+B1*x1+B2*x2+・・・Bm*xm") sw.WriteLine("偏回帰係数") For i = 0 To mm sw.WriteLine("B" & CStr(i) & "=," & CStr(BB(i))) Next i sw.WriteLine("重相関係数:R=," & RR.ToString("0.000")) sw.WriteLine("データ数:n=," & (ndata + 1).ToString("0")) sw.WriteLine("残差平均:," & y1.ToString) sw.WriteLine("残差標準偏差:," & std.ToString) sw.WriteLine("目的変数入力値,回帰推定値") For i = 0 To ndata sw.WriteLine(CStr(YD(i)) & "," & CStr(YE(i))) Next i sw.Close() End Sub Private Sub MATGJ(ByVal n As Integer, ByRef a(,) As Double) '連立一次方程式の解法 Dim i As Integer Dim j As Integer Dim k As Integer Dim s As Integer Dim p As Double Dim d As Double Dim max As Double Dim dumy As Double For k = 0 To n max = 0.0 s = k For j = k To n If Math.Abs(a(j, k)) > max Then max = Math.Abs(a(j, k)) s = j End If Next j For j = 0 To n + 1 dumy = a(k, j) a(k, j) = a(s, j) a(s, j) = dumy Next j p = a(k, k) For j = k To n + 1 a(k, j) = a(k, j) / p Next j For i = 0 To n If i <> k Then d = a(i, k) For j = k To n + 1 a(i, j) = a(i, j) - d * a(k, j) Next j End If Next i Next k End Sub End Class