Drawing from the question select a variable from drop-down and pass it as an argument in reactivePlot in R Shiny
and #Jdbaba answer, I was wondering if it was possible to control the name of variables we want to display.
In #Jdbaba example, he uses
dataset <- diamonds
...
selectInput('x','X',names(dataset))
I would like to know if I could pass my own variable names
like this for example
newnames = paste('abc', 1:10)
....
selectInput('x','X', list( newnames = names(dataset)) )
Any thoughts ?
server.R
library(shiny)
library(ggplot2)
newnames = paste('abc', 1:10)
## Define UI for miles per gallon application
dataset <- diamonds
title <- "Diamonds
data Analysis"
## Define UI for application that plots random distributions
shinyUI(pageWithSidebar(
headerPanel(title),
sidebarPanel (
sliderInput('sampleSize','Sample Size', min=1, max=nrow(dataset),
value=min(1000,nrow(dataset)),
step=500,
round=0),
#################
# Question here
#################
selectInput('x','X', list( newnames = names(dataset)) ),
selectInput('y','Y', names(dataset), names(dataset)[[2]]),
selectInput('color','Color',c('None',names(dataset))),
selectInput('shape','Shape',c('None',names(dataset))),
checkboxInput('jitter','Jitter'),
checkboxInput('smooth','Smooth'),
selectInput('facet_col','Facet Column',
c(None='.',names(dataset))),
selectInput('facet_row','Facet Row',
c(None='.',names(dataset)))
),
## Show a plot of the generated distribution
mainPanel(plotOutput('plot',height="700px"))
)
)
ui.R
library(shiny)
library(ggplot2)
## Define server logic required to generate and plot a random distribution
shinyServer(function(input,output) {
dataset <- reactive(function(){
diamonds[sample(nrow(diamonds),input$sampleSize),]
})
output$plot <- renderPlot(function(){
p <- ggplot(dataset(),aes_string(x=input$x, y=input$y))+geom_point()
if(input$color != 'None')
p <- p + aes_string(color=input$color)
if (input$shape != 'None')
p <- p + aes_string(shape=input$shape)
facets <- paste(input$facet_row, '~', input$facet_col)
if (facets != '. ~ .')
p <- p + facet_grid(facets)
if (input$jitter)
p <- p + geom_jitter()
if (input$smooth)
p <- p + geom_smooth()
print(p)
})
})
You can pass a named list to selectInput, the names rather than the values will then be displayed (see ?selectInput)
In your case you could do, to create the named list:
newnames = paste('abc', 1:10)
axis_choices <- names(dataset)
names(axis_choices) <- newnames
and to pass it to the first selectInput:
selectInput('x','X', axis_choices )
Related
I have the following App:
The objective is to:
Add new points to the plot when the user clicks on it.
These are updated in the table (where you can remove points also)
(Where the App fails): Plot the linear regression and spline regression based on the new users updated data.
When I comment-out the lines
#geom_line(aes(x=x, y=fitlm(), color="Simple")) +
#geom_line(aes(x=x, y=fitbslm(), color="B-spline")) +
in the ggplot renderPlot() function at the end, I am able to add points and update the plot without problem
The problem occurs when I try to add these two lines back into the plot and then the updated data is passed to the fitlm and fitBslm eventReactive() functions.
For some reason it doesn't want to re-compute the regressions and apply/update the plot.
Question:
How can I introduce the regressions to the ggplot based on the new users updated data. (I am happy with it updating automatically or through a button)
After clicking the Generate Plot button it makes the below plot. However, the plot failed Error: [object Object] when I click on the plot to add a new point.
App:
library(shiny)
library(dplyr)
library(splines2)
library(ggplot2)
# Get the Temp values, which defines the accepted range of knots
# for the b-spline model.
library(dplyr)
data("airquality")
airquality <- filter(airquality, !is.na(Ozone)) %>%
select(c(Ozone, Temp)) %>%
set_names(c("x", "y"))
uniqueTemps <- unique(airquality[order(airquality$x), "x"])
selectedTemps <- sample(uniqueTemps, 2)
# Define UI for application that draws a histogram
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Simple Linear vs Spline Fit"),
# Sidebar
sidebarLayout(
sidebarPanel(
selectInput("knotSel", "Select knot values for B-spline fit:",
uniqueTemps, selected=selectedTemps,
multiple=TRUE),
actionButton("calcFit", "Generate Plot"),
actionButton("computeRegressions", "Compute Regressions")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("plot_splines", click = "plot_click"),
h4("Example Data: airquality {datasets}"),
p("This plot uses linear models to predict ozone levels based on temperature readings.",
tags$br(),
tags$em("Simple formula: ")
# tags$code("lm(Ozone ~ Temp + I(Temp^2) + I(Temp^3) - 1, airquality)"),
# tags$br(),
# tags$em("Spline formula: "),
# tags$code("lm(airquality$Ozone ~ bSpline(airquality$Temp, knots=getKnots(), degree=3) - 1)")
),
fluidRow(column(width = 6,
h4("Click plot to add points"),
actionButton("rem_point", "Remove Last Point")
#plotOutput("plot1", click = "plot_click")
),
column(width = 6,
h4("Table of points on plot"),
tableOutput("table"))),
fluidRow(column(width = 6,
DTOutput('tab1')),
column(width = 6,
DTOutput('tab2'))
)
)
)))
server <- (function(input, output) {
# Load the airquality dataset.
# data("airquality")
# # Remove observations lacking an Ozone measure.
# airquality <- filter(airquality, !is.na(Ozone)) %>%
# select(c(Ozone, Temp)) %>%
# set_names(c("y", "x"))
########################### Add selections to plot ###########################
## 1. set up reactive dataframe ##
values <- reactiveValues()
values$DT <- data.frame(x = numeric(),
y = numeric()
) %>%
bind_rows(airquality)
## 2. Create a plot ##
# output$plot1 = renderPlot({
# ggplot(values$DT, aes(x = x, y = y)) +
# geom_point(size = 5) +
# lims(x = c(0, 100), y = c(0, 100)) +
# theme(legend.position = "bottom")
# # include so that colors don't change as more color/shape chosen
# # scale_color_discrete(drop = FALSE) +
# # scale_shape_discrete(drop = FALSE)
# })
## 3. add new row to reactive dataframe upon clicking plot ##
observeEvent(input$plot_click, {
# each input is a factor so levels are consistent for plotting characteristics
add_row <- data.frame(x = input$plot_click$x,
y = input$plot_click$y
)
# add row to the data.frame
values$DT <- rbind(values$DT, add_row)
})
## 4. remove row on actionButton click ##
observeEvent(input$rem_point, {
rem_row <- values$DT[-nrow(values$DT), ]
values$DT <- rem_row
})
## 5. render a table of the growing dataframe ##
output$table <- renderTable({
values$DT
})
##############################################################################
# Fit the simple linear model
fitlm <- eventReactive(input$calcFit, {
slm <- lm(y ~ x + I(x^2) + I(x^3) - 1, values$DT)
fitlm <- slm$fitted.values
fitlm
})
# Get knot selection
getKnots <- reactive({as.integer(input$knotSel)})
# Fit the spline model, with the knot selection
fitBslm <- eventReactive(input$calcFit, {
bsMat <- bSpline(values$DT$x, knots=getKnots(), degree=3)
bslm <- lm(values$DT$y ~ bsMat - 1)
bslm
})
# observeEvent({
# print(fitBslm())
# })
# Generate the plot
output$plot_splines <- renderPlot({
splineMdl <- fitBslm()
fitbslm <- splineMdl$fitted.values
cols <- c("Simple"="#ef615c", "B-spline"="#20b2aa", "knot"="black")
g <- ggplot(values$DT, aes(x=x, y=y)) +
geom_point(color="blue") +
geom_line(aes(x=x, y=fitlm(), color="Simple")) +
#geom_line(aes(x=x, y=fitbslm(), color="B-spline")) +
geom_vline(aes(color="knot"), xintercept=getKnots(), linetype="dashed", size=1) +
scale_colour_manual(name="Fit Lines",values=cols) +
ggtitle("Ozone as predicted by Temp", "(knots shown as vertical lines)")
g
})
output$tab1 <- renderDataTable(
airquality
)
output$tab2 <- renderDataTable(
values$DT
)
})
shinyApp(ui, server)
Change eventReactive to just reactive. Also, you just need fitbslm in the second geom_line without (). Try this
server <- (function(input, output) {
########################### Add selections to plot ###########################
## 1. set up reactive dataframe ##
values <- reactiveValues()
values$DT <- data.frame(x = numeric(),
y = numeric()
) %>%
bind_rows(airquality)
## 3. add new row to reactive dataframe upon clicking plot ##
observeEvent(input$plot_click, {
# each input is a factor so levels are consistent for plotting characteristics
add_row <- data.frame(x = input$plot_click$x,
y = input$plot_click$y
)
# add row to the data.frame
values$DT <- rbind(values$DT, add_row)
})
## 4. remove row on actionButton click ##
observeEvent(input$rem_point, {
rem_row <- values$DT[-nrow(values$DT), ]
values$DT <- rem_row
})
## 5. render a table of the growing dataframe ##
output$table <- renderTable({
values$DT
})
##############################################################################
# Fit the simple linear model
# fitlm <- eventReactive(input$calcFit, {
fitlm <- reactive({
slm <- lm(y ~ x + I(x^2) + I(x^3) - 1, values$DT)
fitlm <- slm$fitted.values
fitlm
})
# Get knot selection
getKnots <- reactive({as.integer(input$knotSel)})
# Fit the spline model, with the knot selection
#fitBslm <- eventReactive(input$calcFit, {
fitBslm <- reactive({
bsMat <- bSpline(values$DT$x, knots=getKnots(), degree=3)
bslm <- lm(values$DT$y ~ bsMat - 1)
bslm
})
myPlot <- reactive({
splineMdl <- fitBslm()
fitbslm <- splineMdl$fitted.values
cols <- c("Simple"="#ef615c", "B-spline"="#20b2aa", "knot"="black")
g <- ggplot(values$DT, aes(x=x, y=y)) +
geom_point(color="blue") +
geom_line(aes(x=x, y=fitlm(), color="Simple")) +
geom_line(aes(x=x, y=fitbslm , color="B-spline")) +
geom_vline(aes(color="knot"), xintercept=getKnots(), linetype="dashed", size=1) +
scale_colour_manual(name="Fit Lines",values=cols) +
ggtitle("Ozone as predicted by Temp", "(knots shown as vertical lines)")
g
})
# Generate the plot
output$plot_splines <- renderPlot({
myPlot()
})
output$tab1 <- renderDataTable(
airquality
)
output$tab2 <- renderDataTable(
values$DT
)
})
I have an r script includes a Identify_IP() that returns a list of dataframe and a ggplot. I want to call the script and render both the dataframe and the plot.
This is Identify_IP() function. I took off unrelative code and kept only the plot, lines and ggplot code to give a clear example of my type of ggplot.
library(ggplot2)
library(matrixStats)
library(fda.usc)
#df <- read.table("name.XLS", header = FALSE)
Identify_IP = function(df1){
mlearn <- df1[,'V7']
formul <- plot(blue_curve$x, blue_curve$y * 30, type = 'l', col = 'blue')
formula_deriv <- lines(blue_curve$x, red_curve$y1 * 30, col = 'red')
p <- ggplot(df1, aes(blue_curve$x)) +
geom_line(aes(y = blue_curve$y, colour = "0 Deriv")) +
geom_line(aes(y = red_curve$y1, colour = "1st Deriv")) +
geom_vline(xintercept = x_loc) + geom_hline(yintercept = 0)
return(list(df1,p))
}
Now, this is a modified Shiny code based on amrr and micstr suggestion.
source('InflectionP2.R', local = TRUE)
library(ggplot2)
library(shiny)
runApp(
list(
ui = fluidPage(
titlePanel("Upload your file"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xls file',
accept = c(".XLS")),
actionButton("btn", "Update Table"),
actionButton("btn1", "Display Plot")
),
mainPanel(
tableOutput('what'),
plotOutput('pl'))
)
)
,
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if (is.null(input$file1))
return(NULL)
dfs <- Identify_IP(read.table(inFile$datapath))
return(dfs)
})
observeEvent(input$btn, output$what <- renderTable({
dataOP()[[1]]
}))
observeEvent(input$btn1, output$pl <- renderPlot({
pp <- dataOP()
pp[[2]]
}))
}))
This was really helpful in teaching me how to call r script in reactive(). And it makes sense to me. Yet, it render the table but the Display Plot button is not rendering the plot. Does my ggplot in Identify_IP function has anything to do with not being able to display the plot? I also tried print(ggplot(pp[[2]])) and still the same.
I managed to get this working.
Note I used the internal data set iris and made a toy Identify_IP function as I do not have your code.
Note you still need to choose a file to trigger the events but it will ignore that file and use iris data.
Workaround I used [[1]] to get the table not dataOP()$tble
CODE
library(shiny)
library(ggplot2)
# source('InflectionP2.R', local = TRUE)
# MAKE TEST FUNCTION
Identify_IP <- function(mydata) {
#shrink data
tble <- head(mydata)
plt <- ggplot(data = head(mydata),
mapping = aes(y = Sepal.Length,
x = Petal.Length)) + geom_point()
return(list(tble, plt))
}
runApp(
list(
ui = fluidPage(
titlePanel("Upload your file"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xls file',
accept = c(".XLS")),
actionButton("btn", "Update Table"),
actionButton("btn1", "Display Plot")
),
mainPanel(
tableOutput('what'),
plotOutput('pl'))
)
)
,
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if (is.null(input$file1))
return(NULL)
# ORIGINAL dfs <- Identify_IP(read.table(inFile$datapath))
# using internal dataset for example
dfs <- Identify_IP(iris)
# ORIGINAL list(tble = dfs, plt = dfs)
# lets just return your dfs, its already a list in code above
return(dfs)
})
observeEvent(input$btn, output$what <- renderTable({
#print(dataOP()) # debug line that led to [[1]] idea
# ORIGINAL dataOP()$tble
# just say first in list
dataOP()[[1]]
}))
observeEvent(input$btn1, output$pl <- renderPlot({
#ggplot(dataOP()$plt)
# since already a plot just need to index it
# I found [[2]] worked better than explicit dataOP()$plt
pp <- dataOP()
pp[[2]]
}))
}))
RESULT
Voila!
1) Try print (ggplot(dataOP()$plt))
Take a look at this answer I wrote.
2) Sorry its hard to interpret without your ggplot code bit and data. Given #amrrs questions can you try debug in your Shiny code with print() and str() temporary lines to see what your data is returning. i.e.
print(dataOP()$plt)
str(dataOP())
Worse case, try split your code in two. So Identify_IP code to do the data leg and then make a Print_IP with the ggplot code that just returns the plot. It might rule out your chart is not the problem.
3) Take a look at reactiveValues()
https://shiny.rstudio.com/reference/shiny/0.11/reactiveValues.html
It "bakes" a result that was reactive. The type coming out of your chart may be a reactive type not a chart type. Perhaps share any error messages you are getting.
I'm having trouble with the server.R getting shiny to plot the data based on drop down selections from the ui.R. I would like to select a 'Site' and a 'Parameter' and plot the 'Obs' that reflects that 'Site' and 'Parameter'. Obs as the Y and Date on the X. Here is some sample code.
Site_Names=data.frame(c(A=rep("A",10),B=rep("B",10),C=rep("C",10)))
Site_Names=Site_Names[,1]
Parameters=data.frame(c(pH=rep("pH",10),DO=rep("DO",10),Temp=rep("Temp",10)))
Parameters=Parameters[,1]
Obs=rnorm(30)
Dates=c(seq(as.Date("2000/1/1"), by = "year", length.out =10 ),
seq(as.Date("2005/1/1"), by = "year", length.out =10 ),
seq(as.Date("1990/1/1"), by = "year", length.out =10 ))
data=data.frame(Site_Names,Parameters,Obs,Dates)
#ui.R
Sites=levels(data$Site_Name)
setNames(as.list(Sites), Sites)
params=levels(data$Parameters)
setNames(as.list(params), params)
library(shiny)
library(ggplot2)
shinyUI(fluidPage(
# Application title
titlePanel("Data"),
sidebarLayout(
sidebarPanel(
selectInput("site", "Select Site:", Sites),
selectInput("parameters", "parameter", params)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("Plot")
)
)
))
#server.R
library(shiny)
library(ggplot2)
shinyServer(function(input, output) {
dataset <- reactive({
data[ , (input$Sites),]
})
output$distPlot <- renderPlot({
p <- ggplot(dataset(), aes(x=Dates, y=input$params and input$Sites))
+ geom_point(data$Obs)
print(p)
})
You can use subset within your reactive expression to get the plot data. Be careful though, as you can end up with null values if the parameter isn't included in the site data.
library(shiny)
library(ggplot2)
shinyServer(function(input, output) {
dataset <- reactive({
subset(data, Site_Names == input$Sites & Parameters == input$params)
})
output$distPlot <- renderPlot({
p <- ggplot(dataset(), aes(x = Dates, y = Obs)) +
geom_line()
print(p)
})
I'm trying to create a simple shiny app where the user can select a variable from a drop down menu and then a plot is generated. The selected variable is seen as input$Feature w/in the server function but I am getting errors when trying to access the column of my data frame as df$input$Feature. I'm not sure how to do this.
bw <- read.xls('filename')
ui <- fluidPage(
selectInput(inputId = 'Feature',
label = 'Select a feature to plot:',
c(colnames(bw))),
plotOutput('graph')
)
server <- function(input, output){
output$graph <- renderPlot({
p <- ggplot(bw, aes(bw$Date))
p <- p + geom_line(aes(y=bw$input$Feature, colour='red', group=1))
p <- p + labs(x = 'Date', y = 'Feature Name')
print(p)
})
}
shinyApp(ui=ui, server=server)
Try using this in the geom_line instead:
bw[,input$Feature]
Can't be of much more help without having a reproducible example to work with.
EDIT:
This worked for me:
bw <- mtcars
library(shiny)
ui <- fluidPage(
selectInput(inputId = 'Feature',
label = 'Select a feature to plot:',
c(colnames(bw)),
selected=colnames(bw)[1]),
verbatimTextOutput('value'),
plotOutput('graph')
)
server <- function(input, output){
output$value <- renderPrint(columname())
columname <- reactive({input$Feature})
output$graph <- renderPlot({
p <- ggplot(bw, aes(bw$qsec))+ geom_line(aes_string(y=bw[, input$Feature]))
p <- p + labs(x = 'Date', y = 'Feature Name')
p
})
}
shinyApp(ui=ui, server=server)
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.