I was wondering if it is possible to use the value from a sliderInput() as label for a chart. I tried to build it using reactive() but instead of displaying the value as label is displays a bunch of text (see reproducible example as included below).
Any hints how to solve are much appreciated.
library(shiny)
PT <- c(0.5, 0.5)
label1 <- c(data, 5)
label2 <- c(0, 0)
ui <- fluidPage(
fluidRow(column(width=6, plotOutput("P1", width = "30vw")), column(width = 6, plotOutput("P2", width = "30vw"))),
sliderInput("S1", label = NULL, min = 0, max = 10, value = 5)
)
server <- function(input, output) {
data <- reactive({ c(input$S1) })
output$P1 <- renderPlot({
pie(PT, labels = label1, init.angle = 90)
})
output$P2 <- renderPlot({
pie(PT, labels = label2, init.angle = 90)
})
}
shinyApp(ui = ui, server = server)
Try this
output$P1 <- renderPlot({
label1 <- c(input$S1, 5)
pie(PT, labels = label1, init.angle = 90)
})
Related
I would like click-select points and group them based on color.
I can save selected points with color information into a new data frame and plot it, however I would like to keep track and see what was already selected on the interactive plot.
How can I show/label already selected points or make it permanent after "Add selection"?
library(shiny)
library(tidyverse)
library(DT)
library(colourpicker)
ui = fluidPage(
colourInput("col", "Select colour", "purple"),
actionButton("addToDT", "Add selection", icon = icon("plus")), hr(),
plotOutput("plot", click = "plot_click", dblclick = "plot_reset"),
DT::dataTableOutput('plot_DT'), hr(),
textOutput("clickcoord"),
DT::dataTableOutput('final_DT'),
plotOutput("plotSelected")
)
server = function(input, output, session) {
selectedPoint = reactiveVal(rep(FALSE, nrow(mtcars)))
output$clickcoord <- renderPrint({
print(input$plot_click)
})
observeEvent(input$plot_click, {
clicked = nearPoints(mtcars, input$plot_click, allRows = TRUE)$selected_
selectedPoint(clicked | selectedPoint())
})
observeEvent(input$plot_reset, {
selectedPoint(rep(FALSE, nrow(mtcars)))
})
output$plot_DT = DT::renderDataTable({
mtcars$sel = selectedPoint()
mtcars = dplyr::filter(mtcars, sel == TRUE) %>% mutate(group_color = input$col)
})
final_DT = reactiveValues()
final_DT$df = data.frame()
FinalData = eventReactive(input$addToDT, {
mtcars$sel = selectedPoint()
mtcars = dplyr::filter(mtcars, sel == TRUE) %>% mutate(group_color = input$col)
final_DT$df = bind_rows(final_DT$df, mtcars)
})
output$final_DT = renderDataTable({FinalData()})
output$plot = renderPlot({
mtcars$sel = selectedPoint()
ggplot(mtcars, aes(wt, mpg, color = mtcars$sel, fill=mpg)) +
geom_point(shape = 21, size = 6, stroke = 2) +
scale_color_manual(values = c("#ffffff00", input$col)) +
scale_fill_viridis_c() +
theme_bw()
})
output$plotSelected = renderPlot({
sel_df = FinalData()
ggplot(sel_df, aes(wt, mpg, fill = group_color, colour = group_color)) +
geom_point(shape = 21, size = 6, stroke = 2) +
scale_color_manual(values = unique(sel_df$group_color)) +
scale_fill_manual(values = unique(sel_df$group_color)) +
theme_bw()
})
observeEvent(input$addToDT, {
selectedPoint(rep(FALSE, nrow(mtcars)))
})
}
shinyApp(ui, server)
I think this is the "crux" of what your are looking for. I used a very similar example that I found in the help for entitled:
A demonstration of clicking, hovering, and brushing
(https://shiny.rstudio.com/reference/shiny/0.13.1/plotoutput)
It is very similar to your example.
I create a matrix of T/F elements where the rows are the observations and the columns are in which batch the observation is selected. So when you launch the whole matrix is False, but as you click on observations the switch to positive in the first column. Then if you click addSelection and continue you start switching the observations in the next column.
Could you confirm that this what you are looking for?
Below is the code.
shinyApp(
ui = basicPage(
fluidRow(
column(
width = 4,
plotOutput("plot",
height = 300,
click = "plot_click", # Equiv, to click=clickOpts(id='plot_click')
),
actionButton("addToDT", "Add selection", icon = icon("plus")), hr(),
h4("Clicked points"),
tableOutput("plot_clickedpoints"),
),
column(
width = 4,
verbatimTextOutput("counter"),
),
)
),
server = function(input, output, session) {
data <- reactive({
input$newplot
# Add a little noise to the cars data so the points move
cars + rnorm(nrow(cars))
})
output$plot <- renderPlot({
d <- data()
plot(d$speed, d$dist, main = paste("No of Sets Chosen", input$addToDT))
})
output$plot_clickinfo <- renderPrint({
cat("Click:
")
str(input$plot_click)
})
selectedPoints <- reactiveVal(rep(FALSE, nrow(cars)))
selectionMatrix <- reactiveVal(matrix(data = F, nrow = nrow(cars), ncol = 7))
observeEvent(input$plot_click, {
clicked <- nearPoints(data(), input$plot_click, "speed", "dist", allRows = TRUE)$selected
selectedPoints(clicked | selectedPoints())
tmp <- unlist(selectionMatrix())
tmp[, (input$addToDT + 1)] <- selectedPoints()
selectionMatrix(tmp)
})
observeEvent(input$addToDT, {
selectedPoints(rep(FALSE, nrow(cars)))
})
output$plot_clickedpoints <- renderTable({
# if (input$addToDT==0) {
res <- selectionMatrix()
return(res)
})
}
)
I want to make an animation in R Shiny where my scatter plot is progressively updated at each iteration, here is my current plot
library(shiny)
library(plotly)
ui <- fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
actionButton("launch", "Launch Simulation"),
radioButtons("display","Show every iteration", selected = 10,
choices = c(1,5,10,50),inline = FALSE),
numericInput("iter","Maximum number of iterations", value = 2000,
min = 500,max = 5000, step = 500)
),
mainPanel(
plotlyOutput('plot')
)
)
)
server <- function(input, output) {
rv <- reactiveValues(i = 0,
df = data.frame(x = -1,y = -1))
observeEvent(input$launch,{
rv$i = 0
rv$df = data.frame(x = runif(5000, min = -1,max = 1),
y = runif(5000, min = -1,max = 1))
})
observe({
isolate({
rv$i = rv$i + as.numeric(input$display)
})
if ((rv$i < input$iter)&input$launch){
invalidateLater(0)
}
})
output$plot <- renderPlotly({
df = data.frame(x = 0,y = -1)
df = rbind(df,rv$df)
plot_ly(df[1:(rv$i + 1),], x = ~x, y = ~y,
type = 'scatter', mode = 'markers',
marker = list(size = 4), hoverinfo="none") %>%
layout(showlegend = FALSE)
})
}
shinyApp(ui = ui, server = server)
The code is working fine at the beginning but after around 1000 iterations, the animation becomes very slow. I think the main problem is that because in my code, I have to re-make the plot all over again at each iteration, is there a smoother way to do what I want to do?
(Not necessarily with Plotly but it is important to me that I keep track of the number of the iterations outside of the plot (here rv$i))
I was wondering if I can get rows data using nearPoints() from an interactive graph with slider input. My app.R file looks like:
library('shiny')
library('ggplot2')
dt <-read.csv('file.csv')
ui <- fluidPage(
plotOutput("plot1", height = 550, click = "plot1_click"),
fluidRow(
column(3,
sliderInput("Obs", "Number of Books", min = 1, max = nrow(up), value = 50)
),
column(3, offset = 3,
h4("Legends"),
verbatimTextOutput("selected")
)
)
)
server <- function(input, output) {
mydata <- reactive({
dt[1:as.numeric(input$Obs),]
})
output$plot1 <- renderPlot({
test <- mydata()
ggplot(data = test, aes(x = test[,2], y = test[,1])) + geom_point()
})
output$selected <- renderPrint({
file <- mydata()
nearPoints(file, input$plot1_click, threshold = 10, maxpoints = 1,
addDist = FALSE)
})
}
shinyApp(ui = ui, server = server)
Shiny nearPoints() is working perfectly without this slider input. When I used slider input, I can't get the row data until max. Is there any approach to work with the slider input? Any help is appreciated.
The following code works for me. It seems nearPoints is not able to tell which columns of your dataset are displayed because of the aes(x = test[,2], y = test[,1]) statement. Another possible fix sould be to set the parameters xvar and yvar in nearPoints.
library('shiny')
library('ggplot2')
dt <-mtcars
ui <- fluidPage(
plotOutput("plot1", height = 550, click = "plot1_click"),
fluidRow(
column(3,
sliderInput("Obs", "Number of Cars", min = 1, max = nrow(dt), value = 50)
),
column(3, offset = 3,
h4("Legends"),
verbatimTextOutput("selected")
)
)
)
server <- function(input, output) {
mydata <- reactive({
dt[1:as.numeric(input$Obs),]
})
output$plot1 <- renderPlot({
test <- mydata()
ggplot(data = test, aes(mpg, wt)) + geom_point()
})
output$selected <- renderPrint({
file <- mydata()
nearPoints(file, input$plot1_click, threshold = 100, maxpoints = 1,
addDist = FALSE)
})
}
shinyApp(ui = ui, server = server)
Quick note: Please try to make the code in your question reproducible by using one of the default datasets in R. You can get a list of all available datasets by calling data().
I would like to preselect some points in a ggiraph::renderggiraph() output.
I can make the following shiny app which allows me to select points and then use those selected points elsewhere like so:
dat <- data.table(x = 1:6, y = 1:6 %% 3, id = 1:6, status = rep(c('on','off'),3))
ui <- fluidPage( ggiraphOutput("plot"),
verbatimTextOutput("choices"))
server <- function(input, output, session){
output$plot <- renderggiraph({
p <- ggplot(dat ) +
geom_point_interactive(aes(x = x, y = y, data_id = id), size = 5) +
scale_color_manual(limits = c('on','off'),values = c('red','black'))
ggiraph(code = print(p),
hover_css = "fill:red;cursor:pointer;",
selection_type = "multiple",
selected_css = "fill:red;")
})
output$choices <- renderPrint({
input$plot_selected
})
}
shinyApp(ui = ui, server = server)
But sometimes I want to have certain points selected before I initialize the app.
For example, if the points 1, 3, and 5 are already "on" orginally, I would like the user to be able to turn them "off".
So my question is, is it possible to achieve something like this?
Yes, by using session$sendCustomMessage in session$onFlushed:
library(shiny)
library(ggiraph)
library(data.table)
library(magrittr)
dat <- data.table(x = 1:6, y = 1:6 %% 3, id = 1:6, status = rep(c('on','off'),3))
ui <- fluidPage( fluidRow(
column(width = 7,
ggiraphOutput("ggobj") ),
column(width = 5, verbatimTextOutput("choices"))
) )
server <- function(input, output, session){
output$ggobj <- renderggiraph({
p <- ggplot(dat ) +
geom_point_interactive(aes(x = x, y = y, data_id = id), size = 5) +
scale_color_manual(limits = c('on','off'),values = c('red','black'))
ggiraph(code = print(p),
hover_css = "fill:red;cursor:pointer;",
selection_type = "multiple",
selected_css = "fill:red;")
})
session$onFlushed(function(){
session$sendCustomMessage(type = 'ggobj_set', message = 1:3)
})
output$choices <- renderPrint({
input$ggobj_selected
})
}
shinyApp(ui = ui, server = server)
I would really appreciate some help with the following code:
library(shiny)
library(rhandsontable)
library(tidyr)
dataa <- as.data.frame(cbind(rnorm(100, sd=2), rchisq(100, df = 0, ncp = 2.), rnorm(100)))
ldataa <- gather(dataa, key="variable", value = "value")
thresholds <- as.data.frame(cbind(1,1,1))
ui <- fluidPage(fluidRow(
plotOutput(outputId = "plot", click="plot_click")),
fluidRow(rHandsontableOutput("hot"))
)
server <- function(input, output) {
values <- reactiveValues(
df=thresholds
)
observeEvent(input$plot_click, {
values$trsh <- input$plot_click$x
})
observeEvent(input$hot_select, {
values$trsh <- 1
})
output$hot = renderRHandsontable({
rhandsontable(values$df, readOnly = F, selectCallback = TRUE)
})
output$plot <- renderPlot({
if (!is.null(input$hot_select)) {
x_val = colnames(dataa)[input$hot_select$select$c]
dens.plot <- ggplot(ldataa) +
geom_density(data=subset(ldataa,variable==x_val), aes(x=value), adjust=0.8) +
geom_rug(data=subset(ldataa,variable==x_val), aes(x=value)) +
geom_vline(xintercept = 1, linetype="longdash", alpha=0.3) +
geom_vline(xintercept = values$trsh)
dens.plot
}
})
}
shinyApp(ui = ui, server = server)
I have a plot and a handsontable object in the app.
Clicking on whichever cell loads a corresponding plot, with a threshold value. Clicking the plot changes the position of one of the vertical lines.
I would like to get the x value from clicking the plot into the corresponding cell, and I would like to be able to set the position of the vertical line by typing in a value in the cell too.
I'm currently a bit stuck with how I should feed back values into a reactiveValue dataframe.
Many thanks in advance.
This works as I imagined:
(The trick was to fill right columns of "df" with input$plot_click$x by indexing them with values$df[,input$hot_select$select$c].)
library(shiny)
library(rhandsontable)
library(tidyr)
dataa <- as.data.frame(cbind(rnorm(100, sd=2), rchisq(100, df = 0, ncp = 2.), rnorm(100)))
ldataa <- gather(dataa, key="variable", value = "value")
thresholds <- as.data.frame(cbind(1,1,1))
ui <- fluidPage(fluidRow(
plotOutput(outputId = "plot", click="plot_click")),
fluidRow(rHandsontableOutput("hot"))
)
server <- function(input, output) {
values <- reactiveValues(
df=thresholds
)
observeEvent(input$plot_click, {
values$df[,input$hot_select$select$c] <- input$plot_click$x
})
output$hot = renderRHandsontable({
rhandsontable(values$df, readOnly = F, selectCallback = TRUE)
})
output$plot <- renderPlot({
if (!is.null(input$hot_select)) {
x_val = colnames(dataa)[input$hot_select$select$c]
dens.plot <- ggplot(ldataa) +
geom_density(data=subset(ldataa,variable==x_val), aes(x=value), adjust=0.8) +
geom_rug(data=subset(ldataa,variable==x_val), aes(x=value)) +
geom_vline(xintercept = 1, linetype="longdash", alpha=0.3) +
geom_vline(xintercept = values$df[,input$hot_select$select$c])
dens.plot
}
})
}
shinyApp(ui = ui, server = server)
Update your reactiveValue dataframe from inside of an observeEvent, where you are watching for whichever event is useful, i.e. a click or something.
observeEvent(input$someInput{
values$df <- SOMECODE})