I am new to shiny but kind of like it. Now I have an interesting question in needing of help. I have a database can be queried by either indexA and indexB, but not both. That is if I use selectInput to retrieve data from one index(for example, indexA), I have to set another index(in this case, indexB) to default value(B0), and vise versa. The output widget is depends on both selectInput. Hence, if I interact one selectInput to query data, I need to update another selectInput, which will cause the reactive of selectInput will be called twice. Is there anyway to execute updateSelectInput without triggering reactive()?
The simplified code is below for your reference:
library(shiny)
indexA = c('A0', 'A1', 'A2', 'A3', 'A4', 'A5')
indexB = c('B0', 'B1', 'B2', 'B3', 'B4', 'B5')
ui <- fluidPage(
selectInput('SelA', 'IndexA', choices = indexA, selected = NULL),
selectInput('SelB', 'IndexB', choices = indexB, selected = NULL),
verbatimTextOutput('textout')
)
server <- function(input, output, session) {
GetIndexA <- reactive({
updateSelectInput(session, "SelB", choices = indexB, selected = NULL)
ta <- input$SelA
})
GetIndexB <- reactive({
updateSelectInput(session, "SelA", choices = indexA, selected = NULL)
tb <- input$SelB
})
output$textout <- renderText({
textA = GetIndexA()
textB = GetIndexB()
paste("IndexA=", textA, " IndexB=", textB, "\n")
})
}
shinyApp(ui, server)
Here is a simple way to do it by updating only when selected value is not the default value:
server <- function(input, output, session) {
GetIndexA <- reactive({
ta <- input$SelA
if(ta!=indexA[1])
updateSelectInput(session, "SelB", choices = indexB, selected = NULL)
ta
})
GetIndexB <- reactive({
tb <- input$SelB
if(tb!=indexB[1])
updateSelectInput(session, "SelA", choices = indexA, selected = NULL)
tb
})
output$textout <- renderText({
textA = GetIndexA()
textB = GetIndexB()
paste("IndexA=", textA, " IndexB=", textB, "\n")
})
}
Related
I have the following code that basically uploads the data and once you have clicked on the row of the dataset you have uploaded, it reads the file. If you go to the second page in the navbar called regression you can choose variables from the dataset and run linear model. That works with the summary table. I want to achieve is something like here: https://towardsdatascience.com/build-an-interactive-machine-learning-model-with-shiny-and-flexdashboard-6d76f59a37f9
I want the prediction table and plot visualisation based on what has been selected. Appreciate your understanding and helpfulness.
library(shiny)
library(magrittr)
library(shiny)
library(readxl)
library(tidyverse)
library(DT)
library(reactable)
ui <- navbarPage("Demo",
tabPanel("Data Manipulation",
sidebarLayout(
sidebarPanel(
fileInput("upload", "Upload your file", multiple = TRUE, accept = c(".csv", ".xlsx") ),
selectInput('mydropdown', label = 'Select', choices = 'No choices here yet'),
h2("Modify variable type"),
selectInput("var_name", "Select variable", choices = c()),
radioButtons("action", NULL,
choiceNames = c("Make factor", "Make numeric"),
choiceValues = c("factor", "numeric")),
actionButton("modify", "Do it!"),
verbatimTextOutput("str")
),
mainPanel(
DT::DTOutput("files"),
reactable::reactableOutput("uploaded_files")
)
)
),
tabPanel("Regression",
sidebarLayout(
sidebarPanel(
selectInput("dep_var", "Select dependent variable", choices = c()),
selectInput("ind_var", "Select independent variables", choices = c(), multiple = TRUE),
actionButton("submit_reg", "Do it!")),
mainPanel(
verbatimTextOutput(outputId = "regsum")
)
)
),
)
server <- function(input, output, session) {
output$files <- DT::renderDT({
DT::datatable(input$upload, selection = c("single"))
})
selected_file <- reactiveVal()
observe({
## when developing, use a sample file you have on your computer so that you
## can load it immediately instead of going through button clicks
# demofile <- "/path/to/your/file.csv"
# selected_file( read.csv(demofile) )
# return()
req(input$upload, input$files_rows_selected)
idx <- input$files_rows_selected
file_info <- input$upload[idx, ]
if (tools::file_ext(file_info$datapath) == "csv") {
selected_file(read.csv(file_info$datapath))
} else if (tools::file_ext(file_info$datapath) == "xlsx") {
selected_file(readxl::read_xlsx(file_info$datapath))
} else {
stop("Invalid file type")
}
})
output$uploaded_files <- reactable::renderReactable({
req(selected_file())
reactable::reactable(
selected_file(),
searchable = TRUE
)
})
observe({
req(input$upload)
file_names <- input$upload$name
updateSelectInput(
session,
"mydropdown",
choices = file_names
)
})
observe({
req(selected_file())
updateSelectInput(session, "var_name", choices = names(selected_file()))
})
output$str <- renderPrint({
req(selected_file())
str(selected_file())
})
observeEvent(input$modify, {
df <- selected_file()
if (input$action == "factor") {
df[[input$var_name]] <- as.factor(df[[input$var_name]])
} else if (input$action == "numeric") {
df[[input$var_name]] <- as.numeric(df[[input$var_name]])
} else {
stop("Invalid action")
}
selected_file(df)
})
# Second Page
observe({
req(selected_file())
Dependent <- updateSelectInput(session, "dep_var", choices = names(selected_file()))
})
observe({
req(selected_file())
Independent <- updateSelectInput(session, "ind_var", choices = names(selected_file()))
})
observeEvent(input$submit_reg, {
lm1 <- reactive({
req(selected_file())
Model1 <- lm(reformulate(input$ind_var, input$dep_var), data = selected_file())})
options(scipen=999)
output$regsum <- renderPrint({summary(lm1())})
DT::renderDataTable({
df <- req(selected_file())
DT::datatable(df %>% select(input$dep_var, input$ind_var) %>% mutate(predicted = predict(lm1()), residuals = residuals(lm1())) %>% select(input$dep_var, predicted, residuals),
rownames = FALSE, colnames = c('actual value', 'predicted value', 'residuals'), extensions = c('Buttons', 'Responsive'),
options = list(columnDefs = list(list(className = 'dt-center', targets = "_all")), dom = 'Blfrt',
buttons = c('copy', 'csv', 'excel', 'print'), searching = FALSE, lengthMenu = c(20, 100, 1000, nrow(housing)), scrollY = 300, scrollCollapse = TRUE))
})
})
}
shinyApp(ui, server)
I'm new to shiny and I have tried multiple ways to update the leaflet output based on two selectinput, the first chooses the data frame to use and the second what to filter on. this bit is working but I don't seem to be able to pass this to the leaflet proxy, any thoughts would be appreciated
poldat <- vroom::vroom("F:/ming1/data/poldat.csv")
meddat <- vroom::vroom("F:/ming1/data/meddat.csv")
medlist <- vroom::vroom("F:/ming1/data/ddl1.csv")
pollist <- vroom::vroom("F:/ming1/data/ddl2.csv")
library(shiny)
library(leaflet)
library(RColorBrewer)
library(vroom)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "50%", height = "100%"),
absolutePanel(top = 10, right = 10,
selectInput('var1', 'Select the area you wish to view', choices = c("choose" = "","police","Medical")),
selectInput('var2', 'Select the area you would like to view' ,choices =c("choose" = "")),
))
server <- function(input, output, session){
output$map <- renderLeaflet({
leaflet(map1) %>% addTiles() %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
})
observe({
a_option <- input$var1
if (a_option == "police") {
updateSelectInput(session, "var2", choices = c("choose" = "",pollist$row1))
}else{
updateSelectInput(session, "var2", choices = c("choose" = "",medlist$row1))
}
})
observe({
catreq <- input$var1
#mapfilt <- input$var2
mydf<- input$var1
if (mydf == "police") {
mydf = poldat
}else{
mydf = meddat
}
mycol <- input$var1
if (mycol == "police") {
mycol = "fallswithin"
}else{
mycol = "healtharea"
}
map1 <- subset(mydf, mycol == input$var2)
leafletProxy("map", data = map1[2:3]) %>% addTiles()# %>%
addMarkers(clusterOptions = markerClusterOptions(),label = paste("test"))
})
}
shinyApp(ui, server)
I am building an application in shiny R where in required tabs can be selected by the users and data relevant to those tabs will be displayed under it.
For example, in below sample application, mtcars data in .csv will be accepted as input parameter.User can select required column names in tabs field.Those colmns will be created as tabs.
Now, I want to show data pertaining to that column from .csv in the appropriate tab.Say, data from the column 'mpg' will be shown under 'mpg' tab.
But i am stuck here.Appreciate someone could tell me a way to display data from relevant column under appropriate tab ,dynamically.
Sample codes used is shown below:
write.csv(mtcars,'mtcars.csv')
#
library(shiny)
library(plyr)
library(dplyr)
ui <- pageWithSidebar(
headerPanel = headerPanel('data'),
sidebarPanel = sidebarPanel(fileInput(
'mtcars', h4('Uplaodmtcardata in csv format')
),
uiOutput('tabnamesui')),
mainPanel(uiOutput("tabsets"))
)
server <- function(input, output, session) {
mtcarsFile <- reactive({input$mtcars})
xxmtcars <-
reactive({
read.table(
file = mtcarsFile()$datapath,
sep = ',',
header = T,
stringsAsFactors = T
)
})
tabsnames <- reactive({
names(xxmtcars())
})
output$tabnamesui <- renderUI({
req(mtcarsFile())
selectInput(
'tabnamesui',
h5('Tab names'),
choices = as.list(tabsnames()),
multiple = T
)
})
tabnamesinput <- reactive({
input$tabnamesui
})
output$tabsets <- renderUI({
req(mtcarsFile())
tabs <-
reactive({
lapply(tabnamesinput(), function(x)
tabPanel(title = basename(x), dataTableOutput(x)))
})
do.call(tabsetPanel, c(tabs()))
})
output[['mpg']] <-
renderDataTable(as.data.frame(select(xxmtcars(), mpg)))#HOW TO AVOID THIS HARD CODING..?BASED ON THE TAB NAME DATA FROM RELEVANT COLUMN IN THE CSV TO BE RETURNED.
}
runApp(list(ui = ui, server = server))
#
Try this
library(shiny)
library(plyr)
library(dplyr)
library(rlang)
library(DT)
ui <- pageWithSidebar(
headerPanel = headerPanel('data'),
sidebarPanel = sidebarPanel(fileInput(
'mtcars', h4('Uplaodmtcardata in csv format')
),
uiOutput('tabnamesui')),
mainPanel(uiOutput("tabsets"))
)
server <- function(input, output, session) {
mtcarsFile <- reactive({input$mtcars})
xxmtcars <-
reactive({
read.table(
file = mtcarsFile()$datapath,
sep = ',',
header = T,
stringsAsFactors = FALSE
)
})
tabsnames <- reactive({
names(xxmtcars())
})
output$tabnamesui <- renderUI({
req(mtcarsFile())
selectInput(
'tabnamesui',
h5('Tab names'),
choices = as.list(tabsnames()),
multiple = T
)
})
tabnamesinput <- reactive({
input$tabnamesui
})
output$tabsets <- renderUI({
req(mtcarsFile())
tabs <-
reactive({
lapply(tabnamesinput(), function(x)
tabPanel(title = basename(x), dataTableOutput(x)))
})
do.call(tabsetPanel, c(tabs()))
})
observe(
lapply(tabnamesinput(), function(x) {
output[[x]] <- DT::renderDataTable({
t<-as.data.frame(dplyr::select(xxmtcars(), !! sym(x)) )
print(t)
datatable(t)
})
})
)
}
runApp(list(ui = ui, server = server))
In the basic example below I would like to have all filters updated every time user add a filter.
ui :
library(shiny)
library(DT)
fluidPage(
fluidRow(
column(4,
DT::dataTableOutput("dt")
)
)
)
Server :
library(shiny)
shinyServer(function(input, output) {
df <- data.frame(var1 = c(rep("A",3),rep("B",3)), var2 = c("x","y","x","z","x","s"), var3 = c(1:6))
output$dt <- renderDataTable({
DT::datatable(df, filter = 'top')
})
})
When no filter applied :
When I apply filter on var1 to "A", s and z still remain in the suggested label in var2 filter even if there are no value to s or z
This is how I would do if I use selectInput for the filters. May not be the best solution, but it has always worked for me.
Code for ui.r
library(shiny)
library(DT)
fluidPage(
fluidRow(
column(4,selectizeInput("var1", label = "Var 1", choices = NULL, multiple = TRUE)),
column(4,selectizeInput("var2", label = "Var 2", choices = NULL, multiple = TRUE)),
column(4,selectizeInput("var3", label = "Var 3", choices = NULL, multiple = TRUE)),
column(4,DT::dataTableOutput("dt")
)
)
)
Code for server.R
library(shiny)
shinyServer(function(input, output, session) {
df <- data.frame(var1 = c(rep("A",3),rep("B",3)), var2 = c("x","y","x","z","x","s"), var3 = c(1:6))
updateSelectizeInput(session, 'var1', choices = sort(unique(df$var1)), server = TRUE)
updateSelectizeInput(session, 'var2', choices = sort(unique(df$var2)), server = TRUE)
updateSelectizeInput(session, 'var3', choices = sort(unique(df$var3)), server = TRUE)
filterData <- function(dataset){
df <- dataset
if (!is.null(input$var1)){
df <- df[which(df$var1 == input$var1),]
}
if (!is.null(input$var2)){
df <- df[which(df$var2 == input$var2),]
}
if (!is.null(input$var3)){
df <- df[which(df$var3 == input$var3),]
}
df
}
output$dt <- renderDataTable({
DT::datatable(filterData(df))
})
getwhich<-function(){
whichs<-which(df$var3 == df$var3)
if(!is.null(input$var1)){
whichs<-intersect(whichs,which(df$var1 %in% input$var1))
}
if(!is.null(input$var2)){
whichs<-intersect(whichs,which(df$var2 %in% input$var2))
}
if(!is.null(input$var3)){
whichs<-intersect(whichs,which(df$var3 %in% input$var3))
}
return(whichs)
}
observe({
w<-getwhich()
if(is.null(input$var1)){
updateSelectizeInput(session,"var1",choices=sort(unique(df$var1[w])))
}
})
observe({
w<-getwhich()
if(is.null(input$var2)){
updateSelectizeInput(session,"var2",choices=sort(unique(df$var2[w])))
}
})
observe({
w<-getwhich()
if(is.null(input$var3)){
updateSelectizeInput(session,"var3",choices=sort(unique(df$var3[w])))
}
})
})
Hope this helps.
I want to upload a .csv file. Then, update the radio button choices as column names of the uploaded file and then, through that radio button choose which columns to show. The problem is whenever I run the code, it gives me this error.
P.S.1. Is there any way to read the data before we run this app? like in another app?
library(shiny)
ui = basicPage(
fileInput('uploadedcsv', "", accept = '.csv'),
radioButtons(
"column1",
"select columns",
choices = "",
inline = T
),
radioButtons(
"column2",
"select columns",
choices = "",
inline = T
),
dataTableOutput('mytable')
)
server = function(session,input, output) {
z <- reactive({
infile <- input$uploadedcsv
if (is.null(infile))
return(NULL)
read.csv(infile$datapath, header = TRUE, sep = ",")
})
observe({
vchoices <- names(z())
updateRadioButtons(session, "column1", choices = vchoices)
updateRadioButtons(session, "column2", choices = vchoices)
})
z <- reactive(z[,c(input$column1,input$column2)])
output$mytable = renderDataTable(z())
}
shinyApp(ui = ui, server = server)
z is the closure that is not sub-settable:
z <- reactive(z[,c(input$column1,input$column2)])
z is a reactive function returned by your first assignment. It is not subsettable (you cannot index it) because it is a function. You can call z and index the result as in renderDataTable below. renderDataTable will call z() and is reactive to changes in z's output, input$column1 and input$column2.
server = function(input, output, session) {
# z is reactive to a change in the input data
z <- reactive({
infile <- input$uploadedcsv
if (is.null(infile))
return(NULL)
read.csv(infile$datapath, header = TRUE, sep = ",")
})
observe({
vchoices <- names(z())
updateRadioButtons(session, "column1", choices = vchoices)
updateRadioButtons(session, "column2", choices = vchoices)
})
# renderDataTable is reactive to a change in the input data
# or the selected columns
output$mytable = renderDataTable({
z()[,c(input$column1, input$column2)]
})
}