Skip to content

Commit

Permalink
Merge branch 'namedialog' of https://github.com/Fidel365/R-Instat int…
Browse files Browse the repository at this point in the history
…o namedialog
  • Loading branch information
Fidel365 committed Nov 27, 2024
2 parents 26eb99a + 7404912 commit 2afce42
Show file tree
Hide file tree
Showing 30 changed files with 1,277 additions and 1,097 deletions.
33 changes: 8 additions & 25 deletions instat/UserTables/sdgTableOptions.vb
Original file line number Diff line number Diff line change
Expand Up @@ -41,16 +41,12 @@ Public Class sdgTableOptions
End Sub

''' <summary>
''' An R operateor that has a parameter named "gt" set up.
''' The parameter should be an R Function that generates script "gt:gt()" as part of the last script statement.
''' Sets up the sub dialog.
''' Expected to be called before showing the dialog.
''' </summary>
''' <param name="clsNewOperator"></param>
''' <param name="strDataFrameName">Name of the data frame contained in the data book</param>
''' <param name="clsNewOperator">R operator that has a 'gt' parameter that produces a 'gt' object.</param>
Public Sub Setup(strDataFrameName As String, clsNewOperator As ROperator)
If clsTablesUtils.FindRFunctionsParamsWithRCommand({"gt"}, clsNewOperator).Count = 0 Then
MsgBox("Developer Error: Parameter with 'gt' as name MUST be set up before using this subdialog")
Exit Sub
End If

clsOperator = clsNewOperator

ucrHeader.Setup(clsOperator)
Expand Down Expand Up @@ -80,25 +76,12 @@ Public Class sdgTableOptions
' Themes

Private Sub SetupTheme(clsOperator As ROperator)
clsThemeRFunction = New RFunction

' Uncheck then the check radio button to forces the panel to raise its ControlValueChanged event
rdoSelectTheme.Checked = False
rdoSelectTheme.Checked = True

If Not clsOperator.ContainsParameter("theme_format") Then
Exit Sub
End If

clsThemeRFunction = clsOperator.GetParameter("theme_format").clsArgumentCodeStructure

If clsThemeRFunction.strRCommand = "tab_options" Then
rdoManualTheme.Checked = True
If clsOperator.ContainsParameter("theme_format") Then
clsThemeRFunction = clsOperator.GetParameter("theme_format").clsArgumentCodeStructure
Else
rdoSelectTheme.Checked = True
ucrCboSelectThemes.SetName(clsThemeRFunction.strRCommand)
clsThemeRFunction = New RFunction
clsThemeRFunction.SetPackageName("gtExtras")
End If

End Sub

Private Sub ucrPnlThemes_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrPnlThemesPanel.ControlValueChanged
Expand Down
14 changes: 7 additions & 7 deletions instat/clsRLink.vb
Original file line number Diff line number Diff line change
Expand Up @@ -132,13 +132,13 @@ Public Class RLink
Private strRVersionMajorRequired As String = "4"

''' <summary> The R version minor required. </summary>
Private strRVersionMinorRequired As String = "1"
Private strRVersionMinorRequired As String = "4"

''' <summary> The R version required. </summary>
Private strRVersionRequired As String = strRVersionMajorRequired & "." & strRVersionMinorRequired & ".0"
Private strRVersionRequired As String = strRVersionMajorRequired & "." & strRVersionMinorRequired & ".1"

''' <summary> The R bundled version. </summary>
Private strRBundledVersion As String = "4.1.3"
Private strRBundledVersion As String = "4.4.1"

Private clsOutputLogger As clsOutputLogger

Expand Down Expand Up @@ -200,9 +200,9 @@ Public Class RLink
Catch ex As Exception
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 3.5.0. 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.",
"Note that R-Instat does not work with R below 4.4.1. We recommend using R " & strRBundledVersion &
". 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
3 changes: 1 addition & 2 deletions instat/dlgClimaticSummary.vb
Original file line number Diff line number Diff line change
Expand Up @@ -194,8 +194,7 @@ Public Class dlgClimaticSummary

'TODO: what defaults do we want?
clsSummariesList.SetRCommand("c")
clsSummariesList.AddParameter("summary_count_non_missing", Chr(34) & "summary_count_non_missing" & Chr(34), bIncludeArgumentName:=False, iPosition:=1)
clsSummariesList.AddParameter("summary_count", Chr(34) & "summary_count" & Chr(34), bIncludeArgumentName:=False, iPosition:=3)
clsSummariesList.AddParameter("summary_count", Chr(34) & "summary_count" & Chr(34), bIncludeArgumentName:=False, iPosition:=1)
clsSummariesList.AddParameter("summary_sum", Chr(34) & "summary_sum" & Chr(34), bIncludeArgumentName:=False, iPosition:=11)

clsDefaultFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$calculate_summary")
Expand Down
48 changes: 32 additions & 16 deletions instat/dlgColumnStats.vb
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand Down Expand Up @@ -112,11 +109,12 @@ Public Class dlgColumnStats
clsConcFunction.SetRCommand("c")

clsSummariesList.SetRCommand("c")
clsSummariesList.AddParameter("summary_count_non_missing", Chr(34) & "summary_count_non_missing" & Chr(34), bIncludeArgumentName:=False, iPosition:=1)
clsSummariesList.AddParameter("summary_count", Chr(34) & "summary_count" & Chr(34), bIncludeArgumentName:=False, iPosition:=1)
clsSummariesList.AddParameter("summary_sum", Chr(34) & "summary_sum" & Chr(34), bIncludeArgumentName:=False, iPosition:=11)

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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -226,14 +220,36 @@ 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, ucrReceiverSelectedVariables.ControlValueChanged, ucrChkOriginalLevel.ControlValueChanged
If Not ucrChkOriginalLevel.Checked Then
If ucrReceiverByFactor.IsEmpty AndAlso Not ucrReceiverSelectedVariables.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)
Else
clsDefaultFunction.AddParameter("store_results", "FALSE", iPosition:=3)
End If
If ucrChkPrintOutput.Checked Then
clsDefaultFunction.AddParameter("return_output", "TRUE", iPosition:=4)
Else
clsDefaultFunction.AddParameter("return_output", "FALSE", iPosition:=4)
End If
End If
Else
If ucrChkPrintOutput.Checked Then
clsDefaultFunction.AddParameter("return_output", "TRUE", iPosition:=4)
Else
clsDefaultFunction.RemoveParameterByName("return_output")
End If
clsDefaultFunction.AddParameter("store_results", "TRUE", iPosition:=3)
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
2 changes: 1 addition & 1 deletion instat/dlgDisplayDailyData.vb
Original file line number Diff line number Diff line change
Expand Up @@ -156,7 +156,7 @@ Public Class dlgDisplayDailyData
ucrChkIQR.SetParameter(New RParameter("IQR", 5), bNewChangeParameterValue:=True, bNewAddRemoveParameter:=True, strNewValueIfChecked:=Chr(34) & "IQR" & Chr(34), strNewValueIfUnchecked:=Chr(34) & Chr(34))
ucrChkIQR.SetText("IQR")

ucrChkSumMissing.SetParameter(New RParameter("summary_count_missing", 6), bNewChangeParameterValue:=True, bNewAddRemoveParameter:=True, strNewValueIfChecked:=Chr(34) & "summary_count_missing" & Chr(34), strNewValueIfUnchecked:=Chr(34) & Chr(34))
ucrChkSumMissing.SetParameter(New RParameter("summary_count_miss", 6), bNewChangeParameterValue:=True, bNewAddRemoveParameter:=True, strNewValueIfChecked:=Chr(34) & "summary_count_miss" & Chr(34), strNewValueIfUnchecked:=Chr(34) & Chr(34))
ucrChkSumMissing.SetText("N Missing")

ucrNudNumberOfColumns.SetParameter(New RParameter("ncol", 1))
Expand Down
1 change: 1 addition & 0 deletions instat/dlgDistances.vb
Original file line number Diff line number Diff line change
Expand Up @@ -37,6 +37,7 @@ Public Class dlgDistances
autoTranslate(Me)
End Sub
Private Sub InitialiseDialog()
ucrBase.iHelpTopicID = 145

ucrSelectorDistance.SetParameter(New RParameter("df", 0))
ucrSelectorDistance.SetParameterIsrfunction()
Expand Down
2 changes: 1 addition & 1 deletion instat/dlgExtremesClimatic.vb
Original file line number Diff line number Diff line change
Expand Up @@ -447,7 +447,7 @@ Public Class dlgExtremesClimatic
clsNSummary.AddParameter("save", "2", iPosition:=4)
clsNSummary.SetAssignTo("n_dates_summary")

clsNFunction.SetRCommand("summary_count")
clsNFunction.SetRCommand("summary_count_all")
clsNFunction.bToScriptAsRString = True

clsFilterExtremeCalc.SetRCommand("instat_calculation$new")
Expand Down
2 changes: 1 addition & 1 deletion instat/dlgHeatMapPlot.vb
Original file line number Diff line number Diff line change
Expand Up @@ -81,7 +81,7 @@ Public Class dlgHeatMapPlot
Dim dctLegendPosition As New Dictionary(Of String, String)
Dim dctPalette As New Dictionary(Of String, String)

ucrBase.iHelpTopicID = 476
ucrBase.iHelpTopicID = 437
ucrBase.clsRsyntax.bExcludeAssignedFunctionOutput = False
ucrBase.clsRsyntax.iCallType = 3

Expand Down
2 changes: 1 addition & 1 deletion instat/dlgLabelsLevels.vb
Original file line number Diff line number Diff line change
Expand Up @@ -80,7 +80,7 @@ Public Class dlgLabelsLevels
ucrSelectorForLabels.Focus()


clsSumCountMissingFunction.SetRCommand("summary_count_missing")
clsSumCountMissingFunction.SetRCommand("summary_count_miss")

clsViewLabelsFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$set_factor_levels")
ucrBase.clsRsyntax.SetBaseRFunction(clsViewLabelsFunction)
Expand Down
12 changes: 0 additions & 12 deletions instat/dlgLinePlot.designer.vb

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit 2afce42

Please sign in to comment.