I have a drop down menu which is a selectizeInput - using which I need to subset my dataframe for analysis further.
Consider the following,
d - dataframe (has a column named 'test')
menu - the selectizeInput drop down
d[d$test %in% input$menu, ]
This doesn't do what I actually need to. Any thoughts?
It should work.
ui
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput("in", "in", choices = as.list(letters[1:10]), multiple = TRUE)
),
mainPanel(
verbatimTextOutput("view")
)
)
))
server
library(shiny)
d <- data.frame(test = letters[1:10], value = 1:10)
shinyServer(function(input, output) {
view <- reactive({d[d$test %in% input$"in", ]})
output$view <- renderPrint(view())
})
Related
I saw some previous questions that may circle around this issue, but I couldn't find a clear answer to that.
My problem is that an ui element added using insertUI that depends on a reactive value does not update.
In the example I gave below, if one adds the new selectInput using the button and then changes the gender selection, the choices are updated only in the first selectInput.
The question is: is there an "official" way to make this selectInput reactive? I can imagine some workarounds, but they are not ideal.
server.R
library(shiny)
library(tidyverse)
server <- function(input, output, session) {
data <- reactive({
req(input$genderSelection)
starwars %>%
filter(gender == input$genderSelection)
})
output$characterSelection1 <- renderUI({
selectInput(
"char1",
"Character 1",
choices = data() %>%
.$name
)
})
observeEvent(
input$btn,
{
insertUI(
selector = "#selection2",
where = "beforeEnd",
ui = selectInput(
"char2",
"Character 2",
choices = data() %>%
.$name
)
)
}
)
}
ui.R
ui <- fluidPage(
radioButtons(
"genderSelection",
"Gender",
choices = c("male", "female")
),
uiOutput("characterSelection1"),
tags$div(
id = "selection2",
actionButton("btn", "Add selection")
)
)
I confess, I did post this question over on RStudio three days ago but it has not had enough love yet, so I'm trying again here. I hope that's okay. The original question is here (the text is the same in both, I'm just being transparent). https://community.rstudio.com/t/selecting-rows-from-a-dt-table-using-crosstalk-in-shiny/4079
So I would like to brush across points in D3Scatter and use it to filter the rows of a datatable produced using the DT package with crosstalk.
Just like this, which totally works outside of shiny:
library(crosstalk)
library(d3scatter)
library(DT)
shared_iris <- SharedData$new(iris)
bscols(d3scatter(shared_iris, ~Petal.Length, ~Petal.Width, ~Species, width = "100%",
x_lim = range(iris$Petal.Length), y_lim = range(iris$Petal.Width)),
datatable(shared_iris))
But when I put it in Shiny, I can select points on the scatter from the table, but not vice versa:
library(shiny)
library(crosstalk)
library(d3scatter)
library(DT)
ui <- fluidPage(
fluidRow(
column(6, d3scatterOutput("scatter1")),
column(6, DT::dataTableOutput("scatter2"))
)
)
server <- function(input, output, session) {
jittered_iris <- reactive({
iris
})
shared_iris <- SharedData$new(jittered_iris)
output$scatter1 <- renderD3scatter({
d3scatter(shared_iris, ~Petal.Length, ~Petal.Width, ~Species, width = "100%",
x_lim = range(iris$Petal.Length), y_lim = range(iris$Petal.Width))
})
output$scatter2 <- DT::renderDataTable({
datatable(shared_iris)
})
}
shinyApp(ui, server)
They’ve got it working here: https://rstudio-pubs-static.s3.amazonaws.com/215948_95c1ab86ad334d2f82856d9e5ebc16af.html
I’m at a loss. I feel like I’ve tried everything. Any clues anyone?
Thanks,
Crosstalk integration in DT only works with client-side processing . Try DT::renderDataTable with server = FALSE
library(shiny)
library(crosstalk)
library(d3scatter)
library(DT)
ui <- fluidPage(
fluidRow(
column(6, d3scatterOutput("scatter1")),
column(6, DT::dataTableOutput("scatter2"))
)
)
server <- function(input, output, session) {
jittered_iris <- reactive({
iris
})
shared_iris <- SharedData$new(jittered_iris)
output$scatter1 <- renderD3scatter({
d3scatter(shared_iris, ~Petal.Length, ~Petal.Width, ~Species, width = "100%",
x_lim = range(iris$Petal.Length), y_lim = range(iris$Petal.Width))
})
output$scatter2 <- DT::renderDataTable({
datatable(shared_iris)
}, server = FALSE)
}
shinyApp(ui, server)
DT should throw an error when using Crosstalk with server-side processing
Error in widgetFunc: Crosstalk only works with DT client mode: DT::renderDataTable({...}, server=FALSE)
but I think that broke here: https://github.com/rstudio/DT/commit/893708ca10def9cfe0733598019b62a8230fc52b
Guess I can file an issue on this if no one else has.
I have created several likert scales with R package "likert" and would like to plot each one of them in shiny when the radio button of that one is selected.
The sample scales is:
a <- sample(rep((1:5),5))
b <- sample(rep((1:5),5))
c <- data.frame(sapply(data.frame(a), factor))
d <- data.frame(sapply(data.frame(b), factor))
scaledc <- likert(c)
scaledd <- likert(d)
The shiny codes are:
ui <- fluidPage(
titlePanel("Survey"),
sidebarLayout(
sidebarPanel(
selectInput("type",
"Plot Type",
choices = c("Likert"="bar",
"Density"="density",
"Heatmap"="heat"), selected="Likert"),
radioButtons("qtype",
"Question type:",
c("Agreement"="scaledc", "Helpfulness"="scaledd"),
selected="scaledc")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel("Yearly Data", plotOutput("distPlot1"))
)
)
)
)
#server
server <- function(input, output) {
output$distPlot1 <- renderPlot({plot(input$qtype, type=input$type)+
ggtitle("How agree are you with following statements?")}, height = 1000)
}
The shiny returned error "need finite 'ylim' values." I think it's becaue the input$qtype doesn't pass the correct information to the plot command, but I don't know how to fix it. Thank you for advance!
I've just solved the problem.
The missing codes in server are:
scale <- reactive({
get(input$qtype)
})
output$dat <- renderPrint({
scale()
})
And then do plot with scale() will show selected plot.
How can I get the list of choices in a SelectInpute?
ui.R
selectInput(inputId = "select_gender",
label = "Gender",
choices = c("Male","Female"),
width = 150
)
server.R
# Something like...
genders <- input$select_gender["choices"]
# So that the gender would be:
> genders
[1] Male Female
From the scoping rules of Shiny:
Objects defined in global.R are similar to those defined in app.R outside of the server function definition, with one important difference: they are also visible to the code in the ui object. This is because they are loaded into the global environment of the R session; all R code in a Shiny app is run in the global environment or a child of it.
However, this doesn't mean that objects defined in the app.R can't be used on both the UI and Server side, they just belong to a different environment.
For example:
library("shiny")
library("pryr")
# or in global.R
genders <- c("Male", "Female")
gen_env <- where("genders")
par_env <- parent.env(gen_env)
ui <- fluidPage(
selectInput("shiny_gender", "Select Gender", choices = genders),
verbatimTextOutput("selected_gender_index"),
p("The `genders` object belongs to the environment:"),
verbatimTextOutput("gen_env_print"),
p("Which is the child of the environment:"),
verbatimTextOutput("par_env_print")
)
server <- function(input, output) {
output$selected_gender_index <- renderPrint({
# use the 'genders' vector on the server side as well
which(genders %in% input$shiny_gender)
})
output$gen_env_print <- renderPrint(gen_env)
output$par_env_print <- renderPrint(par_env)
}
shinyApp(ui = ui, server = server)
I've looked for get choices of selectinput but without recompute the choices. For example if the datas come from database, or file or other source.
And I didn't get answer. (I get this question but not the solution for me).
Here is ma solution which also could set the selectinput from the server:
set the choices list in a reactive function
build the selectinput in the server side (with the choices list reactive function)
set and get the selectinput in the server side
Here is the code
options(encoding = "UTF-8")
library("shiny")
library("pryr")
ui <- fluidPage(
uiOutput("shiny_gender.UI"),
verbatimTextOutput("selected_gender_index"),
p("The `genders` object belongs to the environment:"),
verbatimTextOutput("gen_env_print"),
p("Which is the child of the environment:"),
verbatimTextOutput("par_env_print"),
p(""),
textInput("set_input_txt","Set the car in letter (for example `Datsun 710`)",
#" Set the Select Input Male / Female ",
""),
actionButton("submit","submit")
)
server <- function(input, output, session) {
observeEvent(
c(input$submit),
{
if (input$submit>0) {
updateSelectInput(session, "shiny_gender",
# server = TRUE, if updateSelectizeInput
choices =shiny_gender.list(),
selected = input$set_input_txt
)
}
}
)
shiny_gender.list <- reactive ({
#c("Male", "Female")
rownames(mtcars)
})
output$shiny_gender.UI <- renderUI({
selectInput( "shiny_gender",
label="Select car",#"Select Gender",
choices =shiny_gender.list()
)
})
output$selected_gender_index <- renderPrint({
which(shiny_gender.list() %in% input$shiny_gender)
})
output$gen_env_print <- renderPrint(where("shiny_gender.list"))
output$par_env_print <- renderPrint(parent.env( where("shiny_gender.list")))
}
shinyApp(ui = ui, server = server)
I'm currently designing a Shiny app that outputs a table. I would like to highlight the cells in a particular column (e.g., make the cells blue). I've tried using the HighlightRows function from the shinyBS package, but that doesn't seem to work.
Here is a portion of my server script making up the table:
output$text1 <- renderTable({
tab1 <- as.data.frame(matrix(c(rrround(input$patha,3),PowerF()$tta,input$nxn,rrround(currentInput()$patha,3),rrround(rxyval()$rxy,3),rrround(rxyval()$rxy_p,3),rround(PowerF()$tra,3),
rrround(input$pathp,3),PowerF()$ttp,input$nxn,rrround(currentInput()$pathp,3),rrround(rxyval()$rxyp,3),rrround(rxyval()$rxyp_p,3),rround(PowerF()$trp,3))
,ncol=7, byrow=TRUE))
rownames(tab1) <- c('Actor', 'Partner')
colnames(tab1) <- c('Size', 'Power', 'N','Beta','r','partial r','ncp')
tab1.align = "r"
highlightRows(session, id='tab1', class = "info", column="Power", regex = ".")
print(tab1, type="html")
})
Any help would be greatly appreciated.
Thanks!
You can modify your datatable using tags$script. below is an example of highlighting 3 columns (1), (5) and (9) of a sample datatable. I had a small problem with a similar issue, you can view that How to change Datatable row background colour based on the condition in a column, Rshiny
rm(list = ls())
library(shiny)
options(digits.secs=3)
test_table <- cbind(rep(as.character(Sys.time()),10),rep('a',10),rep('b',10),rep('b',10),rep('c',10),rep('c',10),rep('d',10),rep('d',10),rep('e',10),rep('e',10))
colnames(test_table) <- c("Time","Test","T3","T4","T5","T6","T7","T8","T9","T10")
ui =navbarPage(inverse=TRUE,title = "Coloring datatables",
tabPanel("Logs",icon = icon("bell"),
mainPanel(htmlOutput("logs"))),
tabPanel("Extra 2",icon = icon("bell")),
tabPanel("Extra 3",icon = icon("bell")),
tags$style(type="text/css", "#logs td:nth-child(1) {text-align:center;background-color:red;color: white;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(5) {text-align:center;background-color:blue;color: white;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(9) {text-align:center;background-color:green;color: white;text-align:center}")
)
server <- (function(input, output, session) {
my_test_table <- reactive({
other_data <- rbind(c(as.character(Sys.time()),(sample(c("Pass","Aggr","Bad"))[1]),round(c(rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1)),2)),
(c(as.character(Sys.time()),(sample(c("Pass","Aggr","Bad"))[1]),round(c(rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1)),2))))
test_table <<- rbind(apply(other_data, 2, rev),test_table)
as.data.frame(test_table)
})
output$logs <- renderTable({my_test_table()},include.rownames=FALSE)
})
runApp(list(ui = ui, server = server))