Option Explicit On Option Strict On Public Class Form1 Private fnamedvi As String Private Sub ToolStripButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton1.Click Call main() End Sub Private Sub ToolStripButton2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton2.Click Dim dvipath As String 'カレントフォルダを出力ファイルのフォルダにする dvipath = System.IO.Path.GetDirectoryName(fnamedvi) System.IO.Directory.SetCurrentDirectory(dvipath) 'platex.exe実行 System.Diagnostics.Process.Start("c:\usr\local\bin\platex.exe", fnamedvi) End Sub Private Sub ToolStripButton3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton3.Click Dim dvipath As String 'dvipdfmによるpdf化 dvipath = System.IO.Path.GetDirectoryName(fnamedvi) fnamedvi = dvipath & "\" & System.IO.Path.GetFileNameWithoutExtension(fnamedvi) fnamedvi = fnamedvi & ".dvi" System.Diagnostics.Process.Start("c:\usr\local\bin\dvipdfm.exe", fnamedvi) End Sub Private Sub ToolStripButton4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton4.Click Dim pdfpath As String 'pdf表示 pdfpath = System.IO.Path.GetDirectoryName(fnamedvi) fnamedvi = pdfpath & "\" & System.IO.Path.GetFileNameWithoutExtension(fnamedvi) fnamedvi = fnamedvi & ".pdf" System.Diagnostics.Process.Start(fnamedvi) End Sub Private Sub main() '作図用変数宣言 Dim HSIZE As Double '画像横寸法(mm) Dim DHL As Double '画像左余白寸法:縦軸描画用(mm) Dim DHR As Double '画像右余白寸法(mm) Dim VSIZE As Double '画像縦寸法(mm) Dim DVL As Double '画像下余白寸法:横軸描画用(mm) Dim DVU As Double '画像上余白寸法(mm) Dim sxjiku As String 'x軸名(単位含む) Dim xmin As Double 'x軸最小値 Dim xmax As Double 'x軸最大値 Dim dx As Double 'x軸増分 Dim slog As String 'x軸の種類(L:対数,N:普通) Dim syjiku As String Dim ymin As Double Dim ymax As Double Dim xx As Double : Dim yy As Double Dim kxx1 As Double : Dim kyy1 As Double Dim kxx2 As Double : Dim kyy2 As Double Dim kxx As Double : Dim kyy As Double Dim dd As Double Dim str1 As String : Dim str2 As String Dim str3 As String : Dim str4 As String Dim kxi As Double : Dim kxf As Double : Dim kyi As Double : Dim kyf As Double 'データ格納用変数宣言 Dim ndata As Integer Dim datax() As Double Dim datay() As Double Dim alpha As Double = 0.5 'Hazen公式 Dim aa As Double Dim bb As Double Dim rr As Double 'データ入出力用変数宣言 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 fname1 As String = "" Dim fname2 As String = "" Dim work As Double Dim strs As String Dim i As Integer Dim j As Integer Dim k As Integer 'データ入力 OpenFileDialog1.InitialDirectory = My.Computer.FileSystem.CurrentDirectory If OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then fname1 = OpenFileDialog1.FileName sr = New System.IO.StreamReader(fname1, System.Text.Encoding.Default) dat = sr.ReadLine() dat = sr.ReadLine() : sbuf = dat.Split(delim) : sxjiku = sbuf(0) 'x軸名 dat = sr.ReadLine() : sbuf = dat.Split(delim) : HSIZE = CDbl(sbuf(0)) : DHL = CDbl(sbuf(1)) : DHR = CDbl(sbuf(2)) dat = sr.ReadLine() : sbuf = dat.Split(delim) : VSIZE = CDbl(sbuf(0)) : DVL = CDbl(sbuf(1)) : DVU = CDbl(sbuf(2)) dat = sr.ReadLine() : sbuf = dat.Split(delim) : xmin = CDbl(sbuf(0)) : xmax = CDbl(sbuf(1)) : dx = CDbl(sbuf(2)) : slog = sbuf(3) dat = sr.ReadLine() : sbuf = dat.Split(delim) : ndata = CInt(sbuf(0)) - 1 ReDim datax(ndata) ReDim datay(ndata) k = 0 Do While sr.Peek() >= 0 dat = sr.ReadLine() : sbuf = dat.Split(delim) datax(k) = CDbl(sbuf(0)) k = k + 1 Loop sr.Close() ndata = k - 1 'プロット領域定義 kxi = DHL kxf = HSIZE - DHR kyi = DVL kyf = VSIZE - DVU 'ソート(大きい順) For i = 0 To ndata For j = i + 1 To ndata If datax(i) < datax(j) Then work = datax(i) datax(i) = datax(j) datax(j) = work End If Next j, i 'x軸対数値の場合0データ処理 If slog = "L" Then For i = 0 To ndata If datax(i) <= 0 Then datax(i) = 0.00001 datax(i) = Math.Log10(datax(i)) If datax(i) < xmin Then datax(i) = xmin Next i End If '超過確率計算とy軸データ処理 For i = 0 To ndata datay(i) = (CDbl(i + 1) - alpha) / (CDbl(ndata + 1) + 1.0 - 2.0 * alpha) work = datay(i) datay(i) = TODA(work) Next i '回帰式(y=aa*x+bb,rr) Call KAIKI(ndata, datax, datay, aa, bb, rr) 'TeXファイル書き込み SaveFileDialog1.Filter = "*.tex|*.tex" If SaveFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then fname2 = SaveFileDialog1.FileName fnamedvi = fname2 sw = New System.IO.StreamWriter(fname2, False, System.Text.Encoding.Default) sw.WriteLine("\documentclass[a4paper,10pt]{jsarticle}") sw.WriteLine("\input{jartfmt}") sw.WriteLine("\usepackage[dvipdfm]{graphics,graphicx}") sw.WriteLine("\usepackage{colortbl}") sw.WriteLine("\begin{document}") sw.WriteLine("\begin{center}") sw.WriteLine("\unitlength=1mm") sw.WriteLine("\normalsize") sw.WriteLine("\begin{picture}(" & HSIZE.ToString("0.000") & "," & VSIZE.ToString("0.000") & ")") 'x軸描画 If slog = "N" Then Call TeX_DRN_XJIKU(sw, xmin, xmax, dx, kxi, kxf, kyi, kyf) If slog = "L" Then Call TeX_DRL_XJIKU(sw, xmin, xmax, kxi, kxf, kyi, kyf) 'y軸描画 ymax = TODA(0.999) ymin = TODA(0.001) Call TeX_DRH_YJIKU(sw, ymin, ymax, kxi, kxf, kyi, kyf) '枠線の描画 str1 = kxi.ToString("0.000") str2 = kyi.ToString("0.000") str3 = (kxf - kxi).ToString("0.000") sw.WriteLine("\put(" & str1 & "," & str2 & "){\line(1,0){" & str3 & "}}") str1 = kxi.ToString("0.000") str2 = kyf.ToString("0.000") str3 = (kxf - kxi).ToString("0.000") sw.WriteLine("\put(" & str1 & "," & str2 & "){\line(1,0){" & str3 & "}}") str1 = kxi.ToString("0.000") str2 = kyi.ToString("0.000") str3 = (kyf - kyi).ToString("0.000") sw.WriteLine("\put(" & str1 & "," & str2 & "){\line(0,1){" & str3 & "}}") str1 = kxf.ToString("0.000") str2 = kyi.ToString("0.000") str3 = (kyf - kyi).ToString("0.000") sw.WriteLine("\put(" & str1 & "," & str2 & "){\line(0,1){" & str3 & "}}") 'x軸名 str1 = (kxi + 0.5 * (kxf - kxi)).ToString("0.000") str2 = (2.0).ToString("0.000") sw.WriteLine("\put(" & str1 & "," & str2 & "){\makebox(0,0){" & sxjiku & "}}") 'y軸名 syjiku = "超過確率~(\%)" str1 = (5.0).ToString("0.000") str2 = (kyi + 0.5 * (kyf - kyi)).ToString("0.000") sw.WriteLine("\put(" & str1 & "," & str2 & "){\makebox(0,0){\rotatebox{90}{" & syjiku & "}}}") '丸印描画 For i = 0 To ndata xx = datax(i) yy = datay(i) If yy < ymin Then yy = ymin kxx = kxi + (xx - xmin) * (kxf - kxi) / (xmax - xmin) kyy = kyi + (yy - ymin) * (kyf - kyi) / (ymax - ymin) strs = "$\bullet$" str1 = kxx.ToString("0.000") str2 = kyy.ToString("0.000") sw.WriteLine("\put(" & str1 & "," & str2 & "){\makebox(0,0){" & strs & "}}") Next i '回帰曲線描画 xx = xmin : yy = aa * xx + bb If yy >= ymax Then yy = ymax : xx = (yy - bb) / aa End If kxx1 = kxi + (xx - xmin) * (kxf - kxi) / (xmax - xmin) kyy1 = kyi + (yy - ymin) * (kyf - kyi) / (ymax - ymin) xx = xmax : yy = aa * xx + bb If yy < ymin Then yy = ymin : xx = (yy - bb) / aa End If kxx2 = kxi + (xx - xmin) * (kxf - kxi) / (xmax - xmin) kyy2 = kyi + (yy - ymin) * (kyf - kyi) / (ymax - ymin) str1 = kxx1.ToString("0.000") str2 = kyy1.ToString("0.000") str3 = kxx2.ToString("0.000") str4 = kyy2.ToString("0.000") sw.WriteLine("\path(" & str1 & "," & str2 & ")(" & str3 & "," & str4 & ")") '回帰係数・相関係数表示 dd = 2.0 str1 = (kxf - 25.0).ToString("0.000") str2 = (kyf - dd * 5.0).ToString("0.000") sw.WriteLine("\put(" & str1 & "," & str2 & "){\begin{minipage}{2.5cm}") sw.WriteLine("\footnotesize") sw.WriteLine("\begin{tabular}{|l|}\hline") sw.WriteLine("\rowcolor{white} $y=a\cdot x+b$ \\") str1 = aa.ToString("0.00000") : sw.WriteLine("\rowcolor{white} $a=" & str1 & "$ \\") str1 = bb.ToString("0.00000") : sw.WriteLine("\rowcolor{white} $b=" & str1 & "$ \\") str1 = rr.ToString("0.00000") : sw.WriteLine("\rowcolor{white} $r=" & str1 & "$ \\ \hline") sw.WriteLine("\end{tabular}") sw.WriteLine("\end{minipage}}") sw.WriteLine("\end{picture}") sw.WriteLine("\end{center}") sw.WriteLine("\end{document}") sw.Close() End Sub Private Sub TeX_DRN_XJIKU(ByVal sw As System.IO.StreamWriter, _ ByVal xmin As Double, ByVal xmax As Double, ByVal dx As Double, _ ByVal kxi As Double, ByVal kxf As Double, _ ByVal kyi As Double, ByVal kyf As Double) Dim i As Integer Dim ix As Integer Dim xx As Double Dim kxx As Double Dim wv As Double Dim str0 As String Dim str1 As String Dim str2 As String Dim str3 As String Dim str4 As String Dim dat1 As String Dim dat2 As String '普通x軸描画 ix = CInt((xmax - xmin) / dx) For i = 0 To ix xx = xmin + CDbl(i) * dx kxx = kxi + (xx - xmin) * (kxf - kxi) / (xmax - xmin) wv = xmin + CDbl(i) * dx str0 = wv.ToString("0") If CInt(dx * 1000.0) Mod 10 <> 0 Then str0 = wv.ToString("0.000") If CInt(dx * 1000.0) Mod 10 = 0 And CInt(dx * 100.0) Mod 10 <> 0 Then str0 = wv.ToString("0.00") If (CInt(dx * 1000.0) Mod 10 = 0 And CInt(dx * 100.0) Mod 10 = 0) And CInt(dx * 10.0) Mod 10 <> 0 Then str0 = wv.ToString("0.0") str1 = kxx.ToString("0.000") str2 = kyi.ToString("0.000") str3 = kxx.ToString("0.000") str4 = kyf.ToString("0.000") dat1 = "\dottedline{1}(" & str1 & "," & str2 & ")(" & str3 & "," & str4 & ")" str2 = (kyi - 3.0).ToString("0.000") dat2 = "\put(" & str1 & "," & str2 & "){\makebox(0,0){" & str0 & "}}" sw.WriteLine(dat1 & dat2) Next i End Sub Private Sub TeX_DRL_XJIKU(ByVal sw As System.IO.StreamWriter, _ ByVal xmin As Double, ByVal xmax As Double, _ ByVal kxi As Double, ByVal kxf As Double, _ ByVal kyi As Double, ByVal kyf As Double) Dim i As Integer Dim xx As Double Dim kxx As Double Dim str0 As String Dim str1 As String Dim str2 As String Dim str3 As String Dim str4 As String Dim dat1 As String Dim dat2 As String '対数x軸描画 For i = CInt(xmin) To CInt(xmax) - 1 For j = 1 To 9 xx = System.Math.Log10(CDbl(j) * System.Math.Pow(10.0, CDbl(i))) kxx = kxi + (xx - xmin) * (kxf - kxi) / (xmax - xmin) str1 = kxx.ToString("0.000") str2 = kyi.ToString("0.000") str3 = kxx.ToString("0.000") str4 = kyf.ToString("0.000") dat1 = "\dottedline{1}(" & str1 & "," & str2 & ")(" & str3 & "," & str4 & ")" sw.WriteLine(dat1) Next j Next i For i = CInt(xmin) To CInt(xmax) xx = CDbl(i) kxx = kxi + (xx - xmin) * (kxf - kxi) / (xmax - xmin) str0 = CStr(System.Math.Pow(10.0, CDbl(i))) str1 = kxx.ToString("0.000") str2 = (kyi - 3.0).ToString("0.000") dat2 = "\put(" & str1 & "," & str2 & "){\makebox(0,0){" & str0 & "}}" sw.WriteLine(dat2) Next i End Sub Private Sub TeX_DRH_YJIKU(ByVal sw As System.IO.StreamWriter, _ ByVal ymin As Double, ByVal ymax As Double, _ ByVal kxi As Double, ByVal kxf As Double, _ ByVal kyi As Double, ByVal kyf As Double) Dim i As Integer Dim yy As Double Dim kyy As Double Dim strs As String = "" Dim str1 As String Dim str2 As String Dim str3 As String Dim str4 As String Dim str5 As String Dim str6 As String Dim work As Double For i = 1 To 11 If i = 1 Then strs = "99.9" If i = 2 Then strs = "99" If i = 3 Then strs = "95" If i = 4 Then strs = "90" If i = 5 Then strs = "80" If i = 6 Then strs = "50" If i = 7 Then strs = "20" If i = 8 Then strs = "10" If i = 9 Then strs = "5" If i = 10 Then strs = "1" If i = 11 Then strs = "0.1" work = CDbl(CDbl(strs) / 100.0) : yy = TODA(work) kyy = kyi + (yy - ymin) * (kyf - kyi) / (ymax - ymin) str1 = kxi.ToString("0.000") str2 = kyy.ToString("0.000") str3 = kxf.ToString("0.000") str4 = kyy.ToString("0.000") str5 = (kxi - 5.0).ToString("0.000") str6 = kyy.ToString("0.000") sw.WriteLine("\dottedline{0.5}(" & str1 & "," & str2 & ")(" & str3 & "," & str4 & ")\put(" & str5 & "," & str6 & "){\makebox(0,0){" & strs & "}}") Next i End Sub Private Sub KAIKI(ByVal ndata As Integer, ByRef datax() As Double, ByRef datay() As Double, _ ByRef aa As Double, ByRef bb As Double, ByRef rr As Double) Dim i As Integer Dim x1 As Double : Dim y1 As Double : Dim x2 As Double : Dim xy As Double Dim xm As Double : Dim ym As Double Dim c1 As Double : Dim c2 As Double : Dim c3 As Double '回帰式:y=aa*x+bb x1 = 0.0 : y1 = 0.0 : x2 = 0.0 : xy = 0.0 For i = 0 To ndata x1 = x1 + datax(i) y1 = y1 + datay(i) x2 = x2 + datax(i) * datax(i) xy = xy + datax(i) * datay(i) Next i xm = x1 / CDbl(ndata + 1) : ym = y1 / CDbl(ndata + 1) aa = (CDbl(ndata + 1) * xy - x1 * y1) / (CDbl(ndata + 1) * x2 - x1 * x1) bb = (x2 * y1 - x1 * xy) / (CDbl(ndata + 1) * x2 - x1 * x1) c1 = 0.0 : c2 = 0.0 : c3 = 0.0 For i = 0 To ndata c1 = c1 + (datax(i) - xm) * (datay(i) - ym) c2 = c2 + (datax(i) - xm) * (datax(i) - xm) c3 = c3 + (datay(i) - ym) * (datay(i) - ym) Next i rr = c1 / Math.Sqrt(c2 * c3) End Sub Private Function TODA(ByVal rx As Double) As Double Dim ry As Double Dim ay As Double Dim uay As Double Dim b0 As Double Dim b1 As Double Dim b2 As Double Dim b3 As Double Dim b4 As Double Dim b5 As Double Dim b6 As Double Dim b7 As Double Dim b8 As Double Dim b9 As Double Dim b10 As Double If rx = 0.5 Then uay = 0 Else If rx < 0.5 Then ry = rx Else ry = 1 - rx End If ay = -Math.Log(4.0 * ry * (1.0 - ry)) b0 = 1.570796288 b1 = 0.03706987906 b2 = -0.0008364353589 b3 = -0.0002250947176 b4 = 0.000006841218299 b5 = 0.000005824238515 b6 = -0.00000104527497 b7 = 0.00000008360937017 b8 = -0.000000003231081277 b9 = 0.00000000003657763036 b10 = 0.0000000000006936233982 uay = Math.Sqrt(ay * (b0 + b1 * ay + b2 * ay ^ 2.0 + b3 * ay ^ 3.0 + b4 * ay ^ 4.0 + b5 * ay ^ 5.0 + b6 * ay ^ 6.0 + b7 * ay ^ 7.0 + b8 * ay ^ 8.0 + b9 * ay ^ 9.0 + b10 * ay ^ 10.0)) If rx < 0.5 Then uay = -uay End If TODA = uay End Function End Class