diff --git a/instat/clsRLink.vb b/instat/clsRLink.vb index 2fdadd05506..2af1f8fc1a4 100644 --- a/instat/clsRLink.vb +++ b/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 diff --git a/instat/dlgConvertColumns.vb b/instat/dlgConvertColumns.vb index e621f4489e6..c905cf20dd1 100644 --- a/instat/dlgConvertColumns.vb +++ b/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 diff --git a/instat/static/InstatObject/R/data_object_R6.R b/instat/static/InstatObject/R/data_object_R6.R index 6cde2c2e43c..e6aebad4a89 100644 --- a/instat/static/InstatObject/R/data_object_R6.R +++ b/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))){ diff --git a/instat/static/InstatObject/R/instat_object_R6.R b/instat/static/InstatObject/R/instat_object_R6.R index d0cfb2b6e8c..85479be8461 100644 --- a/instat/static/InstatObject/R/instat_object_R6.R +++ b/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)) + } } ) diff --git a/instat/ucrFactor.vb b/instat/ucrFactor.vb index 8f3a4ff909f..cf6c43add9e 100644 --- a/instat/ucrFactor.vb +++ b/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 diff --git a/instat/ucrReceiver.vb b/instat/ucrReceiver.vb index 3ad81e7e6d7..d442a71434b 100644 --- a/instat/ucrReceiver.vb +++ b/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 diff --git a/instat/ucrReorder.vb b/instat/ucrReorder.vb index 69340b03794..16936872f12 100644 --- a/instat/ucrReorder.vb +++ b/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" diff --git a/instat/ucrSelector.vb b/instat/ucrSelector.vb index 83ea4c99af8..3af38fddf2a 100644 --- a/instat/ucrSelector.vb +++ b/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 diff --git a/instat/ucrSelectorByDataFrame.vb b/instat/ucrSelectorByDataFrame.vb index 138bc13f008..dcbc5d9c3f7 100644 --- a/instat/ucrSelectorByDataFrame.vb +++ b/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