Merge pull request #136 from africanmathsinitiative/master

updating branch

instat/DlgDefineClimaticData.vb

@@ -19,21 +19,32 @@ Imports System.Text.RegularExpressions
 
 Public Class DlgDefineClimaticData
     Public bFirstLoad As Boolean = True
+    Private bReset As Boolean = True
     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 Sub DlgDefineClimaticData_Load(sender As Object, e As EventArgs) Handles MyBase.Load
+        autoTranslate(Me)
         If bFirstLoad Then
             InitialiseDialog()
-            SetDefaults()
             bFirstLoad = False
         End If
+        If bReset Then
+            SetDefaults()
+        End If
+        SetRCodeForControls(bReset)
+        bReset = False
+        ReopenDialog()
         TestOKEnabled()
-        autoTranslate(Me)
+    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())
         Dim kvpDate As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("date", {"date", "record"}.ToList())
         Dim kvpStation As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("station", {"station", "id", "name"}.ToList())
@@ -47,55 +58,66 @@ Public Class DlgDefineClimaticData
         Dim kvpYear As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("year", {"year"}.ToList())
         Dim kvpMonth As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("month", {"month"}.ToList())
         Dim kvpDay As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("day", {"day"}.ToList())
-        Dim kvpDOY As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("doy", {"doy"}.ToList())
+        Dim kvpDOY As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("doy", {"doy", "doy_366"}.ToList())
 
-        lstRecognisedTypes.AddRange({kvpRain, kvpDate, kvpStation, kvpCloudCover, kvpTempMax, kvpTempMin, kvpRadiation, kvpSunshineHours, kvpWindDirection, kvpWindSpeed, kvpYear, kvpMonth, kvpDay})
+        lstRecognisedTypes.AddRange({kvpRain, kvpStation, kvpCloudCover, kvpTempMax, kvpTempMin, kvpRadiation, kvpSunshineHours, kvpWindDirection, kvpWindSpeed, kvpYear, kvpMonth, kvpDay, kvpDOY, kvpDate})
+        lstReceivers.AddRange({ucrReceiverCloudCover, ucrReceiverDay, ucrReceiverMaxTemp, ucrReceiverMinTemp, ucrReceiverMonth, ucrReceiverRadiation, ucrReceiverRain, ucrReceiverStationName, ucrReceiverSunshine, ucrReceiverWindDirection, ucrReceiverWindSpeed, ucrReceiverYear, ucrReceiverDOY, ucrReceiverDate})
 
-        ucrBase.iHelpTopicID = 328
-        ucrBase.clsRsyntax.SetFunction(frmMain.clsRLink.strInstatDataObject & "$define_as_climatic")
-        clsTypesFunction.SetRCommand("c")
-        ucrBase.clsRsyntax.AddParameter("types", clsRFunctionParameter:=clsTypesFunction)
-        ucrReceiverDate.Selector = ucrSelectorDefineClimaticData
+        ucrSelectorDefineClimaticData.SetParameter(New RParameter("data_name", 0))
+        ucrSelectorDefineClimaticData.SetParameterIsString()
         ucrReceiverDate.Tag = "date"
-        ucrReceiverCloudCover.Selector = ucrSelectorDefineClimaticData
         ucrReceiverCloudCover.Tag = "cloud_cover"
-        ucrReceiverStation.Selector = ucrSelectorDefineClimaticData
-        ucrReceiverStation.Tag = "station"
-        ucrReceiverMaxTemp.Selector = ucrSelectorDefineClimaticData
+        ucrReceiverStationName.Tag = "station"
         ucrReceiverMaxTemp.Tag = "temp_max"
-        ucrReceiverMinTemp.Selector = ucrSelectorDefineClimaticData
         ucrReceiverMinTemp.Tag = "temp_min"
-        ucrReceiverRadiation.Selector = ucrSelectorDefineClimaticData
         ucrReceiverRadiation.Tag = "radiation"
-        ucrReceiverRain.Selector = ucrSelectorDefineClimaticData
         ucrReceiverRain.Tag = "rain"
-        ucrReceiverSunshine.Selector = ucrSelectorDefineClimaticData
         ucrReceiverSunshine.Tag = "sunshine_hours"
-        ucrReceiverWindDirection.Selector = ucrSelectorDefineClimaticData
         ucrReceiverWindDirection.Tag = "wind_direction"
-        ucrReceiverWindSpeed.Selector = ucrSelectorDefineClimaticData
         ucrReceiverWindSpeed.Tag = "wind_speed"
-        ucrReceiverYear.Selector = ucrSelectorDefineClimaticData
         ucrReceiverYear.Tag = "year"
-        ucrReceiverMonth.Selector = ucrSelectorDefineClimaticData
         ucrReceiverMonth.Tag = "month"
-        ucrReceiverDay.Selector = ucrSelectorDefineClimaticData
         ucrReceiverDay.Tag = "day"
-        ucrReceiverDOY.Selector = ucrSelectorDefineClimaticData
         ucrReceiverDOY.Tag = "doy"
-        lstReceivers.AddRange({ucrReceiverCloudCover, ucrReceiverDate, ucrReceiverDay, ucrReceiverMaxTemp, ucrReceiverMinTemp, ucrReceiverMonth, ucrReceiverRadiation, ucrReceiverRain, ucrReceiverStation, ucrReceiverSunshine, ucrReceiverWindDirection, ucrReceiverWindSpeed, ucrReceiverYear, ucrReceiverDOY})
-        For Each ucrTempReceiver As ucrReceiver In lstReceivers
-            ucrTempReceiver.bExcludeFromSelector = True
-        Next
+
+        SetRSelector()
     End Sub
 
     Private Sub SetDefaults()
-        ucrReceiverDate.SetMeAsReceiver()
+        Dim clsDefaultFunction As New RFunction
+
         ucrSelectorDefineClimaticData.Reset()
-        TestOKEnabled()
+        ucrReceiverDate.SetMeAsReceiver()
+        clsDefaultFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$define_as_climatic")
+        clsTypesFunction.SetRCommand("c")
+        ucrBase.clsRsyntax.SetBaseRFunction(clsDefaultFunction.Clone())
+        ucrBase.clsRsyntax.AddParameter("types", clsRFunctionParameter:=clsTypesFunction)
+
         AutoFillReceivers()
     End Sub
 
+    Public Sub SetRCodeForControls(bReset As Boolean)
+        ucrSelectorDefineClimaticData.SetRCode(ucrBase.clsRsyntax.clsBaseFunction, bReset)
+        SetRcodesforReceivers(bReset)
+    End Sub
+
+    Private Sub SetRcodesforReceivers(bReset As Boolean)
+        Dim ucrTempReceiver As ucrReceiver
+        For Each ucrTempReceiver In lstReceivers
+            ucrTempReceiver.SetRCode(clsTypesFunction, bReset)
+        Next
+    End Sub
+
+    Private Sub SetRSelector()
+        Dim ucrTempReceiver As ucrReceiver
+        For Each ucrTempReceiver In lstReceivers
+            ucrTempReceiver.SetParameter(New RParameter(ucrTempReceiver.Tag))
+            ucrTempReceiver.Selector = ucrSelectorDefineClimaticData
+            ucrTempReceiver.SetParameterIsString()
+            ucrTempReceiver.bExcludeFromSelector = True
+        Next
+    End Sub
+
     Private Sub TestOKEnabled()
         If Not ucrReceiverDate.IsEmpty Then
             ucrBase.OKEnabled(True)
@@ -106,30 +128,10 @@ Public Class DlgDefineClimaticData
 
     Private Sub ucrBase_ClickReset(sender As Object, e As EventArgs) Handles ucrBase.ClickReset
         SetDefaults()
+        SetRCodeForControls(True)
         TestOKEnabled()
     End Sub
 
-    Private Sub ucrReceiverDate_SelectionChanged(sender As Object, e As EventArgs) Handles ucrReceiverDate.SelectionChanged, ucrReceiverCloudCover.SelectionChanged, ucrReceiverDate.SelectionChanged, ucrReceiverDay.SelectionChanged, ucrReceiverMaxTemp.SelectionChanged, ucrReceiverMinTemp.SelectionChanged, ucrReceiverMonth.SelectionChanged, ucrReceiverRadiation.SelectionChanged, ucrReceiverRain.SelectionChanged, ucrReceiverStation.SelectionChanged, ucrReceiverSunshine.SelectionChanged, ucrReceiverWindDirection.SelectionChanged, ucrReceiverWindSpeed.SelectionChanged, ucrReceiverYear.SelectionChanged
-        FillClimaticTypes()
-        TestOKEnabled()
-    End Sub
-
-    Private Sub ucrSelectorDefineClimaticData_DataFrameChanged() Handles ucrSelectorDefineClimaticData.DataFrameChanged
-        ucrBase.clsRsyntax.AddParameter("data_name", Chr(34) & ucrSelectorDefineClimaticData.ucrAvailableDataFrames.cboAvailableDataFrames.SelectedItem & Chr(34))
-        AutoFillReceivers()
-    End Sub
-
-    Private Sub FillClimaticTypes()
-        Dim ucrTempReceiver As ucrReceiver
-        For Each ucrTempReceiver In lstReceivers
-            If Not ucrTempReceiver.IsEmpty Then
-                clsTypesFunction.AddParameter(ucrTempReceiver.Tag, ucrTempReceiver.GetVariableNames)
-            Else
-                clsTypesFunction.RemoveParameterByName(ucrTempReceiver.Tag)
-            End If
-        Next
-    End Sub
-
     Private Sub AutoFillReceivers()
         Dim lstRecognisedValues As List(Of String)
         Dim ucrCurrentReceiver As ucrReceiver
@@ -174,4 +176,12 @@ Public Class DlgDefineClimaticData
         Next
         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
 End Class

instat/clsCondition.vb

@@ -1,25 +1,31 @@
 Public Class Condition
     Private bIsParameterValues As Boolean = False
-    Private bIsParameterPresenet As Boolean = False
+    Private bIsParameterPresent As Boolean = False
     Private bIsFunctionNames As Boolean = False
+    Private bIsParameterType As Boolean = False
+    Private strParameterType As String = ""
     Private strParameterName As String = ""
     Private lstValues As List(Of String) = New List(Of String)
     Private bIsPositive As Boolean = True
 
     Public Sub SetParameterPresentName(strParamName As String, Optional bNewIsPositive As Boolean = True)
         strParameterName = strParamName
-        bIsParameterPresenet = True
+        bIsParameterPresent = True
         bIsParameterValues = False
         bIsFunctionNames = False
+        bIsParameterType = False
+        strParameterType = ""
         bIsPositive = bNewIsPositive
     End Sub
 
     Public Sub SetParameterValues(strParamName As String, lstParamValues As List(Of String), Optional bNewIsPositive As Boolean = True)
         strParameterName = strParamName
         lstValues = lstParamValues
         bIsParameterValues = True
-        bIsParameterPresenet = False
+        bIsParameterPresent = False
         bIsFunctionNames = False
+        bIsParameterType = False
+        strParameterType = ""
         bIsPositive = bNewIsPositive
     End Sub
 
@@ -35,8 +41,24 @@
         lstValues = lstFuncNames
         bIsFunctionNames = True
         bIsParameterValues = False
-        bIsParameterPresenet = False
+        bIsParameterPresent = False
+        bIsParameterType = False
+        strParameterType = ""
         bIsPositive = bNewIsPositive
+    End Sub
+
+    Public Sub SetParameterType(strType As String, strParamName As String, Optional bNewIsPositive As Boolean = True)
+        bIsFunctionNames = False
+        bIsParameterValues = False
+        bIsParameterPresent = False
+        bIsParameterType = True
+        strParameterName = strParamName
+        If Not {"string", "RFunction", "ROperator"}.Contains(strType) Then
+            MsgBox("Developer error: strType must be either string, RFunction or ROperator.")
+            strParameterType = ""
+        Else
+            strParameterType = strType
+        End If
     End Sub
 
     Public Function IsSatisfied(clsRCode As RCodeStructure, Optional clsParameter As RParameter = Nothing) As Boolean
@@ -50,14 +72,31 @@
                 clsTempParam = clsRCode.GetParameter(strParameterName)
             End If
             Return (clsTempParam IsNot Nothing AndAlso clsTempParam.bIsString AndAlso clsTempParam.strArgumentValue IsNot Nothing AndAlso (bIsPositive = lstValues.Contains(clsTempParam.strArgumentValue)))
-        ElseIf bIsParameterPresenet Then
+        ElseIf bIsParameterPresent Then
             Return (bIsPositive = clsRCode.ContainsParameter(strParameterName))
         ElseIf bIsFunctionNames Then
             If TypeOf clsRCode Is RFunction Then
                 clsTempFunc = CType(clsRCode, RFunction)
                 Return (bIsPositive = lstValues.Contains(clsTempFunc.strRCommand))
             Else
                 Return False
+            End If
+        ElseIf bIsParameterType Then
+            If Not clsRCode.ContainsParameter(strParameterName) Then
+                Return Not bIsPositive
+            Else
+                clsTempParam = clsRCode.GetParameter(strParameterName)
+                Select Case strParameterType
+                    Case "string"
+                        Return (bIsPositive = clsTempParam.bIsString)
+                    Case "RFunction"
+                        Return (bIsPositive = clsTempParam.bIsFunction)
+                    Case "ROperator"
+                        Return (bIsPositive = clsTempParam.bIsOperator)
+                    Case Else
+                        MsgBox("Developer error: strType must be either string, RFunction or ROperator.")
+                        Return False
+                End Select
             End If
         Else
             Return True

instat/clsRLink.vb

@@ -486,7 +486,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)
+    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 = "")
         Dim vecColumns As GenericVector
         Dim chrCurrColumns As CharacterVector
         Dim i As Integer
@@ -517,6 +517,9 @@ Public Class RLink
                     clsGetItems.SetRCommand(strInstatDataObject & "$get_link_names")
                 Case "key"
                     clsGetItems.SetRCommand(strInstatDataObject & "$get_key_names")
+                Case "database_variables"
+                    clsGetItems.SetRCommand(strInstatDataObject & "$get_database_variable_names")
+                    clsGetItems.AddParameter("query", Chr(34) & strDatabaseQuery & Chr(34))
             End Select
             clsGetItems.AddParameter("as_list", "TRUE")
             lstView.Clear()
@@ -740,5 +743,30 @@ Public Class RLink
         clsMakeNames.AddParameter("names", Chr(34) & strText & Chr(34))
         strOut = RunInternalScriptGetValue(clsMakeNames.ToScript()).AsCharacter(0)
         Return strOut
+    End Function
+
+    'Corruption analysis functions
+    Public Function GetCorruptionDataFrameNames() As List(Of String)
+        Dim clsGetDataNames As New RFunction
+        Dim lstNames As New List(Of String)
+        Dim expDataNames As SymbolicExpression
+
+        clsGetDataNames.SetRCommand(strInstatDataObject & "$get_corruption_data_names")
+        expDataNames = RunInternalScriptGetValue(clsGetDataNames.ToScript())
+        If Not expDataNames.Type = Internals.SymbolicExpressionType.Null Then
+            lstNames = expDataNames.AsCharacter.ToList()
+        End If
+        Return lstNames
+    End Function
+
+    Public Function GetCorruptionColumnOfType(strDataName As String, strType As String) As String
+        Dim clsGetColumnName As New RFunction
+        Dim strColumn As String
+
+        clsGetColumnName.SetRCommand(strInstatDataObject & "$get_corruption_column_name")
+        clsGetColumnName.AddParameter("data_name", Chr(34) & strDataName & Chr(34))
+        clsGetColumnName.AddParameter("type", Chr(34) & strType & Chr(34))
+        strColumn = RunInternalScriptGetValue(clsGetColumnName.ToScript()).AsCharacter(0)
+        Return strColumn
     End Function
 End Class