diff --git a/OPMA functions - d.vb b/OPMA functions - d.vb new file mode 100644 index 0000000..2aea8b0 --- /dev/null +++ b/OPMA functions - d.vb @@ -0,0 +1,370 @@ +' Open Psychometric Meta-Analyis (d values) +' Created by Brenton M. Wiernik +' version 1.0.0 + +' Open Psychometric Meta-Analysis (d values) -- VBA scripts for conducting psychometric +' meta-analysis using Microsoft Excel. +' Copyright (C) 2018 Brenton M. Wiernik. + +' This program is free software: you can redistribute it and/or modify +' it under the terms of the GNU General Public License as published by +' the Free Software Foundation, either version 3 of the License, or +' (at your option) any later version. + +' This program is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU General Public License for more details. + +' You should have received a copy of the GNU General Public License +' along with this program. If not, see . + + +' Variable list: +' k = number of effect sizes +' nRyy = number of reliability (ryy) values +' D = matrix of effect sizes and sample sizes +' RY = matrix of ryy values and frequencies + +' Ntotal = total sample size (N) +' effectiveNtotal = effective total sample size (N) accounting for unequal groups +' sumD = weighted sumD of uncorrected d values +' meanD = weighted average uncorrected d value + +' SampErrVar = Expected sampling error +' ObsSSQ = Observed Sums of Squares +' ObsVar = Observed variance of effect sizes +' SDobs = Observed SD of effect sizes +' PercentVarSamp = Percent of observed effect size variance due to sampling error + +' SumRyy = Sum of y measure reliabilities +' SumRyyFreq = Sum of reliability frequencies +' SumRyySq = Sum of squared y measure reliabilities +' MeanRyy = Mean y measure reliability +' SDRyy = SD of y measure reliabilities +' SumQualy = Sum of y measure qualities (sqrt of reliability) +' MeanQualy = Mean y measure quality (sqrt of reliability) +' SDQualy = SD of y measure qualities (sqrt of reliabilities) + +' Delta = estimated mean true d effect size + +' Datten = Attenuated d value for a particular ryy value +' DattenWeighted = Weighted attenuated d value for a particular ryy value +' SumDatten = Sum of attenuated d values +' SumDattenSq = Sum of squared attenuated d values +' ArtVar = Expected variance due to artifacts + +' ResVar = Residual Variance of effect sizes +' SDres = Residual SD of effect sizes +' SDpred = Predicted SD of effect sizes +' PerVarAcc = Percent of variance in effect sizes accounted for + +' SDdelta = True effect standard deviation + +' SEmeanD = Standard error of mean d +' df = Degrees of freedom for confidence interval when k < 30 +' Crit = Critical value for confidence interval when k < 30 +' UpCIdelta = Upper value of 80% confidence interval for delta +' LoCIdelta = Lower value of 80% confidence interval for delta +' UpCImeanD = Upper value of 80% confidence interval for mean d +' LoCImeanD = Lower value of 80% confidence interval for mean d + +' UpCVdelta = Upper value of 80% credibility interval for delta +' LoCVdelta = Lower value of 80% credibility interval for delta +' UpCVmeanD = Upper value of 80% credibility interval for mean d +' LoCVmeanD = Lower value of 80% credibility interval for mean d + +' TODO: Add range restriction corrections +' TODO: Add indirect range restriction corrections via interactive method +' TODO: Compute sampling error based on unequal group sizes +' TODO: Allow weighting based on inverse variance + +Sub MetaAnalysisD() + +' Set up control parameters based on OS version and options set via worksheet controls +If Application.Version < 15 Then + If Application.OperatingSystem Like "*Mac*" Then + CompatMode = True + ElseIf Application.Version < 14 Then + CompatMode = True + Else + CompatMode = False + End If +Else + CompatMode = False +End If + +If Worksheets("d - Artifact").Shapes("SepGroupN").ControlFormat.Value = 1 Then groupNs = True Else groupNs = False +If Worksheets("d - Artifact").Shapes("WtTotal").ControlFormat.Value = 1 Then + Weights = "Total" +ElseIf Worksheets("d - Artifact").Shapes("WtUnit").ControlFormat.Value = 1 Then + Weights = "Unit" +ElseIf Worksheets("d - Artifact").Shapes("WtInvSamp").ControlFormat.Value = 1 Then + Weights = "InvSamp" +Else + MsgBox ("Please select a weighting method.") + Stop +End If +If Worksheets("ryy").Shapes("SpecDist").ControlFormat.Value = 1 Then SpecDist = True Else SpecDist = False + +k = Application.Count(Worksheets("d - Artifact").Range("A:A")) +nRyy = Application.Count(Worksheets("ryy").Range("A:A")) + +Ntotal = 0 +effectiveNtotal = 0 +Ngroup1 = 0 +Ngroup2 = 0 +If groupNs = True Then + ReDim N(k, 3) + For I = 1 To k + N(I, 1) = Worksheets("d - Artifact").Cells(I + 1, 2).Value + N(I, 2) = Worksheets("d - Artifact").Cells(I + 1, 3).Value + N(I, 3) = (N(I, 1) * N(I, 2)) / (N(I, 1) + N(I, 2)) + Ntotal = Ntotal + N(I, 1) + N(I, 2) + Ngroup1 = Ngroup1 + N(I, 1) + Ngroup2 = Ngroup2 + N(I, 2) + effectiveNtotal = effectiveNtotal + N(I, 3) + Next I +Else + ReDim N(k, 3) + For I = 1 To k + N(I, 1) = Worksheets("d - Artifact").Cells(I + 1, 2).Value + N(I, 2) = 0 + N(I, 3) = N(I, 1) + Ntotal = Ntotal + N(I, 1) + Ngroup1 = "" + Ngroup2 = "" + effectiveNtotal = effectiveNtotal + N(I, 1) + Next I +End If + +ReDim D(k, 2) +For I = 1 To k + D(I, 1) = Worksheets("d - Artifact").Cells(I + 1, 1).Value + D(I, 2) = N(I, 3) + Next I + +If SpecDist = True Then + ' TODO: Add support for specified artifact distributions +Else + ReDim RY(nRyy, 2) + For I = 1 To nRyy + RY(I, 1) = Worksheets("ryy").Cells(I + 1, 1).Value + RY(I, 2) = Worksheets("ryy").Cells(I + 1, 2).Value + Next I +End If + +' TODO: Correct d values for small sample size + +' COMPUTE MEAN UNCORRECTED D +sumD = 0 +For I = 1 To k + sumD = sumD + D(I, 2) * D(I, 1) + Next I +meanD = sumD / effectiveNtotal + +' COMPUTE SAMPLING VAR OF OBS D'S +SampErrVar = (4 * (1 + (meanD ^ 2) / 8) * k) / effectiveNtotal +' TODO: Change variance to compute using unequal groups formula + +' COMPUTE VAR OF OBS D'S +ObsSSQ = 0 +For I = 1 To k +ObsSSQ = ObsSSQ + D(I, 2) * (D(I, 1) - meanD) ^ 2 +Next I +ObsVar = ObsSSQ / effectiveNtotal +SDobs = Sqr(ObsVar) + +' COMPUTE PERCENT VAR DUE TO SAMPLING ERROR +If ObsVar < 1E-16 Then + PerVarSamp = "No Obs. Var." +Else + PerVarSamp = (SampErrVar / ObsVar) +End If + +' COMPUTE Ryy DISTRIBUTION +SumRyy = 0 +SumRyyFreq = 0 +SumRyySq = 0 +SumQualy = 0 +For I = 1 To nRyy +SumRyy = SumRyy + RY(I, 1) * RY(I, 2) +SumRyySq = SumRyySq + (RY(I, 1) ^ 2) * RY(1, 2) +SumQualy = SumQualy + Sqr(RY(I, 1)) * RY(I, 2) +SumRyyFreq = SumRyyFreq + RY(I, 2) +Next I +MeanRyy = SumRyy / SumRyyFreq +SDRyy = Sqr((SumRyySq / SumRyyFreq) - (SumRyy / SumRyyFreq) ^ 2) +MeanQualy = SumQualy / SumRyyFreq +SDQualy = Sqr((SumRyy / SumRyyFreq) - (SumQualy / SumRyyFreq) ^ 2) + +' COMPUTE TRUE SCORE MEAN D +Delta = meanD / MeanQualy + +' COMPUTE VAR DUE TO RYY DIFFS +Datten = 0 +DattenWeighted = 0 +SumDatten = 0 +SumDattenSq = 0 +For I = 1 To nRyy +Datten = Delta * Sqr(RY(I, 1)) +DattenWeighted = Datten * RY(I, 2) +SumDatten = SumDatten + DattenWeighted +SumDattenSq = SumDattenSq + Datten ^ 2 * RY(I, 2) +Next I +ArtVar = (SumDattenSq / SumRyyFreq) - (SumDatten / SumRyyFreq) ^ 2 + +' COMPUTE RESIDUAL VAR and SD +ResVar = ObsVar - SampErrVar - ArtVar +If ResVar < 0 Then + SDres = 0 +Else + SDres = Sqr(ResVar) +End If + +' COMPUTE SD-PREDICTED +SDpred = Sqr(SampErrVar + ArtVar) + +' COMPUTE PERCENT VAR ACC FOR +If ObsVar < 1E-16 Then + PerVarAcc = "No Obs. Var." +Else + PerVarAcc = ((SampErrVar + ArtVar) / ObsVar) +End If + +' COMPUTE SD OF TRUE SCORE D'S +' TODO: Change this to the more robust method (based on .1*SDQualy steps up to 3*SDQualy) once range restriction is added +SDdelta = (Delta / meanD) * SDres + +' Confidence Interval - 90% (meanD) +SEmeanD = SDobs / Sqr(k) +If k < 30 Then + df = k - 1 + If CompatMode Then + Crit = Application.TInv(0.1, df) + Else + Crit = Application.T_Inv_2T(0.1, df) + End If + UpCImeanD = meanD + Crit * SEmeanD + LoCImeanD = meanD - Crit * SEmeanD +Else + UpCImeanD = meanD + 1.64 * SEmeanD + LoCImeanD = meanD - 1.64 * SEmeanD +End If + +' Confidence Interval - 90% (Delta) +' TODO: Change this to correct endpoints individually for unreliability and range restriction once RR is added +UpCIdelta = UpCImeanD * (Delta / meanD) +LoCIdelta = LoCImeanD * (Delta / meanD) + +' Credibility Interval - 80% (meanD) +UpCVmeanD = meanD + 1.28 * SDres +LoCVmeanD = meanD - 1.28 * SDres + +' Credibility Interval - 80% (Delta) +UpCVdelta = Delta + 1.28 * SDdelta +LoCVdelta = Delta - 1.28 * SDdelta + +' TODO: Fix output page + Worksheets("Output").Select + Worksheets("Output").Cells.ClearContents + + Cells(1, 1).Value = "Meta-analysis Results" + Cells(1, 1).Font.Bold = True + Cells(2, 1).Value = "Standardized mean difference (Unbiased Cohen's d or Hedge's g)" + Cells(3, 1).Value = "Corrected using artifact distribution" + ' TODO: List the chosen checkbox options once they are implemented + + Cells(5, 1).Value = "Main Results" + Cells(5, 1).Font.Bold = True + Cells(6, 1).Value = "Recommended results table" + Cells(6, 2).Value = "N (Total sample size)" + Cells(7, 2).Value = Ntotal + Cells(6, 3).Value = "Total Group 1 sample size" + Cells(7, 3).Value = Ngroup1 + Cells(6, 4).Value = "Total Group 2 sample size" + Cells(7, 4).Value = Ngroup2 + Cells(6, 5).Value = "Effective total sample size" + Cells(7, 5).Value = effectiveNtotal + Cells(6, 6).Value = "k (No. d values)" + Cells(7, 6).Value = k + Range("B7:F7").NumberFormat = "0" + Cells(8, 2).Value = "Mean Uncorrected d" + Cells(9, 2).Value = meanD + Cells(8, 3).Value = "Observed SD of d" + Cells(9, 3).Value = SDobs + Cells(8, 4).Value = "Residual SD of d" + Cells(9, 4).Value = SDres + Cells(8, 5).Value = "Mean Corrected " & ChrW(948) + Cells(9, 5).Value = Delta + Cells(8, 6).Value = "SD of " & ChrW(948) + Cells(9, 6).Value = SDdelta + Cells(8, 7).Value = "90% Conf. Int. (" & ChrW(948) & ")" + Cells(9, 7).Value = Application.Text(LoCIdelta, ".00") & ", " & Application.Text(UpCIdelta, ".00") + Cells(8, 8).Value = "80% Cred. Int. (" & ChrW(948) & ")" + Cells(9, 8).Value = Application.Text(LoCVdelta, ".00") & ", " & Application.Text(UpCVdelta, ".00") + Range("B8:H8").NumberFormat = ".00" + + Cells(11, 1).Value = "Artifact Distribution" + Cells(11, 1).Font.Bold = True + Cells(12, 1).Value = "Recommended results table" + Cells(12, 2).Value = "No. ryy values" + Cells(12, 2).Value = SumRyyFreq + Cells(12, 3).Value = "Mean ryy" + Cells(13, 3).Value = MeanRyy + Cells(12, 4).Value = "SD of ryy" + Cells(13, 4).Value = SDRyy + Cells(12, 5).Value = "Mean SQRT of ryy" + Cells(13, 5).Value = MeanQualy + Cells(12, 6).Value = "SD of SQRT of ryy" + Cells(13, 6).Value = SDQualy + Range("B13").NumberFormat = "0" + Range("C13:F13").NumberFormat = ".00" + + Cells(15, 1).Value = "Supplemental Results" + Cells(15, 1).Font.Bold = True + Cells(16, 1).Value = "90% Conf. Int. (d)" + Cells(16, 2).Value = Application.Text(LoCImeanD, ".00") & ", " & Application.Text(UpCImeanD, ".00") + Cells(17, 1).Value = "80% Cred. Int. (d)" + Cells(17, 2).Value = Application.Text(LoCVmeanD, ".00") & ", " & Application.Text(UpCVmeanD, ".00") + Cells(18, 1).Value = "Lower CI (d)" + Cells(18, 2).Value = LoCImeanD + Cells(19, 1).Value = "Upper CI (d)" + Cells(19, 2).Value = UpCImeanD + Cells(20, 1).Value = "Lower CV (d)" + Cells(20, 2).Value = LoCVmeanD + Cells(21, 1).Value = "Upper CV (d)" + Cells(21, 2).Value = UpCVmeanD + Cells(23, 1).Value = "Lower CI (" & ChrW(948) & ")" + Cells(23, 2).Value = LoCIdelta + Cells(24, 1).Value = "Upper CI (" & ChrW(948) & ")" + Cells(24, 2).Value = UpCIdelta + Cells(25, 1).Value = "Lower CV (" & ChrW(948) & ")" + Cells(25, 2).Value = LoCVdelta + Cells(26, 1).Value = "Upper CV (" & ChrW(948) & ")" + Cells(26, 2).Value = UpCVdelta + Range("B16:B26").NumberFormat = ".00" + + Cells(28, 1).Value = "Observed variance of d" + Cells(28, 2).Value = ObsVar + Cells(29, 1).Value = "Sampling error variance of d" + Cells(29, 2).Value = SampErrVar + Cells(30, 1).Value = "Variance due to artifact differences" + Cells(30, 2).Value = ArtVar + Cells(31, 1).Value = "Residual variance" + Cells(31, 2).Value = ResVar + Cells(32, 1).Value = "Percent variance due to sampling error" + Cells(32, 2).Value = PerVarSamp + Cells(33, 1).Value = "Percent variance accounted for" + Cells(33, 2).Value = PerVarAcc + Range("B28:B31").NumberFormat = ".0000" + Range("B32:B33").NumberFormat = "0%" + + Cells(35, 1).Value = "Observed SD" + Cells(35, 2).Value = SDobs + Cells(36, 1).Value = "Predicted SD" + Cells(36, 2).Value = SDpred + Range("B35:B36").NumberFormat = ".00" +End Sub + + diff --git a/OPMA functions.vb b/OPMA functions - r.vb similarity index 100% rename from OPMA functions.vb rename to OPMA functions - r.vb diff --git a/Open Psychometric Meta-Analysis - d - spreadsheet.xlsm b/Open Psychometric Meta-Analysis - d - spreadsheet.xlsm new file mode 100644 index 0000000..e2261d1 Binary files /dev/null and b/Open Psychometric Meta-Analysis - d - spreadsheet.xlsm differ diff --git a/Open Psychometric Meta-Analysis - r - spreadsheet.xlsm b/Open Psychometric Meta-Analysis - r - spreadsheet.xlsm index 0cf653f..66c4b02 100644 Binary files a/Open Psychometric Meta-Analysis - r - spreadsheet.xlsm and b/Open Psychometric Meta-Analysis - r - spreadsheet.xlsm differ