142 lines
6.4 KiB
VB.net
142 lines
6.4 KiB
VB.net
Function GetCol(ByVal headerName As String, ByVal ws As Worksheet) As Long
|
|
Dim lastCol As Long
|
|
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
|
|
On Error Resume Next
|
|
Dim m As Variant
|
|
m = Application.Match(headerName, ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)), 0)
|
|
On Error GoTo 0
|
|
If IsError(m) Then
|
|
GetCol = 0
|
|
Else
|
|
GetCol = CLng(m)
|
|
End If
|
|
End Function
|
|
|
|
Private Function NormalizeTruth(ByVal v As Variant) As Variant
|
|
' Returns True/False or Null if cannot determine
|
|
If VarType(v) = vbBoolean Then
|
|
NormalizeTruth = v
|
|
Exit Function
|
|
End If
|
|
If IsError(v) Or IsEmpty(v) Then
|
|
NormalizeTruth = Null
|
|
Exit Function
|
|
End If
|
|
Dim s As String
|
|
s = Trim$(UCase$(CStr(v)))
|
|
Select Case s
|
|
Case "TRUE", "T", "1", "YES", "Y"
|
|
NormalizeTruth = True
|
|
Case "FALSE", "F", "0", "NO", "N"
|
|
NormalizeTruth = False
|
|
Case Else
|
|
NormalizeTruth = Null
|
|
End Select
|
|
End Function
|
|
|
|
Private Function NormalizeProb01(ByVal v As Variant) As Double
|
|
' Converts confidence values to [0,1]
|
|
If IsError(v) Or IsEmpty(v) Then
|
|
NormalizeProb01 = -1
|
|
Exit Function
|
|
End If
|
|
Dim s As String
|
|
s = CStr(v)
|
|
If InStr(s, "%") > 0 Then
|
|
s = Replace$(s, "%", "")
|
|
If IsNumeric(s) Then
|
|
NormalizeProb01 = CDbl(s) / 100#
|
|
Exit Function
|
|
End If
|
|
End If
|
|
If IsNumeric(v) Then
|
|
Dim d As Double
|
|
d = CDbl(v)
|
|
If d > 1# Then
|
|
NormalizeProb01 = d / 100#
|
|
Else
|
|
NormalizeProb01 = d
|
|
End If
|
|
Else
|
|
NormalizeProb01 = -1
|
|
End If
|
|
End Function
|
|
|
|
Sub brierVARS()
|
|
Dim false_vars As Variant
|
|
Dim true_vars As Variant
|
|
false_vars = Array("moza_55_F_1", "moza_55_CON", "demo_15_F_1", "demo_15_CON", "hume_35_F_1", "hume_35_CON", "gulf_15_F_1", "gulf_15_CON", "memo_75_F_1", "memo_75_CON", "vitc_55_F_1", "vitc_55_CON", "hert_35_F_1", "hert_35_CON", "gees_55_F_1", "gees_55_CON", "gang_15_F_1", "gang_15_CON", "list_75_F_1", "list_75_CON", "mont_35_F_1", "mont_35_CON", "dwar_55_F_1", "dwar_55_CON", "pucc_15_F_1", "pucc_15_CON", "spee_75_F_1", "spee_75_CON", "lute_35_F_1", "lute_35_CON", "croc_75_F_1", "croc_75_CON")
|
|
true_vars = Array("vaud_15_T_1", "vaud_15_CON", "oedi_35_T_1", "oedi_35_CON", "mons_55_T_1", "mons_55_CON", "gest_75_T_1", "gest_75_CON", "kabu_15_T_1", "kabu_15_CON", "sham_55_T_1", "sham_55_CON", "pana_35_T_1", "pana_35_CON", "bohr_15_T_1", "bohr_15_CON", "chur_75_T_1", "chur_75_CON", "carb_35_T_1", "carb_35_CON", "cons_55_T_1", "cons_55_CON", "papy_75_T_1", "papy_75_CON", "dors_55_T_1", "dors_55_CON", "tsun_75_T_1", "tsun_75_CON", "troy_15_T_1", "troy_15_CON", "lock_35_T_1", "lock_35_CON")
|
|
Dim target_headers As Variant
|
|
target_headers = Array("gest_T_ex", "dors_T_ex", "chur_T_ex", "mons_T_ex", "lock_T_easy", "hume_F_easy", "papy_T_easy", "sham_T_easy", "list_F_easy", "cons_T_easy", "tsun_T_easy", "pana_T_easy", "kabu_T_easy", "gulf_F_easy", "oedi_T_easy", "vaud_T_easy", "mont_F_easy", "demo_F_easy", "spee_F_hard", "dwar_F_hard", "carb_T_hard", "bohr_T_hard", "gang_F_hard", "vitc_F_hard", "hert_F_hard", "pucc_F_hard", "troy_T_hard", "moza_F_hard", "croc_F_hard", "gees_F_hard", "lute_F_hard", "memo_F_hard")
|
|
Dim ws As Worksheet
|
|
Set ws = ThisWorkbook.Sheets(1)
|
|
Dim i As Long, rowCount As Long, colSource1 As Long, colSourceCON As Long, colTarget As Long
|
|
Dim srcVar As String, matchPrefix As String, checkVal As String, val As Double
|
|
Dim result As Variant
|
|
Dim r As Long, j As Long
|
|
rowCount = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
|
|
For i = 0 To UBound(false_vars) Step 2
|
|
srcVar = false_vars(i)
|
|
matchPrefix = Left(srcVar, InStrRev(srcVar, "_") - 1)
|
|
colSource1 = GetCol(srcVar, ws)
|
|
colSourceCON = GetCol(false_vars(i + 1), ws)
|
|
If colSource1 > 0 And colSourceCON > 0 Then
|
|
For r = 2 To rowCount
|
|
checkVal = ws.Cells(r, colSource1).Value
|
|
val = NormalizeProb01(ws.Cells(r, colSourceCON).Value)
|
|
colTarget = 0
|
|
For j = 0 To UBound(target_headers)
|
|
If Left(target_headers(j), InStr(target_headers(j), "_") - 1) = Left(matchPrefix, InStr(matchPrefix, "_") - 1) Then
|
|
colTarget = GetCol(target_headers(j), ws)
|
|
Exit For
|
|
End If
|
|
Next j
|
|
If colTarget > 0 Then
|
|
Dim truth As Variant
|
|
truth = NormalizeTruth(checkVal)
|
|
If IsNull(truth) Or val < 0 Then
|
|
result = CVErr(xlErrNA)
|
|
ElseIf truth = True Then
|
|
result = (val - 0#) ^ 2
|
|
Else
|
|
result = ((1# - val) - 0#) ^ 2
|
|
End If
|
|
ws.Cells(r, colTarget).Value = result
|
|
End If
|
|
Next r
|
|
End If
|
|
Next i
|
|
For i = 0 To UBound(true_vars) Step 2
|
|
srcVar = true_vars(i)
|
|
matchPrefix = Left(srcVar, InStrRev(srcVar, "_") - 1)
|
|
colSource1 = GetCol(srcVar, ws)
|
|
colSourceCON = GetCol(true_vars(i + 1), ws)
|
|
If colSource1 > 0 And colSourceCON > 0 Then
|
|
For r = 2 To rowCount
|
|
checkVal = ws.Cells(r, colSource1).Value
|
|
val = NormalizeProb01(ws.Cells(r, colSourceCON).Value)
|
|
colTarget = 0
|
|
For j = 0 To UBound(target_headers)
|
|
If Left(target_headers(j), InStr(target_headers(j), "_") - 1) = Left(matchPrefix, InStr(matchPrefix, "_") - 1) Then
|
|
colTarget = GetCol(target_headers(j), ws)
|
|
Exit For
|
|
End If
|
|
Next j
|
|
If colTarget > 0 Then
|
|
Dim truth2 As Variant
|
|
truth2 = NormalizeTruth(checkVal)
|
|
If IsNull(truth2) Or val < 0 Then
|
|
result = CVErr(xlErrNA)
|
|
ElseIf truth2 = True Then
|
|
result = (val - 1#) ^ 2
|
|
Else
|
|
result = ((1# - val) - 1#) ^ 2
|
|
End If
|
|
ws.Cells(r, colTarget).Value = result
|
|
End If
|
|
Next r
|
|
End If
|
|
Next i
|
|
End Sub
|