発電(水力)

'フーリエ変換
Public Function Fourier(rows As Variant, Optional window As String) As Variant

Dim rowCount As Long
Dim n As Double

'2のｎ乗か？調べる
n = Log(rows.count) / Log(2)

If n = Int(n) Then
' データ個数が２のｎ乗のとき
' FFT
Fourier = FFT(rows, 1#, window)
Else
' DFT
Fourier = DFT(rows, 1#, window)
End If

End Function

'逆フーリエ変換
Public Function IFourier(rows As Variant, Optional window As String) As Variant

Dim rowCount As Long
Dim n As Double

'2のｎ乗か？調べる
n = Log(rows.count) / Log(2)

If n = Int(n) Then
' データ個数が２のｎ乗のとき
' FFT
IFourier = FFT(rows, -1#, window)
Else
' DFT
IFourier = DFT(rows, -1#, window)
End If

End Function

 

'フーリエ変換(絶対値出力)
Public Function FourierAbs(rows As Variant, Optional window As String) As Variant

Dim rowCount As Long
Dim n As Double

'2のｎ乗か？調べる
n = Log(rows.count) / Log(2)

If n = Int(n) Then
' データ個数が２のｎ乗のとき
' FFT
FourierAbs = FFTAbs(rows, 1#, window)
Else
' DFT
FourierAbs = DFTAbs(rows, 1#, window)
End If

End Function

'逆フーリエ変換(絶対値出力)
Public Function IFourierAbs(rows As Variant, Optional window As String) As Variant

Dim rowCount As Long
Dim n As Double

'2のｎ乗か？調べる
n = Log(rows.count) / Log(2)

If n = Int(n) Then
' データ個数が２のｎ乗のとき
' FFT
IFourierAbs = FFTAbs(rows, -1#, window)
Else
' DFT
IFourierAbs = DFTAbs(rows, -1#, window)
End If

End Function

 

'FFT関数
Public Function FFT(rows As Variant, id As Double, Optional window As String) As Variant

Dim re() As Double
Dim im() As Double
Dim imaginary() As String

'GetRowsArray rows, re(), "FFT"

'ReDim im(UBound(re))
RowsToReIm rows, re, im, window

' FFTの計算
FftCalc re, im, id

' セルへの表示文字列の作成
GetImaginaryStringArr re, im, imaginary

FFT = WorksheetFunction.Transpose(imaginary)

End Function

'FFT（パワースペクトル出力）
Public Function FFTAbs(rows As Variant, id As Double, Optional window As String) As Variant

Dim re() As Double
Dim im() As Double
Dim imAbs() As Double

'GetRowsArray rows, re(), "FFT"

'ReDim im(UBound(re))

RowsToReIm rows, re, im, window

' FFTの計算
FftCalc re, im, id

' セルへの表示文字列の作成（パワースペクトル）
GetImAbsArr re, im, imAbs

FFTAbs = WorksheetFunction.Transpose(imAbs)

End Function

' FFTの計算
' re() 実部の配列 添え字は1～Nにデータを格納のこと
' im() 実部の配列 添え字は1～Nにデータを格納のこと
' id 1のときFFT、　-1のとき逆FFT
Private Sub FftCalc(re() As Double, im() As Double, id As Double)

Dim i, i0, i1, j, ns, k, arg As Long
Dim sinVal, cosVal, radTemp, re1, im1, th As Double

Dim n As Long
n = UBound(re)

ns = n / 2
radTemp = 2# * 4# * Atn(1#) / n

Do While ns >= 1

arg = 0

For j = 1 To n Step 2 * ns

k = n / 4

th = -id * radTemp * arg
cosVal = Cos(th)
sinVal = Sin(th)

For i0 = j To j + ns - 1

i1 = i0 + ns

re1 = re(i1) * cosVal - im(i1) * sinVal
im1 = re(i1) * sinVal + im(i1) * cosVal

re(i1) = re(i0) - re1
im(i1) = im(i0) - im1

re(i0) = re(i0) + re1
im(i0) = im(i0) + im1

Next

Do While k <= arg
arg = arg - k
k = k / 2
If k = 0 Then Exit Do
Loop

arg = arg + k

Next

ns = ns / 2

Loop

' 逆変換のとき
If id < 0 Then
For i = 1 To n
re(i) = re(i) / n
im(i) = im(i) / n
Next
End If

j = 1
For i = 1 To n - 1
If i <= j Then
re1 = re(i)
re(i) = re(j)
re(j) = re1

im1 = im(i)
im(i) = im(j)
im(j) = im1
End If

k = n / 2

Do While k < j
j = j - k
k = k / 2
Loop

j = j + k

Next

End Sub

'DFT関数
Public Function DFT(rows As Variant, id As Double, Optional window As String) As Variant

Dim re() As Double
Dim im() As Double
Dim imaginary() As String

'GetRowsArray rows, re()

'ReDim im(UBound(re))

RowsToReIm rows, re, im, window

' DFTの計算
DftCalc re, im, id

' セルへの表示文字列の作成
GetImaginaryStringArr re, im, imaginary

DFT = WorksheetFunction.Transpose(imaginary)

End Function

'DFT関数(パワースペクトル出力)
Public Function DFTAbs(rows As Variant, id As Double, Optional window As String) As Variant

Dim re() As Double
Dim im() As Double
Dim imAbs() As Double

'GetRowsArray rows, re()
'ReDim im(UBound(re))

RowsToReIm rows, re, im

' DFTの計算
DftCalc re, im, id

' セルへの表示文字列の作成
GetImAbsArr re, im, imAbs

DFTAbs = WorksheetFunction.Transpose(imAbs)

End Function

' セルの配列を実部と虚部の配列に分ける
Private Sub RowsToReIm(rows As Variant, re() As Double, im() As Double, Optional window As String)
Dim count As Long

count = rows.count

ReDim re(count)
ReDim im(count)

Dim i As Long

For i = 1 To count
re(i) = WorksheetFunction.ImReal(rows(i).Cells)
im(i) = WorksheetFunction.imaginary(rows(i).Cells)
Next

' 窓関数
FFTWindow re, window
FFTWindow im, window

End Sub

' DFTの計算
' re() 実部の配列 添え字は1～Nにデータを格納のこと
' im() 実部の配列 添え字は1～Nにデータを格納のこと
' id 1のときFFT、　-1のとき逆FFT
Private Sub DftCalc(re() As Double, im() As Double, id As Double)

Dim i, t As Long
Dim radTemp As Double

' データ個数
Dim n As Long
n = UBound(re)

' データ個数の半分まで
Dim i1 As Long
i1 = Int(n / 2)

Dim reTemp(), imTemp() As Double

'ReDim reTemp(i1 + 1)
'ReDim imTemp(i1 + 1)
ReDim reTemp(n)
ReDim imTemp(n)

' Cos,Sinの値を先に計算しておく
Dim cosVal(), sinVal() As Double
ReDim cosVal(n - 1)
ReDim sinVal(n - 1)

radTemp = -id * 2# * 4# * Atn(1#) / n

For i = 0 To n - 1
cosVal(i) = Cos(radTemp * i)
sinVal(i) = Sin(radTemp * i)
Next

Dim thIndex As Long
Dim reSum, imSum As Double

' データ数分DFT
'For t = 0 To i1
For t = 0 To n - 1

reSum = 0
imSum = 0

For i = 0 To n - 1

thIndex = (i * t) Mod n

reSum = reSum + re(i + 1) * cosVal(thIndex) - im(i + 1) * sinVal(thIndex)
imSum = imSum + re(i + 1) * sinVal(thIndex) + im(i + 1) * cosVal(thIndex)

Next

reTemp(t + 1) = reSum
imTemp(t + 1) = imSum

If id < 0 Then
reTemp(t + 1) = reTemp(t + 1) / n
imTemp(t + 1) = imTemp(t + 1) / n
End If

Next

' 結果を元の配列に戻す
For t = 1 To n 'i1 + 1
re(t) = reTemp(t)
im(t) = imTemp(t)
Next

End Sub

Private Sub FFTWindow(x() As Double, window As String)

' 窓関数
Select Case window
Case "Hamming"
HammingWindow x

Case "Hanning"
HanningWindow x

Case "Blackman"
BlackmanWindow x

End Select
End Sub

' ハミング窓
Private Sub HammingWindow(x() As Double)
Dim i, n As Long
Dim radTemp As Double

n = UBound(x)

radTemp = 2# * 4# * Atn(1#) / n

For i = 1 To n
x(i) = x(i) * (0.54 - 0.46 * Cos(radTemp * (i - 1)))
Next

End Sub

' ハニング窓
Private Sub HanningWindow(x() As Double)
Dim i, n As Long
Dim radTemp As Double

n = UBound(x)

radTemp = 2# * 4# * Atn(1#) / n

For i = 1 To n
x(i) = x(i) * 0.5 * (1# - Cos(radTemp * (i - 1)))
Next

End Sub

' ブラックマン窓
Private Sub BlackmanWindow(x() As Double)
Dim i, n As Long
Dim radTemp As Double

n = UBound(x)

radTemp = 2# * 4# * Atn(1#) / n

For i = 1 To n
x(i) = x(i) * (0.42 - 0.5 * Cos(radTemp * (i - 1)) + 0.08 * Cos(2# * radTemp * (i - 1)))
Next

End Sub

Private Sub GetRowsArray(rows As Variant, data() As Double, Optional dataType As String)

Dim dataCount As Long
Dim i As Long
Dim rowCount As Long
Dim n As Double

rowCount = rows.count

If dataType = "FFT" Then
'2のｎ乗か？調べる
n = Log(rowCount) / Log(2)

'2のｎ乗に切り詰める
rowCount = 2 ^ Int(n)
End If

ReDim data(rowCount)

For i = 1 To rowCount
data(i) = rows(i, 1)
Next

End Sub

Private Sub GetImaginaryStringArr(re() As Double, im() As Double, imginary() As String)

Dim i, count As Long

Dim strRe, strIm As String

count = UBound(re)
ReDim imginary(count - 1)

For i = 1 To count

strRe = Str(re(i))

If im(i) = 0 Then
strIm = ""
ElseIf im(i) > 0 Then
strIm = " + " + Str(im(i)) + "i"
Else
strIm = " - " + Str(Abs(im(i))) + "i"
End If

imginary(i - 1) = strRe + strIm
Next

End Sub

Private Sub GetImAbsArr(re() As Double, im() As Double, imAbs() As Double)

Dim i, count As Long
Dim p As Double

count = UBound(re)
ReDim imAbs(count - 1)

For i = 1 To count
imAbs(i - 1) = Sqr(re(i) * re(i) + im(i) * im(i))
Next