Created
November 7, 2020 19:03
-
-
Save dj1711572002/4b15039167bd53042553d9b83b5a0140 to your computer and use it in GitHub Desktop.
VB.NET Matrix_Calculator rev03 libraryChange TonoikeKotaro version
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Imports Microsoft.VisualBasic.FileIO | |
| Imports System.Text | |
| Imports System.IO | |
| Imports System.Math | |
| Imports ImagingSolution 'ImagingSolution.Matクラス用 | |
| Public Class Form1 | |
| '===================DataGridView ============== | |
| Public dgv() As DataGridView | |
| Public i, j, k As Integer | |
| Public dgN As Integer | |
| '===================DETCHECK================ | |
| Public detMat(,) As Double | |
| Public LUA(,) As Double 'LUA matA Dummy Array | |
| Public LUB(,) As Double 'LUB matB Dummy Array | |
| Public LUAB(,) As Double 'LUAB matAB Dummy Array | |
| '=================MATRIX A================= | |
| Public matA_rowN As Integer | |
| Public matA_colN As Integer | |
| Public matA(,) As Double | |
| Public RmatA(,) As Double | |
| '=================MATRIX B================= | |
| Public matB_rowN As Integer | |
| Public matB_colN As Integer | |
| Public matB(,) As Double | |
| Public RmatB(,) As Double | |
| '=============matA とmatBの計算============= | |
| Public RmatAB(,) As Double | |
| Public maxN As Integer 'Row COlの大きいほう | |
| '================Data Set============ | |
| Public ds As DataSet | |
| Public dsFlag As Integer = 0 | |
| '======================DataTable &DGV Parameters ======================== | |
| Public dt() As DataTable | |
| Public dtRow As DataRow '型宣言 | |
| Public dt_chname() As String | |
| Public chHead() As String | |
| Public selectdt As Integer = 0 'dt ComboBox selected Index | |
| Public selectdt_1 As Integer = 1 'dt ComboBox selected Index | |
| Public copyCol() As String | |
| Public copyRow() As String | |
| Public copyHead As String | |
| Public copyCols(,) As String | |
| Public copyRows(,) As String | |
| Public copyHeads() As String | |
| '=============CSV Save====================== | |
| Public headerFlg As Integer = 0 | |
| Public file As System.IO.StreamWriter | |
| Public file1 As System.IO.StreamWriter | |
| Public Tfile1 As System.IO.StreamWriter | |
| Public readata(10000, 10000) As String | |
| Public cIndex, cIndex_max As Integer | |
| '====FILE Headers ============================= | |
| Public fname As String | |
| Public chname(17) As String | |
| Public wakuch(17) As String | |
| Public wakuN(6) As String | |
| '===============DataGridView用パラメータ========== | |
| Public Path As String '= "D:\Temp\TestData.csv" 'CsvファイルのPathを指定 | |
| Public Path_1 As String '1個前のファイル名 | |
| Public kaishiKeta As Integer = 1 ' データ配列書き込み開始列数 | |
| '==================Data Array======================== | |
| Public rIndex As Integer | |
| Public kajyuN As Integer | |
| 'waku1,2,3(荷重No,結果No)=correl,slope,intercept,X軸値mV、Y軸値mV | |
| 'chdata(荷重No,CHNo)=CH1-CH16 | |
| Public waku1(200, 7) As Double | |
| Public waku2(200, 7) As Double | |
| Public waku3(200, 7) As Double | |
| Public chdata(200, 17) As Double | |
| Public dgRow(17) As Double | |
| Private Sub TextBox3_TextChanged(sender As Object, e As EventArgs) Handles TextBox3.TextChanged | |
| End Sub | |
| '====================Current Cell 座標表示============================== | |
| Private Sub dgv1_CellClick(sender As Object, e As DataGridViewCellEventArgs) Handles dgv1.CellClick | |
| ''現在のセルの行インデックスを表示 | |
| TextBox1.Text = dgv1.CurrentCell.RowIndex | |
| '現在のセルの列インデックスを表示 | |
| TextBox2.Text = dgv1.CurrentCell.ColumnIndex | |
| End Sub | |
| Private Sub dgv2_CellClick(sender As Object, e As DataGridViewCellEventArgs) Handles dgv2.CellClick | |
| ''現在のセルの行インデックスを表示 | |
| TextBox1.Text = dgv2.CurrentCell.RowIndex | |
| '現在のセルの列インデックスを表示 | |
| TextBox2.Text = dgv2.CurrentCell.ColumnIndex | |
| End Sub | |
| Private Sub dgv3_CellClick(sender As Object, e As DataGridViewCellEventArgs) Handles dgv3.CellClick | |
| ''現在のセルの行インデックスを表示 | |
| TextBox1.Text = dgv3.CurrentCell.RowIndex | |
| '現在のセルの列インデックスを表示 | |
| TextBox2.Text = dgv3.CurrentCell.ColumnIndex | |
| End Sub | |
| '=============DataGridView Size 表示=================================== | |
| Private Sub maxRowCol() | |
| Label10.Text = "DataRow_" & dgv(dgN).RowCount & "行" & dgv(dgN).ColumnCount & "列" | |
| End Sub | |
| '=========================単列or単行コピー================================================= | |
| Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click | |
| 'Clipboard.SetDataObject(dgv(dgN).GetClipboardContent()) | |
| Dim cX As Integer = dgv(dgN).CurrentCell.ColumnIndex | |
| Dim cY As Integer = dgv(dgN).RowCount | |
| Dim rX As Integer = dgv(dgN).ColumnCount | |
| Dim rY As Integer = dgv(dgN).CurrentCell.RowIndex | |
| ReDim copyCol(cY) | |
| ReDim copyRow(rX) | |
| '-------------列コピー----------------------------- | |
| If RadioButton1.Checked = True Then | |
| copyHead = dgv(dgN).Columns(cX).HeaderText | |
| For i = 0 To cY - 1 | |
| copyCol(i) = CStr(dgv(dgN).Rows(i).Cells(cX).Value) | |
| Next i | |
| Label6.Text = "CopiedColNo" & cX | |
| End If | |
| '------------行コピー------------------------------- | |
| If RadioButton2.Checked = True Then | |
| For i = 0 To rX - 1 | |
| copyRow(i) = CStr(dgv(dgN).Rows(rY).Cells(i).Value) | |
| Next i | |
| Label6.Text = "CopiedRowNo" & rY | |
| End If | |
| End Sub | |
| '=========================単列or単行 上書きペースト============================================== | |
| Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click | |
| If Label6.Text <> "" Then 'COPY 在り | |
| '-------------列ペースト----------------------------- | |
| If RadioButton1.Checked = True Then | |
| Dim cX As Integer = dgv(dgN).CurrentCell.ColumnIndex | |
| Dim cY As Integer = dgv(dgN).RowCount | |
| dgv(dgN).Columns(cX).HeaderText = copyHead | |
| For i = 0 To dgv(dgN).Rows.Count - 1 | |
| dgv(dgN).Rows(i).Cells(cX).Value = copyCol(i) | |
| Next i | |
| Label6.Text = "PastedColNo" & cX | |
| End If | |
| '------------行ペースト------------------------------- | |
| If RadioButton2.Checked = True Then | |
| Dim rX As Integer = dgv(dgN).ColumnCount | |
| Dim rY As Integer = dgv(dgN).CurrentCell.RowIndex | |
| For i = 0 To rX - 1 | |
| dgv(dgN).Rows(rY).Cells(i).Value = copyRow(i) | |
| Next i | |
| Label6.Text = "PastedRowNo" & rY | |
| End If | |
| End If | |
| maxRowCol() | |
| End Sub | |
| '=====================列or行削除Remove Columns of Current Cursor==== | |
| Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click | |
| '-------------列消去----------------------------- | |
| If RadioButton1.Checked = True Then | |
| dgv(dgN).Columns.RemoveAt(dgv(dgN).CurrentCell.ColumnIndex) | |
| Label6.Text = "Deleted:" & dgv(dgN).CurrentCell.ColumnIndex | |
| End If | |
| '------------行消去------------------------------- | |
| If RadioButton2.Checked = True Then | |
| Dim rX As Integer = dgv(dgN).ColumnCount | |
| Dim rY As Integer = dgv(dgN).CurrentCell.RowIndex | |
| dgv(dgN).Rows.RemoveAt(rY) | |
| Label6.Text = "Deleted RowNo" & rY | |
| End If | |
| maxRowCol() | |
| End Sub | |
| '====================列挿入 現在列以降の前列をコピーして1列追加してペーストして現在列を空にする============ | |
| Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click | |
| Dim cmax As Integer = dgv(dgN).ColumnCount | |
| Dim cX As Integer = dgv(dgN).CurrentCell.ColumnIndex | |
| Dim cY As Integer = dgv(dgN).RowCount | |
| ReDim copyCols(cY, cmax) | |
| ReDim copyHeads(cmax) | |
| '-------------列挿入----------------------------- | |
| If RadioButton1.Checked = True Then | |
| copyHead = dgv(dgN).Columns(cX).HeaderText | |
| '-----------移動行列コピー-------------------------------- | |
| For i = 0 To cY - 1 | |
| For j = 0 To cmax - cX - 1 | |
| copyHeads(j) = dgv(dgN).Columns(j + cX).HeaderText | |
| copyCols(i, j) = CStr(dgv(dgN).Rows(i).Cells(j + cX).Value) | |
| Next j | |
| Next i | |
| Label6.Text = "CopiedCols=" & cX & "-" & cmax | |
| '----------------列追加----------------------------------- | |
| Dim colName As New DataGridViewTextBoxColumn() | |
| colName.Name = "dummy" | |
| colName.HeaderText = "dummy" | |
| dgv(dgN).Columns.Add(colName) | |
| cmax = dgv(dgN).ColumnCount | |
| '-----------------列ペースト--------------- | |
| For i = 0 To cY - 1 | |
| For j = 0 To cmax - cX - 2 | |
| dgv(dgN).Columns(j + cX + 1).HeaderText = copyHeads(j) | |
| dgv(dgN).Rows(i).Cells(j + cX + 1).Value = copyCols(i, j) | |
| Next j | |
| Next i | |
| For i = 0 To cY - 1 | |
| dgv(dgN).Rows(i).Cells(cX).Value = 0 | |
| Next i | |
| End If | |
| '------------行挿入------------------------------- | |
| If RadioButton2.Checked = True Then | |
| Dim rX As Integer = dgv(dgN).ColumnCount | |
| Dim rY As Integer = dgv(dgN).CurrentCell.RowIndex | |
| dgv(dgN).Rows.Insert(rY) | |
| End If | |
| maxRowCol() | |
| End Sub | |
| '======================================================================== | |
| '==================DataTableをdgvに表示================================== | |
| '======================================================================== | |
| Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click | |
| '------dgv Clear-------------- | |
| dgv(dgN).Columns.Clear（） | |
| dgv(dgN).DataSource = Nothing | |
| selectdt = ComboBox1.SelectedIndex | |
| If selectdt_1 <> selectdt Then | |
| selectdt_1 = selectdt | |
| dgv(dgN).Columns.Clear（） | |
| dgv(dgN).DataSource = DataSet1.Tables(selectdt) 'selectdt | |
| Label3.Text = "DataTable:" & ComboBox1.SelectedItem | |
| End If | |
| ' 最終行のインデックスを取得する | |
| 'Dim idx As Integer = dg(dgN).RowCount - 1 | |
| '' DataGridView の最終行を削除（インデックス指定） | |
| 'dgv(dgN).Rows.RemoveAt(idx) | |
| maxRowCol() | |
| End Sub | |
| '=============================================================================== | |
| ' DataTable Make | |
| 'DGVから読み込んでDataTable化する | |
| '=============================================================================== | |
| Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click | |
| '---------dgv(dgN) サイズ表示------- | |
| TextBox4.Text = dgv(dgN).Columns.Count | |
| TextBox5.Text = dgv(dgN).Rows.Count | |
| '---------------------------------- | |
| File_matrix() | |
| End Sub | |
| '================================================================================== | |
| 'DataGridView全データを CSV保存 | |
| '================================================================================= | |
| Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click | |
| Dim f1open As Integer | |
| Dim fname1 As String | |
| Dim fStr1 As String | |
| Dim fStr2 As String | |
| f1open = 0 | |
| '========First CSV File Declaration====================== | |
| If f1open = 0 Then | |
| fname1 = Format(Now, "yyyyMMdd_HHmmss") | |
| fStr1 = "" 'ComboBox9.SelectedItem.ToString() | |
| fname1 = "C:\vb_LOG\" & fStr1 & fname1 & ".csv" | |
| fStr2 = "FileOpen:" + fname1 | |
| '------------------------------------------ | |
| Dim enc As System.Text.Encoding = System.Text.Encoding.GetEncoding(“Shift_JIS”) | |
| file1 = My.Computer.FileSystem.OpenTextFileWriter(fname1, False, enc) | |
| f1open = 1 | |
| '---------定義されたサイズ全体を保存する-------------------- | |
| For i = 0 To dgv(dgN).RowCount - 1 | |
| For j = 0 To dgv(dgN).ColumnCount - 1 | |
| Dim sdata = CStr(dgv(dgN).Rows(i).Cells(j).Value) | |
| If sdata = "" Then | |
| Exit For | |
| End If | |
| If j < dgv(dgN).Columns.Count - 1 Then | |
| sdata = sdata & "," | |
| End If | |
| file1.Write(sdata) | |
| Next j | |
| file1.Write(vbCrLf) | |
| Next i | |
| file1.Close() | |
| End If | |
| End Sub | |
| '=================FILE OPEN FIleReading DGVへ自動追記======================== | |
| Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click | |
| CSV_DGV() | |
| End Sub | |
| '========================================================================== | |
| '==============--一般のＣＳＶファイル読み込みＤＧＶ=================================== | |
| '===================ヘッダの有無は、最初変数がが数値か文字かで判定============================ | |
| Private Sub CSV_DGV() | |
| Dim datasu As Integer | |
| Dim maxRowCSV As Integer | |
| '---------dgv サイズ表示------- | |
| TextBox4.Text = dgv(dgN).Columns.Count | |
| TextBox5.Text = dgv(dgN).Rows.Count | |
| '---------------------------------- | |
| If CheckBox1.Checked = True Then | |
| '-----dgvに表示------------ | |
| '------dgv初期化-------------- | |
| dgv(dgN).Columns.Clear（） | |
| dgv(dgN).DataSource = Nothing | |
| '------File名Path------------------- | |
| Path = readfile() 'Dialogから読み込むファイル名指定 | |
| Label3.Text = Path | |
| '-------ファイルの行数---------------- | |
| maxRowCSV = GetLinesOfTextFile(Path) | |
| Label1.Text = CStr(maxRowCSV) & "行" | |
| '--------CSVァイル読み込み----------------- | |
| ' Label2.Text = "CSV File Reading" | |
| datasu = CSV_crlf(Path) 'ファイルの改行数なのでHeader行も含まれる行数なのでRowではない | |
| 'Label2.Text = "CSV File Read Finished" | |
| '--------dgv 行数設定-------------------- | |
| If IsNumeric(readata(0, 0)) = False Then 'ヘッダーあり | |
| Label15.Text = "ヘッダーあり" | |
| dgv(dgN).RowCount = datasu - 1 'ヘッダー行を差し引いてDGVの行を作る | |
| Debug.Print("cIndex_max=" & CStr(cIndex_max)) | |
| dgv(dgN).ColumnCount = cIndex_max | |
| headerFlg = 1 | |
| End If | |
| If IsNumeric(readata(0, 0)) = True Then 'ヘッダーなし | |
| Label15.Text = "ヘッダーなし" | |
| dgv(dgN).RowCount = datasu 'データ数分DGVの行を作る | |
| Debug.Print("cIndex_max=" & CStr(cIndex_max)) | |
| dgv(dgN).ColumnCount = cIndex_max | |
| headerFlg = 0 | |
| End If | |
| '========================Header Col作成================= | |
| If IsNumeric(readata(0, 0)) = False Then 'ヘッダーがある場合 | |
| For j = 0 To cIndex_max - 1 | |
| dgv(dgN).Columns(j).HeaderText = readata(0, j) 'dgvの列Header Property定義 | |
| Next | |
| End If | |
| '=========CSVから全データ配列 redata(maxRowCSV,cIndex)========== | |
| rIndex += 1 | |
| For i = 0 To dgv(dgN).RowCount - 1 | |
| For j = 0 To dgv(dgN).ColumnCount - 1 '1その行の列数は、readata(行,0)に格納されている | |
| 'Debug.Print("DGV_rdata(" & CStr(i) & "," & CStr(j) & ")=" & CStr(readata(i, j))) | |
| dgv(dgN).Rows(i).Cells(j).Value = readata(i + headerFlg, j) | |
| Next j | |
| Next i | |
| End If | |
| maxRowCol() | |
| End Sub | |
| Private Function readfile() As String | |
| Dim ofd As New OpenFileDialog() | |
| 'はじめのファイル名を指定する | |
| 'はじめに「ファイル名」で表示される文字列を指定する | |
| ofd.FileName = "yyyyMMdd_HHmmss" '"default.html" | |
| 'はじめに表示されるフォルダを指定する | |
| '指定しない（空の文字列）の時は、現在のディレクトリが表示される | |
| ofd.InitialDirectory = "C:\vb_DT " | |
| '[ファイルの種類]に表示される選択肢を指定する | |
| '指定しないとすべてのファイルが表示される | |
| ofd.Filter = "TXTファイル|*.txt|CSVファイル|*.csv|すべてのファイル|*.*" | |
| '[ファイルの種類]ではじめに選択されるものを指定する | |
| '2番目の「すべてのファイル」が選択されているようにする | |
| ofd.FilterIndex = 2 | |
| 'タイトルを設定する | |
| ofd.Title = "開くファイルを選択してください" | |
| 'ダイアログボックスを閉じる前に現在のディレクトリを復元するようにする | |
| ofd.RestoreDirectory = True | |
| '存在しないファイルの名前が指定されたとき警告を表示する | |
| 'デフォルトでTrueなので指定する必要はない | |
| ofd.CheckFileExists = True | |
| '存在しないパスが指定されたとき警告を表示する | |
| 'デフォルトでTrueなので指定する必要はない | |
| ofd.CheckPathExists = True | |
| If ofd.ShowDialog() = DialogResult.OK Then | |
| 'OKボタンがクリックされたとき、選択されたファイル名を表示する | |
| Debug.Print(ofd.FileName) | |
| End If | |
| Return ofd.FileName | |
| End Function | |
| Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click | |
| '------dgv Clear-------------- | |
| dgv(dgN).Columns.Clear（） | |
| dgv(dgN).DataSource = Nothing | |
| End Sub | |
| Private Sub Label7_Click(sender As Object, e As EventArgs) Handles Label7.Click | |
| End Sub | |
| '============================================================================================== | |
| '====================FOTM初期============================================================ | |
| '============================================================================================== | |
| Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load | |
| rIndex = 0 ' DGVの初期行番号 | |
| dgv = {dgv1, dgv2, dgv3} | |
| RadioButton10.Checked = True | |
| dgN = 0 | |
| For i = 0 To 2 | |
| dgv(i).RowCount = 3 | |
| dgv(i).ColumnCount = 3 | |
| Next | |
| End Sub | |
| '========================================================================================== | |
| '===================CSVファイル読み込み ＣｒＬｆ付 FILE Read Function================================================= | |
| '====================================================================================== | |
| Private Function CSV_crlf(ByVal fnm As String) As Integer '戻り値はデータ数 | |
| Dim rdataN As Integer | |
| Using parser As New TextFieldParser(fnm, System.Text.Encoding.GetEncoding("Shift_JIS")) | |
| parser.TextFieldType = FieldType.Delimited | |
| parser.SetDelimiters(",") ' 区切り文字はコンマ | |
| ' parser.HasFieldsEnclosedInQuotes = False | |
| ' parser.TrimWhiteSpace = False | |
| cIndex = 0 | |
| cIndex_max = 0 | |
| rdataN = 0 | |
| While Not parser.EndOfData | |
| Dim row As String() = parser.ReadFields() ' 1行読み込み | |
| For Each field As String In row | |
| readata(rdataN, cIndex) = field | |
| cIndex += 1 | |
| ' Debug.Print("field=" & field) | |
| Debug.Print("readata(" & CStr(rdataN) & "," & CStr(cIndex) & ")=" & CStr(readata(rdataN, cIndex))) | |
| Next | |
| If cIndex > cIndex_max Then | |
| cIndex_max = cIndex | |
| End If | |
| cIndex = 0 | |
| rdataN += 1 | |
| End While | |
| End Using | |
| Return rdataN | |
| End Function | |
| '============================CSVファイル 総行数カウントFunction============================== | |
| Public Function GetLinesOfTextFile(ByVal FileName As String) As Integer | |
| Dim StReader As New System.IO.StreamReader(FileName) | |
| Dim LineCount As Integer | |
| While (StReader.Peek() >= 0) | |
| StReader.ReadLine() | |
| LineCount += 1 | |
| End While | |
| Return LineCount | |
| End Function | |
| '****************************************************************************************************************************** | |
| '****************************************************************************************************************************** | |
| ' マトリックス計算 ブロック | |
| '****************************************************************************************************************************** | |
| '****************************************************************************************************************************** | |
| '============================================================================================== | |
| '=================csv ファイルを読んでdgvに書いmatA配列を作る================================================= | |
| '============================================================================================== | |
| Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click | |
| RadioButton10.Checked = True | |
| dgv(dgN).Columns.Clear() | |
| '-----MatA file read ----------------------------- | |
| CSV_DGV() 'Sub ファイルを読んで、dgvに書き込む | |
| Label9.Text = Label3.Text '読み込んだFile 名 | |
| matA_rowN = dgv(dgN).Rows.Count - 1 | |
| matA_colN = dgv(dgN).Columns.Count - 1 | |
| '---set dgv(dgN)------------------ | |
| dgv(dgN).RowCount = matA_rowN + 1 | |
| dgv(dgN).ColumnCount = matA_colN + 1 | |
| Dim matAstr As String | |
| If dgv(dgN).Rows(0).Cells(matA_colN).Value = "" Then | |
| matA_colN = matA_colN - 1 | |
| End If | |
| Label13.Text = CStr(matA_rowN + 1) & "x" & CStr(matA_colN + 1) & ":" & "matA(" & CStr(matA_rowN) & "," & CStr(matA_colN) & ")" | |
| '-------matA(,) Making-------------------------------------------------- | |
| ReDim matA(matA_rowN, matA_colN) | |
| ReDim LUA(matA_rowN, matA_colN) | |
| For i = 0 To matA_rowN | |
| For j = 0 To matA_colN | |
| If dgv(dgN).Rows(i).Cells(j).Value <> "" Then | |
| matA(i, j) = dgv(dgN).Rows(i).Cells(j).Value | |
| LUA(i, j) = matA(i, j) | |
| matAstr = "matA(" & CStr(i) & "," & CStr(j) & ")=" & CStr(matA(i, j)) & vbCrLf | |
| RichTextBox1.AppendText(matAstr) | |
| matAstr = "" | |
| End If | |
| Next j | |
| Next i | |
| End Sub | |
| '============================================================================================== | |
| '=================マトリックスB ファイルを読み込み================================================== | |
| '============================================================================================== | |
| Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click | |
| RadioButton11.Checked = True | |
| CSV_DGV() | |
| Label12.Text = Label3.Text | |
| matB_rowN = dgv(1).Rows.Count - 1 | |
| matB_colN = dgv(1).Columns.Count - 1 | |
| Dim matBstr As String | |
| If dgv(1).Rows(0).Cells(matB_colN).Value = "" Then | |
| matB_colN = matB_colN - 1 | |
| End If | |
| Label14.Text = CStr(matB_rowN + 1) & "x" & CStr(matB_colN + 1) & ":" & "matB(" & CStr(matB_rowN) & "," & CStr(matB_colN) & ")" | |
| '-------matB(,) Making-------------------------------------------------- | |
| ReDim matB(matB_rowN, matB_colN) | |
| ReDim LUB(matB_rowN, matB_colN) | |
| For i = 0 To matB_rowN | |
| For j = 0 To matB_colN | |
| matB(i, j) = dgv(1).Rows(i).Cells(j).Value | |
| LUB(i, j) = matB(i, j) | |
| matBstr = "matB(" & CStr(i) & "," & CStr(j) & ")=" & CStr(matB(i, j)) & vbCrLf | |
| RichTextBox2.AppendText(matBstr) | |
| matBstr = "" | |
| Next j | |
| Next i | |
| End Sub | |
| '=========================行列計算Ａ================================================ | |
| '========================== matA 計算=============================================== | |
| Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click | |
| Dim matname As String = "" | |
| ReDim chHead(dgv(dgN).ColumnCount) | |
| dgN = 0 | |
| If RadioButton3.Checked = True Then ' 逆行列 | |
| matname = "Invs_A_" & Label9.Text.Substring(9, 4) | |
| End If | |
| If RadioButton4.Checked = True Then ' 転置 | |
| matname = "Trps_A_" & Label9.Text.Substring(9, 4) | |
| End If | |
| '=================Tfile1 Saving Preparation====================== | |
| Dim Tfname1 = Format(Now, "MMdd_HHmmss") | |
| Dim TfStr1 = matname 'Making Data Table Name | |
| Tfname1 = "C:\vb_DT\" & TfStr1 & Tfname1 & ".csv" | |
| Dim enc As System.Text.Encoding = System.Text.Encoding.GetEncoding(“Shift_JIS”) | |
| Tfile1 = My.Computer.FileSystem.OpenTextFileWriter(Tfname1, False, enc) | |
| Dim Tf1open = 1 | |
| '---------逆行列-------------------------- | |
| If RadioButton3.Checked = True Then '逆行列 | |
| ReDim RmatA(matA_rowN, matA_colN) | |
| Dim matAstr As String | |
| Dim xoff As Integer = matA_colN + 1 | |
| Dim addHeader(matA_colN) As String | |
| '---結果表示はdgv右横2行空け分列拡張---------- | |
| dgv(dgN).ColumnCount = (matA_colN + 1) * 2 + xoff | |
| '---------------Header追加-------------------- | |
| For j = 0 To matA_colN | |
| addHeader(j) = "Inv_A_" & CStr(j) | |
| Tfile1.Write(addHeader(j)) | |
| If j < matA_colN Then | |
| Tfile1.Write(",") | |
| End If | |
| dgv(dgN).Columns(j + xoff).HeaderText = addHeader(j) 'ヘッダー追加表示 | |
| Next j | |
| Tfile1.Write(vbCrLf) ' header改行 | |
| '----Mtrix Inverse------------------ | |
| ' RmatA = inverse(matA_colN + 1, matA) | |
| '--------------Check matA-------------------------------------------------------------------- | |
| For i = 0 To matA_rowN | |
| For j = 0 To matA_colN | |
| Debug.Print("InverseStart:matA(" & CStr(i) & "," & CStr(j) & ")=" & CStr(matA(i, j))) | |
| Next j | |
| Next i | |
| '--------------ChekcEnd--------------------------------------------------------------------- | |
| ' RmatA = gauss(matA, matA_colN + 1, matA_colN + 1) '静岡理科大 Function pivot選択 | |
| LuInv(LUA, RmatA) ' numeric world 引用 | |
| '--------------Check RmatA-------------------------------------------------------------------- | |
| For i = 0 To matA_rowN | |
| For j = 0 To matA_colN | |
| Debug.Print("InverseResult:matA(" & CStr(i) & "," & CStr(j) & ")=" & CStr(matA(i, j))) | |
| Debug.Print("InverseResult:LUA(" & CStr(i) & "," & CStr(j) & ")=" & CStr(LUA(i, j))) | |
| Debug.Print("InverseResult:RmatA(" & CStr(i) & "," & CStr(j) & ")=" & CStr(RmatA(i, j))) | |
| Next j | |
| Next i | |
| '--------------ChekcEnd--------------------------------------------------------------------- | |
| '=====表示=========================================== | |
| For i = 0 To matA_rowN | |
| For j = 0 To matA_colN | |
| dgv(dgN).Rows(i).Cells(j + xoff).Value = RmatA(i, j) | |
| Tfile1.Write(RmatA(i, j)) | |
| If j < matA_colN Then | |
| Tfile1.Write(",") | |
| End If | |
| matAstr = "Inv_A(" & CStr(i) & "," & CStr(j) & ")=" & CStr(RmatA(i, j)) & vbCrLf | |
| RichTextBox1.AppendText(matAstr) | |
| matAstr = "" | |
| Next j | |
| Tfile1.Write(vbCrLf) | |
| Next i | |
| Tfile1.Close() | |
| End If | |
| '-------------------転置-------------------------- | |
| If RadioButton4.Checked = True Then '逆行列 | |
| ReDim RmatA(matA_colN, matA_rowN) | |
| Dim matAstr As String | |
| Dim xoff As Integer = matA_colN + 1 | |
| Dim addHeader(matA_rowN) As String | |
| '---結果表示はdgv右横2行空け分列拡張---------- | |
| dgv(dgN).ColumnCount = (matA_rowN + 1) * 2 + xoff | |
| '---------------Header追加-------------------- | |
| For j = 0 To matA_rowN | |
| addHeader(j) = "Inv_A_" & CStr(j) | |
| Tfile1.Write(addHeader(j)) | |
| If j < matA_rowN Then | |
| Tfile1.Write(",") | |
| End If | |
| dgv(dgN).Columns(j + xoff).HeaderText = addHeader(j) 'ヘッダー追加表示 | |
| Next j | |
| Tfile1.Write(vbCrLf) ' header改行 | |
| '---------------計算転置------------------------------- | |
| RmatA = Transpose(matA_rowN + 1, matA_colN + 1, matA) | |
| '------結果表示---------------------- | |
| For i = 0 To matA_colN | |
| For j = 0 To matA_rowN | |
| dgv(dgN).Rows(i).Cells(j + xoff).Value = RmatA(i, j) | |
| Tfile1.Write(RmatA(i, j)) | |
| If j < matA_rowN Then | |
| Tfile1.Write(",") | |
| End If | |
| matAstr = "Trps_A(" & CStr(i) & "," & CStr(j) & ")=" & CStr(RmatA(i, j)) & vbCrLf | |
| RichTextBox1.AppendText(matAstr) | |
| matAstr = "" | |
| Next j | |
| Tfile1.Write(vbCrLf) | |
| Next i | |
| Tfile1.Close() | |
| End If | |
| End Sub | |
| Private Sub File_matrix() | |
| Dim matname As String = TextBox3.Text | |
| ReDim chHead(dgv(dgN).ColumnCount) | |
| If TextBox3.Text = "" Then | |
| matname = Label3.Text.Substring(9, 6) & "d" | |
| End If | |
| '=================Tfile1 Saving Preparation====================== | |
| Dim Tfname1 = Format(Now, "MMdd_HHmmss") | |
| Dim TfStr1 = matname 'Making Data Table Name | |
| Tfname1 = "C:\vb_DT\" & TfStr1 & Tfname1 & ".csv" | |
| Dim enc As System.Text.Encoding = System.Text.Encoding.GetEncoding(“Shift_JIS”) | |
| Tfile1 = My.Computer.FileSystem.OpenTextFileWriter(Tfname1, False, enc) | |
| Dim Tf1open = 1 | |
| '==================ComboBoxa に登録=================== | |
| ComboBox1.Items.Add(TfStr1 & Tfname1) | |
| Label16.Text = "Saved " & TfStr1 & Tfname1 | |
| '--------Rows.Count Check----------------------------- | |
| Debug.Print("File:dgv.Rows.Count=" & CStr(dgv(dgN).Rows.Count)) | |
| '------------------------------------------------------- | |
| '================================================= | |
| '========Col Header name ======================= | |
| '--------Rows.Count Check----------------------------- | |
| Debug.Print("header:dgv.Rows.Count=" & CStr(dgv(dgN).Rows.Count)) | |
| '------------------------------------------------------- | |
| '================Header行保存================= | |
| '------dgv１のヘッダー 0列目が数値でなかったらヘッダー文字ありと判断--------------- | |
| If IsNumeric(dgv(dgN).Columns(1).HeaderText) = False Then | |
| For j = 0 To dgv(dgN).ColumnCount - 1 'chHead(1)から開始 | |
| chHead(j) = dgv(dgN).Columns(j).HeaderText ' 最上部Header行の列名 | |
| Tfile1.Write(chHead(j)) | |
| If j < dgv(dgN).ColumnCount - 1 Then | |
| Tfile1.Write(",") | |
| End If | |
| Debug.Print("ColumnNo=" & CStr(j) & "chHead=" & chHead(j)) | |
| '------Header Writing to Tfile1 csv File------ | |
| Next j | |
| End If | |
| Tfile1.Write(vbCrLf) | |
| '=================data 行保存=================================== | |
| '--------Rows.Count Check----------------------------- | |
| Debug.Print("data:dgv.Rows.Count=" & CStr(dgv(dgN).Rows.Count)) | |
| '------------------------------------------------------- | |
| For i = 0 To dgv(dgN).Rows.Count - 1 | |
| For j = 0 To Me.dgv(dgN).ColumnCount - 1 '追加した行へ値を書き込み | |
| Dim matdata As String = dgv(dgN).Rows(i).Cells(j).Value | |
| Debug.Print("dgv.Cells=(" & CStr(i) & "," & CStr(j) & ")=" & matdata) | |
| '------Data Writing to Tfile1 csv File------ | |
| Tfile1.Write(matdata) | |
| If j < dgv(dgN).ColumnCount - 1 Then | |
| Tfile1.Write(",") | |
| End If | |
| Next j | |
| Tfile1.Write(vbCrLf) | |
| Next i | |
| '--------Rows.Count Check----------------------------- | |
| Debug.Print("dataset:dgv.Rows.Count=" & CStr(dgv(dgN).Rows.Count)) | |
| ' '------------------------------------------------------- | |
| 'DataSet1.Tables(0).Rows.Count | |
| TextBox3.Text = "" | |
| Tfile1.Close() | |
| maxRowCol() | |
| End Sub | |
| Private Sub dgv1_MouseClick(sender As Object, e As MouseEventArgs) Handles dgv1.MouseClick | |
| dgv1.Columns(1).HeaderCell.SortGlyphDirection = SortOrder.None | |
| End Sub | |
| Private Sub dgv2_MouseClick(sender As Object, e As MouseEventArgs) Handles dgv2.MouseClick | |
| dgv2.Columns(1).HeaderCell.SortGlyphDirection = SortOrder.None | |
| End Sub | |
| Private Sub dgv3_MouseClick(sender As Object, e As MouseEventArgs) Handles dgv2.MouseClick | |
| dgv3.Columns(1).HeaderCell.SortGlyphDirection = SortOrder.None | |
| End Sub | |
| '=========================行列計算Ｂ================================================ | |
| '========================== matB 計算=============================================== | |
| Private Sub Button13_Click_1(sender As Object, e As EventArgs) Handles Button13.Click | |
| Dim matname As String = "" | |
| ReDim chHead(dgv(dgN).ColumnCount) | |
| dgN = 1 | |
| If RadioButton8.Checked = True Then ' 逆行列 | |
| matname = "Invs_B_" & Label12.Text.Substring(9, 6) | |
| End If | |
| If RadioButton9.Checked = True Then ' 転置 | |
| matname = "Trps_B_" & Label12.Text.Substring(9, 6) | |
| End If | |
| '=================Tfile1 Saving Preparation====================== | |
| Dim Tfname1 = Format(Now, "MMdd_HHmmss") | |
| Dim TfStr1 = matname 'Making Data Table Name | |
| Tfname1 = "C:\vb_DT\" & TfStr1 & Tfname1 & ".csv" | |
| Dim enc As System.Text.Encoding = System.Text.Encoding.GetEncoding(“Shift_JIS”) | |
| Tfile1 = My.Computer.FileSystem.OpenTextFileWriter(Tfname1, False, enc) | |
| Dim Tf1open = 1 | |
| '---------逆行列-------------------------- | |
| If RadioButton8.Checked = True Then '逆行列 | |
| ReDim RmatB(matB_rowN, matB_colN) | |
| Dim matBstr As String | |
| Dim xoff As Integer = matB_colN + 1 | |
| Dim addHeader(matB_colN) As String | |
| '---結果表示はdgv右横2行空け分列拡張---------- | |
| dgv(dgN).ColumnCount = (matB_colN + 1) * 2 + xoff | |
| '---------------Header追加-------------------- | |
| For j = 0 To matB_colN | |
| addHeader(j) = "Inv_B_" & CStr(j) | |
| Tfile1.Write(addHeader(j)) | |
| If j < matB_colN Then | |
| Tfile1.Write(",") | |
| End If | |
| dgv(dgN).Columns(j + xoff).HeaderText = addHeader(j) 'ヘッダー追加表示 | |
| Next j | |
| Tfile1.Write(vbCrLf) ' header改行 | |
| '----Mtrix Inverse------------------ | |
| ' RmatB = matB.Inverse()'imageSolution | |
| 'RmatB = inverse(matB_colN + 1, matB)'Shizuoka Rikoudai | |
| LuInv(LUB, RmatB) ' numeric world 引用 | |
| For i = 0 To matB_rowN | |
| For j = 0 To matB_colN | |
| dgv(1).Rows(i).Cells(j + xoff).Value = RmatB(i, j) | |
| Tfile1.Write(RmatB(i, j)) | |
| If j < matB_colN Then | |
| Tfile1.Write(",") | |
| End If | |
| matBstr = "Inv_B(" & CStr(i) & "," & CStr(j) & ")=" & CStr(RmatB(i, j)) & vbCrLf | |
| RichTextBox1.AppendText(matBstr) | |
| matBstr = "" | |
| Next j | |
| Tfile1.Write(vbCrLf) | |
| Next i | |
| Tfile1.Close() | |
| End If | |
| '-------------------転置-------------------------- | |
| If RadioButton9.Checked = True Then '転置 | |
| ReDim RmatB(matB_colN, matB_rowN) | |
| Dim matBstr As String | |
| Dim xoff As Integer = matB_colN + 1 | |
| Dim addHeader(matB_rowN) As String | |
| '---結果表示はdgv右横2行空け分列拡張---------- | |
| dgv(dgN).ColumnCount = (matB_rowN + 1) * 2 + xoff | |
| '---------------Header追加-------------------- | |
| For j = 0 To matB_rowN | |
| addHeader(j) = "Inv_B_" & CStr(j) | |
| Tfile1.Write(addHeader(j)) | |
| If j < matB_rowN Then | |
| Tfile1.Write(",") | |
| End If | |
| dgv(1).Columns(j + xoff).HeaderText = addHeader(j) 'ヘッダー追加表示 | |
| Next j | |
| Tfile1.Write(vbCrLf) ' header改行 | |
| '---------------計算転置------------------------------- | |
| 'RmatB = matB.Transpose() | |
| RmatB = Transpose(matB_rowN + 1, matB_colN + 1, matB) | |
| '----結果表示-------------------------------------- | |
| dgN = 1 | |
| For i = 0 To matB_colN | |
| For j = 0 To matB_rowN | |
| dgv(1).Rows(i).Cells(j + xoff).Value = RmatB(i, j) | |
| Tfile1.Write(RmatB(i, j)) | |
| If j < matB_rowN Then | |
| Tfile1.Write(",") | |
| End If | |
| matBstr = "Trps_B(" & CStr(i) & "," & CStr(j) & ")=" & CStr(RmatB(i, j)) & vbCrLf | |
| RichTextBox1.AppendText(matBstr) | |
| matBstr = "" | |
| Next j | |
| Tfile1.Write(vbCrLf) | |
| Next i | |
| Tfile1.Close() | |
| End If | |
| End Sub | |
| '==================================================================================================== | |
| '============================matA matB計算============================================================ | |
| '==================================================================================================== | |
| Private Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Click | |
| RadioButton12.Checked = True | |
| '-------------------RmatA(,)とRmatB(,)が用意されていること----------------------- | |
| '---matA_rowN,matA_colNとmatB_rown,matB_colNが整合していること | |
| If RadioButton5.Checked = True Then '積 | |
| '積は、matAの列数とmatBの行数が一致 | |
| If matA_colN >= matA_rowN Then | |
| ReDim RmatAB(matA_colN, matA_colN) | |
| dgv(dgN).RowCount = matA_colN + 1 | |
| dgv(dgN).ColumnCount = matA_colN + 1 | |
| maxN = matA_colN | |
| End If | |
| If matA_colN < matA_rowN Then | |
| ReDim RmatAB(matA_rowN, matA_rowN) | |
| dgv(dgN).RowCount = matA_rowN + 1 | |
| dgv(dgN).ColumnCount = matA_rowN + 1 | |
| maxN = matA_rowN + 1 | |
| End If | |
| Else | |
| Label18.Text = "計算に対して行列数が整合してませんMatrixを修正してください" | |
| End If | |
| For i = 0 To maxN | |
| For j = 0 To maxN | |
| Debug.Print("Mult_Start:matA(" & CStr(i) & "," & CStr(j) & ")=" & CStr(matA(i, j))) | |
| Debug.Print("Mult_Start:matB(" & CStr(i) & "," & CStr(j) & ")=" & CStr(matB(i, j))) | |
| Next j | |
| Next i | |
| '-----積計算-------------- | |
| ' RmatAB = matA.Mult(matB) 'imageSlution | |
| RmatAB = mult(matA, matB) 'ShizuokaRikouDai | |
| '------結果表示---------------------- | |
| For i = 0 To maxN | |
| For j = 0 To maxN | |
| Debug.Print("Mult_Rexult:RmatAB(" & CStr(i) & "," & CStr(j) & ")=" & CStr(RmatAB(i, j))) | |
| Next j | |
| Next i | |
| dgN = 2 | |
| For i = 0 To maxN 'matA_colN - 1 | |
| For j = 0 To maxN 'matA_rowN - 1 | |
| dgv(dgN).Rows(i).Cells(j).Value = RmatAB(i, j) | |
| 'Tfile1.Write(RmatAB(i, j)) | |
| 'If j < matA_rowN Then | |
| ' Tfile1.Write(",") | |
| 'End If | |
| 'matAstr = "Trps_A(" & CStr(i) & "," & CStr(j) & ")=" & CStr(RmatA(i, j)) & vbCrLf | |
| 'RichTextBox1.AppendText(matAstr) | |
| 'matAstr = "" | |
| Next j | |
| 'Tfile1.Write(vbCrLf) | |
| Next i | |
| 'Tfile1.Close() | |
| End Sub | |
| Private Sub RadioButton10_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButton10.CheckedChanged | |
| If RadioButton10.Checked = True Then | |
| dgv(0).Visible = True | |
| dgN = 0 | |
| End If | |
| If RadioButton10.Checked = False Then | |
| dgv(0).Visible = False | |
| End If | |
| End Sub | |
| Private Sub RadioButton11_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButton11.CheckedChanged | |
| If RadioButton11.Checked = True Then | |
| dgv(1).Visible = True | |
| dgN = 1 | |
| End If | |
| If RadioButton11.Checked = False Then | |
| dgv(1).Visible = False | |
| End If | |
| End Sub | |
| Private Sub RadioButton12_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButton12.CheckedChanged | |
| If RadioButton12.Checked = True Then | |
| dgv(2).Visible = True | |
| dgN = 2 | |
| End If | |
| If RadioButton12.Checked = False Then | |
| dgv(2).Visible = False | |
| End If | |
| End Sub | |
| '****************************************行列計算 Functions ************************************************************ | |
| '**************************************** 逆行列 inverse(N,dataArray)************************************************ | |
| '**************************************** 転置 transpose(M,N,dataArray) ******************************************* | |
| '****************************************** 乗算 mult(dataArray1,dataArray2)***************************************** | |
| '************************************************************************************************************************* | |
| '========================逆行列 Function inverse(N,matA) as double (,)================== | |
| Public Function inverse(ByVal N As Integer, ByRef b(,) As Double) As Double(,) | |
| '掃き出し法により逆行列を計算する | |
| '参考資料：http://www.econ.nagoya-cu.ac.jp/~kamiyama/siryou/minv.html | |
| Dim nn As Integer | |
| Dim p As Double 'ピボット | |
| Dim c As Double '行 | |
| Dim x As Double | |
| Dim y As Double | |
| Dim A(,) As Double | |
| Dim Binv(,) As Double | |
| nn = N + N | |
| ReDim A(N - 1, nn - 1) | |
| ReDim Binv(N - 1, N - 1) | |
| '左半分に逆行列を求めたい行列を入れる | |
| For i = 0 To N - 1 | |
| For j = 0 To N - 1 | |
| A(i, j) = b(i, j) | |
| Next j | |
| Next i | |
| '行列の右半分に単位行列を入れる | |
| For i = 0 To N - 1 | |
| For j = N To nn - 1 | |
| A(i, j) = 0 | |
| Next j | |
| A(i, i + N) = 1 | |
| Next i | |
| '掃き出し法の基本操作 | |
| For k = 0 To N - 1 | |
| p = 0 : c = 0 | |
| 'k行以降で絶対値が最も大きい行を調べる | |
| For i = k To N - 1 | |
| If Math.Abs(A(i, k)) > p Then | |
| p = Math.Abs(A(i, k)) | |
| c = i | |
| End If | |
| Next i | |
| 'k行目とc行目の成分を入れ替える | |
| If c <> k Then | |
| For j = k To nn - 1 | |
| y = A(k, j) | |
| A(k, j) = A(c, j) | |
| A(c, j) = y | |
| Next j | |
| End If | |
| 'k行目以降の対角成分をk行目の対角成分で割る | |
| x = A(k, k) | |
| For j = k To nn - 1 | |
| A(k, j) = A(k, j) / x | |
| Next j | |
| For i = 0 To N - 1 | |
| If i <> k Then | |
| x = A(i, k) | |
| For j = k To nn - 1 | |
| A(i, j) = A(i, j) - x * A(k, j) | |
| Next j | |
| End If | |
| Next i | |
| Next k | |
| For i = 0 To N - 1 | |
| For j = N To nn - 1 | |
| Binv(i, j - N) = A(i, j) | |
| Next j | |
| Next i | |
| Return Binv | |
| End Function | |
| '====================================-inverse END=================================== | |
| '====================================Transpose転置======================================== | |
| Public Function Transpose(ByVal M As Integer, ByVal N As Integer, ByRef A(,) As Double) As Double(,) | |
| ' '転置行列を計算する | |
| ' 'Aはm×n行列，Atはn×m行列 | |
| ' '変数の宣言 | |
| Dim At(,) As Double '解を入れる配列 | |
| ReDim At(N - 1, M - 1) '解を入れる配列 | |
| ' 'カウンター | |
| Dim r As Integer | |
| Dim c As Integer | |
| For r = 0 To M - 1 | |
| For c = 0 To N - 1 | |
| At(c, r) = A(r, c) | |
| Next c | |
| Next r | |
| Return At | |
| End Function | |
| ''=================================mult 乗算========================================= | |
| Public Function mult(m1(,) As Double, m2(,) As Double) As Double(,) | |
| ' 'm1[l,m]*m2[m,n]の行列の掛け算を行う | |
| Dim L As Integer | |
| Dim M As Integer | |
| Dim N As Integer | |
| Dim sum As Double | |
| Dim ans(,) As Double | |
| ' 'カウンター | |
| Dim i As Integer | |
| Dim j As Integer | |
| Dim k As Integer | |
| ' '行列の大きさを取得 | |
| L = UBound(m1, 1) | |
| M = UBound(m1, 2) | |
| N = UBound(m2, 2) | |
| ' '配列の大きさを定義 | |
| ReDim ans(L, N) | |
| For i = 0 To L | |
| For j = 0 To N | |
| sum = 0 | |
| For k = 0 To M | |
| sum = sum + m1(i, k) * m2(k, j) | |
| Next k | |
| ans(i, j) = sum | |
| Next j | |
| Next i | |
| mult = ans | |
| End Function | |
| Public Function detMatrix(ByVal n As Integer, ByRef dataArray(,) As Double) As Double | |
| Dim det As Double = 1.0 | |
| Dim buf As Double | |
| Dim i, j, k As Integer | |
| '//三角行列を作成 | |
| For i = 0 To n - 1 | |
| For j = 0 To n - 1 | |
| buf = dataArray(j, i) / dataArray(i, j) | |
| For k = 0 To n - 1 | |
| dataArray(j, k) = dataArray(i, k) * buf | |
| Next | |
| Next | |
| Next | |
| '//対角部分の積 | |
| For i = 0 To n - 1 | |
| det = det * dataArray(i, i) | |
| Next | |
| Return det | |
| ' Double a[4][4]={{2, -2, 4, 2}, {2, -1, 6, 3}, {3, -2, 12, 12}, {-1, 3, -4, 4}}; | |
| 'Double det = 1.0, buf; | |
| 'Int n = 4; //配列の次数 | |
| 'Int i, j, k; | |
| '//三角行列を作成 | |
| 'For (i = 0;i<n;i++){ | |
| ' For (j = 0;j<n;j++){ | |
| ' If (i < j) Then{ | |
| ' buf = a[j][i]/a[i][i]; | |
| ' For (k = 0;k<n;k++){ | |
| ' a[j][k]-=a[i][k]*buf; | |
| ' } | |
| ' } | |
| ' } | |
| '} | |
| '//対角部分の積 | |
| 'For (i = 0;i<n;i++){ | |
| ' det *= a[i][i]; | |
| '} | |
| End Function | |
| '===================================DETCHECK================================================== | |
| Private Sub Button15_Click(sender As Object, e As EventArgs) Handles Button15.Click | |
| ReDim detMat(dgv(dgN).RowCount, dgv(dgN).ColumnCount) | |
| '---------定義されたサイズ全体を保存する-------------------- | |
| For i = 0 To dgv(dgN).RowCount - 1 | |
| For j = 0 To dgv(dgN).ColumnCount - 1 | |
| Dim sdata = CStr(dgv(dgN).Rows(i).Cells(j).Value) | |
| If sdata = "" Then | |
| Exit For | |
| End If | |
| detMat(i, j) = CDbl(sdata) | |
| Next j | |
| Next i | |
| Dim detValue = detMatrix(dgv(dgN).ColumnCount, detMat) | |
| Label19.Text = "Det=" & CStr(detValue) | |
| End Sub | |
| '======================================Gauss pivot付 逆行列====================================== | |
| 'https://www.sist.ac.jp/~suganuma/programming/9-sho/num/gauss/gauss.htm#gauss_VB | |
| '''''''''''''''''''''''''''''''''''''''''' | |
| ' 線形連立方程式を解く（逆行列を求める） ' | |
| ' w : 方程式の左辺及び右辺 ' | |
| ' n : 方程式の数 ' | |
| ' m : 方程式の右辺の列の数 ' | |
| ' eps : 逆行列の存在を判定する規準 ' | |
| ' return : =0 : 正常 ' | |
| ' =1 : 逆行列が存在しない ' | |
| ' Dim n As Integer = 2 | |
| 'Dim m As Integer = 2 | |
| 'Dim eps As Double = 0.0000000001 | |
| ' Dim w(,) = {{2.0, 1.0, 1.0, 0.0}, | |
| ' {1.0, 1.0, 0.0, 1.0}} | |
| '''''''''''''''''''''''''''''''''''''''''' | |
| Function gauss(ByRef w(,) As Double, ByVal n As Integer, ByVal m As Integer) As Double(,) | |
| ' ReDim w(n, m) | |
| Dim ind As Integer = 0 | |
| Dim nm As Integer = n + m | |
| Dim array(n, m) As Double | |
| Dim i1 As Integer = 0 | |
| Dim eps As Double = 0.0000000001 | |
| Dim i, j As Integer | |
| For i = 0 To matA_rowN | |
| For j = 0 To matA_colN | |
| Debug.Print("Gauss_Start:w(" & CStr(i) & "," & CStr(j) & ")=" & CStr(w(i, j))) | |
| Next j | |
| Next i | |
| Do While i1 < n And ind = 0 | |
| Dim y1 As Double = 0.0 | |
| Dim m1 As Integer = i1 + 1 | |
| Dim m2 As Integer = 0 | |
| ' ピボット要素の選択 | |
| For i2 As Integer = i1 To n - 1 | |
| Debug.Print("gauss_w(" & CStr(i2) & "," & CStr(i1) & ")=" & CStr(w(i2, i1))) | |
| Dim y2 As Double = Math.Abs(w(i2, i1)) | |
| If y1 < y2 Then | |
| y1 = y2 | |
| m2 = i2 | |
| End If | |
| Next | |
| ' 逆行列が存在しない | |
| If y1 < eps Then | |
| ind = 1 | |
| ' 逆行列が存在する | |
| Else | |
| ' 行の入れ替え | |
| For i2 As Integer = i1 To nm - 1 | |
| y1 = w(i1, i2) | |
| w(i1, i2) = w(m2, i2) | |
| w(m2, i2) = y1 | |
| Next | |
| ' 掃き出し操作 | |
| y1 = 1.0 / w(i1, i1) | |
| For i2 As Integer = m1 To nm - 1 | |
| w(i1, i2) *= y1 | |
| Next | |
| For i2 As Integer = 0 To n - 1 | |
| If i2 <> i1 Then | |
| For i3 As Integer = m1 To nm - 1 | |
| w(i2, i3) -= w(i2, i1) * w(i1, i3) | |
| Next | |
| End If | |
| Next | |
| End If | |
| i1 += 1 | |
| Loop | |
| Return w | |
| End Function | |
| '====================NUMERICAL RECIPES からの移植=========================================== | |
| 'http://numeric.world.coocan.jp/computer/vb/mathpack.htm | |
| '============================================================================================= | |
| Public Function LuDet(ByVal A(,) As Double) As Double | |
| Dim N As Integer = A.GetUpperBound(0) | |
| Dim Indx(N) As Integer | |
| Dim D As Double | |
| LuDcmp(A, Indx, D) | |
| For J As Integer = 0 To N | |
| D *= A(J, J) | |
| Next J | |
| Return D | |
| End Function | |
| Public Sub LuInv(ByVal A(,) As Double, ByRef B(,) As Double) | |
| Dim N As Integer = A.GetUpperBound(0) | |
| Dim Indx(N) As Integer, Col(N) As Double | |
| ReDim B(N, N) | |
| Dim D As Double | |
| LuDcmp(A, Indx, D) | |
| For J As Integer = 0 To N | |
| Array.Clear(Col, 0, N + 1) | |
| Col(J) = 1.0# | |
| LuBksb(A, Indx, Col) | |
| For I As Integer = 0 To N : B(I, J) = Col(I) : Next I | |
| Next J | |
| End Sub | |
| Public Sub LuBksb(ByVal A(,) As Double, ByVal Indx() As Integer, ByVal B() As Double) | |
| Dim N As Integer = A.GetUpperBound(0) | |
| Dim II As Integer = 0 | |
| For I As Integer = 0 To N | |
| Dim Ip As Integer = Indx(I) | |
| Dim Sum As Double = B(Ip) | |
| B(Ip) = B(I) | |
| If II >= 0 Then | |
| For J As Integer = II To I - 1 | |
| Sum -= A(I, J) * B(J) | |
| Next J | |
| ElseIf Sum <> 0.0# Then | |
| II = I | |
| End If | |
| B(I) = Sum | |
| Next I | |
| For I As Integer = N To 0 Step -1 | |
| Dim Sum As Double = B(I) | |
| For J As Integer = I + 1 To N | |
| Sum -= A(I, J) * B(J) | |
| Next J | |
| B(I) = Sum / A(I, I) | |
| Next I | |
| End Sub | |
| Public Sub LuDcmp(ByVal A(,) As Double, ByRef Indx() As Integer, ByRef D As Double) | |
| Const TINY As Double = 1.0E-20# | |
| Dim N As Integer = A.GetUpperBound(0) | |
| Dim VV(N) As Double | |
| ReDim Indx(N) | |
| D = 1.0# | |
| For I As Integer = 0 To N | |
| Dim Big As Double = 0.0# | |
| For J As Integer = 0 To N | |
| Dim Temp As Double = Abs(A(I, J)) | |
| If Temp > Big Then Big = Temp | |
| Next J | |
| If Big = 0.0# Then Throw New System.ArithmeticException("Singular Matrix in LuDcmp") | |
| VV(I) = 1.0# / Big | |
| Next I | |
| For J As Integer = 0 To N | |
| Dim IMAX As Integer | |
| For I As Integer = 0 To J - 1 | |
| Dim Sum As Double = A(I, J) | |
| For K As Integer = 0 To I - 1 | |
| Sum -= A(I, K) * A(K, J) | |
| Next K | |
| A(I, J) = Sum | |
| Next I | |
| Dim Big As Double = 0.0# | |
| For I As Integer = J To N | |
| Dim Sum As Double = A(I, J) | |
| For K As Integer = 0 To J - 1 | |
| Sum -= A(I, K) * A(K, J) | |
| Next K | |
| A(I, J) = Sum | |
| Dim Dum As Double = VV(I) * Abs(Sum) | |
| If Dum >= Big Then | |
| Big = Dum | |
| IMAX = I | |
| End If | |
| Next I | |
| If J <> IMAX Then | |
| For K As Integer = 0 To N | |
| Dim Dum As Double = A(IMAX, K) | |
| A(IMAX, K) = A(J, K) | |
| A(J, K) = Dum | |
| Next K | |
| D = -D | |
| VV(IMAX) = VV(J) | |
| End If | |
| Indx(J) = IMAX | |
| If A(J, J) = 0.0# Then A(J, J) = TINY | |
| If J <> N Then | |
| Dim Dum As Double = 1.0# / A(J, J) | |
| For I As Integer = J + 1 To N | |
| A(I, J) *= Dum | |
| Next I | |
| End If | |
| Next J | |
| End Sub | |
| Public Sub Mprove(ByVal A(,) As Double, ByVal Alud(,) As Double, ByVal Indx() As Integer, | |
| ByVal B() As Double, ByVal X() As Double) | |
| Dim N As Integer = A.GetUpperBound(0) | |
| Dim R(N) As Double | |
| For I As Integer = 0 To N | |
| Dim Sdp As Double = -B(I) | |
| For J As Integer = 0 To N | |
| Sdp += A(I, J) * X(J) | |
| Next J | |
| R(I) = CSng(Sdp) | |
| Next I | |
| LuBksb(Alud, Indx, R) | |
| For I As Integer = 0 To N | |
| X(I) -= R(I) | |
| Next I | |
| End Sub | |
| End Class |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment