Merge pull request #97 from africanmathsinitiative/master

update branch

instat/DlgDefineClimaticData.vb

@@ -23,6 +23,7 @@ Public Class DlgDefineClimaticData
     Dim clsTypesFunction As New RFunction
     Dim lstReceivers As New List(Of ucrReceiverSingle)
     Dim lstRecognisedTypes As New List(Of KeyValuePair(Of String, List(Of String)))
+    Private clsDefaultFunction As New RFunction
 
     Private Sub DlgDefineClimaticData_Load(sender As Object, e As EventArgs) Handles MyBase.Load
         autoTranslate(Me)
@@ -35,14 +36,9 @@ Public Class DlgDefineClimaticData
         End If
         SetRCodeForControls(bReset)
         bReset = False
-        ReopenDialog()
         TestOKEnabled()
     End Sub
 
-    Private Sub ReopenDialog()
-
-    End Sub
-
     Private Sub InitialiseDialog()
         ucrBase.iHelpTopicID = 328
         Dim kvpRain As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("rain", {"rain", "prec", "rr", "prcp"}.ToList())
@@ -84,24 +80,42 @@ Public Class DlgDefineClimaticData
     End Sub
 
     Private Sub SetDefaults()
-        Dim clsDefaultFunction As New RFunction
+        clsDefaultFunction = New RFunction
 
         ucrSelectorDefineClimaticData.Reset()
         ucrReceiverDate.SetMeAsReceiver()
+
         clsDefaultFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$define_as_climatic")
         clsTypesFunction.SetRCommand("c")
-        ucrBase.clsRsyntax.SetBaseRFunction(clsDefaultFunction.Clone())
-        ucrBase.clsRsyntax.AddParameter("types", clsRFunctionParameter:=clsTypesFunction)
+
+        clsDefaultFunction.AddParameter("types", clsRFunctionParameter:=clsTypesFunction)
+
+        ucrBase.clsRsyntax.SetBaseRFunction(clsDefaultFunction)
+
 
         AutoFillReceivers()
     End Sub
 
-    Public Sub SetRCodeForControls(bReset As Boolean)
+    Private Sub SetRCodeForControls(bReset As Boolean)
         ucrSelectorDefineClimaticData.SetRCode(ucrBase.clsRsyntax.clsBaseFunction, bReset)
-        SetRcodesforReceivers(bReset)
+        SetRCodesforReceivers(bReset)
+    End Sub
+
+    Private Sub TestOKEnabled()
+        If Not ucrReceiverDate.IsEmpty Then
+            ucrBase.OKEnabled(True)
+        Else
+            ucrBase.OKEnabled(False)
+        End If
     End Sub
 
-    Private Sub SetRcodesforReceivers(bReset As Boolean)
+    Private Sub ucrBase_ClickReset(sender As Object, e As EventArgs) Handles ucrBase.ClickReset
+        SetDefaults()
+        SetRCodeForControls(True)
+        TestOKEnabled()
+    End Sub
+
+    Private Sub SetRCodesforReceivers(bReset As Boolean)
         Dim ucrTempReceiver As ucrReceiver
         For Each ucrTempReceiver In lstReceivers
             ucrTempReceiver.SetRCode(clsTypesFunction, bReset)
@@ -118,20 +132,6 @@ Public Class DlgDefineClimaticData
         Next
     End Sub
 
-    Private Sub TestOKEnabled()
-        If Not ucrReceiverDate.IsEmpty Then
-            ucrBase.OKEnabled(True)
-        Else
-            ucrBase.OKEnabled(False)
-        End If
-    End Sub
-
-    Private Sub ucrBase_ClickReset(sender As Object, e As EventArgs) Handles ucrBase.ClickReset
-        SetDefaults()
-        SetRCodeForControls(True)
-        TestOKEnabled()
-    End Sub
-
     Private Sub AutoFillReceivers()
         Dim lstRecognisedValues As List(Of String)
         Dim ucrCurrentReceiver As ucrReceiver
@@ -177,11 +177,11 @@ Public Class DlgDefineClimaticData
         Return lstValues
     End Function
 
-    Private Sub Controls_ControlContentsChanged(ucrChangedControl As ucrCore) Handles ucrReceiverDate.ControlContentsChanged
-        TestOKEnabled()
-    End Sub
-
     Private Sub Selector_ControlContentsChanged(ucrChangedControl As ucrCore) Handles ucrSelectorDefineClimaticData.ControlContentsChanged
         AutoFillReceivers()
     End Sub
+
+    Private Sub Controls_ControlContentsChanged(ucrChangedControl As ucrCore) Handles ucrReceiverDate.ControlContentsChanged
+        TestOKEnabled()
+    End Sub
 End Class

instat/UcrPanel.vb

@@ -51,7 +51,7 @@ Public Class UcrPanel
         OnControlValueChanged()
     End Sub
 
-    Protected Overrides Sub UpdateParameter(clsTempParam As RParameter)
+    Public Overrides Sub UpdateParameter(clsTempParam As RParameter)
         Dim strNewValue As String = ""
         Dim rdoTemp As RadioButton
 

instat/clsCondition.vb

@@ -3,6 +3,7 @@
     Private bIsParameterPresent As Boolean = False
     Private bIsFunctionNames As Boolean = False
     Private bIsParameterType As Boolean = False
+    Private bIsParameterValuesRFunctionNames As Boolean = False
     Private strParameterType As String = ""
     Private strParameterName As String = ""
     Private lstValues As List(Of String) = New List(Of String)
@@ -15,6 +16,7 @@
         bIsFunctionNames = False
         bIsParameterType = False
         strParameterType = ""
+        bIsParameterValuesRFunctionNames = False
         bIsPositive = bNewIsPositive
     End Sub
 
@@ -26,13 +28,30 @@
         bIsFunctionNames = False
         bIsParameterType = False
         strParameterType = ""
+        bIsParameterValuesRFunctionNames = False
         bIsPositive = bNewIsPositive
     End Sub
 
     Public Sub SetParameterValues(strParamName As String, strParamValues As String, Optional bNewIsPositive As Boolean = True)
         SetParameterValues(strParamName, New List(Of String)({strParamValues}), bNewIsPositive)
     End Sub
 
+    Public Sub SetParameterValuesRFunctionNames(strParamName As String, lstRCodeNames As List(Of String), Optional bNewIsPositive As Boolean = True)
+        strParameterName = strParamName
+        lstValues = lstRCodeNames
+        bIsParameterValues = False
+        bIsParameterPresent = False
+        bIsFunctionNames = False
+        bIsParameterType = False
+        strParameterType = ""
+        bIsParameterValuesRFunctionNames = True
+        bIsPositive = bNewIsPositive
+    End Sub
+
+    Public Sub SetParameterValuesRFunctionNames(strParamName As String, strRCodeNames As String, Optional bNewIsPositive As Boolean = True)
+        SetParameterValuesRFunctionNames(strParamName, New List(Of String)({strRCodeNames}), bNewIsPositive)
+    End Sub
+
     Public Sub SetFunctionName(strFuncName As String, Optional bNewIsPositive As Boolean = True)
         SetFunctionNamesMultiple(New List(Of String)({strFuncName}), bNewIsPositive)
     End Sub
@@ -44,6 +63,7 @@
         bIsParameterPresent = False
         bIsParameterType = False
         strParameterType = ""
+        bIsParameterValuesRFunctionNames = False
         bIsPositive = bNewIsPositive
     End Sub
 
@@ -52,6 +72,7 @@
         bIsParameterValues = False
         bIsParameterPresent = False
         bIsParameterType = True
+        bIsParameterValuesRFunctionNames = False
         strParameterName = strParamName
         If Not {"string", "RFunction", "ROperator"}.Contains(strType) Then
             MsgBox("Developer error: strType must be either string, RFunction or ROperator.")
@@ -97,9 +118,23 @@
                         MsgBox("Developer error: strType must be either string, RFunction or ROperator.")
                         Return False
                 End Select
+            End If
+        ElseIf bIsParameterValuesRFunctionNames Then
+            If clsParameter IsNot Nothing Then
+                If clsParameter.strArgumentName = strParameterName Then
+                    clsTempParam = clsParameter
+                Else
+                    clsTempParam = clsRCode.GetParameter(strParameterName)
+                End If
+            Else
+                clsTempParam = clsRCode.GetParameter(strParameterName)
             End If
-        Else
-            Return True
+            If Not (clsTempParam IsNot Nothing AndAlso clsTempParam.bIsFunction AndAlso clsTempParam.clsArgumentCodeStructure IsNot Nothing) Then
+                Return Not bIsPositive
+            End If
+            Return ((bIsPositive = lstValues.Contains(DirectCast(clsTempParam.clsArgumentCodeStructure, RFunction).strRCommand)))
+        Else
+                Return True
         End If
     End Function
 End Class

instat/clsRLink.vb

@@ -493,7 +493,7 @@ Public Class RLink
         bInstatObjectExists = True
     End Sub
 
-    Public Sub FillListView(lstView As ListView, strType As String, Optional lstIncludedDataTypes As List(Of KeyValuePair(Of String, String())) = Nothing, Optional lstExcludedDataTypes As List(Of KeyValuePair(Of String, String())) = Nothing, Optional strDataFrameName As String = "", Optional strHeading As String = "Variables", Optional strExcludedItems As String() = Nothing, Optional strDatabaseQuery As String = "")
+    Public Sub FillListView(lstView As ListView, strType As String, Optional lstIncludedDataTypes As List(Of KeyValuePair(Of String, String())) = Nothing, Optional lstExcludedDataTypes As List(Of KeyValuePair(Of String, String())) = Nothing, Optional strDataFrameName As String = "", Optional strHeading As String = "Variables", Optional strExcludedItems As String() = Nothing, Optional strDatabaseQuery As String = "", Optional strNcFilePath As String = "")
         Dim vecColumns As GenericVector
         Dim chrCurrColumns As CharacterVector
         Dim i As Integer
@@ -527,6 +527,9 @@ Public Class RLink
                 Case "database_variables"
                     clsGetItems.SetRCommand(strInstatDataObject & "$get_database_variable_names")
                     clsGetItems.AddParameter("query", Chr(34) & strDatabaseQuery & Chr(34))
+                Case "nc_dim_variables"
+                    clsGetItems.SetRCommand(strInstatDataObject & "$get_nc_variable_names")
+                    clsGetItems.AddParameter("file", Chr(34) & strNcFilePath & Chr(34))
             End Select
             clsGetItems.AddParameter("as_list", "TRUE")
             lstView.Clear()
@@ -599,6 +602,9 @@ Public Class RLink
             ucrCurrentReceiver.Clear()
             For i = 0 To vecColumns.Count - 1
                 chrCurrColumns = vecColumns(i).AsCharacter
+                If chrCurrColumns Is Nothing Then
+                    Continue For
+                End If
                 For Each strColumn As String In chrCurrColumns
                     lstItems.Add(New KeyValuePair(Of String, String)(strDataFrameName, strColumn))
                 Next
@@ -784,5 +790,19 @@ Public Class RLink
         clsGetColumnName.AddParameter("type", strType)
         strColumn = RunInternalScriptGetValue(clsGetColumnName.ToScript()).AsCharacter(0)
         Return strColumn
+    End Function
+
+    Public Function IsBinary(strDataName As String, strColumn As String) As Boolean
+        Dim clsGetColumn As New RFunction
+        Dim clsIsBinary As New RFunction
+        Dim bIsBinary As Boolean
+
+        clsGetColumn.SetRCommand(strInstatDataObject & "$get_columns_from_data")
+        clsGetColumn.AddParameter("data_name", Chr(34) & strDataName & Chr(34))
+        clsGetColumn.AddParameter("col_names", Chr(34) & strColumn & Chr(34))
+        clsIsBinary.SetRCommand("is.binary")
+        clsIsBinary.AddParameter("x", clsRFunctionParameter:=clsGetColumn)
+        bIsBinary = RunInternalScriptGetValue(clsIsBinary.ToScript()).AsLogical(0)
+        Return bIsBinary
     End Function
 End Class