How to retain sliderInput range of a variable(s) when additional variables added dynamically? - dynamic

The following code allows to create sliderInput control widgets for selected number of variables. For the brevity, filtering code as per sliderInput range is removed. So, please neglect what is being seen in the data table. sliderInput widgets pop up whenever a new variable selected or added to the list of already existing variables. However, these widgets do not retain the previously selected values, i.e., let's say you selected sepal.length, modified slider range, and then selected sepal.width. We'll have two widgets but widget of sepal.length does not retain the modified values, i.e., the slider falls back to the original values. Agreed that retaining modified values is not being coded, and I'm unable to figure it out how it can be done. I understand that I need to read sliderInput range values as soon as they modified, save new modified values, and then update sliderInput range with the saved values before the list of functions called in renderUI. And, the other way is read new values as global variable and use them while creating in widgets, but I plan to access the control widgets in other tabs, so, this does not appear to be a neat idea. Greatly appreciate suggestions.
# Create a data frame of which information is used in creating (dynamical) control widgets
varnames <- names(iris[,1:4]) # names
varinit <- apply(iris[,1:4],2,median) # initival value used in slider
varmin <- apply(iris[,1:4],2,min) # min.
varmax <- apply(iris[,1:4],2,max) # max.
ui <- navbarPage(
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
checkboxGroupInput("ConditioningVariables", "Conditioning variables (choose one or more):",
varnames,inline = TRUE),
uiOutput("ControlWidgetsofConditioningVariables")
),
mainPanel(
dataTableOutput("data")
)
)
)
)
server <- function(input, output, session) {
allControls <- lapply(setNames(varnames, varnames), function(x) {
sliderInput(x, x, varmin[x], varmax[x], c(varmin[x], varinit[x]),
round = -2)
})
output$ControlWidgetsofConditioningVariables <- renderUI({
if (is.null(input$ConditioningVariables)){
return()
} else {
allControls[input$ConditioningVariables]
}
})
## filtering related code is removed, so, data does not change ...
newdata <- reactive({
iris
})
output$data <- renderDataTable({ newdata() })
}
shinyApp(ui, server)

Related

xml_nodeset to tibble, one row per xml_nodeset (item)

I have a complicated xml file with items as 1st child nodes. The items can have different structure and some of the attributes are missing in some of them. I need to store one item (nodeset) in tibble row, so that I keep track on missing attributes and write a function handling all variants.
I found a solution of the first step by Felix Ebert:
https://stackoverflow.com/questions/49253021/how-to-extract-xml-attr-and-xml-text-on-different-levels-with-xml2-and-purrr
I copy part of the code here:
xml <- xml2::read_xml("input/example.xml")
rows <- xml %>% xml_find_all("//xmlsubsubnode")
rows_df <- data_frame(node = rows)
Function data_frame was depreciated and I got error messages if I replace it with
tibble()
as_tibble()
data.frame()
With "tibble" I get following ERROR:
df_articles <- tibble(item = xml_articles)
Error:
! All columns in a tibble must be vectors.
✖ Column `item` is a `xml_nodeset` object.
Backtrace:
1. tibble::tibble(item = xml_articles)
2. tibble:::tibble_quos(xs, .rows, .name_repair)
3. tibble:::check_valid_col(res, col_names[[j]], j)
4. tibble:::check_valid_cols(set_names(list(x), name))
I would be grateful if anybody can update the original post.

How to filter items in QListWidget

I have the following QlistWidget:
self.myListWidget1 = QListWidget()
os.chdir("./Downloads")
for file in glob.glob("*.pdf"):
QListWidgetItem(file, self.myListWidget1)
self.myListWidget1.sortItems()
How can I add a QLineEdit that is able to filter items in self.myListWidget1 by partial
string?
The currently accepted answer by Papooch is not very good unfortunately. The reason is that it will not keep the current row event if it remains withing filter criteria. You do not want to generate a new list. You actually want to hide items which are not withing filter criteria. Do it like this:
void ItemsListWidget::filterItems(QString filter)
{
for (int row = 0; row < count(); ++row)
{
item(row)->setHidden(!item(row)->text().contains(filter, Qt::CaseInsensitive)); // you can leave out the case insensitivity if you do not want it
}
}
(it is Qt/C++ code but I am pretty sure you can easily adapt it for Python)
You are going to need a separate list on which you will do the filtering and then display the filtered list in the QListWidget.
The most basic example could look like this:
self.myLineEdit = QLineEdit()
self.myListWidget1 = QListWidget()
self.listOfPdfs = [] # this will hold the complete list of files
os.chdir("./Downloads")
for file in glob.glob("*.pdf"):
self.listOfPdfs.append(file) # fill the list
QListWidgetItem(file, self.myListWidget1)
# connect the signal textChanged to the filter function
self.myLineEdit.textChanged.connect(self.filterList)
def filterList(self, text):
self.myListWidget1.clear() # clear the list widget
for file on self.listOfPdfs:
if text in file: # only add the line if it passes the filter
QListWidgetItem(file, self.myListWidget1)
(note that I didn't check the validity of the code, minor modifications might be needed)

r flexdashboard issue with arules reactive input

I'm trying to create a flexdashboard with results from the r arules apriori function, so to display associated relations for specific items selected from the pull down menu in the markdown dashboard. When I create function outside the markdown environment I'm able successfully feed the new product item to the apriori function without problem and the graph changes as expected when I change item. When I replace the function variable with the reactive function name I get an error message saying no rules "Error: x contains 0 rules!"
Using the provided Grocery data, I'm want to the reactive input to feed the selected variable either "whole milk" or "sugar" and output the rules for the the specified variable and create a graph. I'm new to dashboards so I don't know if need to use a different function than the "reactive".
Below is the markdown code I'm having trouble feeding a new variables into the aproiri function.
---
title: "Grocery_Test"
output:
flexdashboard::flex_dashboard:
storyboard: true
social: menu
source_code: embed
runtime: shiny
---
```{r global, include=FALSE}
library(plotly)
library(flexdashboard)
library(htmlwidgets)
library(htmltools)
library(knitr)
library(arules)
library(arulesViz)
library(igraph)
library(datasets)
data(Groceries)
```Inputs {.sidebar}
-----------------------------------------------------------------------
```{r}
selectInput("Product","Product", c("whole milk","sugar"))
```
###Associated Product
```{r}
product <- reactive({input$product})
renderPlot({
#product<-"whole milk"
rules <- apriori (data=Groceries
,parameter=list (supp=0.001,conf = 0.15,maxlen=3)
,appearance = list(default="rhs",lhs=Product())
,control = list (verbose=F))
rules_conf <- sort (rules, by=c("confidence"), decreasing=TRUE) # 'high-confidence' rules.
redundant <- which (colSums (is.subset (rules_conf, rules_conf)) > 1) # get redundant rules in vector
rules_conf <- rules_conf[-redundant] # remove redundant rules
plot(rules_conf, method="graph",measure = "confidence", shading = "lift"
,control = list(engine="htmlwidget"))
})
```

Creating multiple Data Frames in the same reactive function and outputting each separately

On the server side I take user inputted data:
stressed.flag <- reactive({input$flags})
Then I use this input to create multiple data frames in reactive statement:
getdata <- reactive({
df <- readWorksheetFromFile(x, y)
df1 <- df[which(df[,1] %in% stressed.flag()),1:11]
)}
Here's the issue --> I want to output both the dataframes df1 and df2 to the user but I cannot figure out the syntax to do so.I can try to output one data frame using the renderDataTable command (on the server side and linked to the UI side) but that doesn't work either.
output$bogus = renderDataTable({
df1()
})
I guess my problem is how do I tell the machine which data frame to grab in the output$bogus statement. Maybe I want df1, maybe I want df2, maybe both from the getdata reactive statement
You can use a list to return a pair of objects list(df1=..., df2=...) then use getdata()[['df1']]
But it's usually a good idea to have one dataset by reactive so this is what I would do:
stressed.flag <- reactive({input$flags})
df <- reactive(readWorksheetFromFile(x, y))
df1 <- reactive({
data <- df();
data[data[,1] %in% stressed.flag(),1:11]})
output$full= renderDataTable(df())
output$stressed= renderDataTable(df1())
Also you could probably replace data[data[,1] %in% stressed.flag(),1:11] by data[data$col1Name==stressed.flag(),1:11]

Handling paginated SQL query results

For my dissertation data collection, one of the sources is an externally-managed system, which is based on Web form for submitting SQL queries. Using R and RCurl, I have implemented an automated data collection framework, where I simulate the above-mentioned form. Everything worked well while I was limiting the size of the resulting dataset. But, when I tried to go over 100000 records (RQ_SIZE in the code below), the tandem "my code - their system" started being unresponsive ("hanging").
So, I have decided to use SQL pagination feature (LIMIT ... OFFSET ...) to submit a series of requests, hoping then to combine the paginated results into a target data frame. However, after changing my code accordingly, the output that I see is only one pagination progress character (*) and then no more output. I'd appreciate, if you could help me identify the probable cause of the unexpected behavior. I cannot provide reproducible example, as it's very difficult to extract the functionality, not to mention the data, but I hope that the following code snippet would be enough to reveal the issue (or, at least, a direction toward the problem).
# First, retrieve total number of rows for the request
srdaRequestData(queryURL, "COUNT(*)", rq$from, rq$where,
DATA_SEP, ADD_SQL)
assign(dataName, srdaGetData()) # retrieve result
data <- get(dataName)
numRequests <- as.numeric(data) %/% RQ_SIZE + 1
# Now, we can request & retrieve data via SQL pagination
for (i in 1:numRequests) {
# setup SQL pagination
if (rq$where == '') rq$where <- '1=1'
rq$where <- paste(rq$where, 'LIMIT', RQ_SIZE, 'OFFSET', RQ_SIZE*(i-1))
# Submit data request
srdaRequestData(queryURL, rq$select, rq$from, rq$where,
DATA_SEP, ADD_SQL)
assign(dataName, srdaGetData()) # retrieve result
data <- get(dataName)
# some code
# add current data frame to the list
dfList <- c(dfList, data)
if (DEBUG) message("*", appendLF = FALSE)
}
# merge all the result pages' data frames
data <- do.call("rbind", dfList)
# save current data frame to RDS file
saveRDS(data, rdataFile)
It probably falls into the category when presumably MySQL hinders LIMIT OFFSET:
Why does MYSQL higher LIMIT offset slow the query down?
Overall, fetching large data sets over HTTP repeatedly is not very reliable.
Since this is for your dissertation, here is a hand:
## Folder were to save the results to disk.
## Ideally, use a new, empty folder. Easier then to load from disk
folder.out <- "~/mydissertation/sql_data_scrape/"
## Create the folder if not exist.
dir.create(folder.out, showWarnings=FALSE, recursive=TRUE)
## The larger this number, the more memory you will require.
## If you are renting a large box on, say, EC2, then you can make this 100, or so
NumberOfOffsetsBetweenSaves <- 10
## The limit size per request
RQ_SIZE <- 1000
# First, retrieve total number of rows for the request
srdaRequestData(queryURL, "COUNT(*)", rq$from, rq$where,
DATA_SEP, ADD_SQL)
## Get the total number of rows
TotalRows <- as.numeric(srdaGetData())
TotalNumberOfRequests <- TotalRows %/% RQ_SIZE
TotalNumberOfGroups <- TotalNumberOfRequests %/% NumberOfOffsetsBetweenSaves + 1
## FYI: Total number of rows being requested is
## (NumberOfOffsetsBetweenSaves * RQ_SIZE * TotalNumberOfGroups)
for (g in seq(TotalNumberOfGroups)) {
ret <-
lapply(seq(NumberOfOffsetsBetweenSaves), function(i) {
## function(i) is the same code you have
## inside your for loop, but cleaned up.
# setup SQL pagination
if (rq$where == '')
rq$where <- '1=1'
rq$where <- paste(rq$where, 'LIMIT', RQ_SIZE, 'OFFSET', RQ_SIZE*g*(i-1))
# Submit data request
srdaRequestData(queryURL, rq$select, rq$from, rq$where,
DATA_SEP, ADD_SQL)
# retrieve result
data <- srdaGetData()
# some code
if (DEBUG) message("*", appendLF = FALSE)
### DONT ASSIGN TO dfList, JUST RETURN `data`
# xxxxxx DONT DO: xxxxx dfList <- c(dfList, data)
### INSTEAD:
## return
data
})
## save each iteration
file.out <- sprintf("%s/data_scrape_%04i.RDS", folder.out, g)
saveRDS(do.call(rbind, ret), file=file.out)
## OPTIONAL (this will be slower, but will keep your rams and goats in line)
# rm(ret)
# gc()
}
Then, once you are done scraping:
library(data.table)
folder.out <- "~/mydissertation/sql_data_scrape/"
files <- dir(folder.out, full=TRUE, pattern="\\.RDS$")
## Create an empty list
myData <- vector("list", length=length(files))
## Option 1, using data.frame
for (i in seq(myData))
myData[[i]] <- readRDS(files[[i]])
DT <- do.call(rbind, myData)
## Option 2, using data.table
for (i in seq(myData))
myData[[i]] <- as.data.table(readRDS(files[[i]]))
DT <- rbindlist(myData)
I'm answering my own question, as, finally, I have figured out what has been the real source of the problem. My investigation revealed that the unexpected waiting state of the program was due to PostgreSQL becoming confused by malformed SQL queries, which contained multiple LIMIT and OFFSET keywords.
The reason of that is pretty simple: I used rq$where both outside and inside the for loop, which made paste() concatenate previous iteration's WHERE clause with the current one. I have fixed the code by processing contents of the WHERE clause and saving it before the loop and then using the saved value in each iteration of the loop safely, as it became independent from the value of the original WHERE clause.
This investigation also helped me to fix some other deficiencies in my code and make improvements (such as using sub-selects to properly handle SQL queries returning number of records for queries with aggregate functions). The moral of the story: you can never be too careful in software development. Big thank you to those nice people who helped with this question.