Merge pull request IDEMSInternational#1236 from dannyparsons/column_t…

…ypes

Enhanced options for column types of receiver

instat/clsRLink.vb

@@ -277,45 +277,80 @@ Public Class RLink
         bInstatObjectExists = True
     End Sub
 
-    Public Sub FillListView(lstView As ListView, Optional strDataType As String = "all", Optional strDataFrameName As String = "")
-        Dim dfList As GenericVector
-        Dim dfTemp As DataFrame
+    Public Sub FillListView(lstView As ListView, Optional lstIncludedDataTypes As List(Of String) = Nothing, Optional lstExcludedDataTypes As List(Of String) = Nothing, Optional strDataFrameName As String = "", Optional strHeading As String = "Available Variables")
+        Dim vecColumns As GenericVector
+        Dim chrCurrColumns As CharacterVector
         Dim i As Integer
         Dim grps As New ListViewGroup
         If bInstatObjectExists Then
             lstView.Clear()
-            lstView.Groups.Clear()
-            If strDataType = "factor" Then
-                lstView.Columns.Add("Available Factors")
-            ElseIf strDataType = "numeric" Then
-                lstView.Columns.Add("Available Numerics")
-            ElseIf strDataType = "all" Then
-                lstView.Columns.Add("Available Variables")
-            End If
+            lstView.Groups.Clear()
+            lstView.Columns.Add(strHeading)
             If strDataFrameName = "" Then
-                dfList = clsEngine.Evaluate(strInstatDataObject & "$get_variables_metadata(data_type = " & Chr(34) & strDataType & Chr(34) & ")").AsList
+                If lstIncludedDataTypes IsNot Nothing Then
+                    vecColumns = clsEngine.Evaluate(strInstatDataObject & "$get_column_names(include_type = " & GetListAsRString(lstIncludedDataTypes) & ", as_list = TRUE)").AsList
+                ElseIf lstExcludedDataTypes IsNot Nothing Then
+                    vecColumns = clsEngine.Evaluate(strInstatDataObject & "$get_column_names(exclude_type = " & GetListAsRString(lstExcludedDataTypes) & ", as_list = TRUE)").AsList
+                Else
+                    vecColumns = clsEngine.Evaluate(strInstatDataObject & "$get_column_names(as_list = TRUE)").AsList
+                End If
             Else
-                dfList = clsEngine.Evaluate("list(" & strDataFrameName & "=" & strInstatDataObject & "$get_variables_metadata(data_name = " & Chr(34) & strDataFrameName & Chr(34) & ", data_type = " & Chr(34) & strDataType & Chr(34) & "))").AsList
+                If lstIncludedDataTypes IsNot Nothing Then
+                    vecColumns = clsEngine.Evaluate(strInstatDataObject & "$get_column_names(data_name = " & Chr(34) & strDataFrameName & Chr(34) & ", include_type = " & GetListAsRString(lstIncludedDataTypes) & ", as_list = TRUE)").AsList
+                ElseIf lstExcludedDataTypes IsNot Nothing Then
+                    vecColumns = clsEngine.Evaluate(strInstatDataObject & "$get_column_names(data_name = " & Chr(34) & strDataFrameName & Chr(34) & ", exclude_type = " & GetListAsRString(lstExcludedDataTypes) & ", as_list = TRUE)").AsList
+                Else
+                    vecColumns = clsEngine.Evaluate(strInstatDataObject & "$get_column_names(data_name = " & Chr(34) & strDataFrameName & Chr(34) & ", as_list = TRUE)").AsList
                 End If
 
-            For i = 0 To dfList.Count - 1
-                If dfList.Count = 1 Then
-                    grps = New ListViewGroup(key:=dfList.Names(i), headerText:="")
+            End If
+
+            For i = 0 To vecColumns.Count - 1
+                If vecColumns.Count = 1 Then
+                    grps = New ListViewGroup(key:=vecColumns.Names(i), headerText:="")
                 Else
-                    grps = New ListViewGroup(key:=dfList.Names(i), headerText:=dfList.Names(i))
+                    grps = New ListViewGroup(key:=vecColumns.Names(i), headerText:=vecColumns.Names(i))
                 End If
                 If Not lstView.Groups.Contains(grps) Then
                     lstView.Groups.Add(grps)
                 End If
-                dfTemp = dfList(i).AsDataFrame()
-                For j = 0 To dfTemp.RowCount - 1
-                    lstView.Items.Add(dfTemp(j, 0)).Group = lstView.Groups(i)
+                chrCurrColumns = vecColumns(i).AsCharacter
+                For Each strCol As String In chrCurrColumns
+                    lstView.Items.Add(strCol).Group = lstView.Groups(i)
                 Next
             Next
             'TODO Find out how to get this to set automatically ( Width = -2 almost works)
             lstView.Columns(0).Width = 115
         End If
-    End Sub
+    End Sub
+
+    Public Function GetListAsRString(lstStrings As List(Of String), Optional bWithQuotes As Boolean = True) As String
+        Dim strTemp As String = ""
+        Dim i As Integer
+        If lstStrings.Count = 1 Then
+            If bWithQuotes Then
+                strTemp = Chr(34) & lstStrings.Item(0) & Chr(34)
+            Else
+                strTemp = lstStrings.Item(0)
+            End If
+        ElseIf lstStrings.Count > 1 Then
+            strTemp = "c" & "("
+            For i = 0 To lstStrings.Count - 1
+                If i > 0 Then
+                    strTemp = strTemp & ","
+                End If
+                If lstStrings.Item(i) <> "" Then
+                    If bWithQuotes Then
+                        strTemp = strTemp & Chr(34) & lstStrings.Item(i) & Chr(34)
+                    Else
+                        strTemp = strTemp & lstStrings.Item(i)
+                    End If
+                End If
+            Next
+            strTemp = strTemp & ")"
+        End If
+        Return strTemp
+    End Function
 
     Public Function GetDataFrameLength(strDataFrameName As String) As Integer
         Dim intLength As Integer

instat/dlgConvertColumns.vb

@@ -19,7 +19,7 @@ Public Class dlgConvertColumns
     Public bFirstLoad As Boolean = True
     Public bToFactorOnly As Boolean = False
 
-    Private Sub ucrSelectorDataFrameColumns_Load(sender As Object, e As EventArgs) Handles ucrSelectorDataFrameColumns.Load
+    Private Sub dlgConvertColumns_Load(sender As Object, e As EventArgs) Handles Me.Load
         autoTranslate(Me)
 
         If bFirstLoad Then
@@ -32,7 +32,9 @@ Public Class dlgConvertColumns
 
         TestOKEnabled()
 
+
     End Sub
+
     Private Sub ReopenDialog()
         SetToFactorStatus(bToFactorOnly)
     End Sub

instat/static/InstatObject/R/data_object_R6.R

@@ -695,6 +695,30 @@ data_object$set("public", "get_column_count", function(col_name, new_level_names
 }
 )
 
+data_object$set("public", "get_column_names", function(as_list = FALSE, include_type = c(), exclude_type = c()) {
+  types = c("factor", "integer", "numeric", "logical", "character")
+  if(!length(include_type) == 0) {
+    if(!all(include_type %in% types)) stop(paste("include_type can only contain", paste(types, collapse = ", ")))
+    if("numeric" %in% include_type) include_type = c(include_type, "integer")
+    if(!length(exclude_type) == 0) warning("exclude_type argument will be ignored. Only one of include_type and exclude_type should be specified.")
+    out = names(private$data)[sapply(private$data, class) %in% include_type]
+  }
+  else if(!length(exclude_type) == 0) {
+    if(!all(exclude_type %in% types)) stop(paste("exclude_type can only contain", paste(types, collapse = ", ")))
+    if("numeric" %in% exclude_type) exclude_type = c(exclude_type, "integer")
+    out = names(private$data)[!(sapply(private$data, class) %in% exclude_type)]
+  }
+  else out = names(private$data)
+
+  if(as_list) {
+    lst = list()
+    lst[[self$get_metadata(data_name_label)]] <- out
+    return(lst)
+  }
+  else return(out)
+}
+)
+
 #TODO: Are there other types needed here?
 data_object$set("public", "get_data_type", function(col_name = "") {
   if(!(col_name %in% names(private$data))){

instat/static/InstatObject/R/instat_object_R6.R

@@ -464,8 +464,13 @@ instat_object$set("public", "get_next_default_column_name", function(data_name,
 } 
 )
 
-instat_object$set("public", "get_column_names", function(data_name) {
-  return(names(self$get_data_objects(data_name)$data))
+instat_object$set("public", "get_column_names", function(data_name, as_list = FALSE, include_type = c(), exclude_type = c()) {
+  if(missing(data_name)) {
+    return(lapply(self$get_data_objects(), function(x) x$get_column_names(include_type = include_type, exclude_type = exclude_type)))
+  } 
+  else {
+    return(self$get_data_objects(data_name)$get_column_names(as_list, include_type, exclude_type))
+  }
 }
 )
 

instat/ucrFactor.vb

@@ -77,7 +77,7 @@ Public Class ucrFactor
         Dim dfTemp As CharacterMatrix
         Dim bShowGrid As Boolean = False
         grdFactorData.Worksheets.Clear()
-        If clsReceiver IsNot Nothing AndAlso clsReceiver.strDataType = "factor" AndAlso Not clsReceiver.IsEmpty() Then
+        If clsReceiver IsNot Nothing AndAlso clsReceiver.lstIncludedDataTypes.Count = 1 AndAlso clsReceiver.lstIncludedDataTypes.Contains("factor") AndAlso Not clsReceiver.IsEmpty() Then
             dfTemp = frmMain.clsRLink.GetData(frmMain.clsRLink.strInstatDataObject & "$get_column_factor_levels(data_name = " & Chr(34) & clsReceiver.GetDataName() & Chr(34) & ", col_name = " & clsReceiver.GetVariableNames() & ")")
             frmMain.clsGrids.FillSheet(dfTemp, "Factor Data", grdFactorData)
             shtCurrSheet = grdFactorData.CurrentWorksheet

instat/ucrReceiver.vb

@@ -17,7 +17,10 @@
 Imports instat.Translations
 Public Class ucrReceiver
     Public WithEvents Selector As ucrSelector
-    Public strDataType As String = "all"
+    Public lstIncludedDataTypes As List(Of String)
+    Public lstExcludedDataTypes As List(Of String)
+    Public bFirstLoad As Boolean = True
+    Public strSelectorHeading As String = "Available Variables"
 
     Public Overridable Sub AddSelected()
 
@@ -61,8 +64,50 @@ Public Class ucrReceiver
 
     Private Sub ucrReceiver_Load(sender As Object, e As EventArgs) Handles MyBase.Load
         translateEach(Controls)
+        If bFirstLoad Then
+            lstIncludedDataTypes = New List(Of String)
+            lstExcludedDataTypes = New List(Of String)
+            bFirstLoad = False
+        End If
     End Sub
 
+    Public Function GetIncludedDataTypes(Optional bWithQuotes As Boolean = True) As String
+        Return GetListAsRString(lstIncludedDataTypes, bWithQuotes)
+    End Function
+
+    Public Function GetExcludedDataTypes(Optional bWithQuotes As Boolean = True) As String
+        Return GetListAsRString(lstExcludedDataTypes, bWithQuotes)
+    End Function
+
+    'TODO make this function available throughout project
+    Public Function GetListAsRString(lstStrings As List(Of String), Optional bWithQuotes As Boolean = True) As String
+        Dim strTemp As String = ""
+        Dim i As Integer
+        If lstStrings.Count = 1 Then
+            If bWithQuotes Then
+                strTemp = Chr(34) & lstStrings.Item(0) & Chr(34)
+            Else
+                strTemp = lstStrings.Item(0)
+            End If
+        ElseIf lstStrings.Count > 1 Then
+            strTemp = "c" & "("
+            For i = 0 To lstStrings.Count - 1
+                If i > 0 Then
+                    strTemp = strTemp & ","
+                End If
+                If lstStrings.Item(i) <> "" Then
+                    If bWithQuotes Then
+                        strTemp = strTemp & Chr(34) & lstStrings.Item(i) & Chr(34)
+                    Else
+                        strTemp = strTemp & lstStrings.Item(i)
+                    End If
+                End If
+            Next
+            strTemp = strTemp & ")"
+        End If
+        Return strTemp
+    End Function
+
     Private Sub ucrReceiver_Enter(sender As Object, e As EventArgs) Handles Me.Enter
         SetMeAsReceiver()
     End Sub
@@ -71,15 +116,32 @@ Public Class ucrReceiver
 
     Public Sub OnValueChanged(ByVal sender As Object, ByVal e As EventArgs)
         RaiseEvent ValueChanged(sender, e)
+    End Sub
+
+    'TODO remove this method and replace with SetIncludedDataTypes
+    Public Sub SetDataType(strTemp As String)
+        lstIncludedDataTypes.Add(strTemp)
+        If Selector IsNot Nothing Then
+            Selector.LoadList()
+        End If
     End Sub
 
-    Public Sub SetDataType(strTemp As String)
-        strDataType = strTemp
-        If Selector IsNot Nothing Then
-            Selector.LoadList()
+    Public Sub SetIncludedDataTypes(strInclude As String())
+        lstIncludedDataTypes.AddRange(strInclude)
+        lstExcludedDataTypes.Clear()
+        If Selector IsNot Nothing Then
+            Selector.LoadList()
         End If
     End Sub
 
+    Public Sub SetExcludedDataTypes(strExclude As String())
+        lstExcludedDataTypes.AddRange(strExclude)
+        lstIncludedDataTypes.Clear()
+        If Selector IsNot Nothing Then
+            Selector.LoadList()
+        End If
+    End Sub
+
     Private Sub Selector_ResetAll() Handles Selector.ResetReceivers
         Clear()
     End Sub

instat/ucrReorder.vb

@@ -151,7 +151,7 @@ Public Class ucrReorder
                     dfTemp = frmMain.clsRLink.clsEngine.GetSymbol(ucrDataFrameList.cboAvailableDataFrames.SelectedItem).AsCharacterMatrix
                 End If
             Case "factor"
-                If ucrReceiver IsNot Nothing AndAlso ucrReceiver.strDataType = "factor" AndAlso ucrReceiver.GetVariableNames <> "" Then
+                If ucrReceiver IsNot Nothing AndAlso ucrReceiver.lstIncludedDataTypes.Count = 1 AndAlso ucrReceiver.lstIncludedDataTypes.Contains("factor") AndAlso ucrReceiver.GetVariableNames <> "" Then
                     dfTemp = frmMain.clsRLink.GetData(frmMain.clsRLink.strInstatDataObject & "$get_column_factor_levels(data_name = " & Chr(34) & ucrReceiver.GetDataName() & Chr(34) & ", col_name = " & ucrReceiver.GetVariableNames() & ")")
                 End If
             Case "others"

instat/ucrSelector.vb

@@ -46,7 +46,11 @@ Public Class ucrSelector
 
     Public Overridable Sub LoadList()
         If CurrentReceiver IsNot Nothing Then
-            frmMain.clsRLink.FillListView(lstAvailableVariable, strDataType:=CurrentReceiver.strDataType)
+            If CurrentReceiver.lstIncludedDataTypes.Count > 0 Then
+                frmMain.clsRLink.FillListView(lstAvailableVariable, lstIncludedDataTypes:=CurrentReceiver.lstIncludedDataTypes, strHeading:=CurrentReceiver.strSelectorHeading)
+            ElseIf CurrentReceiver.lstExcludedDataTypes.Count > 0 Then
+                frmMain.clsRLink.FillListView(lstAvailableVariable, lstExcludedDataTypes:=CurrentReceiver.lstExcludedDataTypes, strHeading:=CurrentReceiver.strSelectorHeading)
+            End If
         End If
     End Sub
 

instat/ucrSelectorByDataFrame.vb

@@ -31,11 +31,16 @@ Public Class ucrSelectorByDataFrame
     End Sub
 
     Public Overrides Sub LoadList()
+
         If ucrAvailableDataFrames.cboAvailableDataFrames.Text <> "" Then
             If CurrentReceiver IsNot Nothing Then
-                frmMain.clsRLink.FillListView(lstAvailableVariable, strDataType:=CurrentReceiver.strDataType, strDataFrameName:=ucrAvailableDataFrames.cboAvailableDataFrames.Text)
-            Else
-                frmMain.clsRLink.FillListView(lstAvailableVariable, strDataFrameName:=ucrAvailableDataFrames.cboAvailableDataFrames.Text)
+                If CurrentReceiver.lstIncludedDataTypes.Count > 0 Then
+                    frmMain.clsRLink.FillListView(lstAvailableVariable, lstIncludedDataTypes:=CurrentReceiver.lstIncludedDataTypes, strDataFrameName:=ucrAvailableDataFrames.cboAvailableDataFrames.Text, strHeading:=CurrentReceiver.strSelectorHeading)
+                ElseIf CurrentReceiver.lstExcludedDataTypes.Count > 0 Then
+                    frmMain.clsRLink.FillListView(lstAvailableVariable, lstExcludedDataTypes:=CurrentReceiver.lstExcludedDataTypes, strDataFrameName:=ucrAvailableDataFrames.cboAvailableDataFrames.Text, strHeading:=CurrentReceiver.strSelectorHeading)
+                Else
+                    frmMain.clsRLink.FillListView(lstAvailableVariable, strDataFrameName:=ucrAvailableDataFrames.cboAvailableDataFrames.Text, strHeading:=CurrentReceiver.strSelectorHeading)
+                End If
             End If
         End If
     End Sub