this is my first time asking on stack overflow so sorry for mistakes.
I am making a project where I should create a Shiny app in R. The app should download the data from a certain domain and after that there are several things it should allow the user to do:
download the latest data from the EUROSTAT website;
select the set of countries whose data will be presented;
select the years of data to be presented;
selection of genders for which data will be presented;
presentation of selected data in tabular form in the format:
COUNTRY; TRIBE; WEEK; NUMBER;
aggregation of data on the map of EUROPE;
total for the indicated period, for the indicated genders, within the country;
visualization of selected data in the form of time series;
one time series for selected genders, for each country separately;
Right now I am focusing on the first 5 points. I know how to get the data downloaded and how to filter and prepare it properly but I think I am doing something wrong when it comes to the Shiny environment, because when I run the app it opens up but the table created has no data inside of it. I am having problems understading shiny since this is my first time doing anything in it. Any help is welcome.
I did 2 codes and tried to run them but as I said the outcome was and empty table no matter what year or week I chose.
This is how my server.R file looks:
library(ggplot2)
library(shiny)
library(dplyr)
library(data.table)
library(googleVis)
shinyServer(function(input, output) {
outVar <- reactiveValues(
selectYearVar = "2021"
)
outVar1 <- reactiveValues(
selectWeekVar = "1"
)
outVar2 <- reactiveValues(
selectSexVar = "f"
)
outVar3 <- reactiveValues(
selectCountryVar = "PL"
)
observeEvent(input$selectCountry,{
outVar3$selectCountryVar <- input$selectCountry
})
observeEvent(input$selectSex,{
outVar2$selectSexVar <- input$selectSex
})
observeEvent(input$selectYear,{
outVar$selectYearVar <- input$selectYear
})
observeEvent(input$selectWeek,{
outVar1$selectWeekVar <- input$selectWeek
})
dataIn <- reactive({
try({
options(width=250)
rm(list=ls())
dataDir <- getwd()#file.path(getwd(),"data")
download.file(url="https://ec.europa.eu/eurostat/estat-navtree-portlet-prod/BulkDownloadListing?file=data/demo_r_mwk_ts.tsv.gz",
destfile=file.path(dataDir,"demo_r_mwk_ts.tsv.gz"),method="curl")
d <- read.table(file=file.path(dataDir,"demo_r_mwk_ts.tsv.gz"),sep="\t",dec=".",header=T)
x <- as.data.frame(rbindlist(lapply(c("AD","AL","AM","AT","BE","BG","CH","CY","CZ","DE","DK","EE","EL","ES","FI","FR","GE","HR","HU","IE","IS","IT","LI","LT",
"LU","LV","ME","MT","NL","NO","PL","PT","RO","RS","SE","SI","SK","UK"),function(country){
x <- t(d[grep(country,d[,1]),])
x <- x[-1,]
options(warn=-1)
x <- data.frame(
week = gsub("X","",rownames(x)),
f = as.integer(gsub(" p","",x[,1])),
m = as.integer(gsub(" p","",x[,2])),
t = as.integer(gsub(" p","",x[,3])),
c = country
)
options(warn=0)
rownames(x) <- NULL
x <- x[order(x$week),]
return(x)
})))
rownames(x) <- NULL
x[, "year"] <- as.integer(substr(x[, "week"], 0, 4))
x[, "week"] <- as.integer(substr(x[, "week"], 6, 7))
x <- x[week, year, c, outVar2$selectSexVar]
x <- x[(as.character(x$year)==as.character(outVar$selectYearVar)) & (as.character(x$week)==as.character(outVar1$selectWeekVar)) & (as.character(x$c)==as.character(outVar3$selectCountryVar)),]
return(x)
},silent=T)
return(data.frame())
})
output$dataSample <- DT::renderDataTable({
DT::datatable(
dataIn(),
rownames = FALSE,
options = list(
scrollX = TRUE,
pageLength = 16,
lengthMenu = seq(from=2,by=2,to=16)
)
)
})
})
and here is the ui.R file
library(shiny)
library(data.table)
library(googleVis)
shinyUI(fluidPage(
titlePanel("PiWD/shiny/sgh/umieralnosc"),
sidebarLayout(
sidebarPanel(
selectInput("selectYear",
label = "Rok danych",
choices = as.vector(as.character(2023:2000),mode="list")
),
selectInput("selectWeek",
label = "Tydzień danych",
choices = as.vector(as.character(53:1),mode="list")
),
selectInput("selectSex",
label = "Płeć",
choices = as.vector(as.character(c("f","m","t")),mode="list")
),
selectInput("selectCountry",
label = "Rok danych",
choices = as.vector(as.character(c("AD","AL","AM","AT","BE","BG","CH","CY","CZ","DE","DK","EE","EL","ES","FI","FR","GE","HR","HU","IE","IS","IT","LI","LT",
"LU","LV","ME","MT","NL","NO","PL","PT","RO","RS","SE","SI","SK","UK")),mode="list")
)
),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Moja tabela", DT::dataTableOutput("dataSample")),
)
)
)
))
Related
Hi I'm relatively new to Shiny and am not sure how to do this. I am making a dashboard that should first pull the relevant dataframe based on user selectInput, after which further selectInput functions will further filter down the sheet for the relevant price. However, I can't seem to link the InputId from the selectInput to the relevant dataframe name. (Below is code)
UI.R
ui <- navbarPage(
"Dashboard",
tabPanel(
"Cost1",
fluidPage(
selectInput("type",
label = "Select Type",
choices = NULL),
textOutput("message")
)
)
)
Server.R
#load libraries, data
library(tidyr)
library(readxl)
library(dplyr)
library(purrr)
a <- read_excel('source.xlsx', sheet = 'a')
b <- read_excel('source.xlsx', sheet = 'b')
c <- read_excel('source.xlsx', sheet = 'c')
mylist <- list(a = a, b = b, c = c)
server <- function(input, output, session) {
updateSelectInput(session,
"type",
choices = names(mylist))
material = reactive(input$type)
price <- material[1,"price"]
output$message <- renderText({
paste(price)
})
}
Thank you!
There is a few things that need to correct in your original code - here is my code for 3 files global.R, server.R, and ui.R with detail explanation comments. (my habit of separating them so it easier to manage.
global.R
#load libraries, data
library(shiny)
library(tidyr)
library(readxl)
library(dplyr)
library(purrr)
# This is just a generation of sample data to be used in this answer.
set.seed(1)
generate_random_df <- function(name) {
tibble(
product = paste0(name, "-", round(runif(n = 10, min = 1, max = 100))),
price = runif(10))
}
a <- generate_random_df("a")
b <- generate_random_df("b")
c <- generate_random_df("c")
mylist <- list(a = a, b = b, c = c)
server.R
set.seed(1)
generate_random_df <- function(name) {
tibble(
product = paste0(name, "-", round(runif(n = 10, min = 1, max = 100))),
price = runif(10))
}
a <- generate_random_df("a")
b <- generate_random_df("b")
c <- generate_random_df("c")
mylist <- list(a = a, b = b, c = c)
server <- function(input, output, session) {
updateSelectInput(session,
"type",
choices = names(mylist))
# to extract the data you need to reference to mylist as the Input only take
# the name of your list not the dataset within it
price <- reactive({
# Here the material command also inside the reactive not as you do initially
material <- mylist[[input$type]]
paste0(material[1,"price"])
})
# You don't need renderText for this just assign the value to message
output$message <- price
# I also output the table for easier to see
output$price_table <- renderTable(mylist[[input$type]])
}
ui.R
ui <- navbarPage(
"Dashboard",
tabPanel(
"Cost1",
fluidPage(
selectInput("type",
label = "Select Type",
choices = NULL),
textOutput("message"),
tableOutput("price_table")
)
)
)
Here is the screenshot of the app
I have an application where the user selects the stocks she want's to analyze. Depending on the number of stocks chosen, the app will render equal amounts of UIOuputs where the user can choose the weight for each stock. So for example, if you choose 6 stocks to analyze, 6 uioutputs will render each asking to select a weight.
The problem I am having is, I would like to create a data frame with the inputs. So if a user selects AAPl and MSFT with weights .50 and .50. I would like to create a df:
Ticker Weight
AAPL .50
MSFT .50
However, when I try and create the dataframe I get an error inputs are not of the same length. I believe this is because of how shiny reactivity works (not ordered). Any inputs would be greatly appreciated. Below is the app.
library(shiny)
library(purrr)
library(tidyverse)
library(DT)
tickers = c("SPY", "IWM", "QQQ", "TLT", "AGG", "GLD", "SLV")
ui <- fluidPage(
# Application title
titlePanel("Portfolio Builder"),
#select the stocks you want to analyze
mainPanel(
selectizeInput("mult", "chose stock", choices = tickers, selected = "SPY", multiple = T),
uiOutput("plo"),
dataTableOutput("dataTab")
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$plo = renderUI({
z = length(input$mult)
name = input$mult
map2(seq(z), name, ~ numericInput(inputId = paste0("hey",.x), label = paste("weight", .y), value = 10))
})
weights = reactiveValues()
observe({weights$current = map(seq(length(input$mult)),~input[[paste0("hey",.x)]]) %>% unlist()})
mat = reactive({
#if(length(weights$current) == length(input$mult)){
df = data.frame(ticker = input$mult, weight = weights$current) %>% mutate(weightPct = weights$current/sum(weights$current))
# }else{NULL}
})
output$dataTab = renderDataTable({
mat()
})
observe(print(weights$current))
observe(print(input$mult))
}
I converted your observe() and reactiveValues() to a single reactive() object. This way it reacts to changes without the complexity you had. The other big difference is that I converted the weights object to a list, but I think it should still be easy to follow. The data frame error persisted as the length of the user inputs and weights momentarily mismatch, so I returned the length check you already had:
library(shiny)
library(purrr)
library(tidyverse)
library(DT)
tickers = c("SPY", "IWM", "QQQ", "TLT", "AGG", "GLD", "SLV")
suppressWarnings()
ui <- fluidPage(
# Application title
titlePanel("Portfolio Builder"),
#select the stocks you want to analyze
mainPanel(
selectizeInput("mult", "chose stock", choices = tickers, selected = "SPY", multiple = T),
uiOutput("plo"),
dataTableOutput("dataTab")
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$plo = renderUI({
z = length(input$mult)
name = input$mult
map2(seq(z), name, ~ numericInput(inputId = paste0("hey",.x), label = paste("weight", .y), value = 10))
})
weights = reactive({
req(input$mult)
list(current = map(seq(length(input$mult)),~input[[paste0("hey",.x)]]) %>% unlist())
})
mat = reactive({
req(weights()$current)
if(length(weights()$current) == length(input$mult)){
df = data.frame(ticker = input$mult, weight = weights()$current) %>% mutate(weightPct = weights()$current/sum(weights()$current))
}
})
output$dataTab = renderDataTable({
req(mat())
mat()
})
}
shinyApp(ui, server)
I would like a user to be able to type in the name of a dataframe object and have that object rendered as a formatted data table in a Shiny application.
Here is a toy example. There are two dataframe objects available in the workspace: df1 and df2. When the user types in df1, I would like that dataframe to be rendered. Likewise for df2 or for any other dataframe they have in their workspace.
I suspect I have to do something with environments or scoping or evaluation but I am not sure what.
I have commented in the code where I can hardcode in the built-in mtcars dataset and have that rendered correctly. Now I just want to be able to do the same for any ad-hoc dataframe in a user's workspace.
library(shiny)
set.seed(1234)
x <- sample.int(n = 20)
y <- sample(x = LETTERS, size = 20)
a <- rnorm(n = 20)
b <- sample(x = letters, size = 20)
df1 <- data.frame(x = x, y = y)
df2 <- data.frame(a = a, b = b)
# Define UI ----
ui <- fluidPage(
titlePanel("Using text inputs to select dataframes"),
sidebarLayout(position = "left",
sidebarPanel(width = 5,
textInput("dfInput", h5("Enter name of dataframe"),
value = "")),
mainPanel(width = 6,
h4("Here's your data"),
textOutput("selected_df"),
dataTableOutput("view")
)
)
)
# Define server logic ----
server <- function(input, output, session) {
output$selected_df <- renderText({
paste("You have selected ", input$dfInput)
})
output$view <-
renderDataTable({
input$dfInput # this should render the selected dataframe. If you replace this with mtcars then that dataset is correctly rendered.
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
We are going to get all the dataframes within the global enviriment first and then use get in order to access the object. I changed the textInput to selectInput so you dont need to type anything, potentially making a mistake. Moreover I added the data from datasets package however you should build more test cases to check if the data exists
library(shiny)
set.seed(1234)
x <- sample.int(n = 20)
y <- sample(x = LETTERS, size = 20)
a <- rnorm(n = 20)
b <- sample(x = letters, size = 20)
df1 <- data.frame(x = x, y = y)
df2 <- data.frame(a = a, b = b)
mydataframes <- names(which(unlist(eapply(.GlobalEnv,is.data.frame))))
OpenData <- data()$results[,3]
#Define UI ----
ui <- fluidPage(
titlePanel("Using text inputs to select dataframes"),
sidebarLayout(position = "left",
sidebarPanel(width = 5,
selectInput("dfInput","Select Dataframe",
#choices = mydataframes,
list("Your Datasets" = c(mydataframes),
"R Datasets" = c(OpenData),
selected=NULL))),
mainPanel(width = 6,
h4("Here's your data"),
textOutput("selected_df"),
dataTableOutput("view")
)
)
)
# Define server logic ----
server <- function(input, output, session) {
output$selected_df <- renderText({
paste("You have selected ", input$dfInput)
})
output$view <-
renderDataTable({
as.data.frame(get(input$dfInput)) # this should render the selected dataframe. If you replace this with mtcars then that dataset is correctly rendered.
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
I've been working on a visualization project in shiny. I'm trying to filter a data set by given input - number of state and range of the slider. Unfortunately, r 'omits' the the code part and outputs the entire data set. I also get warnings: 'data' is not a graphical parameter.
library(shiny)
library(Ecdat)
u <- shinyUI(pageWithSidebar(
headerPanel("Social benefits"),
sidebarPanel(
selectInput("variable", "Variable:",
list("Unemployment",
"Max benefit"
)),
#Specification of state
textInput("state", "State:", value = "93"),
# Specification of range within an interval
sliderInput("range", "Range:",
min = 1, max = 100, value = c(20,100))
),
mainPanel(
plotOutput("mpgPlot")
)
))
s <- shinyServer(function(input, output)
{
#filter by state -ERROR
p <- reactive({ Benefits[Benefits$state == input$state,]})
#filter by slider range - ERROR
dataX <- reactive({ p()[input$range[1]:input$range[2],,drop = FALSE] })
variable <- reactive({
switch(input$variable,
"Unemployment" = stateur,
"Max benefit" = statemb
)
})
caption <- reactive({
paste(input$variable)
})
output$mpgPlot <- renderPlot({
plot(variable(), data = dataX(), type = "l",ylab = caption())
})
})
shinyApp(u,s)
All that was actually needed was to specify the data set name before the variable, since the data set from the environment was overshadowing the filtered one.
output$urPlot <- renderPlot({
plot(dataX()$stateur, data = dataX(), type = "l",ylab = "Unemployment")
})
output$mbPlot <- renderPlot({
plot(dataX()$statemb, data = dataX(), type = "l",ylab = "Max benefit")
})
I'm new to Shiny and coding. I found an example that uses a choropleth map (ichorophlet function) to show crime rates across years and US states. I'd like to replicate this map in Shiny using annual poverty rates in the US. My questions are: 1) How do get the map to load on Shiny? 2) How do I get the animation button to work? Below are the R codes I used. Any ideas how to fix this issue?
ui.R
shinyUI(fluidPage(
titlePanel("U.S. Poverty Rates"),
# Sidebar with slider that demonstrates various years
sidebarLayout(
sidebarPanel(
helpText("Create a poverty map."),
# Animation with custom interval (in ms) to control speed, plus looping
sliderInput("animation", "Press Play:", 1980, 2015, 1, step=1,
animate=animationOptions(interval=800, loop=TRUE))),
# Show map summarizing the values entered
mainPanel(
plotOutput("map")
)
)
))
server.R
# Load libraries
library(lattice)
library(plyr)
library(dplyr)
library(readxl)
library(RColorBrewer)
library(rMaps)
library(rjson)
library(rCharts)
library(shiny)
# Load data and helper files
data <- read_excel("data/hstpov21.xls", sheet = "Sheet1")
source("toJASON.R")
source("ichoropleth.R")
# Remove DC
datm <- subset(na.omit(data),
!(State %in% c("D.C.", "District of Columbia")))
# Discreticize poverty rates
datm2 <- transform(datm,
State = state.abb[match(as.character(State), state.name)],
fillKey = cut(Poverty,
quantile(Poverty, seq(0, 1, 1/5)),
labels = LETTERS[1:5]),
Year = as.numeric(substr(Year, 1, 4))
)
# Fill colors
fills = setNames(
c(RColorBrewer::brewer.pal(5, 'YlOrRd'), 'white'),
c(LETTERS[1:5], 'defaultFill')
)
# Create Payload for DataMaps
dat2 <- dlply(na.omit(datm2), "Year", function(x){
y = toJSONArray2(x, json = F)
names(y) = lapply(y, '[[', 'State')
return(y)
})
# Define server logic for slider
shinyServer(
function(input, output) {
# Reactive expression to compose a data frame containing all of the values
sliderValues <- reactive({
# Compose data frame
data.frame(
Name = c("Animation"),
Value = as.character(c(input$animation)),
stringsAsFactors=FALSE)
})
# Show the values using a chorophlet map
output$map <- renderPlot({
sliderValues()
ichoropleth(Poverty ~ State,
data = datm2[,1:3],
pal = 'PuRd',
ncuts = 5,
animate = 'Year',
play = TRUE)
})
})