jasp-stats · LSLindeloo · Jan 11, 2023
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,4 +1,4 @@
-Package: jaspDescriptives
+Package: jaspDescriptives2
 Type: Package
 Title: Descriptives Module for JASP
 Version: 0.17.0

diff --git a/R/descriptives.R b/R/descriptives.R
@@ -361,7 +361,7 @@ DescriptivesInternal <- function(jaspResults, dataset, options) {
   if (numberMissingSplitBy)
     stats$addFootnote(message=gettextf("Excluded %1$i rows from the analysis that correspond to the missing values of the split-by variable %2$s", numberMissingSplitBy, options$splitBy))
 
-  stats$dependOn(c("splitBy", "variables", "quantilesForEqualGroupsNumber", "percentileValues", "mode", "median", "mean",
+  stats$dependOn(c("splitBy", "variables", "quantilesForEqualGroupsNumber", "percentileValues", "mode", "median", "mean", "geometricMean", "harmonicMean",
                    "seMean", "sd", "coefficientOfVariation", "variance", "skewness", "kurtosis", "shapiroWilkTest",
                    "range", "iqr", "mad", "madRobust", "minimum", "maximum", "sum", "quartiles", "quantilesForEqualGroups",
                    "percentiles", "descriptivesTableTransposed", "valid", "missing", "meanCi", "meanCiLevel", "meanCiMethod",
@@ -374,11 +374,11 @@ DescriptivesInternal <- function(jaspResults, dataset, options) {
   } else {
     stats$addColumnInfo(name="Variable",  title="", type="string")
   }
-  
+
   formattedMeanCiPercent <- format(100 * options[["meanCiLevel"]], digits = 3, drop0trailing = TRUE)
   formattedSdCiPercent <- format(100 * options[["sdCiLevel"]], digits = 3, drop0trailing = TRUE)
-  formattedVarianceCiPercent <- format(100 * options[["varianceCiLevel"]], digits = 3, drop0trailing = TRUE) 
-  
+  formattedVarianceCiPercent <- format(100 * options[["varianceCiLevel"]], digits = 3, drop0trailing = TRUE)
+
   # only add overtitle for CIs if table is transposed, else describe CIs in title
   if (options[["descriptivesTableTransposed"]]) {
     meanCiOvertitle <- gettextf("%s%% Confidence Interval Mean", formattedMeanCiPercent)
@@ -406,7 +406,15 @@ DescriptivesInternal <- function(jaspResults, dataset, options) {
   if (options$missing)                        stats$addColumnInfo(name="Missing",                     title=gettext("Missing"),                 type="integer")
   if (options$mode)                           stats$addColumnInfo(name="Mode",                        title=gettext("Mode"),                    type="number")
   if (options$median)                         stats$addColumnInfo(name="Median",                      title=gettext("Median"),                  type="number")
-  if (options$mean)                           stats$addColumnInfo(name="Mean",                        title=gettext("Mean"), 				            type="number")
+
+  if (sum(options$mean, options$geometricMean, options$harmonicMean) > 1) {
+    if (options$mean)               stats$addColumnInfo(name="Mean",                        title=gettext("Arithmetic Mean"),         type="number")
+  } else {
+    if (options$mean)               stats$addColumnInfo(name="Mean",                        title=gettext("Mean"), 				            type="number")
+  }
+  if (options$geometricMean)                  stats$addColumnInfo(name="Geometric Mean",              title=gettext("Geometric Mean"), 				  type="number")
+  if (options$harmonicMean)                   stats$addColumnInfo(name="Harmonic Mean",               title=gettext("Harmonic Mean"), 				  type="number")
+
   if (options$seMean)                         stats$addColumnInfo(name="Std. Error of Mean",          title=gettext("Std. Error of Mean"),      type="number")
   if (options$meanCi) {                       stats$addColumnInfo(name="MeanCIUB",                    title=meanCiUbTitle,                      type="number", overtitle = meanCiOvertitle)
                                               stats$addColumnInfo(name="MeanCILB",                    title=meanCiLbTitle,                      type="number", overtitle = meanCiOvertitle)}
@@ -419,7 +427,7 @@ DescriptivesInternal <- function(jaspResults, dataset, options) {
   if (options$iqr)                            stats$addColumnInfo(name="IQR",                         title=gettext("IQR"),                     type="number")
   if (options$variance)                       stats$addColumnInfo(name="Variance",                    title=gettext("Variance"),                type="number")
   if (options$varianceCi) {                   stats$addColumnInfo(name="VarianceCIUB",                title=varianceCiUbTitle,                  type="number", overtitle = varianceCiOvertitle)
-                                              stats$addColumnInfo(name="VarianceCILB",                title=varianceCiLbTitle,                  type="number", overtitle = varianceCiOvertitle)} 
+                                              stats$addColumnInfo(name="VarianceCILB",                title=varianceCiLbTitle,                  type="number", overtitle = varianceCiOvertitle)}
   if (options$skewness) {                     stats$addColumnInfo(name="Skewness",                    title=gettext("Skewness"),                type="number")
                                               stats$addColumnInfo(name="Std. Error of Skewness",      title=gettext("Std. Error of Skewness"),  type="number") }
   if (options$kurtosis) {                     stats$addColumnInfo(name="Kurtosis",                    title=gettext("Kurtosis"),                type="number")
@@ -519,6 +527,26 @@ DescriptivesInternal <- function(jaspResults, dataset, options) {
   if(shouldAddModeMoreThanOnceFootnote)
     stats$addFootnote(message=gettext("More than one mode exists, only the first is reported"), colNames="Mode")
 
+
+  #Determine which numeric variables contain values of 0 or lower
+  numeric_variables <- colnames(dataset[, variables])[unlist(sapply(dataset[, variables], is.numeric))]
+  if(length(numeric_variables) > 0) {
+    zero_or_negative_variables <- colnames(dataset[, numeric_variables])[unlist(sapply(dataset[, numeric_variables], function(x) any(x <= 0)))]
+    zero_or_negative_variables <- zero_or_negative_variables[!is.na(zero_or_negative_variables)]
+  } else {
+    zero_or_negative_variables <- NULL
+  }
+  #Add geometric/harmonic mean footnote
+  if(length(zero_or_negative_variables > 0)) {
+    if(options$geometricMean && options$harmonicMean) {
+      stats$addFootnote(gettextf("The geometric and harmonic means are only defined for a set of non-zero, positive numbers. The following variable(s) contain(s) zero or negative values: %s", paste(zero_or_negative_variables, collapse = ", ")))
+    } else if (options$geometricMean) {
+      stats$addFootnote(gettextf("The geometric mean is only defined for a set of non-zero, positive numbers. The following variable(s) contain(s) zero or negative values: %s", paste(zero_or_negative_variables, collapse = ", ")))
+    } else if (options$harmonicMean) {
+      stats$addFootnote(gettextf("The harmonic mean is only defined for a set of non-zero, positive numbers. The following variable(s) contain(s) zero or negative values: %s", paste(zero_or_negative_variables, collapse = ", ")))
+    }
+  }
+
   return(stats)
 }
 
@@ -529,21 +557,46 @@ DescriptivesInternal <- function(jaspResults, dataset, options) {
   rows        <- length(column)
   na.omitted  <- na.omit(column)
 
-  if (base::is.factor(na.omitted) && (options$mode || options$median || options$mean || options$minimum || options$seMean || options$iqr || options$mad || options$madRobust || options$kurtosis || options$shapiroWilkTest || options$skewness || options$quartiles || options$variance || options$sd ||  options$coefficientOfVariation || options$percentiles || options$sum || options$maximum)) {
+  if (base::is.factor(na.omitted) && (options$mode || options$median || options$mean || options$geometricMean || harmonicMean || options$minimum || options$seMean || options$iqr || options$mad || options$madRobust || options$kurtosis || options$shapiroWilkTest || options$skewness || options$quartiles || options$variance || options$sd ||  options$coefficientOfVariation || options$percentiles || options$sum || options$maximum)) {
     shouldAddNominalTextFootnote <- TRUE
   }
 
   shouldAddIdenticalFootnote <- all(na.omitted[1] == na.omitted) && (options$skewness || options$kurtosis || options$shapiroWilkTest)
 
+  geometricMean <- function (x)
+  {
+    if (!is.numeric(x) || any(x <= 0)) {
+      geometric_mean <- NULL
+    } else {
+      # Compute the geometric mean
+      geometric_mean <- exp(mean(log(x)))
+    }
+    return(geometric_mean)
+  }
+
+  harmonicMean <- function (x)
+  {
+    if (!is.numeric(x) || any(x <= 0)) {
+      harmonic_mean <- NULL
+    } else {
+      # Compute the harmonic mean
+      n <- length(x)
+      sum_reciprocals <- sum(1/x)
+      harmonic_mean <- n / sum_reciprocals
+    }
+    return(harmonic_mean)
+  }
+
   valid <- length(na.omitted)
   resultsCol[["Valid"]]                   <- if (options$valid)   valid
   resultsCol[["Missing"]]                 <- if (options$missing) rows - length(na.omitted)
-
   resultsCol[["Median"]]                  <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$median,            na.omitted, median)
-  resultsCol[["Mean"]]                    <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$mean,              na.omitted, mean)
-  resultsCol[["Std. Error of Mean"]]      <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$seMean, na.omitted, function(param) { sd(param)/sqrt(length(param))} )
-  resultsCol[["Std. Deviation"]]          <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$sd, na.omitted, sd)
-  resultsCol[["Coefficient of Variation"]]<- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$coefficientOfVariation,      na.omitted, function(param) { sd(param) / mean(param)})
+  resultsCol[["Mean"]]                    <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$mean,    na.omitted, mean)
+  resultsCol[["Geometric Mean"]]          <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$geometricMean,     na.omitted, geometricMean)
+  resultsCol[["Harmonic Mean"]]           <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$harmonicMean,      na.omitted, harmonicMean)
+  resultsCol[["Std. Error of Mean"]]      <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$seMean,            na.omitted, function(param) { sd(param)/sqrt(length(param))} )
+  resultsCol[["Std. Deviation"]]          <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$sd,                na.omitted, sd)
+  resultsCol[["Coefficient of Variation"]]<- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$coefficientOfVariation, na.omitted, function(param) { sd(param) / mean(param)})
   resultsCol[["MAD"]]                     <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$mad,               na.omitted, function(param) { mad(param, constant = 1) } )
   resultsCol[["MAD Robust"]]              <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$madRobust,         na.omitted, mad)
   resultsCol[["IQR"]]                     <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$iqr,               na.omitted, .descriptivesIqr)
@@ -558,7 +611,7 @@ DescriptivesInternal <- function(jaspResults, dataset, options) {
   resultsCol[["Minimum"]]                 <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$minimum,           na.omitted, min)
   resultsCol[["Maximum"]]                 <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$maximum,           na.omitted, max)
   resultsCol[["Sum"]]                     <- .descriptivesDescriptivesTable_subFunction_OptionChecker(options$sum,               na.omitted, sum)
-  
+
   if (options[["meanCi"]]) {
     variableName <- if (is.null(resultsCol[["Level"]])) resultsCol[["Variable"]] else paste0(resultsCol[["Variable"]], resultsCol[["Level"]])
     meanCiResults <- .descriptivesMeanCI(na.omitted, options, jaspResults, variableName)
@@ -1669,7 +1722,7 @@ DescriptivesInternal <- function(jaspResults, dataset, options) {
 .bootstrapStats <- function(data, options, jaspResults, stateContainerName) {
   if (!is.null(jaspResults[[stateContainerName]]$object))
     return(jaspResults[[stateContainerName]]$object)
-  
+
   bootstrapSamples <- createJaspState()
   k <- options[["ciBootstrapSamples"]]
   means <- numeric(k)

diff --git a/inst/Description.qml b/inst/Description.qml
@@ -3,7 +3,7 @@ import JASP.Module 	1.0
 
 Description
 {
-	name		: "jaspDescriptives"
+	name		: "jaspDescriptives2"
 	title		: qsTr("Descriptives")
 	description	: qsTr("Explore the data with tables and plots")
 	version		: "0.17.0"

diff --git a/inst/qml/Descriptives.qml b/inst/qml/Descriptives.qml
@@ -97,7 +97,9 @@ Form
 
 			CheckBox { name: "mode";			label: qsTr("Mode");					}
 			CheckBox { name: "median";			label: qsTr("Median")					}
-			CheckBox { name: "mean";			label: qsTr("Mean");	checked: true	}
+			CheckBox { name: "mean";	label: qsTr("Arithmetic mean");	checked: true	}
+			CheckBox { name: "geometricMean";	label: qsTr("Geometric mean")			}
+			CheckBox { name: "harmonicMean";	label: qsTr("Harmonic mean")			}
 		}
 
 		Group
@@ -130,21 +132,21 @@ Form
 				Group
 		{
 			title:		qsTr("Inference")
-			
+
 			CheckBox { name: "seMean";	label: qsTr("S.E. mean")			}
-			
+
 			CheckBox
 			{
-				name: "meanCi" 
+				name: "meanCi"
 				label: qsTr("Confidence interval for mean")
-				
-				CIField 
-				{ 
-					name: "meanCiLevel" 
+
+				CIField
+				{
+					name: "meanCiLevel"
 					label: qsTr("Width")
 				}
-				
-				DropDown 
+
+				DropDown
 				{
 					name: "meanCiMethod"
 					label: qsTr("Method")
@@ -157,36 +159,36 @@ Form
 					]
 				}
 			}
-			
+
 			CheckBox
 			{
-				name: "sdCi" 
+				name: "sdCi"
 				label: qsTr("Confidence interval for std. deviation")
 
-				CIField 
-				{ 
-					name: "sdCiLevel" 
+				CIField
+				{
+					name: "sdCiLevel"
 					label: qsTr("Width")
 				}
 			}
 
 			CheckBox
 			{
-				name: "varianceCi" 
+				name: "varianceCi"
 				label: qsTr("Confidence interval for variance")
 
-				CIField 
-				{ 
-					name: "varianceCiLevel" 
+				CIField
+				{
+					name: "varianceCiLevel"
 					label: qsTr("Width")
 				}
 			}
 
 			Group
-			{ 
+			{
     			title: qsTr("Bootstrap confidence interval options")
-    			
-				IntegerField 
+
+				IntegerField
 				{
 					name:			"ciBootstrapSamples"
 					label:			qsTr("Bootstrap samples")
@@ -253,40 +255,40 @@ Form
 			CheckBox {				name: "qqPlot";			label: qsTr("Q-Q plots")						}
 			CheckBox {				name: "pieChart";		label: qsTr("Pie charts")						}
 			CheckBox {				name: "dotPlot";		label: qsTr("Dot plots")						}
-		}	
-		
+		}
+
 		Group
 		{
 			title: qsTr("Categorical plots")
-			
-			CheckBox 
-			{			
+
+			CheckBox
+			{
 				name: 		"paretoPlot"
 				label: 		qsTr("Pareto plots")
-				
-				CheckBox 
-				{			
-					name: 				"paretoPlotRule"	
+
+				CheckBox
+				{
+					name: 				"paretoPlotRule"
 					label: 				qsTr("Pareto rule")
 					childrenOnSameRow: 	true
-					
+
 					CIField { name: 	"paretoPlotRuleCi" }
 				}
 			}
-			
-			CheckBox 
-			{	
+
+			CheckBox
+			{
 				name: 		"likertPlot"
-				label: 		qsTr("Likert plots")	
+				label: 		qsTr("Likert plots")
 
-				CheckBox 
-				{			
-					name: 				"likertPlotAssumeVariablesSameLevel"	
+				CheckBox
+				{
+					name: 				"likertPlotAssumeVariablesSameLevel"
 					label: 				qsTr("Assume all variables share the same levels")
 					childrenOnSameRow: 	true
-				}				
-				
-				DropDown 
+				}
+
+				DropDown
 				{
 					id: 				likertPlotAdjustableFontSize
 					name: 				"likertPlotAdjustableFontSize"
@@ -393,35 +395,35 @@ Form
 				checked: true
 			}
 		}
-			
+
 		Group
 		{
-			
+
 			VariablesForm
 			{
 				preferredHeight: 100 * preferencesModel.uiScale
-				
-				AvailableVariablesList 
-				{ 
+
+				AvailableVariablesList
+				{
 					name: 				"densityPlotVariables"
 					label: 				qsTr("Density plots")
 					source: 			[{ name: "allVariablesList", discard: ["variables", "splitBy"], use: "type=ordinal|nominal|nominalText"}]
 				}
-				
-				AssignedVariablesList 
-				{ 
+
+				AssignedVariablesList
+				{
 					name: 				"densityPlotSeparate"
 					singleVariable: 	true
 					title: 				qsTr("Separate densities:")
-					suggestedColumns: 	["ordinal", "nominal"] 
+					suggestedColumns: 	["ordinal", "nominal"]
 				}
 			}
-			
-			CheckBox 
-			{ 
+
+			CheckBox
+			{
 				name: 		"densityPlot"
-				label: 		qsTr("Display density plots") 
-			
+				label: 		qsTr("Display density plots")
+
 				DoubleField
 				{
 					name:			"densityPlotTransparency"