Shiny Correlation Plot - r

I'm trying to build a simple Shiny app, using USArrests database, that shows the correlation between density population and the 3 variables of crimes (Murder, Assault, Rape), changing the crime variables with selectInpuct.
Here the code of ui.R:
shinyUI(fluidPage(
titlePanel("Violent Crime Rates by US State"),
sidebarLayout(
sidebarPanel(
helpText("A series of plots that display correlation between density population and various kind of crimes"),
selectInput("var",
label = "Choose a crime",
choices = c("Murder"=1, "Assault"=2,
"Rape"=4),
selected = "Murder")
),
mainPanel(plotOutput('crimeplot'))
)
))
and the server.R
shinyServer(function(input,output){
output$crimeplot<- renderPlot({
x<-as.numeric(input$var)
y<-as.numeric(USArrests$UrbanPop)
plot(x, y, log = "xy")
})
}
but running the app it returns:
ERROR: 'x' and 'y' lengths differ
Could you help me, and explain what's wrong with what I am doing?
Thank you very much in advance!

I fould a couple of small errors that I have fixed in the code below.
Your selection returns the column number (as a string) and you need to convert it to a number and extract the relevant column from the data frame in server.R.
The default value of selected in ui.R should be the starting value and not the label.
The updated server.R looks as follows
shinyServer(function(input,output){
output$crimeplot<- renderPlot({
x<-as.numeric(USArrests[,as.numeric(input$var)])
y<-as.numeric(USArrests$UrbanPop)
plot(x, y, log = "xy", xlab=colnames(USArrests)[as.numeric(input$var)], ylab="Urban Pop")
})
})
and ui.R looks like this:
shinyUI(fluidPage(
titlePanel("Violent Crime Rates by US State"),
sidebarLayout(
sidebarPanel(
helpText("A series of plots that display correlation between density population and various kind of crimes"),
selectInput("var",
label = "Choose a crime",
choices = c("Murder"=1, "Assault"=2,
"Rape"=4),
selected = 1)
),
mainPanel(plotOutput('crimeplot'))
)
))

Related

Create Shiny App with histogram and slidebar and save values

I'm trying to create a histogram of distances between cells with slidebar that varies the range of the x-axis like this:
ui <- fluidPage(
# Application title
titlePanel("Distribution of distance between nucleus"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("x_range", "Range:",
min = min(histo$Dist_Closest_Cell),
max = max(histo$Dist_Closest_Cell),
value = c(min(histo$Dist_Closest_Cell),
max(histo$Dist_Closest_Cell)))
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
# draw the histogram with the specified range
hist(histo$Dist_Closest_Cell,
xlim = c(input$x_range[1], input$x_range[2]),
breaks = 100,
xlab = "Distance µm",
main = "Distribution of distance between nucleus")
})
}
# Run the application
shinyApp(ui = ui, server = server)
histo$Dist_Closest_Cell
I have a DataFrame called histo that has some columns and one of them is Dist_Closest_Cell that contains distance values.
Now, I want to save in a variable as DataFrame the info of histo but in the x-axis range selected with the slidebar. This Shiny App (the code above) is interjected in the middle of a bigger code, so after run the app and choosing the x-axis range I would like to stop the app and return the mencioned DataFrame variable.
I know that with runApp() and stopApp() I could continue with the rest of the code but I don´t know how to write it properly...
Maybe with something like:
...
# Previous code
df <- runApp(
# Above code
return(c(input$x_range[1], input$x_range[2]))
stopApp()
)
# Next code
...
I´m trying this with Shiny because it's the only way to plot a dinamic histogram with slidebar that I've found but if you know another alternative it's welcome.
Thank you in advance.

Creating if functions with checkboxes in R-shiny

I am currently doins a personal project to get used to using R-shiny. I am using the penguins dataset in R. This project is creating several different boxplots. I have been able to create the main code for the boxplots to show and now I am trying to use the checkbox input to allow the user to select if it wants the boxplots to be divided by the Islands ivestigated or rather just see the data as it.
My code is the following.
library("palmerpenguins")
library("shiny")
library("ggplot2")
penguins.data<- penguins
sum(is.na(penguins))
#As their are a few penguins with missing values (19 out of 2752) we decide to carry out the data visualization with
#Only the complete cases of the data
penguins.data<-na.omit(penguins.data)
#Making sure the categorical variables are factors
str(penguins.data)
penguins.data$species<-as.factor(penguins.data$species)
penguins.data$sex<-as.factor(penguins.data$sex)
penguins.data$year<-as.factor(penguins.data$year)
penguins.data$island<-as.factor(penguins.data$island)
#Defining the UI for the App.
ui <- fluidPage(
#Adding a suitable title
titlePanel("Penguin exploration"),
#Getting the layout
sidebarLayout(
#Setting the panel for the used to select the inputs they want
sidebarPanel(
#Selecting the variable for the X-axis
selectInput("horiz", "Select x-axis variable:",
c("Sex" = "sex",
"Species" = "species",
"Year" = "year"),
selected = "sex" ),
#Selecting the variable in the Y-axis
selectInput("vert", "Select y-axis variable:",
c("Bill Length" = "bill_length_mm",
"Bill Depth" = "bill_depth_mm",
"Flipper length" = "flipper_length_mm",
"Body mass" = "body_mass_g"),
selected = "flipper_length_mm" ),
#We create the checkbox input for the user to select if they want to see the data in
checkboxInput("Divide", "check to look at how data is divided by Island Level", value = F)),
mainPanel(
#Setting a title for the output
h3("plot"),
#We decide how to name the plot to use it in the output
plotOutput("PengPlot")
),
)
)
server <- function(input, output) {
horizontal<-reactive(input$horiz)
vertical<-reactive(input$vert)
output$PengPlot <- renderPlot({
if(output$Divide){
ggplot(data = penguins.data, aes_string(horizontal(), vertical()))+
geom_boxplot(aes(fill= island))+
facet_wrap(~horizontal())
}else{
ggplot(data = penguins.data, aes_string(horizontal(), vertical()))+
geom_boxplot()
}
})
}
shinyApp(ui = ui, server = server)
I am currently getting the error Reading from shinyoutput object is not allowed. I am lost on what specifically to do. I am considering if maybe creating both boxplots as reactive objects and then use the if functions but I have seen in other posts that doing that may overcomplicate the code.
Any advice or help will be great. Thank in advance

how to fix 'Error: variable lengths differ (found for 'input$s')' in R Shiny

I'm trying to make a simple shiny ap for creating kaplan-meier survival curves that are stratified by selection the user makes. When I code the KM calculation statically (with the column name thorTr) it works but the calculation and plot is static. When I replace with input$s I get ERROR:variable lengths differ (found for 'input$s')
I've tried looking at other code which use as.formula and paste, but I don't understand and couldn't get to work. But I am a new R and Shiny user so maybe I didn't get it right. Here is a similar shiny ap but I want to use survminer and the ggsurvplot for plotting
library(shiny)
library(ggplot2)
library(survival)
library(survminer)
#load data
data(GBSG2, package = "TH.data")
#Define UI for application that plots stratified km curves
ui <- fluidPage(
# Sidebar layout with a input and output definitions
sidebarLayout(
# Inputs
sidebarPanel(
# Select variable strat
selectInput(inputId = "s",
label = "Select Stratification Variable:",
choices = c("horTh","menostat","tgrade"),
selected = "horTh")
),
# Outputs
mainPanel(
plotOutput(outputId = "km")
)
)
)
# Define server function required to create the km plot
server <- function(input, output) {
# Create the km plot object the plotOutput function is expecting
output$km <- renderPlot({
#calc KM estimate with a hard coded variables - the following line works but obviously is not reactive
#km <- survfit(Surv(time,cens) ~ horTh,data=GBSG2)
#replaced hard coded horTh selection with the respnse from the selection and I get an error
km <- survfit(Surv(time,cens) ~ input$s ,data=GBSG2)
#plot km
ggsurvplot(km)
})
}
# Create a Shiny app object
shinyApp(ui = ui, server = server)
I expect to have a plot that updates the stratification variable with the users selection
Try using surv_fit() instead of survfit().
surv_fit() is a helper from survminer which does different scoping compared to survival:survit(), which is what you seem to need, as Byron suggests.
My snippet looks like:
output$plot <- renderPlot({
formula_text <- paste0("Surv(OS, OS_CENSOR) ~ ", input$covariate)
## for ggsurvplot, use survminer::surv_fit instead of survival:survfit
fit <- surv_fit(as.formula(formula_text), data=os_df)
ggsurvplot(fit = fit, data=os_df)
})
Two things:
The formula in the call to survfit() needs to be defined explicitly. The object being passed to survfit() in the original code uses a character value on the right hand side of the function. This throws an error, which we can address by translating the entire pasted value into a formula, i.e., as.formula(paste('Surv(time,cens) ~',input$s))
The formula needs to be defined in the call to ggsurvplot() to avoid scoping issues. This is a little more technical and has to do with the way that ggsurvplot() is programmed. Basically, ggsurvplot() can't access a formula that is defined outside of its own call.
Try replacing
km <- survfit(Surv(time,cens) ~ input$s ,data=GBSG2)
ggsurvplot(km)
with
ggsurvplot(survfit(as.formula(paste('Surv(time,cens) ~',input$s)),data=GBSG2))
Hi finally got this to work combinigng both solutions. I don't understand the fix but at least it now works the way I wanted it to :)
library(shiny)
library(ggplot2)
library(survival)
library(survminer)
data(GBSG2, package = "TH.data")
# Define UI for application that plots features of movies
ui <- fluidPage(
# Sidebar layout with a input and output definitions
sidebarLayout(
# Inputs
sidebarPanel(
# Select variable strat
selectInput(inputId = "s",
label = "Select Stratification Variable:",
choices = c("Hormone Therapy" = "horTh",
"Menopausal Status" = "menostat",
"Tumor Grade" = "tgrade"),
selected = "horTh")
),
# Outputs
mainPanel(
plotOutput(outputId = "km")
)
)
)
# Define server function required to create the scatterplot
server <- function(input, output) {
# Create the km plot object the plotOutput function is expecting
output$km <- renderPlot({
## calc survival curve and plot
kmdata <- surv_fit(as.formula(paste('Surv(time,cens) ~',input$s)),data=GBSG2)
ggsurvplot(kmdata)
})
}
# Create a Shiny app object
shinyApp(ui = ui, server = server)

Shiny app: Can't plot stock chart based on user input

I am trying to plot a stock chart using quantmod in a shiny app but I get the following error: input$stockInput download failed after two attempts. Error message: HTTP error 404. Any help is appreciated.
Server:
library(quantmod)
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
price <- getSymbols('input$stockInput',from='2017-01-01')
plot(price)
})})
UI:
library(shiny)
shinyUI(fluidPage(
titlePanel("Stock Chart"),
sidebarLayout(
sidebarPanel(
#This is a dropdown to select the stock
selectInput("stockInput",
"Pick your stock:",
c("AMZN","FB","GOOG","NVDA","AAPL"),
"AMZN"),selected = "GOOG"),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
))))
Thank you.
Your code requires a few changes. First when you are accessing a shiny UI object in server.R you should use it as an object not as a quoted character
price <- getSymbols(input$stockInput,from='2017-01-01')
And the function getSymbols without a value set to the argument (auto.assign = F) creates a new xts object in the stock name whose data is requested and so in the below code I've used it with setting auto.assign = F so it becomes easier to access the object price for plotting. Otherwise, you might have to fetch the value inside price using get() and then plot them as I've commented.
server.R
library(quantmod)
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
price <- getSymbols(input$stockInput,from='2017-01-01', auto.assign = F)
#plot(get(price), main = price) #this is used when auto.assign is not set by default which is TRUE
plot(price, main = input$stockInput) # this is when the xts object is stored in the name price itself
})})
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Stock Chart"),
sidebarLayout(
sidebarPanel(
#This is a dropdown to select the stock
selectInput("stockInput",
"Pick your stock:",
c("AMZN","FB","GOOG","NVDA","AAPL"),
"AMZN"),selected = "GOOG"),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
))))
Hope it clarifies!

Saving data frame of user input

Note: Please feel free to criticize the code I have written as I'm learning, what I did wrong, how I can improve etc.
I am learning R and shiny and would like to implement a calculation using the users input, however I am having difficulty storing the user input into a data frame for me to access to run a calculation later.
My idea is to get the user to define a probability distribution for his or her selected variables from the iris dataset. Once he defines them I want to store those defined variables into a data frame so that I can run a calculation such as a Monte Carlo etc. using the users defined data frame later on (so I would need to call upon that as a data frame).
I have tried to make the code as simple as possible below :
library(shiny)
ui <- fluidPage(
fluidRow(
column(4,
wellPanel(
selectizeInput(inputId= "invar", label= "Select Variable",
choices= names(iris),
selected= names(iris)[1],
multiple=T),
uiOutput("moC"))),
mainPanel(
tableOutput("tab")
)
))
server <- function(input, output) {
sorted <- reactive({
data <- iris[ ,c(input$invar)]
data})
output$moC <- renderUI({
numvar<- length(input$invar)
lapply(1:numvar, function(i) {
tagList(
selectInput("inv",paste0("Please Select Probability Distribution of ", input$invar[i]),
choices = c("Normal","Uniform")),
conditionalPanel(condition = "input.inv=='Normal'",
textInput("invarpdfmean","Please Select Input Variable Mean:",0.25),
textInput("invarpdfsd","Please Select Input Variable Standard Deviation", 0.02)),
conditionalPanel(condition = "input.inv=='Uniform'",
textInput("invarpdfmin","Please Select Minimum Input Variable Value:",0.18),
textInput("invarpdfmax","Please Select Maximum Input Variable Value", 0.3))
)})})
}
EDIT: Updated code as per comments. Thanks
library(shiny)
ui <- fluidPage(
fluidRow(
column(4,
wellPanel(
selectizeInput(inputId= "invar", label= "Select Variable",
choices= names(iris),
selected= names(iris)[1],
multiple=TRUE),
uiOutput("moC"))),
mainPanel(
tableOutput("tab")
)
))
server <- function(input, output) {
sorted <- reactive({
iris[input$invar]
})
output$moC <- renderUI({
numvar<- length(input$invar)
lapply(1:numvar, function(i) {
tagList(
selectInput("inv",paste0("Please Select Probability Distribution of ", input$invar[i]),
choices = c("Normal","Uniform")),
conditionalPanel(condition = "input.inv=='Normal'",
textInput("invarpdfmean","Please Select Input Variable Mean:",0.25),
textInput("invarpdfsd","Please Select Input Variable Standard Deviation", 0.02)),
conditionalPanel(condition = "input.inv=='Uniform'",
textInput("invarpdfmin","Please Select Minimum Input Variable Value:",0.18),
textInput("invarpdfmax","Please Select Maximum Input Variable Value", 0.3))
)})})
}
shinyApp(ui, server)
EDIT 2:
Seems I wasn't clear apologize:
The desired output is a histogram of a linear model of the users selected variables with the data coming from the users defined variables. So if he selects Sepal.Length and Petal.Length and defines them with a uniform or normal distribution I want to run a Monte Carlo on the linear model using a data frame created from the users input.
So later on i want to run a code that looks something like this:
n<-1000
Lm <- Sepal.Length + Petal.Length
for (n in 1:n) {
H=predict(LM,MCtab)
}
where MCtab would be a data frame which is created by the user using the variables he or she selects. This is what I have not been able to figure out how to do.
For MCtab (which is just a subset of your dataset based on user selected inputs), you can use MCtab <- iris[ , input$invar]. Note the comma there. Also, you should check if input$invar is empty in case user has deleted all the choices.

Resources