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?
Related
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 shiny which has tooltips which show the full text of a long string. I am able to show all this text in a manageable way using str_wrap function in the text argument field for the tooltip.
library(shiny)
library(tidyverse)
library(plotly)
library(stringi)
dat <- mtcars %>%
rownames_to_column(var = "model")
dat[["lorem"]] <- rep(stri_rand_lipsum(n_paragraphs = 1), 32)
ui <- fluidPage(
plotlyOutput("plot1")
)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
p1 <- dat %>%
ggplot(aes(x = wt, y = mpg,
text = str_wrap(lorem, width = 80))) +
geom_point()
ggplotly(p1, tooltip = "text")
})
}
shinyApp(ui, server)
However, I would like to also include some other labels, for instance model and mpg, with some custom styling (i.e. bolding the column titles), along the lines of:
Cany anyone provide a solution of how to do this - I know how to do it w/o the str_wrap function, but can't figure out how to accomplish this w/ it.
Try this:
library(shiny)
library(tidyverse)
library(plotly)
library(stringi)
dat <- mtcars %>%
rownames_to_column(var = "model")
dat[["lorem"]] <- rep(stri_rand_lipsum(n_paragraphs = 1), 32)
ui <- fluidPage(
plotlyOutput("plot1")
)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
p1 <- dat %>%
ggplot(aes(x = wt, y = mpg,
text = paste0("<b>Model:</b> ", model, "<br>",
"<b>MPG:</b> ", mpg, "<br>",
str_wrap(paste0("<b>Text:</b> ", lorem), width = 80)
))) +
geom_point()
ggplotly(p1, tooltip = "text")
})
}
shinyApp(ui, server)
I tried to calculate the average of pedal length (or width) within in each species and then plot it in bar graph using the shinny app. But the mean function in summarize keeps giving me issues.
library(datasets)
library(shiny)
library(dplyr)
library(ggplot2)
data("iris")
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Analyze Iris table"),
# Sidebar with a dropdown menu selection input for key meausre compoenent
sidebarLayout(
sidebarPanel(
selectInput("yInput", "Measuring element: ",
colnames(iris), selected = colnames(iris)[2]),
selectInput('xInput', 'Grouper: ',
colnames(iris), selected = colnames(iris)[5])
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("barPlot")
)
)
)
Define server logic required to draw a histogram
server <- function(input, output) {
by_xInput <- reactive({
iris %>%
group_by(input$xInput) %>%
summarize(n = length(input$xInput), mean_y = mean(input$yInput))
})
output$barPlot <- renderPlot({
# generate bins based on input$bins from ui.R
ggplot(data = by_xInput(), aes(x = input$xInput, y = mean_y)) +
geom_bar(stat = 'identity')
})
}
Run the application
shinyApp(ui = ui, server = server)
Here, it is a string element, so convert to symbol and evaluate (!!)
library(dplyr)
library(shiny)
library(ggplot2)
server <- function(input, output) {
by_xInput <- reactive({
iris %>%
group_by_at(input$xInput) %>%
# n() can replace the length
# convert string to symbol and evaluate (!!)
summarize(n = n(), mean_y = mean(!! rlang::sym(input$yInput)))
})
output$barPlot <- renderPlot({
# as the input is a string, use `aes_string`
ggplot(data = by_xInput(), aes_string(x = input$xInput, y = "mean_y")) +
geom_bar(stat = 'identity')
})
}
-testing
shinyApp(ui = ui, server = server)
-output
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)
Using R Shiny and plotly I created a interactive scatter plot.
How can I modify my code to interactively label only the points which were selected by the user?
Example plot
Thank you so much for your help!
All the best,
Christian
library(plotly)
library(shiny)
library(dplyr)
data <- data.frame(matrix(runif(500,0,1000), ncol = 2, nrow = 100)) %>%
mutate(ID = row_number())
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("hover"),
verbatimTextOutput("click"),
verbatimTextOutput("brush"),
verbatimTextOutput("zoom"))
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- ggplot(data, aes(x = X1, y = X2, key = ID)) +
geom_point()
ggplotly(p) %>% layout(dragmode = "select")
})
}
shinyApp(ui, server)
Below is a possible solution. I use a reactive function to "label" selected points. I wasn't sure how exactly you want to display the IDs for selected points. The code adds the ID as text when a point is selected. Also, I add some jitter to move the IDs away from the points.
library(plotly)
library(shiny)
library(dplyr)
data <- data.frame(matrix(runif(500,0,1000), ncol = 2, nrow = 100)) %>%
mutate(ID = row_number())
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("hover"),
verbatimTextOutput("click"),
verbatimTextOutput("brush"),
verbatimTextOutput("zoom"))
server <- function(input, output, session) {
output$plot <- renderPlotly({
data <- get_data()
p <- ggplot(data, aes(x = X1, y = X2, key = ID)) +
geom_point() + geom_text(data=subset(data, show_id),aes(X1,X2,label=ID), position = position_jitter(width = 20,height = 20))
ggplotly(p, source = "subset") %>% layout(dragmode = "select")
})
get_data <- reactive({
event.data <- event_data("plotly_selected", source = "subset")
data <- data %>% mutate(show_id = FALSE)
if (!is.null(event.data)) {
data$show_id[event.data$pointNumber + 1] <- TRUE
}
data
})
}
shinyApp(ui, server)