add shapiro-francia as a separate option (for normal dist)

Author: Kucharssim

R/commonDiscoverDistributions.R

@@ -417,6 +417,7 @@
   isTRUE(options[["andersonDarling"]]) ||
   isTRUE(options[["lillienfors"]]) ||
   isTRUE(options[["shapiroWilk"]]) ||
+  isTRUE(options[["shapiroFrancia"]]) ||
   isTRUE(options[["chiSquare"]]) ||
   isTRUE(options[["estPDF"]]) ||
   isTRUE(options[["estPMF"]]) ||
@@ -522,7 +523,7 @@
 .ldFitStatisticsTable <- function(fitContainer, options, method){
   if(!is.null(fitContainer[['fitStatisticsTable']])) return()
 
-  allTests <- c("kolmogorovSmirnov", "cramerVonMisses", "andersonDarling", "lillienfors", "shapiroWilk", "chiSquare")
+  allTests <- c("kolmogorovSmirnov", "cramerVonMisses", "andersonDarling", "lillienfors", "shapiroWilk", "shapiroFrancia", "chiSquare")
   optionsTests <- allTests %in% names(options)
   whichTests <- unlist(options[allTests[optionsTests]])
 
@@ -550,7 +551,7 @@
   if(is.null(fit)) return()
   if(!is.null(fitContainer[['fitStatisticsResults']])) return(fitContainer[['fitStatisticsResults']]$object)
 
-  allTests <- c("kolmogorovSmirnov", "cramerVonMisses", "andersonDarling", "lillienfors", "shapiroWilk", "chiSquare")
+  allTests <- c("kolmogorovSmirnov", "cramerVonMisses", "andersonDarling", "lillienfors", "shapiroWilk", "shapiroFrancia", "chiSquare")
   tests <- allTests[allTests %in% names(options)]
 
   res <- data.frame(test = tests, statistic = numeric(length = length(tests)), p.value = numeric(length = length(tests)))
@@ -562,6 +563,7 @@
                    "kolmogorovSmirnov" = c(list(x = variable, y = options$cdfFun), pars),
                    "lillienfors" = list(x = variable),
                    "shapiroWilk" = list(x = variable),
+                   "shapiroFrancia" = list(x = variable),
                    "chiSquare" = list(x = as.numeric(table(variable)),
                                       p = do.call(options[['pdfFun']],
                                                   utils::modifyList(pars,
@@ -577,7 +579,8 @@
                    "cramerVonMisses"   = goftest::cvm.test,
                    "andersonDarling"   = goftest::ad.test,
                    "lillienfors"       = nortest::lillie.test,
-                   "shapiroWilk"       = nortest::sf.test,
+                   "shapiroWilk"       = stats::shapiro.test,
+                   "shapiroFrancia"    = nortest::sf.test,
                    "chiSquare"         = stats::chisq.test
     )
 
@@ -593,13 +596,9 @@
         fun <- function(x) {
           return(list(statistic = NA, p.value = NA))
         }
-      } else if (test == "shapiroWilk" && (length(variable) < 5 || length(variable) > 5000)) {
-        fun <- stats::shapiro.test
       }
     } else {
-      if (test == "shapiroWilk") {
-        fun <- stats::shapiro.test
-      } else if (test=="lillienfors") {
+      if (test=="lillienfors") {
         fun <- function(x) {
           return(list(statistic = NA, p.value = NA))
         }
@@ -622,13 +621,14 @@
   if(is.null(table)) return()
 
 
-  allTests <- c("kolmogorovSmirnov", "cramerVonMisses", "andersonDarling", "lillienfors", "shapiroWilk", "chiSquare")
+  allTests <- c("kolmogorovSmirnov", "cramerVonMisses", "andersonDarling", "lillienfors", "shapiroWilk", "shapiroFrancia", "chiSquare")
   tests <- allTests[allTests %in% names(options)]
   testNames <- c(gettext("Kolmogorov-Smirnov"),
                  gettext("Cramér-von Mises"),
                  gettext("Anderson-Darling"),
                  gettext("Lillienfors"),
                  gettext("Shapiro-Wilk"),
+                 gettext("Shapiro-Francia"),
                  gettext("Chi-square"))[allTests %in% names(options)]
 
   whichTests <- unlist(options[tests])

inst/qml/LDgaussianunivariate.qml

@@ -107,5 +107,5 @@ Form
 
 	LD.LDEstimateParameters { enabled: dataSetInfo.dataAvailable; includeUnbiased: true }
 
-	LD.LDAssessFit{ enabled: dataSetInfo.dataAvailable; includeShapiroWilk: true; includeLillienfors: true}
+	LD.LDAssessFit{ enabled: dataSetInfo.dataAvailable; includeShapiro: true; includeLillienfors: true}
 }

inst/qml/common/LDAssessFit.qml

@@ -24,7 +24,7 @@ Section
 {
 	property string	distributionType		: "continuous" // "counts" or "categorical"
 	property bool includeLillienfors		: false
-	property bool includeShapiroWilk		: false
+	property bool includeShapiro			: false
 	property bool isDistributionContinuous	: distributionType === "continuous"
 
 	title: enabled ? qsTr("Assess Fit") : qsTr("Assess Fit") + " - " + qsTr("[requires a loaded data set]")
@@ -86,8 +86,9 @@ Section
 				CheckBox{ name: "kolmogorovSmirnov";	label: qsTr("Kolmogorov-Smirnov");	info: qsTr("Displays the Kolmogorov-Smirnov test")	}
 				CheckBox{ name: "cramerVonMisses";		label: qsTr("Cramér–von Mises");	info: qsTr("Displays the Cramér-von Mises test")	}
 				CheckBox{ name: "andersonDarling";		label: qsTr("Anderson-Darling");	info: qsTr("Displays the Anderson-Darling test")	}
-				CheckBox{ name: "lillienfors";			label: qsTr("Lillienfors");			info: qsTr("Displays the Lillienfors test"); 				visible: includeLillienfors	}
-				CheckBox{ name: "shapiroWilk";			label: qsTr("Shapiro-Wilk");		info: qsTr("Displays the Shapiro-Wilk test of normality");	visible: includeShapiroWilk	}
+				CheckBox{ name: "lillienfors";			label: qsTr("Lillienfors");			info: qsTr("Displays the Lillienfors test"); 					visible: includeLillienfors	}
+				CheckBox{ name: "shapiroWilk";			label: qsTr("Shapiro-Wilk");		info: qsTr("Displays the Shapiro-Wilk test of normality");		visible: includeShapiro	}
+				CheckBox{ name: "shapiroFrancia";		label: qsTr("Shapiro-Francia");		info: qsTr("Displays the Shapiro-Francia test of normality");	visible: includeShapiro	}
 			}
 		}
 

tests/testthat/test-ldgaussianunivariate.R

@@ -29,6 +29,7 @@ options$plotQF <- TRUE
 options$ppplot <- TRUE
 options$qqplot <- TRUE
 options$shapiroWilk <- TRUE
+options$shapiroFrancia <- TRUE
 options$qqPlotCi <- TRUE
 options$qqPlotCiLevel <- 0.95
 options$ppPlotCi <- TRUE
@@ -99,8 +100,8 @@ test_that("Fit Statistics table results match", {
                                  list(0.991407439010072, 0.0435417886558164, "Kolmogorov-Smirnov", 0.943808236870346,
                                       0.0222708494545493, "Cram<unicode>r-von Mises", 0.977570565641067,
                                       0.135493314971953, "Anderson-Darling", 0.912509972807986, 0.0435417886558163,
-                                      "Lillienfors", 0.992785911992608, 0.996812818710274, "Shapiro-Wilk"
-                                 ))
+                                      "Lillienfors", 0.994211531885928, 0.996119141722174, "Shapiro-Wilk",
+                                      0.992785911992608, 0.996812818710274, "Shapiro-Francia"))
 })
 
 test_that("P-P plot matches", {