Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Allowing to summarise columns not by a factor #9232

Merged
merged 10 commits into from
Nov 8, 2024
6 changes: 3 additions & 3 deletions instat/clsRLink.vb
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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 &
Expand Down
29 changes: 17 additions & 12 deletions instat/dlgColumnStats.vb
Original file line number Diff line number Diff line change
Expand Up @@ -157,11 +157,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
Expand Down Expand Up @@ -226,14 +222,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
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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]
Expand Down
Loading