Shiny nearPoints() with slider input - r

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().

Related

edit a reactive database

Trying to edit a reactive database so that updates to the database are reflected in the output.
Have tried numerous variants, but none are working, general idea is shown - where I would like to have the figure update with changes to the database.
library(tidyverse)
library(shiny)
library(DT)
# Define UI for application that draws a histogram
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("ages", "Max age:", 10, 100, 15),
sliderInput("nsamp",
"Sample size:",
min = 10,
max = 1000,
value = 100)),
mainPanel(dt_output('Sample sizes and weighting', 'x1'),
plotOutput("fig"))
)
)
server <- function(input, output) {
x = reactive({
df = data.frame(age = 1:input$ages,
samples = input$nsamp,
weighting = 1)
})
output$x1 = renderDT(x(),
selection = 'none',
editable = TRUE,
server = TRUE,
rownames = FALSE)
output$fig = renderPlot({
ggplot(x(), aes(age, samples)) +
geom_line() +
geom_point()
})
}
shinyApp(ui = ui, server = server)
We can use input$x1_cell_edit and reactiveValues to modify the data that is passed to the plot.
Note the use of isolate inside renderDT, that is to prevent the table from re-rendering when db$database is modified.
library(tidyverse)
library(shiny)
library(DT)
# Define UI for application that draws a histogram
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("ages", "Max age:", 10, 100, 15),
sliderInput("nsamp",
"Sample size:",
min = 10,
max = 1000,
value = 100
)
),
mainPanel(
dataTableOutput("x1"),
plotOutput("fig")
)
)
)
server <- function(input, output) {
# all the data will be stored in this two objects
db <- reactiveValues(database = NULL)
# to store the modified values
edited_vals <- reactiveVal(tibble(row = numeric(), col = numeric(), value = numeric()))
# create a new table each time the sliders are changed
observeEvent(c(input$ages, input$nsamp), {
df <- data.frame(
age = 1:input$ages,
samples = input$nsamp,
weighting = 1
)
db$database <- df
})
observeEvent(input$x1_cell_edit, {
db$database[as.numeric(input$x1_cell_edit$row), as.numeric(input$x1_cell_edit$col + 1)] <- as.numeric(input$x1_cell_edit$value)
})
output$x1 <- renderDT(
{
input$ages
input$nsamp
datatable(
isolate(db$database),
selection = "none",
editable = TRUE,
rownames = FALSE,
options = list(stateSave = TRUE)
)
},
server = TRUE
)
output$fig <- renderPlot({
ggplot(db$database, aes(as.numeric(age), as.numeric(samples))) +
geom_point() +
geom_line()
})
}
shinyApp(ui = ui, server = server)

Unsupported index type: NULL --> plotly chart in shiny

I am getting an error with the plotting index using plotly in conjunction with reactive values in shiny. The sidebar panel loads with no issues but there is a problem displaying the chart that I cannot determine. Any help solving the index problem would be much appreciated. Thanks!
library(shiny)
library(plotly)
data(economics, package = "ggplot2")
nms <- names(economics)
ui <- fluidPage(
headerPanel("TEST"),
sidebarPanel(
selectInput('x', 'X', choices = nms, selected = nms[[1]]),
selectInput('y', 'Y', choices = nms, selected = nms[[2]]),
sliderInput('plotHeight', 'Height of plot (in pixels)',
min = 100, max = 2000, value = 1000)
),
mainPanel(
plotlyOutput('trendPlot', height = "900px")
)
)
server <- function(input, output) {
#add reactive data information. Dataset = built in diamonds data
dataset <- reactive({economics[, c(input$xcol, input$ycol)]
})
output$trendPlot <- renderPlotly({
# build graph with ggplot syntax
p <- ggplot(dataset(), aes_string(x = input$x, y = input$y)) +
geom_line()
ggplotly(p) %>%
layout(height = input$plotHeight, autosize=TRUE)
})
}
shinyApp(ui, server)
Warning: Error in : Unsupported index type: NULL
You have mistakenly used xcol and ycol not sure why. Without those names the code works fine.
library(shiny)
library(plotly)
library(tidyverse)
data(economics, package = "ggplot2")
nms <- names(economics)
ui <- fluidPage(
headerPanel("TEST"),
sidebarPanel(
selectInput('x', 'X', choices = nms, selected = nms[[1]]),
selectInput('y', 'Y', choices = nms, selected = nms[[2]]),
sliderInput('plotHeight', 'Height of plot (in pixels)',
min = 100, max = 2000, value = 1000)
),
mainPanel(
plotlyOutput('trendPlot', height = "900px")
)
)
server <- function(input, output) {
#add reactive data information. Dataset = built in diamonds data
dataset <- reactive({
economics[, c(input$x, input$y)]
})
output$trendPlot <- renderPlotly({
# build graph with ggplot syntax
p <- ggplot(dataset(), aes_string(input$x, input$y)) +
geom_line()
ggplotly(p, height = input$plotHeight)
})
}
shinyApp(ui, server)

Shiny slider input to read rows from csv file

I am new to R and Shiny package. I have a csv file with 4 col and 600 rows and I am trying to plot some graphs using ggplot2.
My ui and server codes are like:
dt<-read.csv('file.csv')
server <- function(input, output) {
output$aPlot <- renderPlot({
ggplot(data = dt, aes(x = Col1, y = Col2, group = 'Col3', color = 'Col4')) + geom_point()
})
}
ui <- fluidPage(sidebarLayout(
sidebarPanel(
sliderInput("Obs", "Log FC", min = 1, max = 600, value = 100)
),
mainPanel(plotOutput("aPlot")) ))
Here, I can get the ggplot output but I don't know how to use this slider input to control the number of rows to be read i.e., I want this "Obs" input to define the size of Col1 to be used in the graph.
Try something like this, example here is with mtcars dataset:
library(shiny)
library(ggplot2)
dt <- mtcars[,1:4]
ui <- fluidPage(
sidebarPanel(
sliderInput("Obs", "Log FC", min = 1, max = nrow(dt), value = nrow(dt)-10)
),
mainPanel(plotOutput("aPlot"))
)
server <- function(input, output) {
mydata <- reactive({
dt[1:as.numeric(input$Obs),]
})
output$aPlot <- renderPlot({
test <- mydata()
ggplot(data = test, aes(x = test[,1], y = test[,2], group = names(test)[3], color = names(test)[4])) + geom_point()
})
}
shinyApp(ui = ui, server = server)
Change your server to:
server <- function(input, output) {
observe({
dt_plot <- dt[1:input$Obs,]
output$aPlot <- renderPlot({
ggplot(data = dt_plot, aes(x = Col1, y = Col2, group = 'Col3', color = 'Col4')) + geom_point()
})
})
}

Object not found if created from isolate() function in Shiny

I am working on a Shiny application in which there are two slider inputs. These inputted values subset a data frame differently, and the subset of that data frame is then plotted into a scatterplot.
I am trying to prevent the scatterplot from being replotted unless the user clicks a "Go!" button. To try to achieve this, I am using the isolate() function on the slider input values, so that the data frame and plot are only updated when the "Go!" button is changed.
This seems to be working okay, but I am also trying to allow the user to use the selection tool in Plotly and see the data frame rows that correspond to that selection. However, when I attempt to do so, I receive an error ("Error: object 'datInput' not found"). This line is commented in the example below:
library(shiny)
library(plotly)
ui <- shinyUI(pageWithSidebar(
headerPanel("Click the button"),
sidebarPanel(
sliderInput("val1", "Value 1:", min = 0, max = 1, value=0.5, step=0.1),
sliderInput("val2", "Value 2:", min = 0, max = 1, value=0.5, step=0.1),
actionButton("goButton", "Go!")
),
mainPanel(
plotlyOutput("plot1"),
verbatimTextOutput("click")
)
))
server <- shinyServer(function(input, output) {
set.seed(1)
dat <- data.frame(Case = paste0("case",1:15), val1=runif(15,0,1), val2=runif(15,0,1))
dat$Case <- as.character(dat$Case)
xMax = max(dat$val1)
xMin = min(dat$val1)
yMax = max(dat$val2)
yMin = min(dat$val2)
maxTemp = max(abs(xMax), abs(xMin))
observeEvent(input$goButton,
output$plot1 <- renderPlotly({
# Use isolate() to avoid dependency on input$val1 and input$val2
datInput <- isolate(subset(dat, val1 > input$val1 & val2 > input$val2))
p <- qplot(datInput$val1, datInput$val2) +xlim(0, ceiling(maxTemp)) +ylim(0,1)
ggplotly(p)
})
)
d <- reactive(event_data("plotly_selected"))
output$click <- renderPrint({
if (is.null(d())){
"Click on a state to view event data"
}
else{
#str(d()$pointNumber) #Seems to be working
datInput[d()$pointNumber,] #Error: object 'datInput' not found
}
})
})
shinyApp(ui, server)
Any ideas for a workaround for this issue would be appreciated!
EDIT:
Here is the solution as per #mlegge. I simply added the output after the user selects certain points:
library(shiny)
library(plotly)
ui <- shinyUI(pageWithSidebar(
headerPanel("Click the button"),
sidebarPanel(
sliderInput("val1", "Value 1:", min = 0, max = 1, value=0.5, step=0.1),
sliderInput("val2", "Value 2:", min = 0, max = 1, value=0.5, step=0.1),
actionButton("goButton", "Go!")
),
mainPanel(
plotlyOutput("plot1"),
verbatimTextOutput("click")
)
))
set.seed(1)
dat <- data.frame(Case = paste0("case",1:15), val1=runif(15,0,1), val2=runif(15,0,1))
dat$Case <- as.character(dat$Case)
xMax = max(dat$val1)
xMin = min(dat$val1)
yMax = max(dat$val2)
yMin = min(dat$val2)
maxTemp = max(abs(xMax), abs(xMin))
server <- shinyServer(function(input, output) {
# datInput only validated once the go button is clicked
datInput <- eventReactive(input$goButton, {
subset(dat, val1 > input$val1 & val2 > input$val2)
})
output$plot1 <- renderPlotly({
# will wait to render until datInput is validated
plot_dat <- datInput()
p <- qplot(plot_dat$val1, plot_dat$val2) + xlim(0, ceiling(maxTemp)) +ylim(0,1)
ggplotly(p)
})
d <- reactive(event_data("plotly_selected"))
output$click <- renderPrint({
if (is.null(d())){
"Click on a state to view event data"
}
else{
#str(d()$pointNumber)
datInput()[d()$pointNumber+1,] #Working now
}
})
})
shinyApp(ui, server)
You are not using isolate properly, a better solution is an eventReactive:
library(shiny)
library(plotly)
ui <- shinyUI(pageWithSidebar(
headerPanel("Click the button"),
sidebarPanel(
sliderInput("val1", "Value 1:", min = 0, max = 1, value=0.5, step=0.1),
sliderInput("val2", "Value 2:", min = 0, max = 1, value=0.5, step=0.1),
actionButton("goButton", "Go!")
),
mainPanel(
plotlyOutput("plot1")
)
))
set.seed(1)
dat <- data.frame(Case = paste0("case",1:15), val1=runif(15,0,1), val2=runif(15,0,1))
dat$Case <- as.character(dat$Case)
xMax = max(dat$val1)
xMin = min(dat$val1)
yMax = max(dat$val2)
yMin = min(dat$val2)
maxTemp = max(abs(xMax), abs(xMin))
server <- shinyServer(function(input, output) {
# datInput only validated once the go button is clicked
datInput <- eventReactive(input$goButton, {
subset(dat, val1 > input$val1 & val2 > input$val2)
})
output$plot1 <- renderPlotly({
# will wait to render until datInput is validated
plot_dat <- datInput()
p <- qplot(plot_dat$val1, plot_dat$val2) + xlim(0, ceiling(maxTemp)) +ylim(0,1)
ggplotly(p)
})
})
shinyApp(ui, server)
You'll notice that your data generation has been moved outside the server, this is because it only needs to be run once.
You also should never wrap an output object in an observer, instead control the input data with reactives.

how to delete warnings in reactive inputs in shiny

Could anyone can tell me why I get an error when I change a dataset in first selectInput widget? When I change a dataset from diamonds to mtcars I get an error Could not find 'carat' in input$bins and in the plot just for one second and after that everything works fine. Why it happened?
library(shiny)
library(ggplot2)
data(diamonds)
data(mtcars)
ui <- fluidPage(
column(3,
selectInput("data", "", choices = c('mtcars', 'diamonds')),
uiOutput('server_cols'),
uiOutput('server_bins')
),
column(9,
plotOutput("plot")
)
)
server <- function(input, output) {
data <- reactive({
switch(input$data,
diamonds = diamonds,
mtcars = mtcars)
})
output$server_cols <- renderUI({
data <- data()
nam <- colnames(data)
selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))])
})
output$server_bins <- renderUI({
if (!is.null(input$cols)) {
df <- data()
x <- eval(input$cols)
max_value <- max(df[,x])
sliderInput('bins','Choose number of bins:', min = 0.1,
max = max_value,
value = max_value/2)
}
})
output$plot <- renderPlot({
if (!is.null(input$cols) & !is.null(input$bins)) {
basicData <- data()
var <- eval(input$cols)
ggplot(basicData, aes_string(var)) +
geom_histogram(binwidth = input$bins, color = 'white', fill = 'red')
}
})
}
shinyApp(ui, server)
Your respective output objects respond to any changes of your input variables. Thus, when you change your dataset via input$data, the plot rebuilds itself, although input$cols did not yet adjust. Actually, try inserting some print("a") inside the output$plot to see that it is called up to three times if you change input$data.
The fix is to rethink your reaction logic and let your elements respond only to specific changes, to get some kind of response "thread".
For example, input$data should only trigger output$server_cols. And output$server_bins should only be triggered by input$cols (because this already implies that input$data changed earlier). Ultimately, output$plot just has to listen to changes of input$bins (because changes in input$cols and input$data always result in changes of input$bins since it is at the end of the thread).
Here is my suggestion using isolate.
library(shiny)
library(ggplot2)
data(diamonds)
data(mtcars)
ui <- fluidPage(
column(3,
selectInput("data", "", choices = c('mtcars', 'diamonds')),
uiOutput('server_cols'),
uiOutput('server_bins')
),
column(9,
plotOutput("plot")
)
)
server <- function(input, output) {
data <- reactive({
switch(input$data, diamonds = diamonds, mtcars = mtcars)
})
output$server_cols <- renderUI({
data <- data()
nam <- colnames(data)
selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))])
})
output$server_bins <- renderUI({
if (!is.null(input$cols)) {
df <- isolate(data())
x <- eval(input$cols)
max_value <- max(df[,x])
sliderInput('bins','Choose number of bins:', min = 0.1, max = max_value, value = max_value/2)
}
})
output$plot <- renderPlot({
if (!is.null(isolate(input$cols)) & !is.null(input$bins)) {
basicData <- isolate(data())
var <- eval(isolate(input$cols))
ggplot(basicData, aes_string(var)) +
geom_histogram(binwidth = input$bins, color = 'white', fill = 'red')
}
})
}
shinyApp(ui, server)
You might also want to look into updateSelectInput and updateSliderInput if you want to alter Input Elements depending on other input.

Resources