how to customize the variables shown in dropdown list - r

I am working on a SHINY app, and I am using a dropdown menu which comes with 100 different variables. I want to show only a subset of these. I could shorten the data.frame, but I need it to be this long for other reasons. Any ideas?
Thanks for your help.
this is what I have on server.R:
output$xvar <- renderUI(selectInput('xvar',label='I want to show only certain variables here', choices = names(df),selected = names(df)[1]))

Wrap the subset into a reactive and just render that:
library(shiny)
ui <- fluidPage(
uiOutput("xvar")
)
df <- 1:100
server <- function(input, output, session) {
dfsubset <- reactive({
df[1:10]
})
output$xvar <- renderUI(selectInput('xvar',label='I want to show only certain variables here',
choices = dfsubset(),selected = dfsubset()))
}
shinyApp(ui,server)

Related

How to re-order datatable column names in a R-Shiny App?

I am writing an App which displays data via datatable. Therefore different forms of text files from users are read in. It is often the case that the order of the columns is mixed up in this files, but the information in it is valid.
After displaying the data I want to do some plausibility routines and therefore I want to say: do XY with the data in "Column A". But if there is the wrong data (because of the wrong order of the columns) the plausibility is useless. Therefore I would like reorder the column names like: Column no. 3 is not 'Column A' but contains the data of 'column B', etc.
What I want to do now is to reorder the column names, not the entire column as done here.
With the following code I am able to move the whole column, but how do I only move the column names?
Edit: Just to make things clear: no, I don't want to sort the columns while reading in the data. I want to read in the file as it is and just work with the datatable object. This is mainly because I don't know what kind of file i get and what kind of information is in there. So I first of all want to display what's in there and then have a closer look.
library(shiny)
library(DT)
ui <- fluidPage(
DTOutput("table")
)
server <- function(input, output, session){
output$table <- renderDT({
datatable(
iris,
rownames = FALSE,
extensions = "ColReorder",
options = list(
colReorder = TRUE
),
colnames = c("S-Length", "S-Width", "P-Length", "P-Width", "Species")
)
})
}
shinyApp(ui, server)
Your solution works but the datatable is re-rendered each time you reorder the column names.
Here is a solution using shinyjqui::jqui_sortable with which the datatable is not re-rendered when one sorts the column names:
library(shiny)
library(shinyjqui)
library(DT)
ui <- fluidPage(
br(),
DTOutput("dtable")
)
server <- function(input, output, session){
output[["dtable"]] <- renderDT({
datatable(head(iris, 5))
})
jqui_sortable("#dtable thead tr")
}
shinyApp(ui, server)
Well, I guess I found a solution myself via the package shinyjqui.
library(shiny)
library(DT)
library(shinyjqui) # of course you need to install the package first, if you've never used it before
ui <- fluidPage(
shinyjqui::orderInput("order",
"some order",
items = c("S-Length", "S-Width", "P-Length", "P-Width", "Species")),
tags$br(),
DTOutput("table")
)
server <- function(input, output, session){
output$table <- renderDT({
names(iris) <- input$order
datatable(
iris,
rownames = FALSE,
extensions = "ColReorder",
options = list(
colReorder = TRUE
)
)
})
}
shinyApp(ui, server)
Note: With names(iris) <- input$order I've directly changed the columns' names of the data set and not just the names of the datatable, because I wanted to further access the columns by its (new) names. One could also "only" change the (displayed) names for the datatable.
Edit: btw, here is Stéphane Laurent's version (see answer above) modularized, in case anyone needs it.
library(shiny)
library(shinyjqui)
library(DT)#
ui_modul <- function(id) {
ns <- NS(id)
tagList(
jqui_sortable( DTOutput(ns("dtable")), options = list(items= "thead th"))
)
}
server_modul <- function(id) {
moduleServer(
id,
function(input, output, session) {
output[["dtable"]] <- renderDT({
datatable(head(iris, 5))
})
}
)
}
ui <- fluidPage(
br(),
ui_modul("test")
)
server <- function(input, output, session){
server_modul("test")
}
shinyApp(ui, server)

Object not found R Shiny

I am trying to access the data frame created in one render function into another render function.
There are two server outputs, lvi and Category, in lvi I have created Data1 data frame and Category I have created Data2 dataframe. I want to select Data2 where Data1 ID is matching.
I am following the below steps to achieve my objective but I get error "Object Data1 not found".
My UI is
ui <- fluidPage(
# App title ----
titlePanel("Phase1"),
fluidPage(
column(4,
# Input: Select a file ----
fileInput("file1", "Import file1")
)
),
fluidPage(
column(4,
# Input: Select a file ----
fileInput("file2", "Import File2")
)
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
dataTableOutput("lvi"),
dataTableOutput("category")
)
)
My server code is
server <- function(input, output) {
output$lvi <- renderDataTable({
req(input$file1)
Data1 <- as.data.frame(read_excel(input$file1$datapath, sheet = "Sheet1"))
})
output$category <- renderDataTable({
req(input$file2)
Data2 <- as.data.frame(read_excel(input$file2$datapath, sheet = "Sheet1"))
Data2 <- Data2[,c(2,8)]
Data2 <- Data2[Data1$ID == "ID001",]
})
}
shinyApp(ui, server)
Once a reactive block is done executing, all elements within it go away, like a function. The only thing that survives is what is "returned" from that block, which is typically either the last expression in the block (or, when in a real function, something in return(...)). If you think of reactive (and observe) blocks as "functions", you may realize that the only thing that something outside of the function knows of what goes on inside the function is if the function explicitly returns it somehow.
With that in mind, the way you get to a frame inside one render/reactive block is to not calculate it inside that reactive block: instead, create that frame in its own data-reactive block and use it in both the render and the other render.
Try this (untested):
server <- function(input, output) {
Data1_rx <- eventReactive(input$file1, {
req(input$file1, file.exists(input$file1$datapath))
as.dataframe(read_excel(input$file1$datapath, sheet = "Sheet1"))
})
output$lvi <- renderDataTable({ req(Data1_rx()) })
output$category <- renderDataTable({
req(input$file2, file.exists(input$file2$datapath),
Data1_rx(), "ID" %in% names(Data1_rx()))
Data2 <- as.data.frame(read_excel(input$file2$datapath, sheet = "Sheet1"))
Data2 <- Data2[,c(2,8)]
Data2 <- Data2[Data1_rx()$ID == "ID001",]
})
}
shinyApp(ui, server)
But since we're already going down the road of "better design" and "best practices", let's break data2 out and the data2-filtered frame as well ... you may not be using it separately now, but it's often better to separate "loading/generate frames" from "rendering into something beautiful". That way, if you need to know something about the data you loaded, you don't have to (a) reload it elsewhere, inefficient; or (b) try to rip into the internals of the shiny DataTable object and get it manually. (Both are really bad ideas.)
So a slightly better solution might start with:
server <- function(input, output) {
Data1_rx <- eventReactive(input$file1, {
req(input$file1, file.exists(input$file1$datapath))
as.dataframe(read_excel(input$file1$datapath, sheet = "Sheet1"))
})
Data2_rx <- eventReactive(input$file2, {
req(input$file2, file.exists(input$file2$datapath))
dat <- as.dataframe(read_excel(input$file2$datapath, sheet = "Sheet1"))
dat[,c(2,8)]
})
Data12_rx <- reactive({
req(Data1_rx(), Data2_rx())
Data2_rx()[ Data1_rx()$ID == "ID001", ]
})
output$lvi <- renderDataTable({ req(Data1_rx()); })
output$category <- renderDataTable({ req(Data12_rx()); })
}
shinyApp(ui, server)
While this code is a little longer, it also groups "data loading/munging" together, and "render data into something beautiful" together. And if you need to look at early data or filtered data, it's all right there.
(Side note: one performance hit you might see from this is that you now have more copies of data floating around. As long you are not dealing with "large" data, this isn't a huge deal.)

Subsetting dataframe based on dynamically generated checkBoxGroupInput: checkbox keeps resetting

I would like to use a Shiny app to load a file (tab-separated), dynamically create a checkboxGroupInput, after the loading of the file (using observeEvent) using the column headers, then subset the data frame that comes from the file based on the selected checkboxes. The data is then plotted using code I can't share right now.
All is working fine, apart from the last bit: subsetting the dataframe based on the selected checkboxes in checkboxGroupInput. The checkboxes all start selected, and the plot is created fine. If you un-select one of the checkboxes, the plot re-plots appropriately for a split second (so the subsetting is working fine) then the unselected checkbox re-selects itself and the plot goes back to the old plot.
This is the tiny problem I'm trying to solve, guessing it's one line of code. I'm assuming it's because of some reactivity that I don't understand and the checkbox constantly resetting itself.
Here is an example:
###
## Some functions I can't share
### Shiny app
library(shiny)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("MagicPlotter"),
# Sidebar
sidebarLayout(
sidebarPanel(
fileInput(inputId = "myInputID",
label = "Your .csv file",
placeholder = "File not uploaded"),
uiOutput("mylist"),
uiOutput("submitbutton")
),
# Show a plot
mainPanel(
verticalLayout(
plotOutput("myPlot"))
)
)
)
# Define server
server <- function(input, output) {
output$myPlot <- renderPlot({
inputfile <- input$myInputID
if(is.null(inputfile))
{return()}
mydataframe <- read.table(file=inputfile$datapath, sep="\t", head=T, row.names = 1)
mydataframecolumnnames <- colnames(mydataframe[1:(length(mydataframe)-1)])
# the last column is dropped because it's not relevant as a column name
observeEvent(input$myInputID, {
output$mylist <- renderUI({
checkboxGroupInput(inputId="mylist",
label="List of things to select",
choices=mydataframecolumnnames,
selected=mydataframecolumnnames)
})
})
observeEvent(input$myInputID, {
output$submitbutton <- renderUI({
submitButton("Subset")
})
})
mysubset <- mydataframe[input$mylist]
myPlot(mysubset)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Thanks all
I think there are a few things that might help...
One, you can move your observeEvent methods outside of your renderPlot.
Also, you can create a reactive function to read in the data table.
I hope this helps.
server <- function(input, output) {
myDataFrame <- reactive({
inputfile <- input$myInputID
if(is.null(inputfile))
{return()}
read.table(file=inputfile$datapath, sep="\t", head=T, row.names = 1)
})
output$myPlot <- renderPlot({
req(input$mylist)
mysubset <- myDataFrame()[input$mylist]
plot(mysubset)
})
observeEvent(input$myInputID, {
mydata <- myDataFrame()
mydataframecolumnnames <- colnames(mydata[1:(length(mydata)-1)])
output$mylist <- renderUI({
checkboxGroupInput(inputId="mylist",
label="List of things to select",
choices=mydataframecolumnnames,
selected=mydataframecolumnnames)
})
})
observeEvent(input$myInputID, {
output$submitbutton <- renderUI({
submitButton("Subset")
})
})
}

To create numericinput for all columns in a data set using renderui

I am trying to create numeric boxes for all column names in a data set. I have written below code but this displays a blank page. Not sure what the error is. Any suggestions?
library(shiny)
library(readr)
shinyApp(
ui <- fluidPage(
uiOutput("TestColumns")
),
server <- function(input, output) {
data_set <- read.csv("Data/170210_Flat_File.csv")
output$TestColumns <- renderUI({
for(i in names(data_set)){
numericInput(i, i,30)
}}
)})
First off, when you ask questions you should ALWAYS post a minimal reproducible example. That is basically something that we can run to replicate the issue you are having so that it is much easier for us to help you. This way we don't have to go about using different data, trying to figure out exactly what your error is. See this link for a good intro: How to make a great R reproducible example?
Next to your question - since you didn't explicitly post an error you were seeing or explicitly state what your issue was I'm going to go ahead and assume that your issue is that you don't see any UI's popping up when you run your Shiny App (this is what I got when I tried running your code with different sample data).
The reason you aren't seeing anything is because you aren't returning any objects from your for loop. If you really wanted to do a for loop you would have to loop through, store everything in a list, then return that list. Note that I had to use R's built in data because you didn't provide any. Something like this would work:
shinyApp(
ui <- fluidPage(
#numericInput("test","test",30),
uiOutput("TestColumns")
),
server <- function(input, output) {
data_set <- mtcars
output$TestColumns <- renderUI({
L<-vector("list",length(names(data_set)))
for(i in names(data_set)){
L[[i]]<-numericInput(i, i,30)
}
return(L)
})})
This should give you your desired result. However, the above is unnecessarily complicated. I suggest you use an lapply instead. Something like this is much better in my opinion:
shinyApp(
ui <- fluidPage(
#numericInput("test","test",30),
uiOutput("TestColumns")
),
server <- function(input, output) {
data_set <- mtcars
output$TestColumns <- renderUI({
lapply(names(data_set),function(x){numericInput(x,x,30)})
})})
ui <- bootstrapPage(
fluidRow(
column(4,offset = 2,
tags$h4("numeric inputs"),
uiOutput('mtcars_numerics') # These will be all the numeric inputs for mtcars
),
column(6,
tags$h4("current input values"),
verbatimTextOutput('show_vals') # This will show the current value and id of the inputs
)
)
)
server <- function(input, output, session){
# creates the output UI elements in the loop
output$mtcars_numerics <- renderUI({
tagList(lapply(colnames(mtcars), function(i){ # must use `tagList` `
column(3,
numericInput(
inputId = sprintf("mt_col_%s",i), # Set the id to the column name
label = toupper(i), # Label is upper case of the col name
min = min(mtcars[[i]]), # min value is the minimum of the column
max = max(mtcars[[i]]), # max is the max of the column
value = mtcars[[i]][[1]] # first value set to the first row of the column
))
})
)
})
# So we can see the values and ids in the ui for testing
output$show_vals <- renderPrint({
all_inputs <- names(session$input)
input_vals <- plyr::ldply(all_inputs, function(i){
data.frame(input_name = i, input_value = input[[i]],stringsAsFactors = FALSE)
})
input_vals
})
}
shinyApp(ui, server)
Results in:

Rshiny: transforming selection of interactive InputSelect()

i got my first Shiny App working - at least nearly. The code works find and in simplified form looks like
shinyUI(fluidPage(
titlePanel('Tableau Workbook'),
sidebarPanel(
uiOutput("select")
),
mainPanel(
tableOutput("Columns1"))
))
shinyServer(function(input,output){
output$select <- renderUI({
selectInput("dataset", "Names", as.list(files))
})
output$columns1 <- renderTable({
f<- myfunction(input$dataset)
f[[3]]
})
})
I need to modify "dataset" before it can be used in renderTable(). I tried
output$columns1 <- renderTable({
dataset<- lookuptable[which(dataset== lookuptable$table1),2 ]
f<- myfunction(input$dataset)
f[[3]]
})
The SelectInput shows a selection, from which the user can choose. What the extraline is doing: take the chosen item, look up the matching value in the lookuptable. This value is then fed into the function. The lookuptable is a dataframe with two columns and n rows..
However, when I add the extraline the visualization is broken. Has anyone an idea why?
Thanks a million for any help!

Resources