Merge pull request #203 from africanmathsinitiative/master

update correlations branch
IDEMSInternational · Dec 13, 2016 · 28116db · 28116db
2 parents 75293c0 + f1dd898
commit 28116db
Show file tree

Hide file tree

Showing 34 changed files with 1,112 additions and 962 deletions.
diff --git a/instat/UcrGeomListWithAes.vb b/instat/UcrGeomListWithAes.vb
@@ -77,9 +77,9 @@ Public Class UcrGeomListWithParameters
         Dim iIndexOfData_nameParameter As Integer
 
         strDataFrameName = strGlobalDataFrame
-        If clsGeomFunction.GetParameter("data") IsNot Nothing AndAlso clsGeomFunction.GetParameter("data").clsArgumentFunction.clsParameters.FindIndex(Function(x) x.strArgumentName = "data_name") <> -1 Then
-            iIndexOfData_nameParameter = clsGeomFunction.GetParameter("data").clsArgumentFunction.clsParameters.FindIndex(Function(x) x.strArgumentName = "data_name")
-            strDataFrameName = clsGeomFunction.GetParameter("data").clsArgumentFunction.clsParameters(iIndexOfData_nameParameter).strArgumentValue
+        If clsGeomFunction.GetParameter("data") IsNot Nothing AndAlso clsGeomFunction.GetParameter("data").clsArgumentCodeStructure.clsParameters.FindIndex(Function(x) x.strArgumentName = "data_name") <> -1 Then
+            iIndexOfData_nameParameter = clsGeomFunction.GetParameter("data").clsArgumentCodeStructure.clsParameters.FindIndex(Function(x) x.strArgumentName = "data_name")
+            strDataFrameName = clsGeomFunction.GetParameter("data").clsArgumentCodeStructure.clsParameters(iIndexOfData_nameParameter).strArgumentValue
             strDataFrameName = strDataFrameName.Substring(1, strDataFrameName.Length - 2) 'The value of the parameter "data_name" has quotes around it that need to be erased as we merely want the name of the data_frame.
             ucrGeomWithAesSelector.SetDataframe(strDataFrameName)
         Else

diff --git a/instat/clsBlockReader.vb b/instat/clsBlockReader.vb
diff --git a/instat/clsRCodeStructure.vb b/instat/clsRCodeStructure.vb
@@ -35,16 +35,24 @@ Public Class RCodeStructure
     'So bIsAssigned Is Not enough To decide whether Or Not we should assign, unless we use the information "is strAssignTo empty or not", but for the moment we keep it like it is.
     Public bAssignToIsPrefix As Boolean = False
     Public bAssignToColumnWithoutNames As Boolean = False
-    Public bInsertColumnBefore As Boolean = False
-
-    Public Event ParametersChanged()
+    Public bInsertColumnBefore As Boolean = False
+    Public clsParameters As New List(Of RParameter)
+    Private iNumberOfAddedParameters As Integer = 0 'This might be temporary, it enables to have a default name for parameters...
+
+    Public Event ParametersChanged()
+
+    'Public ReadOnly Property OrderedIndices As List(Of Integer)
+    'This was initially intended to provide
+    '    Get
+    '        Return lstOrderedIndices
+    '    End Get
+    'End Property
 
     Protected Sub OnParametersChanged()
         RaiseEvent ParametersChanged()
-    End Sub
-
-    'More methods can probably be moved into here from RFunction/ROperator
-    'For now the main ones are here
+    End Sub
+
+    'Most methods from RFunction/ROperator have been moved here
     Public Sub SetAssignTo(strTemp 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)
         strAssignTo = strTemp
         If Not strTempDataframe = "" Then
@@ -179,6 +187,121 @@ Public Class RCodeStructure
 
     Public Overridable Function GetParameter(strName As String) As RParameter
         Return New RParameter
-    End Function
+    End Function
+
+    Public Overridable Sub AddParameter(Optional strParameterName As String = "", Optional strParameterValue As String = "", Optional clsRFunctionParameter As RFunction = Nothing, Optional clsROperatorParameter As ROperator = Nothing, Optional bIncludeArgumentName As Boolean = True, Optional clsParam As RParameter = Nothing, Optional iPosition As Integer = -1)
+        'Task, in next version, we want to erase clsParam as a possible argument, but RSyntax will have to be edited first...
+        If clsParam Is Nothing Then
+            clsParam = New RParameter
+            If strParameterName = "" Then
+                'MsgBox("Developer Error: some parameter has been added without specifying a name. We want all parameters to be given a name eventually.", MsgBoxStyle.OkOnly)
+                bIncludeArgumentName = False
+                strParameterName = "Parameter." & iNumberOfAddedParameters
+            End If
+            clsParam.SetArgumentName(strParameterName)
+            If Not strParameterValue = "" Then
+                clsParam.SetArgumentValue(strParameterValue)
+            ElseIf clsRFunctionParameter IsNot Nothing Then
+                clsParam.SetArgument(clsRFunctionParameter)
+            ElseIf clsROperatorParameter IsNot Nothing Then
+                clsParam.SetArgument(clsROperatorParameter)
+            End If
+            clsParam.bIncludeArgumentName = bIncludeArgumentName
+        End If
+        AddParameter(clsParam, iPosition)
+    End Sub
+
+    Public Overridable Sub AddParameter(clsParam As RParameter, Optional iPosition As Integer = -1)
+        Dim i As Integer = -1
+        Dim strTempArgumentName As String = clsParam.strArgumentName
+        clsParam.Position = iPosition
+        If clsParameters IsNot Nothing Then
+            If clsParam.strArgumentName IsNot Nothing Then
+                'Dim match As Predicate(Of RParameter) = Function(x) x.strArgumentName.Equals(clsParam.strArgumentName)
+                i = clsParameters.FindIndex(Function(x) x.strArgumentName.Equals(strTempArgumentName))
+            End If
+            If i = -1 Then
+                clsParameters.Add(clsParam)
+                'SortParameters() 'Not needed, can do this only when necessary...
+            Else
+                If clsParam.bIsString AndAlso clsParam.strArgumentValue IsNot Nothing Then
+                    clsParameters(i).SetArgumentValue(clsParam.strArgumentValue)
+                ElseIf (clsParam.bIsString OrElse clsParam.bIsFunction) AndAlso clsParam.clsArgumentCodeStructure IsNot Nothing Then
+                    clsParameters(i).SetArgument(clsParam.clsArgumentCodeStructure)
+                Else
+                    'message
+                End If
+                If clsParameters(i).Position <> clsParam.Position Then
+                    clsParameters(i).Position = clsParam.Position
+                    'SortParameters() 'Not needed, can do this only when necessary...
+                End If
+            End If
+        Else
+            'message
+        End If
+        bIsAssigned = False
+        iNumberOfAddedParameters = iNumberOfAddedParameters + 1
+        OnParametersChanged()
+    End Sub
+
+    Public Sub SortParameters()
+        'This sub is used to reorder the parameters according to their Position property.
+        'It will be called only in places where it is necessary ie before ToScript or RemoveAdditionalParameters in ROperator.
+        clsParameters.Sort(AddressOf CompareParametersPosition)
+    End Sub
+    Private Function CompareParametersPosition(ByVal clsMain As RParameter, ByVal clsRelative As RParameter) As Integer
+        'Compares two RParameters according to their Position property. If x is "smaller" than y, then return -1, if they are "equal" return 0 else return 1.
+        If clsMain.Position = clsRelative.Position Then
+            Return 0
+        ElseIf clsRelative.Position = -1 Then
+            Return -1
+        ElseIf clsMain.Position = -1 Then
+            Return 1
+        Else
+            Return clsMain.Position.CompareTo(clsRelative.Position)
+        End If
+    End Function
+
+    Public Sub RemoveUnorderedParameters()
+        'Removes all parameters that are of position -1 i e unordered.
+        Dim clsParam As RParameter
+        If Not clsParameters Is Nothing Then
+            clsParam = clsParameters.Find(Function(x) x.Position = -1)
+            clsParameters.Remove(clsParam)
+        End If
+        bIsAssigned = False
+        OnParametersChanged()
+    End Sub
+
+    Public Overridable Sub RemoveParameterByName(strArgName As String)
+        Dim clsParam As RParameter
+        If Not clsParameters Is Nothing Then
+            clsParam = clsParameters.Find(Function(x) x.strArgumentName = strArgName)
+            clsParameters.Remove(clsParam)
+        End If
+        bIsAssigned = False
+        OnParametersChanged()
+    End Sub
+
+    Public Overridable Sub RemoveParameterByPosition(iPosition As Integer)
+        Dim clsParam As RParameter
+        If Not clsParameters Is Nothing Then
+            clsParam = clsParameters.Find(Function(x) x.Position = iPosition)
+            clsParameters.Remove(clsParam)
+        End If
+        bIsAssigned = False
+        OnParametersChanged()
+    End Sub
+
+    Public Overridable Sub ClearParameters()
+        clsParameters.Clear()
+        bIsAssigned = False
+        OnParametersChanged()
+    End Sub
+
+    Public Overridable Function Clone() As RCodeStructure
+        Dim clsTemp As New RCodeStructure
+        Return clsTemp
+    End Function
 
 End Class
diff --git a/instat/clsRFunction.vb b/instat/clsRFunction.vb
@@ -15,9 +15,8 @@
 ' along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 Public Class RFunction
-    Inherits RCodeStructure
-
-    Public clsParameters As New List(Of RParameter)
+    Inherits RCodeStructure
+
     Public strRCommand As String
 
     Public Sub New()
@@ -31,10 +30,12 @@ Public Class RFunction
 
     Public Overrides Function ToScript(Optional ByRef strScript As String = "", Optional strTemp As String = "") As String
         'Converting the RFunction into a string that when run in R gives the appropriate output
-        Dim i As Integer
-
+        Dim i As Integer
+        'For method with OrderedIndices, replace clsParameters.count by Mybase.OrderedIndices.count and i by Mybase.OrderedIndices(i)
+
+        'Parameters are sorted in the appropriate order and then the script is built.
+        SortParameters()
         strTemp = strRCommand & "("
-
         For i = 0 To clsParameters.Count - 1
             If i > 0 Then
                 strTemp = strTemp & ", "
@@ -46,46 +47,11 @@ Public Class RFunction
         Return MyBase.ToScript(strScript, strTemp)
     End Function
 
-    Public Sub AddParameter(strParameterName As String, Optional strParameterValue As String = "", Optional clsRFunctionParameter As RFunction = Nothing, Optional clsROperatorParameter As ROperator = Nothing, Optional bIncludeArgumentName As Boolean = True)
-        Dim clsParam As New RParameter
-
-        clsParam.SetArgumentName(strParameterName)
-        If Not strParameterValue = "" Then
-            clsParam.SetArgumentValue(strParameterValue)
-        End If
-        If Not clsRFunctionParameter Is Nothing Then
-            clsParam.SetArgumentFunction(clsRFunctionParameter)
-        End If
-        If Not clsROperatorParameter Is Nothing Then
-            clsParam.SetArgumentOperator(clsROperatorParameter)
-        End If
-        clsParam.bIncludeArgumentName = bIncludeArgumentName
-        Me.AddParameter(clsParam)
+    Public Overrides Sub AddParameter(Optional strParameterName As String = "", Optional strParameterValue As String = "", Optional clsRFunctionParameter As RFunction = Nothing, Optional clsROperatorParameter As ROperator = Nothing, Optional bIncludeArgumentName As Boolean = True, Optional clsParam As RParameter = Nothing, Optional iPosition As Integer = -1)
+        MyBase.AddParameter(strParameterName, strParameterValue, clsRFunctionParameter, clsROperatorParameter, bIncludeArgumentName, clsParam, iPosition)
     End Sub
-
-    Public Sub AddParameter(clsParam As RParameter)
-        Dim i As Integer = -1
-        If Not clsParameters Is Nothing Then
-            If clsParam.strArgumentName IsNot Nothing Then
-                i = clsParameters.FindIndex(Function(x) x.strArgumentName.Equals(clsParam.strArgumentName))
-            End If
-        End If
-
-        If i = -1 Then
-            clsParameters.Add(clsParam)
-        Else
-            If clsParam.strArgumentValue IsNot Nothing Then
-                clsParameters(i).SetArgumentValue(clsParam.strArgumentValue)
-            End If
-            If clsParam.clsArgumentFunction IsNot Nothing Then
-                clsParameters(i).SetArgumentFunction(clsParam.clsArgumentFunction)
-            End If
-            If clsParam.clsArgumentOperator IsNot Nothing Then
-                clsParameters(i).SetArgumentOperator(clsParam.clsArgumentOperator)
-            End If
-        End If
-        bIsAssigned = False
-        OnParametersChanged()
+    Public Overrides Sub AddParameter(clsParam As RParameter, Optional iPosition As Integer = -1)
+        MyBase.AddParameter(clsParam, iPosition)
     End Sub
 
     Public Overrides Function GetParameter(strName As String) As RParameter
@@ -99,23 +65,11 @@ Public Class RFunction
         Return Nothing
     End Function
 
-    Public Sub RemoveParameterByName(strArgName)
-        Dim clsParam
-        If Not clsParameters Is Nothing Then
-            clsParam = clsParameters.Find(Function(x) x.strArgumentName = strArgName)
-            clsParameters.Remove(clsParam)
-        End If
-        bIsAssigned = False
-        OnParametersChanged()
-    End Sub
-
-    Public Sub ClearParameters()
-        clsParameters.Clear()
-        bIsAssigned = False
-        OnParametersChanged()
+    Public Overrides Sub ClearParameters()
+        MyBase.ClearParameters()
     End Sub
 
-    Public Function Clone() As RFunction
+    Public Overrides Function Clone() As RCodeStructure
 
         Dim clsRFunction As New RFunction
         Dim clsRParam As RParameter