Merge pull request #5 from africanmathsinitiative/master

Updating branch

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

instat/dlgClimSoft.vb

@@ -16,18 +16,26 @@
 
 Imports instat.Translations
 Public Class dlgClimSoft
-    Public bFirstLoad As Boolean = True
+    Private bFirstLoad As Boolean = True
+    Private bReset As Boolean = True
     Private Sub dlgClimSoft_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
+        bReset = False
         TestOKEnabled()
     End Sub
     Private Sub InitialiseDialog()
         ucrBase.iHelpTopicID = 329
+        ucrReceiverMultipleStations.Selector = ucrSelectorForClimSoft
+        ucrReceiverMultipleElements.Selector = ucrSelectorForClimSoft
+        ucrReceiverMultipleStations.SetMeAsReceiver()
+        ucrChkObservationData.SetText("Observation Data")
     End Sub
 
     Private Sub TestOKEnabled()
@@ -36,5 +44,14 @@ Public Class dlgClimSoft
 
     Private Sub SetDefaults()
         TestOKEnabled()
+        ucrSelectorForClimSoft.Reset()
+    End Sub
+
+    Private Sub cmdEstablishConnection_Click(sender As Object, e As EventArgs) Handles cmdEstablishConnection.Click
+        sdgImportFromClimSoft.ShowDialog()
+    End Sub
+
+    Private Sub ucrBase_ClickReset(sender As Object, e As EventArgs) Handles ucrBase.ClickReset
+        SetDefaults()
     End Sub
 End Class

instat/dlgRestrict.vb

@@ -24,22 +24,23 @@ Public Class dlgRestrict
     Private clsFilterView As RFunction
     Public bIsSubsetDialog As Boolean
     Public strDefaultDataframe As String = ""
+    Public strDefaultColumn As String = ""
 
     Public Sub New()
 
         ' This call is required by the designer.
         InitializeComponent()
 
         ' Add any initialization after the InitializeComponent() call.
-        bFirstLoad = True
+        clsSubset = New RFunction
         clsRemoveFilter = New RFunction
-        clsRemoveFilter.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$remove_current_filter")
         clsSetCurrentFilter = New RFunction
-        clsSetCurrentFilter.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$set_current_filter")
-        clsSubset = New RFunction
-        clsSubset.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_data_frame")
-        clsSubset.AddParameter("use_current_filter", "FALSE")
         clsFilterView = New RFunction
+
+        bFirstLoad = True
+        clsRemoveFilter.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$remove_current_filter")
+        clsSetCurrentFilter.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$set_current_filter")
+        clsSubset.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$copy_data_object")
         clsFilterView.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$filter_string")
     End Sub
 
@@ -62,7 +63,7 @@ Public Class dlgRestrict
         ucrReceiverFilter.SetMeAsReceiver()
         ucrNewDataFrameName.SetValidationTypeAsRVariable()
         ucrBase.iHelpTopicID = 340
-        rdoApplyAsSubset.Enabled = False
+        'rdoApplyAsSubset.Enabled = False
     End Sub
 
     Private Sub SetDefaults()
@@ -71,8 +72,8 @@ Public Class dlgRestrict
         SetDefaultNewDataFrameName()
         SetFilterSubsetStatus()
         SetDefaultDataFrame()
-        ucrNewDataFrameName.Visible = False 'temporarily while we have disabled the option to get a new dataframe
-        lblNewDataFrameName.Visible = False 'temporarily while we have disabled the option to get a new dataframe
+        'ucrNewDataFrameName.Visible = False 'temporarily while we have disabled the option to get a new dataframe
+        'lblNewDataFrameName.Visible = False 'temporarily while we have disabled the option to get a new dataframe
     End Sub
 
     Private Sub TestOkEnabled()
@@ -109,7 +110,11 @@ Public Class dlgRestrict
 
     Private Sub cmdNewFilter_Click(sender As Object, e As EventArgs) Handles cmdDefineNewFilter.Click
         sdgCreateFilter.ucrCreateFilter.ucrSelectorForFitler.SetDataframe(ucrSelectorFilter.ucrAvailableDataFrames.cboAvailableDataFrames.Text)
+        If strDefaultColumn <> "" Then
+            sdgCreateFilter.ucrCreateFilter.ucrFilterByReceiver.Add(strDefaultColumn)
+        End If
         sdgCreateFilter.ShowDialog()
+        strDefaultColumn = ""
         If sdgCreateFilter.bFilterDefined Then
             frmMain.clsRLink.RunScript(sdgCreateFilter.clsCurrentFilter.ToScript(), strComment:="Create Filter subdialog: Created new filter")
             ucrSelectorFilter.SetDataframe(sdgCreateFilter.ucrCreateFilter.ucrSelectorForFitler.ucrAvailableDataFrames.cboAvailableDataFrames.Text)
@@ -148,7 +153,11 @@ Public Class dlgRestrict
             clsFilterView.AddParameter("filter_name", ucrReceiverFilter.GetVariableNames())
             clsSubset.AddParameter("filter_name", ucrReceiverFilter.GetVariableNames())
             clsSetCurrentFilter.AddParameter("filter_name", ucrReceiverFilter.GetVariableNames())
-            ucrInputFilterPreview.SetName(frmMain.clsRLink.RunInternalScriptGetValue(clsFilterView.ToScript()).AsCharacter(0))
+            Try
+                ucrInputFilterPreview.SetName(frmMain.clsRLink.RunInternalScriptGetValue(clsFilterView.ToScript()).AsCharacter(0))
+            Catch ex As Exception
+                ucrInputFilterPreview.SetName("Preview not available")
+            End Try
         End If
         TestOkEnabled()
     End Sub
@@ -162,6 +171,7 @@ Public Class dlgRestrict
             ucrNewDataFrameName.Visible = True
         End If
         SetFilterOptions()
+        SetBaseFunction()
     End Sub
 
     Private Sub ucrNewDataFrameName_NameChanged() Handles ucrNewDataFrameName.NameChanged
@@ -178,10 +188,11 @@ Public Class dlgRestrict
             ucrBase.clsRsyntax.RemoveAssignTo()
         Else
             ucrBase.clsRsyntax.SetBaseRFunction(clsSubset)
+            clsSubset.AddParameter("new_name", Chr(34) & ucrNewDataFrameName.GetText() & Chr(34))
             If Not ucrNewDataFrameName.IsEmpty() Then
-                ucrBase.clsRsyntax.SetAssignTo(ucrNewDataFrameName.GetText(), strTempDataframe:=ucrNewDataFrameName.GetText())
+                'ucrBase.clsRsyntax.SetAssignTo(ucrNewDataFrameName.GetText(), strTempDataframe:=ucrNewDataFrameName.GetText())
             Else
-                ucrBase.clsRsyntax.RemoveAssignTo()
+                'ucrBase.clsRsyntax.RemoveAssignTo()
             End If
         End If
     End Sub