I have a dynamic condition where I need to create fluidrows dynamically
cname <- c("A","B")
lapply(cname, function(name){paste0("column(6,",paste0("plotlyOutput(","'",name,"'","))"))})
[[1]]
[1] "column(6,plotlyOutput('A'))"
[[2]]
[1] "column(6,plotlyOutput('B'))"
Expected output
I need to incorporate Fluidrows here created as the beginning
fluidRow(column(6,plotlyOutput("A")),
column(6,plotlyOutput("B")))
Perhaps you are looking for purrr::exec paired with !!! operator to splice a list as arguments.
Example app:
library(shiny)
library(plotly)
library(tidyverse)
cname <- c("A", "B")
plotly_outputs <- map(cname, ~ column(width = 6, plotlyOutput(outputId = .)))
library(shiny)
ui <- fluidPage(
exec("fluidPage", !!!plotly_outputs)
)
server <- function(input, output, session) {
walk(cname, ~ {
output[[.]] <<- renderPlotly({
plt <- mtcars %>% ggplot(aes(x = mpg, y = hp)) +
geom_point()
ggplotly(plt)
})
})
}
shinyApp(ui, server)
Related
Bellow is my code:
library(shiny)
library(shiny.fluent)
library(highcharter)
library(shiny.semantic)
library(tidyverse)
ui <- fluidPage(
radioButtons('btn',label = 'Choice',choices = names(mtcars)),
renderPlot('plot')
)
server <- function(input, output, session) {
output$plot <- renderPlot({
mtcars %>% select(cyl, input$btn) %>%
ggplot() + geom_col(aes(x = cyl, y = input$btn, group = cyl))
})
}
shinyApp(ui, server)
Why input$btnis not selecting my dataframe and create my plot?
To avoid multiple lines with basically the same code, i want to map over multiple (two in this case) vectors to render multiple (two in this case) plots with my custom plot function.
What am i missing with my code?
library(shiny)
library(ggplot2)
if (interactive()) {
options(device.ask.default = FALSE)
ui = fluidPage(
plotOutput(outputId = "plotOne"),
plotOutput(outputId = "plotTwo"))
server = function(input, output, session){
###define dataset filter vector
vars = c("virginica", "setosa")
###define outputId vector
outputIds = c("plotOne", "plotTwo")
###define plotting function
plot_function = function(vars, outputIds){
output$outputIds = renderPlot({
iris %>%
filter(Species == vars) %>%
ggplot(aes(x = Sepal.Length)) +
geom_histogram()
})
}
map2(.x = vars, .y = outputIds, .f = plot_function)
}
shinyApp(ui, server)
}
Instead of creating multiple ggplot's why not use facets here?
library(shiny)
library(ggplot2)
ui = fluidPage(
plotOutput(outputId = "plot"),
)
server = function(input, output, session){
###define dataset filter vector
vars = c("virginica", "setosa")
output$plot = renderPlot({
iris %>%
filter(Species %in% vars) %>%
ggplot(aes(x = Sepal.Length)) +
geom_histogram() +
facet_wrap(~Species)
})
}
shinyApp(ui, server)
I have a bar graph which is part of a shiny app. I have created it with plotly. I would like the user to be able to select a part of the graph (click) and on clicking a datatable would show all rows corresponding to the values given in the hover text from that part of the chart.
So far I am able to show the output from event.data which isnt very interesting. How can I show the relevant rows from the original table?
library(plotly)
library(shiny)
ui <- fluidPage(
uiOutput("ChooserDropdown"),
plotlyOutput("plot2"),
DT::dataTableOutput("tblpolypDetail2")
)
server <- function(input, output, session) {
output$plot2 <- renderPlotly({
# use the key aesthetic/argument to help uniquely identify selected observations
#key <- row.names(mtcars)
browser()
p <- ggplot(iris,aes_string(iris$Species,input$Chooser)) + geom_col()
ggplotly(p,source = "subset") %>% layout(dragmode = "select")
})
output$tblpolypDetail2 <- renderDataTable({
event.data <- event_data("plotly_click", source = "subset")
print(event.data)
})
output$ChooserDropdown<-renderUI({
selectInput("Chooser", label = h4("Choose the endoscopic documentation column"),
choices = colnames(iris) ,selected = 1
)
})
}
shinyApp(ui, server)
I created a small demo where you can highlight rows in datatable by clicking the plotly graph.
You need to do it in two steps:
Map pointNumber of a click to rows in datatable(), you can create an external table for it.
You need to create a dataTableProxy where you can update a datatable
library(plotly)
library(DT)
library(shiny)
library(dplyr)
data <- as_tibble(iris) %>%
group_by(Species) %>%
summarise(avg = mean(Sepal.Width)) %>%
mutate(Species = as.character(Species))
species_mapping <- data.frame(
Species = data$Species,
row_id = 1:length(data$Species),
stringsAsFactors = FALSE
)
ui <- fluidPage(
DT::dataTableOutput("table"),
plotlyOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- data %>%
ggplot() +
geom_col(aes(x = Species, y = avg))
# register this plotly object
plotly_object <- ggplotly(p,source = "source1")
event_register(plotly_object,event = "plotly_click")
plotly_object
})
output$table <- DT::renderDataTable(data)
# create a proxy where we can update datatable
proxy <- DT::dataTableProxy("table")
observe({
s <- event_data("plotly_click",source = "source1")
req(!is.null(s))
# map point number to Species
row_clicked <- species_mapping[s$pointNumber + 1,"row_id"]
proxy %>%
selectRows(NULL) %>%
selectRows(row_clicked)
})
}
shinyApp(ui, server)
I built the shiny app below that updates the line graph based on the user's input. It works fine until I try to generate a 2nd output. How can I display the value total.weight calculated in the renderPlot() function? It seems to me my data set df and the variable total.weight should be created "outside" of the renderPlot() function but I have not figured out how.
ui.r
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("Reproducible Example"),
# Sidebar with a slider input for the number of bins
sidebarLayout(
sidebarPanel(
selectInput("ID", "group", c("A", "B"))
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("plot1"),
verbatimTextOutput("text1")
)
)
))
server.r
library(shiny)
library(ggplot2)
shinyServer(function(input, output) {
output$plot1 <- renderPlot({
years <- c(1:10)
weight <- c(5,7,9,11,12,17,19,20,21,22)
group <- c(rep("A",5), rep("B",5))
df <- data.frame(years,weight,group)
df <- subset(df, group == input$ID)
total.weight <- sum(df$weight)
#Plot
ggplot(data=df, aes(x=df$years, y=df$weight)) +
geom_line() +
geom_point()
})
output$text1 <- renderText({total.weight})
})
Output snapshot:
You can also create reactives:
server.R
library(shiny)
library(ggplot2)
shinyServer(function(input, output) {
df <- reactive({
years <- c(1:10)
weight <- c(5,7,9,11,12,17,19,20,21,22)
group <- c(rep("A",5), rep("B",5))
df <- data.frame(years,weight,group)
df <- subset(df, group == input$ID)
})
total.weight <- reactive({
sum(df()$weight)
})
output$plot1 <- renderPlot({
#Plot
ggplot(data=df(), aes(x=years, y=weight)) +
geom_line() +
geom_point()
})
output$text1 <- renderText({total.weight()})
})
The quick workaround is to put the total weight in a global varaiable:
total.weight <<- sum(df$weight)
The nice way to do it is to subset your data.frame within a reactive function:
shinyServer(function(input, output) {
years <- c(1:10)
weight <- c(5,7,9,11,12,17,19,20,21,22)
group <- c(rep("A",5), rep("B",5))
df <- data.frame(years,weight,group)
reactive_df <- reactive(subset(df, group == input$ID))
output$plot1 <- renderPlot({
ggplot(data=reactive_df(), aes(x=years, y=weight)) +
geom_line() +
geom_point()
})
output$text1 <- renderText({sum(reactive_df()$weight)})
})
I am having issues displaying ggplot (or any form of charts like hist()). I have tried looking through Stack Overflow but the solutions provided were not useful for this instance. I have not been able to display any of the graphs successfully.
I am using R studio with 3.2.0 build, deploying on Shinyapps.io and viewing via Chrome. I am able to display the graph within R but unable to display it when running with shiny.
Is this a code issue or something I had missed out from my packages? (Note: I have reduced my code trying to troubleshoot, so the variables from ui.R are not used in server.R.)
ui.R
library(shiny)
library(ggplot2)
dataset <- diamonds
diamondcolours <- unique( dataset["color"], incomparables = FALSE)
diamondcolours <- lapply(diamondcolours, as.character)
diamondcuts <- unique( dataset["cut"], incomparables = FALSE)
diamondcuts <- lapply(diamondcuts, as.character)
diamondclarity <- unique( dataset["clarity"], incomparables = FALSE)
diamondclarity <- lapply(diamondclarity, as.character)
carat <- dataset["carat"]
mincarat <- min(carat[ carat != min(carat) ])
# mincarat
maxcarat <- max(carat[ carat != max(carat) ])
# maxcarat
fluidPage(
titlePanel("Diamonds"),
sidebarPanel(
sliderInput('carat', 'Carat', min=mincarat, max=maxcarat,
value=mincarat, step=0.01, round=0),
selectInput('cut', 'Cut', diamondcuts$cut),
selectInput('color', 'Color', diamondcolours$color),
selectInput('clarity', 'Clarity', diamondclarity$clarity)
),
mainPanel(
plotOutput(outputId = 'mainplot')
)
)
server.R
library(shiny)
library(ggplot2)
dataset <- diamonds()
shinyServer(function(input, output, session) {
values <- reactiveValues()
testset <- dataset[ which(dataset$color == values$dcolor & dataset$carat > values$dcarat & dataset$clarity == values$dclarity & dataset$cut== values$dcut ), ]
output$mainplot <- renderPlot({
p <- ggplot(dataset[dataset$price <= 326,], aes(x = carat, y = color))
p <- p + geom_point()
print(p)
} )
Some of the more important problems: (1) data should be reactive to user input, (2) the variable names referring to input are incorrect, (3) all of the code in UI should be in server or, if it's not meant to be reactive, in the global environment. Here is a simplified version that runs,
library(shiny)
library(ggplot2)
dataset(diamonds)
## ** From UI: variables defined here can be seen in the whole app
mincarat <- min(diamonds$carat)
maxcarat <- max(diamonds$carat)
shinyApp(
shinyUI(
fluidPage(
titlePanel("Diamonds"),
sidebarPanel(
sliderInput('dcarat', 'Carat', min=mincarat, max=maxcarat,
value=mincarat, step=0.01, round=0),
selectInput('dcut', 'Cut', levels(diamonds$cut)),
selectInput('dcolor', 'Color', levels(diamonds$color)),
selectInput('dclarity', 'Clarity', levels(diamonds$clarity))
),
mainPanel(
plotOutput('mainplot')
)
)
),
shinyServer(function(input, output) {
## values <- reactiveValues() # unused
## Your data should be reactive - and reference `input`
## to get user-entered values
rxData <- reactive({
dat <- with(diamonds,
diamonds[color == input$dcolor &
carat > input$dcarat &
clarity == input$dclarity &
cut == input$dcut, ])
dat
})
output$mainplot <- renderPlot({
dataset <- rxData() # this is the subsetted data
p <- ggplot(dataset, aes(x = carat, y = price))
p <- p + geom_point()
print(p)
})
})
)
There are number of errors in that code:
You are missing to brackets at the end of the server.R
You are not reading your data correctly
Amended file:
library(shiny)
library(ggplot2)
shinyServer(function(input, output, session) {
data("diamonds")
dataset <- diamonds
rm(diamonds)
values <- reactiveValues()
testset <- dataset[ which(dataset$color == values$dcolor & dataset$carat > values$dcarat & dataset$clarity == values$dclarity & dataset$cut== values$dcut ), ]
output$mainplot <- renderPlot({
p <- ggplot(dataset[dataset$price <= 326,], aes(x = carat, y = color))
p <- p + geom_point()
print(p)
})
})
The ui.R is also wrong. You should put that stuff at the beginning in global.R as per guidelines on scoping rules in Shiny.