I have a code as follows and I want to add a Save button to points that are brushed. Many thanks in advance.
library(shiny)
ui <- basicPage(
plotOutput("plot1", brush = "plot_brush"),
verbatimTextOutput("info")
)
server <- function(input, output) {
x <- NULL
output$plot1 <- renderPlot({
plot(mtcars$wt, mtcars$mpg)
})
output$info <- renderPrint({
x <<- brushedPoints(mtcars, input$plot_brush, xvar = "wt", yvar = "mpg")
x
})
}
shinyApp(ui, server)
Add an actionButton when clicked saves the brushed dataframe. Also made output of brushedPoints as reactive so we can use it multiple times in the code.
library(shiny)
ui <- basicPage(
plotOutput("plot1", brush = "plot_brush"),
verbatimTextOutput("info"),
actionButton("save", "Save")
)
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(mtcars$wt, mtcars$mpg)
})
data <- reactive({
brushedPoints(mtcars, input$plot_brush, xvar = "wt", yvar = "mpg")
})
output$info <- renderPrint({data()})
observeEvent(input$save, {
write.csv(data(), 'brushed_data.csv', row.names = FALSE)
})
}
shinyApp(ui, server)
Related
I understand that I can use debounce with reactive() like this, and this is the sort of behaviour I need, but I want to use reactiveValues() instead.
ui <- fluidPage(
textInput(inputId = "text",
label = "To see how quickly..."),
textOutput(outputId = "text")
)
server <- function(input, output, session) {
text_input <- reactive({
input$text
})
debounce(text_input, 2000)
output$text <- renderText({
text_input()
})
}
shinyApp(ui, server)
}
But I would prefer to use reactiveValues() rather than reactive().
Is there any way to use debounce with reactiveValues()?
This does not work:
ui <- fluidPage(
textInput(inputId = "text",
label = "To see how quickly..."),
textOutput(outputId = "text")
)
server <- function(input, output, session) {
values <- reactiveValues()
observe({
values$text= function(x)input$text
values$t <-
debounce(values$text(),2000)
})
output$text <- renderText({
values$t()
})
}
shinyApp(ui, server)
I get an error Warning: Error in r: could not find function "r", I guess because values is not a reactive expression?
observe isn't needed:
library(shiny)
ui <- fluidPage(
textInput(inputId = "text", label = "To see how quickly..."),
textOutput(outputId = "text")
)
server <- function(input, output, session) {
values <- reactiveValues()
values$t <- debounce(reactive({input$text}), 2000)
output$text <- renderText({
values$t()
})
}
shinyApp(ui, server)
Or without reactiveValues:
library(shiny)
ui <- fluidPage(
textInput(inputId = "text", label = "To see how quickly..."),
textOutput(outputId = "text")
)
server <- function(input, output, session) {
debouncedText <- debounce(reactive({input$text}), 2000)
output$text <- renderText({
debouncedText()
})
}
shinyApp(ui, server)
I am working on an Interactive Shiny App. To display the next plot on a mouse click, I have to track the very previous value of a variable. But when I click on the plot All the variables reset. Can you please suggest me a way to stop a variable from resetting on every iteration.
For example:
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
actionButton("Reset", label="Reset Graph")
),
mainPanel(
plotOutput("graph", width = "100%", click = "plot_click"),
verbatimTextOutput("click_info")
)
)
)
)
server <- shinyServer(function(input, output, session) {
level <- "Value1"
observeEvent(input$Reset,{
output$graph <- renderPlot({ plot(1, 1) }) }, ignoreNULL = F)
print(level)
# interaction click in graph
observe({
if(is.null(input$plot_click$x)) return(NULL)
x <- sample(20:30,1,F)
level <- "Value2"
isolate({
output$graph <- renderPlot({
draw.single.venn(x)
})
})
})
})
shinyApp(ui=ui,server=server)
I have changed the level variable to "Value2". But on next iteration, it again turns to "Value1" due to the first line of code. Can you help me to remain it as "Value2"?
You can define it as a reactive value:
server <- shinyServer(function(input, output, session) {
level_init <- reactiveValues(level="Value1")
level_react <- reactive({
level_init$level <- "Value2"
})
print(isolate(level_init$level))
observeEvent(input$Reset,{
output$graph <- renderPlot({ plot(1, 1) }) }, ignoreNULL = F)
# interaction click in graph
observe({
if(is.null(input$plot_click$x)) return(NULL)
x <- sample(20:30,1,F)
level_react()
print(level_init$level)
isolate({
output$graph <- renderPlot({
draw.single.venn(x)
})
})
})
})
shinyApp(ui=ui,server=server)
I've been working with this post as a starting point.
Update handsontable by editing table and/or eventReactive
Very helpful, but I'm trying to extend it to specify the number of values in the table, then update a plot based on the table values after editing.
Here's what I have so far.
library(shiny)
library(rhandsontable)
library(colorSpec)
ui <- fluidPage(
numericInput("x", "number of values", 2),
rHandsontableOutput('table'),
textOutput('result'),
plotOutput('plot'),
actionButton("recalc", "generate new random vals and calculate")
)
server <- function(input,output,session)({
values <- reactiveValues(data=as.data.frame(runif(input$x)))
observe({
input$recalc
values$data <- as.data.frame(runif(input$x))
})
observe({
if(!is.null(input$table))
values$data <- hot_to_r(input$table)
})
output$table <- renderRHandsontable({
rhandsontable(values$data)
})
output$result <- renderText({
sum(values$data)
})
output$plot <- reactivePlot({
barplot(values$data)
})
})
shinyApp(ui = ui, server = server)
I get an error on the reactiveValues line because I'm trying to use input$x. The previous post had a hard coded value of 2.
I think you were almost there. You can, however, not use an input for creating a reactive value. But this is anyways not eneded and you can initiate it with a NULL.
library(shiny)
library(rhandsontable)
ui <- fluidPage(
numericInput("x", "number of values", 2),
rHandsontableOutput('table'),
textOutput('result'),
plotOutput('plot'),
actionButton("recalc", "generate new random vals and calculate")
)
server <- function(input,output,session)({
values <- reactiveValues(data = NULL) ## assign it with NULL
## button press resets now the data frame
observeEvent(input$recalc, {
values$data$x <- 0
})
## changes in numericInput sets all (!) new values
observe({
req(input$x)
values$data <- data.frame(x = runif(input$x))
})
observe({
if(!is.null(input$table))
values$data <- hot_to_r(input$table)
})
output$table <- renderRHandsontable({
req(values$data)
rhandsontable(values$data)
})
output$result <- renderText({
req(values$data)
sum(values$data)
})
output$plot <- renderPlot({
req(values$data)
barplot(values$data$x)
})
})
shinyApp(ui = ui, server = server)
You can use reactive() instead of reactiveValues to do this:
library(shiny)
library(rhandsontable)
library(colorSpec)
ui <- fluidPage(
numericInput("x", "number of values", 2),
rHandsontableOutput('table'),
textOutput('result')
)
server <- function(input,output,session)({
values <- reactive({
foo <- as.data.frame(runif(input$x))
colnames(foo) <- c("Col1")
return(foo)
})
output$table <- renderRHandsontable({
rhandsontable(values())
})
output$result <- renderText({
sum(values())
})
})
shinyApp(ui = ui, server = server)
Is there a way to take the DataTable output with its selection and use the ones highlighted as the reactive input for the plot?
ui <- basicPage(
plotOutput("plot1", click = "plot_click"),
dataTableOutput("table1"),
verbatimTextOutput("info")
)
server <- function(input, output) {
output$table1 <- renderDataTable(({mtcars}))
#figure out a way to reactively select points to point into output$plot1
output$plot1 <- renderPlot({
plot(mtcars$wt, mtcars$mpg)
})
output$info <- renderPrint({
# With base graphics, need to tell it what the x and y variables are.
nearPoints(mtcars, input$plot_click, xvar = "wt", yvar = "mpg")
# nearPoints() also works with hover and dblclick events
})
}
shinyApp(ui, server)
https://shiny.rstudio.com/articles/selecting-rows-of-data.html
https://shiny.rstudio.com/gallery/datatables-options.html
here is the solution to Your question:
library(shiny)
library(DT)
library(ggplot2)
ui <- basicPage(
plotOutput("plot1", click = "plot_click"),
dataTableOutput("table1"),
verbatimTextOutput("info")
)
server <- function(input, output) {
output$table1 <- DT::renderDataTable(mtcars)
#figure out a way to reactively select points to point into output$plot1
output$plot1 <- renderPlot({
s = input$table1_rows_selected
mtcars <- mtcars[ s,]
ggplot(mtcars, aes(mtcars$wt, mtcars$mpg)) + geom_point()
})
output$info <- renderPrint({
# With base graphics, need to tell it what the x and y variables are.
nearPoints(mtcars, input$plot_click, xvar = "wt", yvar = "mpg")
# nearPoints() also works with hover and dblclick events
})
}
shinyApp(ui, server)
I have used the special function from DT package called: input$table1_rows_selected, which selects the higlighted rows, then i further subset them from the dataset mtcars
I hope you can help me again as I stumbled over another problem in Shiny:
I would like a graphic to change in the moment it is clicked on. Here's a minimal example:
ui.R (shows a clickable graphic and a text frame)
shinyUI(fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
plotOutput("graph", width = "100%", click = "plot_click"),
verbatimTextOutput("click_info")
)
)
)
)
server.R (graphic just contains "A","B","C","D", on click I get the nearest letter in the text frame)
shinyServer(function(input, output, session) {
# Visualization output:
observe({
output$graph <- renderPlot({
data <- data.frame(x=c(1,2,1,2), y=c(1,1,2,2),
values=c("A","B","C","D"), stringsAsFactors=FALSE)
plot(data$x, data$y, pch=data$values)
})
})
# interaction click in graph
observe({
click <- c(input$plot_click$x, input$plot_click$y)
data <- data.frame(x=c(1,2,1,2), y=c(1,1,2,2),
values=c("A","B","C","D"), stringsAsFactors=FALSE)
nearest_point <- which.min(apply(data[,1:2], 1, function(a) sum(((click-a)^2))))
id <- data$values[nearest_point]
output$click_info <- renderPrint({
id
})
})
})
Now what I want is to mark the letter I clicked on in the graph, for example by another color. But all my tries failed so far.
Try this:
ui <- shinyUI(fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
plotOutput("graph", width = "100%", click = "plot_click"),
verbatimTextOutput("click_info")
)
)
)
)
server <- shinyServer(function(input, output, session) {
data <- data.frame(x=c(1,2,1,2), y=c(1,1,2,2),
values=c("A","B","C","D"), stringsAsFactors=FALSE)
# Visualization output:
observe({
output$graph <- renderPlot({
plot(data$x, data$y, pch=data$values)
})
})
# interaction click in graph
observe({
if(is.null(input$plot_click$x)) return(NULL)
click <- c(input$plot_click$x, input$plot_click$y)
print(click)
nearest_point <- which.min(apply(data[,1:2], 1, function(a) sum(((click-a)^2))))
id <- data$values[nearest_point]
output$click_info <- renderPrint({
id
})
color <- rep("black",length(data$x))
color[data$values==id] <- "red"
isolate({
output$graph <- renderPlot({
plot(data$x, data$y, pch=data$values, col=color)
})
})
})
})
shinyApp(ui=ui,server=server)
With ggplot2
Edited as per #bunks suggestions:
library(ggplot2)
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
plotOutput("graph", width = "100%", click = "plot_click"),
verbatimTextOutput("click_info")
)
)
))
server <- shinyServer(function(input, output, session) {
data <- data.frame(x=c(1,2,1,2),
y=c(1,1,2,2),
values=c("A","B","C","D"),
stringsAsFactors=FALSE,
color=rep("1",4))
makeReactiveBinding('data')
output$graph <- renderPlot({
ggplot(data=data,aes(x=x,y=y,label=values,color=color))+geom_text()+theme_classic()+guides(colour=FALSE)
})
observeEvent(input$plot_click, {
# Get 1 datapoint within 15 pixels of click, see ?nearPoints
np <- nearPoints(data, input$plot_click, maxpoints=1 , threshold = 15)
output$click_info <- renderPrint({np$values})
data$color <<- rep("1",length(data$x))
data$color[data$values==np$values] <<- "2"
})
})
shinyApp(ui=ui,server=server)