I have solved this programmed but while changing input I am unable to find output change as a table please any one can help me using R shiny code
I have solve the error but it's still showing only
library(shiny)
library(DT)
bcl <- read.csv("R-D.csv", stringsAsFactors = FALSE)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons("TYPE.OF.DATA","View data by:", choices = c("NP", "CR", "AN"), inline = TRUE, selected = "NP"),
tags$hr(),
radioButtons(" LINE.OF.BUSINESS ","View data by:" ,choices = c("AF", "HL"), inline = TRUE, selected = "AF"),
tags$hr(),
selectInput("typeInput6", " APPLICATION ",
choices = c("TERADATA"),
selected = "TERADATA"),
tags$hr(),
radioButtons( "DatabaseName","View data by:",choices = c("DW_re", "DW_np", "DW_AN"), inline = TRUE, selected = "DW_re")
),
mainPanel(
DT::dataTableOutput("table")
)
)
))
server <- shinyServer(function(input, output,session) {
observe({
if(input$bcl == "TYPE.OF.DATA"){
choices = c("NP", "CR", "AN")
firstchoice = "NP"
label = "DATA TYPE:"
}else{
choices = c("DW_re", "DW_np", "DW_AN")
firstchoice = "DW_re"
label = "NAME:"
}
updateSelectInput(session, "bcl", label = label, choices = choices, selected = firstchoice)
})
data <- reactive({
data = switch(input$bcl,
"NP" = NP, "CR" = CR, "AN" = AN,
"DW_re" = DW_re, "DW_np" = DW_np, "DW_AN" = DW_AN
)
})
output$table <- DT::renderDataTable({
datatable(data())
})
})
shinyApp(ui=ui,server=server)
Related
In my Shiny app, I want to include a selectInput in a DT datatable and allow selection of multiple options. This renders fine with multiple = F, but with multiple = T, the selection doesn't display or work properly. Please see example below. When "Multiple" is unselected, the selectInput renders fine in the table, but when it is selected, the selectInput is not rendered properly. Any suggestions?
Update: I modified the code to include a selectInput by itself with multiple = TRUE to show what I expect it to look like in the table. Specifically, in the table, there is no field above the dropdown with the selections displayed and I am unable to select multiple choices. Also see screenshot.
require(shiny)
require(DT)
shinyApp(
ui = fluidPage(
checkboxInput(inputId = "multiple", label = "Multiple", value = F),
selectInput(inputId = "expected", label = "Expected", choices = letters, multiple = T),
DT::dataTableOutput("mytable")
),
server = function(input, output, session) {
output$mytable <- DT::renderDataTable({
if(is.null(input$multiple)) return()
DT::datatable(
data = data.frame(
Col1 = c(
as.character(selectInput(
inputId = "id1",
label = NULL,
choices = letters,
multiple = input$multiple
))
)
),
escape = F,
selection = "none"
)
})
}
)
Update 2:
Thanks to #Jamie for a great solution. I was able to modify that solution when I need multiple selectInputs in my table and want the same desired format. See below:
require(shiny)
require(DT)
SelectizeIDs <- function(ids) {
myStrings <- as.character(sapply(ids, function(id) {
paste0(" $('#", id, "').selectize();")
}))
c(
"function(settings){",
myStrings,
"}"
)
}
shinyApp(
ui = fluidPage(
checkboxInput(inputId = "multiple", label = "Multiple", value = F),
selectInput(inputId = "expected", label = "Expected", choices = letters, multiple = T),
DT::dataTableOutput("mytable")
),
server = function(input, output, session) {
output$mytable <- DT::renderDataTable({
DT::datatable(
data = data.frame(
Col1 = c(
as.character(selectInput(
inputId = "id1",
label = NULL,
choices = letters,
multiple = input$multiple
)),
as.character(selectInput(
inputId = "id2",
label = NULL,
choices = letters,
multiple = input$multiple
))
)
),
escape = F,
selection = "none",
options = list(
ordering = F,
initComplete = JS(SelectizeIDs(c("id1", "id2"))),
preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}')
)
)
})
}
)
Here's an option where I leaned heavily from this question.
SelectizeInput inside DT::datatable only works as html
Which leans on this question. Shiny widgets in DT Table
Since your data data.frame has the appropriate html already set up. You need to make sure that selectize is added to the id in this case id1. From inspecting element on your expected vs actual input, it looks like all the selectize JS is being excluded
js <- c(
"function(settings){",
" $('#id1').selectize()",
"}"
)
Then in the options initialize the js function above and and bind the inputs.
shinyApp(
ui = fluidPage(
checkboxInput(inputId = "multiple", label = "Multiple", value = F),
selectInput(inputId = "expected", label = "Expected", choices = letters, multiple = T),
DT::dataTableOutput("mytable")
),
server = function(input, output, session) {
output$mytable <- DT::renderDataTable({
# if(is.null(input$multiple)) return()
DT::datatable(
data = data.frame(
Col1 = c(
as.character(selectInput(
inputId = "id1",
label = NULL,
choices = letters,
multiple = input$multiple
))
)
),
escape = F,
selection = "none",
options = list(
initComplete = JS(js),
preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}')
)
)
})
}
)
I want to update one of my selectInputs, "variable" with a reactive list of countries that will change depending on the dataset that is selected in another selectInput, "Databases". I want the default list of choices to be the "Home File" dataset that is loaded when the app runs but I want to have the option of switching to an uploaded file. The files I plan to upload will all have the list of countries under the "Countries" column to match the home_df column. Ideally the list will refresh anytime the dataset is switched.
So far I have tried this but cant seem to return the values I want:
Values <- c(145540,145560, 157247, 145566)
Countries <- c(US, Canada, Ireland, Spain)
Zipcodes <- c(145592, 145560, 145566, NA)
home_df <- data.frame(Values , Countries , Zipcodes )
ui <- fluidPage(
tabPanel(
"first_plot",
tabsetPanel(
id = "firstPanel",
type = "tabs",
tabPanel("File Upload",
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput(
"file1",
"Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons(
"sep",
"Separator",
choices = c(
Comma = ",",
Semicolon = ";",
Tab = "\t"
),
selected = ","
),
# Input: Select quotes ----
radioButtons(
"quote",
"Quote",
choices = c(
None = "",
"Double Quote" = '"',
"Single Quote" = "'"
),
selected = '"'
),
# Horizontal line ----
tags$hr(),
# Input: Select number of rows to display ----
radioButtons(
"disp",
"Display",
choices = c(Head = "head",
All = "all"),
selected = "head"
)
),
mainPanel(# Output: Data file ----
tableOutput("contents"))
)),
tabPanel("first_plot",
uiOutput("box"))
server <- function(input, output, session) {
my_data <- reactive({
inFile <- input$file1
req(inFile)
# when reading semicolon separated files,
# having a comma separator causes `read.csv` to error
tryCatch({
df_x <<- read.csv(
inFile$datapath,
header = input$header,
sep = input$sep,
quote = input$quote
)
},
error = function(e) {
# return a safeError if a parsing error occurs
stop(safeError(e))
})
if (input$disp == "head") {
return(head(df_x))
}
else {
return(df_x)
}
})
}
datasetInput <- reactiveValues(
if (input$exp_pr_box == "Home File"){
dataset <- home_df
}
else if (input$exp_pr_box == "Uploaded DB"){
dataset <- my_data()
}
return(dataset)
)
md <- reactiveValues(
list = datasetInput$Countries
)
observeEvent(datasetInput(),
updateSelectInput(session, "variable", choices=md()))
output$box <- renderUI({
tabPanel(
"first_plot",
sidebarPanel(
selectInput(
"exp_pr_box",
"Database",
choices = c("Home File", "Uploaded DB")
), ----
selectInput("variable", "Selection:", choices=NULL, selected = NULL
)
)
),
mainPanel(
h3("plot title", align = "center"),
plotlyOutput("plot", height = '1000px', width = "100%")
)
)
})
output$contents <- renderTable({
my_data()
})
output$plot <- renderPlotly(
ggplot(dx) +
geom_boxplot(col = c("#69b3a2", "red")) +
geom_line(data = dx, aes(group = paired), color =
"grey"))
shinyApp(ui, server)
I was able to solve the issue with the help of this post (R Shiny - How to update a dependent reactive selectInput before updating dependent reactive plot)
And by storing the list in the reactive. For some reason using the names function as was done in the example did not output the list for me but worked after removing it
md <- reactive({
my_list = input_dataset()
})
observeEvent(input$exp_pr_box, {
freezeReactiveValue(input, "variable")
updateSelectInput(session = session, inputId = "variable", choices = unique(str_to_title(md())))
})
I'm trying to let users select columns from a datatable they've uploaded. However, when I try to do this, I get the error message: Error in as.vector: cannot coerce type 'environment' to vector of type 'character'. The error appears due to this output: output$cr_exp_gr. I'm unsure of why this is happening/how to correct it.
library(dplyr)
library(viridis)
library(tidyverse)
library(rio)
library(shiny)
ui <- navbarPage("App Name",
tabPanel("File Upload",
sidebarLayout(
sidebarPanel(
fileInput("file1",
"Choose File",
multiple = FALSE,
accept = c("text/csv",
"text/tab-separated-values",
".csv",
"text/tsv",
"text/comma-separated-values",
".tsv")),
placeholder = "No file selected",
tags$hr(),
selectInput("dftype", label = "Data Type",
choices = c(Phosphoproteome = "pProt",
Proteome = "Prot"),
selected = "Prot"),
tags$hr()
),
mainPanel(
dataTableOutput(outputId = "exp_df")
)
)),
tabPanel("Data Processing",
sidebarPanel(
tags$h1(tags$b("Select Groups")),
actionButton("cr_exp", "Create new experimental group"),
actionButton("cr_con", "Create new control group"),
tags$hr(),
uiOutput("cr_exp_gr"),
tags$hr(),
tags$h1(tags$b("Null Value Settings")),
tags$p(tags$em("How many null values are permitted? Null value threshold can be set per table, per row, or per experimental group. Rows not meeting the threshold will be removed. Rows meeting the threshold will have null values imputed.")),
sliderInput("thresh", label = "Allowed % of Null Values",
min = 0, max = 100,
value = 0),
tags$hr(),
selectInput("threshmode", label = "Mode",
choices = c(Datatable = "dt", Row = "row", Group = "grp"),
selected = "dt"),
tags$hr()
)
),
mainPanel(
dataTableOutput(outputId = "proc_df")
))
server <- function(input, output, session) {
mydf <- eventReactive(input$file1,{
infile <- input$file1
req(infile)
return(import(infile$datapath))
})
exp_dff <- reactive({
req(mydf(),newvar(),nv(),nvar())
return(
cbind(
mydf(),
Residue = nv(),
Position = nvar(),
Protein_id = newvar())
)
})
nv <- reactive({
req(mydf())
eI <- mydf()$Index
gsub('[0-9]*','', sub(".*?_(.*?)$", "\\1",eI))
})
nvar <- reactive({
req(mydf())
eI <- mydf()$Index
gsub('[A-Z.-]','', sub(".*?_(.*?)$","\\1", eI))
})
newvar <-reactive({
req(mydf())
eI <- mydf()$Index
sub("(.*?)_(.*?)$","\\1",eI)
})
output$exp_df <- renderDataTable({
exp_dff()
})
outputOptions(output, "exp_df", suspendWhenHidden=FALSE)
output$cr_exp_gr <- renderUI({
observeEvent(input$cr_exp,
selectizeInput("sel_exp", label = "Select samples for new experimental group", choices = colnames(output$exp_df), options = list(create=TRUE), multiple=TRUE))
})
shinyApp(ui=ui, server=server)
I would like to be able to display a multi-line graph with an imported csv. CSV files contain time series. On import, I would like to be able to choose, knowing that the name of the fields can change according to the CSV, the field representing the X and the one of Y, and define the field containing the ID which will create the various lines. Something like this :
For now, I have this but it's completly wrong
# ui.R
library(shiny)
library(shinydashboard)
library(ggplot2)
shinyUI(
dashboardPage(
dashboardHeader(title ="Sen2extract"),
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Chart", tabName = "chart")
)
),
dashboardBody(
tabItem(tabName = "chart",
box(
width = 12, collapsible=FALSE,
fileInput(inputId = "csv_chart", label = "Upload your CSV", multiple = FALSE,
accept = c(".csv", "text/csv", "text/comma-separated-values,text/plan"), width = "300px"),
selectInput("X", label = "Field X :", choices = list("Choice 1" = "")),
selectInput("Y", label = "Field Y :", choices = list("Choice 1" = "")),
selectInput("group", label = "Group by :", choices = list("Choice 1" = ""))
),
box(plotOutput("plot"), width = 12)
)
)
)
)
# server.R
library(shiny)
library(shinydashboard)
library(ggplot2)
shinyServer(function(input, output, session){
output$plot = renderPlot({
data <- read.csv(file = input$csv_chart)
ggplot(data) +
geom_line(mapping = aes(x = input$X, y = input$Y)) +
labs (x = "Years", y = "", title = "Index Values")
})
})
there were several issues with your code and I have a working version below.
The main issue was that you have to read your data within reactive() and then update the selection. Also, to have multiple lines in your graph, you have to add what to group on in ggplot when you define the mapping in aes or in this case aes_string. I chose color as this gives multiple lines colored according to different groups in the chosen column.
library(shiny)
library(shinydashboard)
library(tidyverse)
ui <- dashboardPage(
dashboardHeader(title ="Sen2extract"),
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Chart", tabName = "chart")
)
),
dashboardBody(
tabItem(tabName = "chart",
box(
width = 12, collapsible=FALSE,
fileInput(inputId = "csv_chart", label = "Upload your CSV",
multiple = FALSE,
accept = c(".csv",
"text/csv",
"text/comma-separated-values,text/plan"),
width = "300px"),
selectInput("X", label = "Field X:", choices = "Pending Upload"),
selectInput("Y", label = "Field Y:", choices = "Pending Upload"),
selectInput("group", label = "Group by:", choices = "Pending Upload")
),
box(plotOutput("plot"), width = 12)
)
)
)
server <- function(input, output, session){
data <- reactive({
req(input$csv_chart)
infile <- input$csv_chart
if (is.null(infile))
return(NULL)
df <- read_csv(infile$datapath)
updateSelectInput(session, inputId = 'X', label = 'Field X:',
choices = names(df), selected = names(df)[1])
updateSelectInput(session, inputId = 'Y', label = 'Field Y:',
choices = names(df), selected = names(df)[2])
updateSelectInput(session, inputId = 'group', label = 'Group by:',
choices = names(df), selected = names(df)[3])
return(df)
})
output$plot <- renderPlot({
ggplot(data()) +
geom_line(mapping = aes_string(x = input$X, y = input$Y, color=input$group)) +
labs(x = "Years", y = "", title = "Index Values")
})
}
shinyApp(ui = ui, server = server)
The process_map() function in the server in the R shiny script creates the diagram image as below. My requirement is that there are two attributes "FUN" and "units" that are part of the performance() function. They have standard four values each that are available in the ui code below under PickerInput ID's Case4 and Case5. Currently, I am hard coding the value to create the map, can you help me to use the id's in the server code and make it dynamic such that when I select the value in the PickerInput, the formula fetches the value directly. Thanks and please help.
library(shiny)
library(shinydashboard)
library(bupaR)
library(processmapR)
library(lubridate)
library(dplyr)
library(edeaR)
library(shinyWidgets)
library(DiagrammeR)
ui <- dashboardPage(
dashboardHeader(title = "Diagram Plot",titleWidth = 290),
dashboardSidebar(width = 0),
dashboardBody(
tabsetPanel(type = "tab",
tabPanel("Overview", value = 1,
box(
column(1,
dropdown(
pickerInput(inputId = "resources",
label = "",
choices = c("Throughput Time"),
choicesOpt = list(icon = c("fa fa-bars",
"fa fa-bars",
"fa fa-safari")),
options = list(`icon-base` = "")),
circle = FALSE, status = "primary", icon = icon("list", lib = "glyphicon"), width = "300px"
),
conditionalPanel(
condition = "input.resources == 'Throughput Time' ",
tags$br(),
tags$br(),
tags$br(),
dropdown(
pickerInput(inputId = "Case4",
label = "Select the Process Time Summary Unit",
choices = c("min","max","mean","median"), options = list(`actions-box` = TRUE),
multiple = F),
circle = FALSE, status = "primary", icon = icon("eye-close", lib = "glyphicon"), width = "300px"
),
tags$br(),
tags$br(),
tags$br(),
dropdown(
pickerInput(inputId = "Case5",
label = "Select the Process Time Unit",
choices = c("mins","hours","days","weeks"), options = list(`actions-box` = TRUE),
multiple = F, selected = "days"),
circle = FALSE, status = "primary", icon = icon("eye-close", lib = "glyphicon"), width = "300px"
))),
title = "Process Map",
status = "primary",height = "575", width = "500",
solidHeader = T,
column(10,grVizOutput("State")),
align = "left")
),
id= "tabselected"
)))
server <- function(input, output) {
output$State <- renderDiagrammeR(
{
if(input$resources == "Throughput Time")
patients %>% process_map(performance(FUN = mean,units = "days"))
else
return()
})}
shinyApp(ui, server)
test this:
output$State <- renderDiagrammeR({
if(input$resources == "Throughput Time")
{
if(input$Case4=="mean"){
patients %>% process_map(performance(FUN = mean,units = input$Case5))}
else if(input$case4=="min"){
patients %>% process_map(performance(FUN = min,units = input$Case5))
}else if(input$case4=="max"){
patients %>% process_map(performance(FUN = max ,units = input$Case5))
}else{
patients %>% process_map(performance(FUN = median ,units = input$Case5))
}
}else
return()
})
or you can use this:
patients %>%
process_map(performance(FUN = eval(parse(text=input$Case4)) ,units = input$Case5))
enjoy;)
here is a sample:
library(shiny)
ui <- fluidPage(
selectInput(inputId = "func", label = "Choose The Function", choices = c("mean", "sum", "median"))
,
textOutput("text")
)
server <- function(input, output, session) {
main_data <- reactive({
data.frame(a= rnorm(100), b=rnorm(100) )
})
output$text <- renderText({
df <- main_data()
apply(df,2, FUN = eval(parse(text=input$func)) )
})
}
shinyApp(ui = ui, server = server)
You could use do.call to call a function from its name, see the example below. You can add arguments by adding them in the list in the do.call function, e.g. list(x,units=input$Case5).
library(shiny)
x=c(1,2,3,4,5,6,7)
ui <- fluidPage(
selectInput('select','Select Function: ', choices=c('mean','max','min','median')),
textOutput('text')
)
server <- function(input,output)
{
output$text <- renderText({
result = do.call(input$select, list(x))
paste0('The ', input$select, ' of [', paste(x,collapse=', '),'] is ', result)
})
}
shinyApp(ui,server)
Hope this helps!