Merge pull request #9403 from Vitalis95/dlginsert

Added Loops to R-Instat

instat/dlgScript.vb

@@ -20,7 +20,7 @@ Public Class dlgScript
     Private strComment As String = "Code generated by the dialog, Script"
     Private bFirstload As Boolean = True
     Private clsSaveDataFunction As New RFunction
-    Private clsGetRObjectFunction As New RFunction
+    Private clsGetRObjectFunction, clsGetSelectedDataFrameFunction As New RFunction
     Private dctOutputObjectTypes As New Dictionary(Of String, String)
     Private dctOutputObjectFormats As New Dictionary(Of String, String)
 
@@ -96,6 +96,8 @@ Public Class dlgScript
         ucrReceiverGetColumns.Selector = ucrSelectorGetObject
         ucrReceiverGetColumns.SetLinkedDisplayControl(lblGetColumn)
 
+        ucrReceiverColumns.Selector = ucrSelectorForRank
+
         ucrCboGetOutputObjectType.SetItems(dctOutputObjectTypes, bSetConditions:=False)
         ucrCboGetOutputObjectType.SetDropDownStyleAsNonEditable()
         ucrCboGetOutputObjectType.SetLinkedDisplayControl(lblGetObjectType)
@@ -152,6 +154,15 @@ Public Class dlgScript
         ucrBase.bAddScriptToScriptWindowOnClickOk = False
         ucrBase.bMakeVisibleScriptWindow = False
 
+        ucrReceiverRank.SetParameter(New RParameter("x", 0))
+        ucrReceiverRank.Selector = ucrSelectorForRank
+        ucrReceiverRank.SetMeAsReceiver()
+        ucrReceiverRank.bUseFilteredData = False
+        ucrReceiverRank.SetParameterIsRFunction()
+
+        ucrSelectorForRank.SetItemType("column_selection")
+        ucrReceiverRank.strSelectorHeading = "Column selections"
+
     End Sub
 
     'todo. this function should eventually be removed once we have a control that displays packages
@@ -197,7 +208,8 @@ Public Class dlgScript
         ucrDataFrameGetDF.Reset()
         rdoGetDataFrame.Checked = True
         rdoDataFrame.Checked = True
-
+        ucrSelectorForRank.Reset()
+        ucrReceiverForCalculation.Clear()
         'activate the selected tab to library tab
         tbFeatures.SelectedIndex = -1
         tbFeatures.SelectedTab = tbPageSaveData
@@ -840,4 +852,47 @@ Public Class dlgScript
         PreviewScript(strScript)
     End Sub
 
+    Private Function ConstructScript(strSelectedScript As String, strVariable As String, strDataFrame As String) As String
+
+        ' Extract the LHS variable
+        Dim match As System.Text.RegularExpressions.Match = System.Text.RegularExpressions.Regex.Match(strSelectedScript, "(\S+)\s*<-\s*(.*)")
+        Dim lhsVariable As String = If(match.Success, match.Groups(1).Value, "calc") ' Default to "calc" if no match
+        Dim rhs As String = If(match.Success, match.Groups(2).Value, strSelectedScript)
+
+        ' Modify RHS with the selected variable
+        Dim modifiedRhs As String = If(Not String.IsNullOrEmpty(strVariable), rhs.Replace(strVariable, $"{strDataFrame}[[.x]]"), rhs)
+
+        ' Construct the main script using string interpolation
+        Dim strConstructedScript As String = $"
+    {lhsVariable} <- purrr::map(.x = {"names(" & lhsVariable & ")"},
+                               .f = ~{modifiedRhs}) %>%
+                   dplyr::bind_cols(.)"
+        Dim strAssignedScript As String = ""
+
+        ' Get the selected data frame columns
+        Dim clsGetSelectedDataFrameFunction As New RFunction
+        clsGetSelectedDataFrameFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_data_frame")
+        clsGetSelectedDataFrameFunction.AddParameter("data_name", Chr(34) & ucrSelectorForRank.strCurrentDataFrame & Chr(34), iPosition:=0, bIncludeArgumentName:=False)
+        clsGetSelectedDataFrameFunction.AddParameter("column_selection_name ", ucrReceiverRank.GetVariableNames, iPosition:=1)
+        clsGetSelectedDataFrameFunction.SetAssignTo(lhsVariable)
+        clsGetSelectedDataFrameFunction.ToScript(strScript:=strAssignedScript)
+
+        ' Prepend the dataframe selection script
+        strConstructedScript = "#Get the variables in the chosen select." & Environment.NewLine & "# Then do the calculation for each variable in turn, " & Environment.NewLine & "# So produce a new column for each variable in the select." & Environment.NewLine & strAssignedScript & Environment.NewLine & strConstructedScript.Trim()
+
+        Return strConstructedScript
+    End Function
+
+    Private Sub ucrReceiverForCalculation_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrReceiverForCalculation.ControlValueChanged
+        PreviewScript(ConstructScript(ucrReceiverForCalculation.GetVariableNames(False), ucrReceiverColumns.GetVariableNames(False), ucrSelectorForRank.strCurrentDataFrame))
+    End Sub
+
+    Private Sub ucrReceiverColumns_Enter(sender As Object, e As EventArgs) Handles ucrReceiverColumns.Enter
+        ucrReceiverColumns.SetItemType("column")
+    End Sub
+
+    Private Sub ucrReceiverRank_Enter(sender As Object, e As EventArgs) Handles ucrReceiverRank.Enter
+        ucrSelectorForRank.SetItemType("column_selection")
+    End Sub
+
 End Class