i'm newly to the R world and i'm just trying to build a Dashboard on Shiny.
My problem is that i want to display some text only if certain conditions are met in the renderplotly function.
shinyUI(fluidPage(
titlePanel("Posti occupati in terapia intensiva"),
sidebarLayout(
sidebarPanel(
selectInput("region","Scegli regione",unique(as.character(region_dataset$denominazione_regione),)
),
dateInput("day","Scegli data", min=region_dataset$data[1], max=region_dataset$data[nrow(region_dataset)], format="dd/mm/yyyy",value=region_dataset$data[nrow(region_dataset)]
),
),
mainPanel(
plotlyOutput(outputId = "TI"),
textOutput(outputId= "text")
)
),
))
This is the ui page and i show you the server
shinyServer(function(input, output) {
output$TI <- renderPlotly({
day <- input$day
region <- input$region
request <- filter(region_dataset,region_dataset$data==day & region_dataset$denominazione_regione==region)
plot_ly(as.data.frame(request$terapia_intensiva),
domain = list(x = c(0, 1), y = c(0, 1)),
value = request$terapia_intensiva,
title = list(text = "Posti occupati TI"),
type = "indicator",
mode = "gauge+number+delta",
delta = (reference = as.integer(request$terapia_intensiva[nrow(request$data)-1])),
gauge = list(
axis =list(range = list(NULL, request$posti_TI)),
bar = list(color = "darkmagenta"),
borderwidth = 3,
steps = list(
list(range = c(0, 0.33*request$posti_TI), color = "green"),
list(range = c(0.33*request$posti_TI, 0.66*request$posti_TI), color = "yellow"),
list(range = c(0.66*request$posti_TI, request$posti_TI), color = "red")),
threshold = list(
line = list(color = "cyan", width = 5),
thickness = 0.75,
value = request$posti_TI)))
})
output$text <- renderText("Numero massimo di posti occupati")
})
My problem is that i want to display the text in the panel only if request$terapia_intensiva>request$posti_TI
I can't find out a solution to this problem, i've tried using reactive function and conditional panel but with no results.
Thanks for helping.
renderText() can contain logic, so
output$text <- renderText({
if (request$terapia_intensiva>request$posti_TI) "Numero massimo di posti occupati"
})
If the if() returns FALSE, renderText returns NULL. If you want to be explicit, you can always add else NULL or else rturn(NULL) if you wish.
Related
I am trying to make a shiny app based on historical data. I am using a multiple shiny page approach.
For some reason when I run app, my output gets outputted only in the Viewer of RStudio and not on the main panel of the Shiny popup.
Here's the code:
Code in UI:
body <- dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
fluidRow(
plotlyOutput(outputId="chart1")
),
fluidRow(
gaugeOutput(outputId="gauge")
)
)
))
Code in Server:
output$gauge <- renderPlotly({
plot_ly(
domain = list(x = c(0, 1), y = c(0, 1)),
value = fatality_rate,
number= list(valueformat=".2f", suffix = "%"),
title = list(text = "Fatality Rate", font = list(size = 24, color = "black")),
type = "indicator",
mode = "gauge+number",
gauge = list(
axis = list(range=list(NULL, 50)),
bar= list(color="darkorange"),
borderwidth = 2,
bordercolor = "black",
threshold = list(
line = list(color="red", width = 4),
thickness = 0.75,
value = 49
)
))
})
I try to display interactive plots by using R shiny. I can successfully make the GUI and published, but the plots in tabPanel shows nothing, just like the picture shows below. There is the data I used (have been downloaded into my laptop).
I think problem may caused by the way how I preprocessing my data in server.R, but whatever I tried, it still display nothing. No Error shows when I run the app.
enter image description here
My code in ui.R:
library(shiny)
shinyUI(fluidPage(
titlePanel("Data Viz Lab"),
sidebarLayout(
sidebarPanel(
## Add X-Variable select element
selectInput(inputId = "var_x",
label = h5("X-Variable"),
choices = c("Structure.Cost", "Land.Value", "Home.Value", "Home.Price.index"),
selected = "Land.Value"),
## Add Fill Color select element
selectInput(inputId = "color",
label = h5("Fill Color"),
choices = c("brown", "yellow", "green", "blue", "red"),
selected = "brown"),
## Add log-scale check box
checkboxInput(inputId = "log",
label = "log-sclae for X-variable in Scatterplot?",
value = FALSE),
## Add Y-Variable select element
selectInput(inputId = "var_y",
label = h5("Y-Variable"),
choices = c("Structure.Cost", "Land.Value", "Home.Value", "Home.Price.index"),
selected = "Structure.Cost"),
## Add Circle-Size side bar
sliderInput(inputId = "size",
label = h5("Circle-Size"),
min = 1,
max = 10,
value = 3),
## Add Outlier color select element
selectInput(inputId = "color_out",
label = h5("Outlier Color"),
choices = c("white", "yellow", "green", "blue", "red"),
selected = "white")
),
mainPanel(
tabsetPanel( # Establish tabset panel
tabPanel(
# Tab1
title = "Histogram",
value = plotOutput(outputId = "hist") # Add an figure in tab1
),
tabPanel(
# Tab2
title = "Scatterplot",
value = plotOutput(outputId = "scatter") # Add an figure in tab2
)
)
)
)
))
My code in server.R:
library(shiny)
library(ggplot2)
library(sp)
library(dplyr)
# setwd()
landdata = read.csv("landdata.csv")
options(scipen = 999)
shinyServer(function(input, output) {
## Plotting Histogram
output$hist = renderPlot({
# Plotting
if (input$log == FALSE){
ggplot(landdata, aes_string(x = input$var_x)) +
geom_histogram(color = input$color)
}else{
ggplot(landdata, aes_string(x = input$var_x)) +
geom_histogram(color = input$color) +
scale_x_log10(input$var_x)
}
})
## Plotting Scatter plot
output$scatter = renderPlot({
# Data pre-processing
p = ggplot(data = landdata, aes_string(x = input$var_x, y = input$var_y)) +
geom_point() +
stat_ellipse(type = "norm", level = 0.95, color = "black")
build = ggplot_build(p)$data
pts = build[[1]]
elli = build[[2]]
Outlier = point.in.polygon(pts$x, pts$y, elli$x, elli$y)
landdata = cbind(landdata, Outlier)
landdata$Outlier = ifelse(landdata$Outlier == 0, yes = "Y", no = "N") %>% factor(level = c("Y", "N"))
# Plotting
if (input$log == FALSE){
ggplot(landdata, aes_string(x = input$var_x, y = input$var_y)) +
geom_point(aes(color = Outlier), size = input$size) +
scale_color_manual(values = c(input$color, input$color_out))
}else{
ggplot(landdata, aes_string(x = input$var_x, y = input$var_y)) +
geom_point(aes(color = Outlier), size = input$size) +
scale_color_manual(values = c(input$color, input$color_out)) +
scale_x_log10(input$var_x)
}
})
})
The mistake lies in the tabPanel setup. value is not the correct argument for the plot. value is "the value that should be sent when tabsetPanel reports that this tab is selected" (taken from the manual). That means, value has the role of an id (like id argument of tabsetPanel or outputId of plotOutput).
Remove value = to make it work (the code snippet below gave me an output on my system).
tabsetPanel( # Establish tabset panel
tabPanel(
# Tab1
title = "Histogram",
plotOutput(outputId = "hist") # Add an figure in tab1
),
tabPanel(
# Tab2
title = "Scatterplot",
plotOutput(outputId = "scatter") # Add an figure in tab2
)
)
I'm working on a Shiny app for a project where a ggplot is the main interface for the user. Depending on input from the sidebar, I'd like the app to record coordinates for two events: a single click (which I have working), or a double click (which is where I'm stuck). Essentially, I'd like to be able to create a way to record a starting and ending point based on sidebar conditions. Here's a brief example:
library(shiny)
library(ggplot2)
ui = pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
radioButtons("color", "Pick Color", c("Pink", "Green", "Blue")),
selectInput("shape", "Select Shape:", c("Circle", "Triangle"))
),
mainPanel(
fluidRow(column(width = 6,
h4("Click plot to add points"),
plotOutput("plot1", click = "plot_click"),
actionButton("rem_point", "Remove Last Point")),
column(width = 6,
h4("Table of points on plot"),
tableOutput("table")))
)
)
server = function(input, output){
values = reactiveValues()
values$DT = data.frame(x = numeric(),
y = numeric(),
color = factor(),
shape = factor())
output$plot1 = renderPlot({
ggplot(values$DT, aes(x = x, y = y)) +
geom_point(aes(color = color,
shape = shape), size = 5) +
lims(x = c(0, 100), y = c(0, 100)) +
theme(legend.position = "bottom") +
scale_color_discrete(drop = FALSE) +
scale_shape_discrete(drop = FALSE)
})
observeEvent(input$plot_click, {
add_row = data.frame(x = input$plot_click$x,
y = input$plot_click$y,
color = factor(input$color, levels = c("Pink", "Green", "Blue")),
shape = factor(input$shape, levels = c("Circle", "Triangle")))
values$DT = rbind(values$DT, add_row)
})
observeEvent(input$rem_point, {
rem_row = values$DT[-nrow(values$DT), ]
values$DT = rem_row
})
output$table = renderTable({
values$DT[, c('color', 'shape')]
})
}
shinyApp(ui, server)
In this example, when the user selects Green or Blue, I'd like to only record the single click as the starting point and record NA for the end point. When they select Pink, I'd like to record the single click as the starting point and the double click as the ending point. Any help would be greatly appreciated!
(Example created by #blondeclover on a question from earlier.)
Found a solution! Just create an observeEvent() to observe a double click and update values$DT with the new information.
I've been developing a Shiny app in a single app.R file (see below). I'm getting the "Error in match.arg(position) : 'arg' must be NULL or a character vector" error, but can't see why? I've looked at previous threads about this and they all seem to relate to issues with placement of the elements of the app (e.g. duplicate sidebarPanel etc), but I can't tell form them what I'm doing wrong. I've been developing this app, and it previous iterations the app has at least appeared, with the two selectInput's working. Any advice hugely appreciated. Apologies for my inelegant coding and layout as I've been trying to follow the formatting instructions, but it just makes it look even worse. Thinking of giving up completely, as I'm spending hours and getting absolutely nowhere.
Ian
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
library(shiny)
library(shinydashboard)
library(fingertipsR)
library(ggplot2)
library(viridis)
library(plotly)
#Import QOF indicators
setwd("/Users/ianbowns/Documents/R/ShinyFT")
dat <- readRDS("data")
my.df <- as.data.frame(dat)
#Defines year and age category choices
yearchoices <- unique(as.character(my.df$Timeperiod))
indicator <- unique(as.character(my.df$IndicatorName))
# Define UI for application that draws boxplot
ui <- fluidPage(
# Application title
titlePanel("FingerTips QOF Prevalences"),
# Input for year and ages
sidebarLayout(
sidebarPanel(
selectInput(inputId = "year",
label = "Choose a year:",
choices = yearchoices,
selected = "2015/16"),
selectInput(inputId = "indicator",
label = "Choose ages:",
choices = indicators,
selected = "All ages")),
actionButton("goButton", "Refresh graph"),
# Show a plot of the generated distribution
mainPanel(
plotlyOutput("bPlot")
)
))
# Define server logic required to draw a histogram
server <- function(input, output) {
inds <- my.df[which(IndicatorID == "input$indicator" & Sex == "Persons"
& Timeperiod == "input$year" & ParentCode != "E92000001"),]
# draw the boxplot
# input$goButton
output$bPlot <- renderPlotly({
plot_ly(data = inds, y = ~Value, color = inds$ParentName,
type = "box", colors = viridis_pal(alpha = 1, begin = 0, end = 1, direction
= -1, option = "D")(3), boxpoints = "all", jitter = 0.3,
pointpos = -1.8) %>%
layout(title = "Dementia", titlefont = list(family =
"Helvetica", size = 16), yaxis = list(title = "Prevalence (%)", titlefont =
list(family = "Helvetica", size = 12)))})
}
# Run the application
shinyApp(ui = ui, server = server)
Since you havent provided any data to go with it, I will speculate that it doesnt work because you didnt wrap your data into a reactive expression. Try the server below:
# Define server logic required to draw a histogram
server <- function(input, output, session) {
inds <- reactive({
my.df[which(IndicatorID %in% input$indicator & Sex == "Persons"
& Timeperiod %in% input$year & ParentCode != "E92000001"),]
})
# draw the boxplot
# input$goButton
output$bPlot <- renderPlotly({
plot_ly(data = inds(), y = ~Value, color = inds()$ParentName,
type = "box", colors = viridis_pal(alpha = 1, begin = 0, end = 1, direction
= -1, option = "D")(3), boxpoints = "all", jitter = 0.3,
pointpos = -1.8) %>%
layout(title = "Dementia", titlefont = list(family =
"Helvetica", size = 16), yaxis = list(title = "Prevalence (%)", titlefont =
list(family = "Helvetica", size = 12)))})
}
# Run the application
shinyApp(ui = ui, server = server)
A few weeks ago I've asked about reactivity in R - Shiny, and I still haven't managed to crack the nut. It is driving me insane, I've read 100s of articles about reactivity, but I just can't make it work!
This is what I got so far:
ui.R:
column(width = 3,
box(
title = "Pick a metric",
status = "primary",
width = 12,
height = 200,
solidHeader = FALSE,
collapsible = FALSE,
selectInput("value", "Metric:",
c("Pages / Session" = "pageviewsPerSession",
"Avg. Session Duration" = "avgSessionDuration"))
) )
column(width = 9,
box(
title = "Title",
status = "primary",
width = 12,
height = 950,
solidHeader = FALSE,
collapsible = FALSE,
plotlyOutput("Scatter1")
server.R:
output$Scatter1 <- renderPlotly({
datasetInput <- reactive({
switch(input$value,
"Pages / Session" = SourcesDetail$pageviewsPerSession,
"Avg. Session Duration" = SourcesDetail$avgSessionDuration)
})
p <- plot_ly(SourcesDetail, x = datasetInput(), y = SourcesDetail$visits, text = paste("Source/Medium: ", SourcesDetail$sourceMedium),
mode = "markers", color = SourcesDetail$medium, opacity = SourcesDetail$sourceMedium, marker = list(size = 15))
})
There is no error message, there is simply no graph in my output.
Any help would be appreciated!!
You are assigning the output to p but not outputting p itself. Either remove p <- or put a single p at the end of renderPlotly:
Either
output$Scatter1 <- renderPlotly({
datasetInput <- reactive({
switch(input$value,
"Pages / Session" = SourcesDetail$pageviewsPerSession,
"Avg. Session Duration" = SourcesDetail$avgSessionDuration)
})
plot_ly(SourcesDetail, x = datasetInput(), y = SourcesDetail$visits, text = paste("Source/Medium: ", SourcesDetail$sourceMedium),
mode = "markers", color = SourcesDetail$medium, opacity = SourcesDetail$sourceMedium, marker = list(size = 15))
})
or
output$Scatter1 <- renderPlotly({
datasetInput <- reactive({
switch(input$value,
"Pages / Session" = SourcesDetail$pageviewsPerSession,
"Avg. Session Duration" = SourcesDetail$avgSessionDuration)
})
p <- plot_ly(SourcesDetail, x = datasetInput(), y = SourcesDetail$visits, text = paste("Source/Medium: ", SourcesDetail$sourceMedium),
mode = "markers", color = SourcesDetail$medium, opacity = SourcesDetail$sourceMedium, marker = list(size = 15))
p
})