Merge branch 'IDEMSInternational:master' into ClimaticDistances

Patowhiz · Nov 11, 2024 · 4dcc7e4 · 4dcc7e4
2 parents 6b6fa8a + 30bfb4d
commit 4dcc7e4
Show file tree

Hide file tree

Showing 5 changed files with 32 additions and 26 deletions.
diff --git a/instat/clsRLink.vb b/instat/clsRLink.vb
@@ -201,8 +201,8 @@ Public Class RLink
             MsgBox(ex.Message & Environment.NewLine & "Could not establish connection to R." & Environment.NewLine &
                    "R-Instat requires version " & strRVersionRequired & " of R." & Environment.NewLine &
                    "Note that R-Instat does not work with R below 4.4.1. We recommend using R " & strRBundledVersion &
-                   ".  Try reruning the installation to install R " & strRBundledVersion & " or download R " &
-                   strRBundledVersion & " from https://cran.r-project.org/bin/windows/base/old/" & strRBundledVersion & "/ and restart R-Instat.",
+                   ".  Try rerunning the installation to install R " & strRBundledVersion & " or download R " &
+                   strRBundledVersion & " from https://cran.r-project.org/bin/windows/base/old/" & strRBundledVersion & "/  and restart R-Instat.",
                    MsgBoxStyle.Critical, "Cannot initialise R connection.")
         End Try
 
@@ -228,7 +228,7 @@ Public Class RLink
                 MsgBox("Could not determine version of R installed on your machine. R-Instat requires version: " & strRVersionRequired & vbNewLine &
                                        "Try uninstalling any versions of R and rerun the installation to install R " & strRVersionRequired & " or download R " &
                                        strRVersionRequired & "From https://cran.r-project.org/bin/windows/base/old/" & strRVersionRequired &
-                                       "And restart R-Instat.",
+                                       " and restart R-Instat.",
                                        MsgBoxStyle.Critical, "R Version error.")
             ElseIf strMajor <> strRVersionMajorRequired OrElse strMinor.Substring(0, 1) < strRVersionMinorRequired Then
                 MsgBox("Your current version of R is outdated. You are currently running R version: " & strMajor & "." & strMinor & Environment.NewLine &

diff --git a/instat/dlgColumnStats.vb b/instat/dlgColumnStats.vb
@@ -72,10 +72,7 @@ Public Class dlgColumnStats
         ucrChkOriginalLevel.SetValuesCheckedAndUnchecked("TRUE", "FALSE")
         ucrChkOriginalLevel.SetRDefault("FALSE")
 
-        ucrChkPrintOutput.SetParameter(New RParameter("return_output", 4))
         ucrChkPrintOutput.SetText("Print Results to Output Window")
-        ucrChkPrintOutput.SetValuesCheckedAndUnchecked("TRUE", "FALSE")
-        ucrChkPrintOutput.SetRDefault("FALSE")
 
         ucrChkDropUnusedLevels.SetParameter(New RParameter("drop", 5))
         ucrChkDropUnusedLevels.SetText("Drop Unused Levels")
@@ -117,6 +114,7 @@ Public Class dlgColumnStats
 
         clsDefaultFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$calculate_summary")
         clsDefaultFunction.AddParameter("summaries", clsRFunctionParameter:=clsSummariesList)
+        clsDefaultFunction.AddParameter("store_results", "TRUE", iPosition:=3)
         'Prevents an error if user chooses non count summaries with no columns to summarise
         clsDefaultFunction.AddParameter("silent", "TRUE")
         ucrBase.clsRsyntax.SetBaseRFunction(clsDefaultFunction)
@@ -157,11 +155,7 @@ Public Class dlgColumnStats
     End Sub
 
     Public Sub TestOKEnabled()
-        If ((ucrChkStoreResults.Checked OrElse ucrChkPrintOutput.Checked) AndAlso Not clsSummariesList.clsParameters.Count = 0) AndAlso sdgSummaries.bOkEnabled Then
-            ucrBase.OKEnabled(True)
-        Else
-            ucrBase.OKEnabled(False)
-        End If
+        ucrBase.OKEnabled(Not clsSummariesList.clsParameters.Count = 0 AndAlso sdgSummaries.bOkEnabled AndAlso Not ucrReceiverSelectedVariables.IsEmpty)
     End Sub
 
     Private Sub ucrBase_ClickReset(sender As Object, e As EventArgs) Handles ucrBase.ClickReset
@@ -226,14 +220,23 @@ Public Class dlgColumnStats
         sdgMissingOptions.ShowDialog()
     End Sub
 
-    'Private Sub ucrReceiverSelectedVariables_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrReceiverSelectedVariables.ControlValueChanged
-    '    Dim bSameType As Boolean = Not ucrReceiverSelectedVariables.IsEmpty _
-    '                            AndAlso ucrReceiverSelectedVariables.GetCurrentItemTypes().All(Function(x) x = "factor")
-    '    ucrChkDropUnusedLevels.Enabled = bSameType
-    '    ucrChkDropUnusedLevels.Checked = Not bSameType
-    'End Sub
+    Private Sub ucrReceiverByFactor_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrReceiverByFactor.ControlValueChanged, ucrChkStoreResults.ControlValueChanged, ucrChkPrintOutput.ControlValueChanged
+        If ucrReceiverByFactor.IsEmpty Then
+            clsDefaultFunction.AddParameter("store_results", "FALSE", iPosition:=3)
+            clsDefaultFunction.AddParameter("return_output", "TRUE", iPosition:=4)
+            ucrBase.clsRsyntax.iCallType = 2
+        Else
+            clsDefaultFunction.RemoveParameterByName("return_output")
+            If ucrChkStoreResults.Checked Then
+                clsDefaultFunction.AddParameter("store_results", "TRUE", iPosition:=3)
+            End If
+            If ucrChkPrintOutput.Checked Then
+                clsDefaultFunction.AddParameter("return_output", "TRUE", iPosition:=4)
+            End If
+        End If
+    End Sub
 
-    Private Sub CoreControls_ControlContentsChanged(ucrChangedControl As ucrCore) Handles ucrChkPrintOutput.ControlContentsChanged, ucrChkStoreResults.ControlContentsChanged
+    Private Sub CoreControls_ControlContentsChanged(ucrChangedControl As ucrCore) Handles ucrReceiverSelectedVariables.ControlContentsChanged
         TestOKEnabled()
     End Sub
 End Class
diff --git a/instat/static/Help/R-Instat.chm b/instat/static/Help/R-Instat.chm
diff --git a/instat/static/InstatObject/R/Backend_Components/summary_functions.R b/instat/static/InstatObject/R/Backend_Components/summary_functions.R
@@ -239,18 +239,20 @@ DataBook$set("public", "calculate_summary", function(data_name, columns_to_summa
     curr_filter_name <- curr_filter[["name"]]
     curr_filter_calc <- self$get_filter_as_instat_calculation(data_name, curr_filter_name)
     manipulations <- c(curr_filter_calc, manipulations)
-  }
+  } 
   if(!missing(additional_filter)) {
     manipulations <- c(additional_filter, manipulations)
   }
   combined_calc_sum <- instat_calculation$new(type="combination", sub_calculations = sub_calculations, manipulations = manipulations)
 
   # setting up param_list. Here we read in .drop and .preserve
   param_list <- list()
-  for (i in 1:length(combined_calc_sum$manipulations)){
-    if (combined_calc_sum$manipulations[[i]]$type %in% c("by", "filter")){
-        param_list <- c(param_list, combined_calc_sum$manipulations[[i]]$param_list)
-    }
+  if (length(combined_calc_sum$manipulations) > 0){
+      for (i in 1:length(combined_calc_sum$manipulations)){
+          if (combined_calc_sum$manipulations[[i]]$type %in% c("by", "filter")){
+              param_list <- c(param_list, combined_calc_sum$manipulations[[i]]$param_list)
+          }
+      }
   }
   out <- self$apply_instat_calculation(combined_calc_sum, param_list = param_list)
   # relocate so that the factors are first still for consistency	
@@ -1063,11 +1065,12 @@ summary_Sn <- function(x, constant = 1.1926, finite.corr = missing(constant), na
 }
 
 # cor function
-summary_cor <- function(x, y, na.rm = FALSE, na_type = "", weights = NULL, method = c("pearson", "kendall", "spearman"), use = c( "everything", "all.obs", "complete.obs", "na.or.complete", "pairwise.complete.obs"), ...) {
+summary_cor <- function(x, y, na.rm = FALSE, na_type = "", weights = NULL, method = c("pearson", "kendall", "spearman"), cor_use = c("everything", "all.obs", "complete.obs", "na.or.complete", "pairwise.complete.obs"), ...) {
+  cor_use <- match.arg(cor_use)
   if (na.rm && na_type != "" && !na_check(x, na_type = na_type, ...)) return(NA)
   else {
     if (missing(weights) || is.null(weights)) {
-      return(cor(x = x, y = y, use = use, method = method))
+      return(cor(x = x, y = y, use = cor_use, method = method))
     }
     else {
       weights::wtd.cor(x = x, y = y, weight = weights)[1]

diff --git a/instat/ucrDataView.vb b/instat/ucrDataView.vb
@@ -949,7 +949,7 @@ Public Class ucrDataView
     End Sub
 
     Private Sub mnuHelp_Click(sender As Object, e As EventArgs) Handles mnuHelp.Click, mnuHelp1.Click, mnuHelp2.Click, mnuHelp3.Click
-        Help.ShowHelp(frmMain, frmMain.strStaticPath & "/" & frmMain.strHelpFilePath, HelpNavigator.TopicId, "134")
+        Help.ShowHelp(frmMain, frmMain.strStaticPath & "/" & frmMain.strHelpFilePath, HelpNavigator.TopicId, "697")
     End Sub
 
     Public Sub GoToSpecificRowPage(iPage As Integer)