Merge pull request #1591 from dannyparsons/calculate

initial implementation of calculator with changes to RSyntax and new receiver for expressions

instat/clsRSyntax.vb

@@ -18,12 +18,24 @@
 Public Class RSyntax
     Public clsBaseFunction As New RFunction
     Public clsBaseOperator As New ROperator
+    Public strCommandString As String = ""
     Public bUseBaseFunction As Boolean = False
     Public bUseBaseOperator As Boolean = False
+    Public bUseCommandString As Boolean = False
     Public iCallType As Integer = 0
     Public strScript As String
     Public i As Integer
     Public bExcludeAssignedFunctionOutput As Boolean = True
+    Private strAssignTo As String
+    Private strAssignToDataframe As String
+    Private strAssignToColumn As String
+    Private strAssignToModel As String
+    Private strAssignToGraph As String
+    Public bToBeAssigned As Boolean = False
+    Public bIsAssigned As Boolean = False
+    Private bAssignToIsPrefix As Boolean
+    Private bAssignToColumnWithoutNames As Boolean
+    Private bInsertColumnBefore As String
 
     Public Sub SetFunction(strFunctionName As String, Optional ByRef clsFunction As RFunction = Nothing)
         If clsFunction Is Nothing Then
@@ -32,18 +44,28 @@ Public Class RSyntax
         clsFunction.SetRCommand(strFunctionName)
         bUseBaseFunction = True
         bUseBaseOperator = False
+        bUseCommandString = False
     End Sub
 
     Public Sub SetBaseRFunction(clsFunction As RFunction)
         clsBaseFunction = clsFunction
         bUseBaseFunction = True
         bUseBaseOperator = False
+        bUseCommandString = False
+    End Sub
+
+    Public Sub SetCommandString(strCommand As String)
+        strCommandString = strCommand
+        bUseBaseFunction = False
+        bUseBaseOperator = False
+        bUseCommandString = True
     End Sub
 
     Public Sub SetOperation(strOp As String, Optional bBracketTemp As Boolean = True)
         clsBaseOperator.SetOperation(strOp, bBracketTemp)
         bUseBaseFunction = False
         bUseBaseOperator = True
+        bUseCommandString = False
     End Sub
 
     Public Sub SetAssignTo(strAssignToName As String, Optional strTempDataframe As String = "", Optional strTempColumn As String = "", Optional strTempModel As String = "", Optional strTempGraph As String = "", Optional bAssignToIsPrefix As Boolean = False, Optional bAssignToColumnWithoutNames As Boolean = False, Optional bInsertColumnBefore As Boolean = False)
@@ -53,6 +75,26 @@ Public Class RSyntax
         If bUseBaseFunction Then
             clsBaseFunction.SetAssignTo(strAssignToName, strTempDataframe:=strTempDataframe, strTempColumn:=strTempColumn, strTempModel:=strTempModel, strTempGraph:=strTempGraph, bAssignToIsPrefix:=bAssignToIsPrefix, bAssignToColumnWithoutNames:=bAssignToColumnWithoutNames, bInsertColumnBefore:=bInsertColumnBefore)
         End If
+        If bUseCommandString Then
+            strAssignTo = strAssignToName
+            If Not strTempDataframe = "" Then
+                strAssignToDataframe = strTempDataframe
+                If Not strTempColumn = "" Then
+                    strAssignToColumn = strTempColumn
+                End If
+            End If
+            If Not strTempModel = "" Then
+                strAssignToModel = strTempModel
+            End If
+            If Not strTempGraph = "" Then
+                strAssignToGraph = strTempGraph
+            End If
+            Me.bAssignToIsPrefix = bAssignToIsPrefix
+            Me.bAssignToColumnWithoutNames = bAssignToColumnWithoutNames
+            Me.bInsertColumnBefore = bInsertColumnBefore
+            bToBeAssigned = True
+            bIsAssigned = False
+        End If
     End Sub
 
     Public Sub RemoveAssignTo()
@@ -120,6 +162,104 @@ Public Class RSyntax
             If bUseBaseOperator Then
                 strTemp = clsBaseOperator.ToScript(strScript)
             End If
+            If bUseCommandString Then
+                Dim clsAddColumns As New RFunction
+                Dim clsGetColumns As New RFunction
+                Dim clsAddData As New RFunction
+                Dim clsGetData As New RFunction
+                Dim clsAddModels As New RFunction
+                Dim clsGetModels As New RFunction
+                Dim clsAddGraphs As New RFunction
+                Dim clsGetGraphs As New RFunction
+                Dim clsDataList As New RFunction
+
+                strTemp = strCommandString
+                If bToBeAssigned Then
+                    If Not frmMain.clsRLink.bInstatObjectExists Then
+                        frmMain.clsRLink.CreateNewInstatObject()
+                    End If
+                    strScript = strScript & strAssignTo & " <- " & strTemp & vbCrLf
+                    If Not strAssignToDataframe = "" AndAlso (Not strAssignToColumn = "" OrElse bAssignToColumnWithoutNames) Then
+                        clsAddColumns.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$add_columns_to_data")
+                        clsAddColumns.AddParameter("data_name", Chr(34) & strAssignToDataframe & Chr(34))
+                        If Not bAssignToColumnWithoutNames Then
+                            clsAddColumns.AddParameter("col_name", Chr(34) & strAssignToColumn & Chr(34))
+                        End If
+                        clsAddColumns.AddParameter("col_data", strAssignTo)
+                        If bAssignToIsPrefix Then
+                            clsAddColumns.AddParameter("use_col_name_as_prefix", "TRUE")
+                        Else
+                            If frmMain.clsInstatOptions.bIncludeRDefaultParameters Then
+                                clsAddColumns.AddParameter("use_col_name_as_prefix", "FALSE")
+                            End If
+                        End If
+                        If bInsertColumnBefore Then
+                            clsAddColumns.AddParameter("before", "TRUE")
+                        Else
+                            If frmMain.clsInstatOptions.bIncludeRDefaultParameters Then
+                                clsAddColumns.AddParameter("before", "FALSE")
+                            End If
+                        End If
+                        strScript = strScript & clsAddColumns.ToScript() & vbCrLf
+
+                        clsGetColumns.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_columns_from_data")
+                        clsGetColumns.AddParameter("data_name", Chr(34) & strAssignToDataframe & Chr(34))
+                        clsGetColumns.AddParameter("col_name", Chr(34) & strAssignToColumn & Chr(34))
+                        strAssignTo = clsGetColumns.ToScript()
+
+                        bIsAssigned = True
+                        bToBeAssigned = False
+                    ElseIf Not strAssignToModel = "" Then
+                        clsAddModels.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$add_model")
+                        clsAddModels.AddParameter("model_name", Chr(34) & strAssignToModel & Chr(34))
+                        clsAddModels.AddParameter("model", strAssignTo)
+                        If Not strAssignToDataframe = "" Then
+                            clsAddColumns.AddParameter("data_name", Chr(34) & strAssignToDataframe & Chr(34))
+                            clsGetModels.AddParameter("data_name", Chr(34) & strAssignToDataframe & Chr(34))
+                        End If
+                        strScript = strScript & clsAddModels.ToScript() & vbCrLf
+
+                        clsGetModels.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_models")
+                        clsGetModels.AddParameter("model_name", Chr(34) & strAssignToModel & Chr(34))
+                        strAssignTo = clsGetModels.ToScript()
+
+                        bIsAssigned = True
+                        bToBeAssigned = False
+                    ElseIf Not strAssignToGraph = "" Then
+                        clsAddGraphs.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$add_graph")
+                        clsAddGraphs.AddParameter("graph_name", Chr(34) & strAssignToGraph & Chr(34))
+                        clsAddGraphs.AddParameter("graph", strAssignTo)
+                        If Not strAssignToDataframe = "" Then
+                            clsAddGraphs.AddParameter("data_name", Chr(34) & strAssignToDataframe & Chr(34))
+                            clsGetGraphs.AddParameter("data_name", Chr(34) & strAssignToDataframe & Chr(34))
+                        End If
+                        strScript = strScript & clsAddGraphs.ToScript() & vbCrLf
+
+                        clsGetGraphs.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_graphs")
+                        clsGetGraphs.AddParameter("graph_name", Chr(34) & strAssignToGraph & Chr(34))
+                        strAssignTo = clsGetGraphs.ToScript()
+
+                        bIsAssigned = True
+                        bToBeAssigned = False
+                    ElseIf Not strAssignToDataframe = "" Then
+                        clsAddData.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$import_data")
+                        clsDataList.SetRCommand("list")
+                        clsDataList.AddParameter(strAssignToDataframe, strAssignTo)
+                        clsAddData.AddParameter("data_tables", clsRFunctionParameter:=clsDataList)
+                        strScript = strScript & clsAddData.ToScript() & vbCrLf
+
+                        clsGetData.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_data_frame")
+                        clsGetData.AddParameter("data_name", Chr(34) & strAssignToDataframe & Chr(34))
+                        strAssignTo = clsGetData.ToScript()
+
+                        bIsAssigned = True
+                        bToBeAssigned = False
+                    End If
+                    strTemp = strAssignTo
+                Else
+                    'Return strTemp
+                End If
+            End If
         Else
             strTemp = clsFunction.ToScript(strScript)
         End If

instat/dlgCalculator.vb

@@ -1,12 +1,24 @@
 Imports RDotNet
 Public Class dlgCalculator
     Dim dataset As DataFrame
+    Dim clsAttach As New RFunction
+    Dim clsDetach As New RFunction
 
     Private Sub dlgCalculator_Load(sender As Object, e As EventArgs) Handles MyBase.Load
         ucrBase.OKEnabled(False)
         cmdBackSpace.Enabled = True
         'txtCalcLine.Select()
         ucrBase.iHelpTopicID = 14
+        InitialiseDialog()
+    End Sub
+
+    Private Sub InitialiseDialog()
+        ucrReceiverForCalculation.Selector = ucrSelectorForCalculations
+        ucrReceiverForCalculation.SetMeAsReceiver()
+        clsAttach.SetRCommand("attach")
+        clsDetach.SetRCommand("detach")
+        clsDetach.AddParameter("unload", "TRUE")
+        ucrBase.clsRsyntax.SetCommandString("")
     End Sub
 
     Private Sub AddText(strVar As String, Optional intStepsBack As Integer = 0, Optional bolInsertSelected As Boolean = False)
@@ -31,6 +43,7 @@ Public Class dlgCalculator
 
     Private Sub cmd1_Click(sender As Object, e As EventArgs) Handles cmd1.Click
         AddText("1")
+        ucrReceiverForCalculation.AddToReceiverAtCursorPosition("1")
     End Sub
 
     Private Sub cmd2_Click(sender As Object, e As EventArgs) Handles cmd2.Click
@@ -150,5 +163,28 @@ Public Class dlgCalculator
         AddText("exp()", 1, True)
     End Sub
 
+    Private Sub ucrSaveResultInto_NameChanged() Handles ucrSaveResultInto.NameChanged
+        ucrBase.clsRsyntax.SetAssignTo(ucrSaveResultInto.GetText(), strTempColumn:=ucrSaveResultInto.GetText(), strTempDataframe:=ucrSelectorForCalculations.ucrAvailableDataFrames.cboAvailableDataFrames.Text)
+    End Sub
+
+    Private Sub ucrBase_BeforeClickOk(sender As Object, e As EventArgs) Handles ucrBase.BeforeClickOk
+        Dim strScript As String = ""
+        Dim strFunc As String
+        clsAttach.AddParameter("what", clsRFunctionParameter:=ucrSelectorForCalculations.ucrAvailableDataFrames.clsCurrDataFrame)
+        strFunc = clsAttach.ToScript(strScript)
+        frmMain.clsRLink.RunScript(strScript & strFunc)
+    End Sub
+
+    Private Sub ucrBase_ClickOk(sender As Object, e As EventArgs) Handles ucrBase.ClickOk
+        Dim strScript As String = ""
+        Dim strFunc As String
+        clsDetach.AddParameter("name", clsRFunctionParameter:=ucrSelectorForCalculations.ucrAvailableDataFrames.clsCurrDataFrame)
+        strFunc = clsDetach.ToScript(strScript)
+        frmMain.clsRLink.RunScript(strScript & strFunc)
+    End Sub
 
+    Private Sub ucrReceiverForCalculation_SelectionChanged(sender As Object, e As EventArgs) Handles ucrReceiverForCalculation.SelectionChanged
+        ucrBase.clsRsyntax.SetCommandString(ucrReceiverForCalculation.GetVariableNames(False))
+        ucrBase.OKEnabled(True)
+    End Sub
 End Class