Attribute VB_Name = "eff_size_hedges_g_os"
'Created by Peter Stikker
'Companion website: https://PeterStatistics.com
'YouTube channel: https://www.youtube.com/stikpet
'Donations welcome at Patreon: https://www.patreon.com/bePatron?u=19398076


Public Sub es_hedges_g_os_addHelp()
Application.MacroOptions _
    Macro:="es_hedges_g_os", _
    Description:="Calculate Hedges g (one-sample)", _
    category:=14, _
    ArgumentDescriptions:=Array( _
        "specific range with the numeric scores", _
        "optional parameter to set the hypothesized mean. If not used the midrange is used", _
        "optional parameter for approximation. Either none, hedges, durlak, or xue", _
        "optional parameter for rule of thumb for qualification. See th_cohen_d for details", _
        "output to show, either value (default) or qual")
        
Application.MacroOptions _
    Macro:="es_hedges_g_os_arr", _
    Description:="Calculate Hedges g (one-sample)" & vbNewLine & "array function, requires 2 rows and 3 columns as output", _
    category:=14, _
    ArgumentDescriptions:=Array( _
        "specific range with the numeric scores", _
        "optional parameter to set the hypothesized mean. If not used the midrange is used", _
        "optional parameter for approximation. Either none, hedges, durlak, or xue", _
        "optional parameter for rule of thumb for qualification. See th_cohen_d for details")
        
End Sub

Function es_hedges_g_os(data As Range, Optional mu = "none", Optional appr = "none", Optional qual = "sawilowsky", Optional out = "value")
' Calculates Hedges G for a one-sample
' appr can be set to 'exact', 'hedges', 'durlak', or 'xue'.

If mu = "none" Then
    mu = (WorksheetFunction.Min(data) + WorksheetFunction.Max(data)) / 2
End If

'Calculate mean, difference with hyp. mean and standard deviation
m = WorksheetFunction.Average(data)
dif = m - mu
s = WorksheetFunction.StDev(data)

'Determine Cohen's d
d = dif / s

n = WorksheetFunction.Count(data)
df = n - 1

m = df / 2

If appr = "none" And m <= 171 Then
    g = d * WorksheetFunction.Gamma(m) / (WorksheetFunction.Gamma(m - 0.5) * m ^ 0.5)
ElseIf appr = "hedges" Or (m > 171 And appr = "auto") Then
    g = d * (1 - 3 / (4 * df - 1))
ElseIf appr = "durlak" Then
    g = d * (n - 3) / (n - 2.25) * ((n - 2) / n) ^ 0.5
Else
    g = d * (1 - 9 / df + 69 / (2 * df ^ 2) - 72 / (df ^ 3) + 687 / (8 * df ^ 4) - 441 / (8 * df ^ 5) + 247 / (16 * df ^ 6)) ^ (1 / 12)
End If
    
'Results
If out = "value" Then
    res = g
Else
    'Qualification
    
    'Adjust to regular Cohen d (for two-sample)
    abs_g_adj = Abs(g) * 2 ^ 0.5
    
    Dim qualification As String
    
    qualification = th_cohen_d(abs_g_adj, qual)
            
    res = qualification
End If
    

es_hedges_g_os = res

End Function


Function es_hedges_g_os_arr(data As Range, Optional mu = "none", Optional appr = "none", Optional qual = "sawilowsky")
' Calculates Hedges G for a one-sample
' appr can be set to 'exact', 'hedges', 'durlak', or 'xue'.

If mu = "none" Then
    mu = (WorksheetFunction.Min(data) + WorksheetFunction.Max(data)) / 2
End If

'Calculate mean, difference with hyp. mean and standard deviation
m = WorksheetFunction.Average(data)
dif = m - mu
s = WorksheetFunction.StDev(data)

'Determine Cohen's d
d = dif / s

n = WorksheetFunction.Count(data)
df = n - 1

m = df / 2

If appr = "none" And m <= 171 Then
    g = d * WorksheetFunction.Gamma(m) / (WorksheetFunction.Gamma(m - 0.5) * m ^ 0.5)
    Comment = "exact"
ElseIf appr = "hedges" Then
    g = d * (1 - 3 / (4 * df - 1))
    Comment = "Hedges approximation"
ElseIf appr = "durlak" Then
    g = d * (n - 3) / (n - 2.25) * ((n - 2) / n) ^ 0.5
    Comment = "Durlak approximation"
Else
    g = d * (1 - 9 / df + 69 / (2 * df ^ 2) - 72 / (df ^ 3) + 687 / (8 * df ^ 4) - 441 / (8 * df ^ 5) + 247 / (16 * df ^ 6)) ^ (1 / 12)
    Comment = "Xue approximation"
End If
    
'Qualification
'Adjust to regular Cohen d (for two-sample)
abs_g_adj = Abs(g) * 2 ^ 0.5
Dim qualification As String
qualification = th_cohen_d(abs_g_adj, qual)
            
'Results
Dim res(1 To 3, 1 To 3)
res(1, 1) = "Hedges g"
res(1, 2) = "Classification"
res(1, 3) = "comment"
res(2, 1) = g
res(2, 2) = qualification
res(2, 3) = Comment

es_hedges_g_os_arr = res

End Function