This repository has been archived by the owner. It is now read-only.
Permalink
Browse files

Dockerize shinysurvey for Heroku Deployment

  • Loading branch information...
cadecairos committed Apr 27, 2018
1 parent 169a0ce commit a8cdcdf198133fe1b22af70f3699184cceeaf230
Showing with 96 additions and 40 deletions.
  1. +30 −0 Dockerfile
  2. +40 −40 server.R
  3. +13 −0 shiny-server.conf
  4. +13 −0 shiny-server.sh
@@ -0,0 +1,30 @@
FROM rocker/shiny
MAINTAINER Vojtech Sedlak (vojtech@mozillafoundation.org)
# install R package dependencies
RUN apt-get update && apt-get install -y \
sudo \
gdebi-core \
pandoc \
pandoc-citeproc \
libcurl4-gnutls-dev \
libcairo2-dev \
libxt-dev \
libssl-dev \
libxml2 \
libxml2-dev \
## clean up
&& apt-get clean \
&& rm -rf /var/lib/apt/lists/
## Install packages from CRAN
RUN R -e "install.packages(c('tidyverse', 'stringr', 'ggthemes', 'scales','shinydashboard','markdown','shinycssloaders','lubridate'), repos='http://cran.rstudio.com/')" \
## clean up
&& rm -rf /tmp/downloaded_packages/ /tmp/*.rds
COPY . /srv/shiny-server/shinysurvey/
RUN cp /srv/shiny-server/shinysurvey/shiny-server.conf /etc/shiny-server/shiny-server.conf
CMD ["/srv/shiny-server/shinysurvey/shiny-server.sh"]
@@ -11,43 +11,43 @@ survey <- getSurvey()
# Define server logic required to draw a histogram
server <- function(input, output) {
questions <- unique(survey$Question)
questions <- unique(survey$Question)
countries <- survey %>%
count(Country) %>%
filter(n>1000) %>%
select(Country)
# populate dropdown of questions
output$questionDropdown <- renderUI({
selectInput("question",label=NULL,questions,width="100%")
})
# populate filter dropdown
output$selectorDropdown <- renderUI({
options <- c("None","Age","Tech Knowledge","Facebook Users and Non-users","Country")
selectInput("filterSelector", label=NULL,
options)
})
# populate individual filter dropdown
output$inSelectorDropdown <- renderUI({
if (is.null(input$filterSelector)) {
return()
} else if (input$filterSelector == "None") {
return()
return()
} else {
options <- survey %>%
mutate(Vars=get(input$filterSelector)) %>%
count(Vars) %>%
filter(n>10000)
options_list <- unique(options$Vars)
selectInput("inFilterSelector", label="Select a filter:",
sort(options_list))
sort(options_list))
}
})
output$message <- renderUI({
if (is.null(input$question)) {
return(NULL)
@@ -60,19 +60,19 @@ server <- function(input, output) {
div(class="box box-solid box-warning",style="padding:20px;",
p("There isn't enough data for the filters you selected. Try changing the filtering criteria.")
)
}
}
}
})
# populate compare dropdown
output$compareDropdown <- renderUI({
selectInput("compareSelector",label=NULL,c("None","Age","Tech Knowledge","Facebook Users and Non-users","Frequency of Use"),selected="None")
})
valid <- reactive(
checkValidity()
)
# find what kind of chart we need
chartType <- reactive(
survey %>%
@@ -83,23 +83,23 @@ server <- function(input, output) {
# check if enough responses are gathered
checkValidity <- function() {
data <- raw()
data <- raw()
if (input$compareSelector != "None") {
totals <- data %>%
group_by(Answer,Vars) %>%
group_by(Answer,Vars) %>%
summarize(count=sum(n)) %>%
mutate(valid=ifelse(count>10,TRUE,FALSE))
mutate(valid=ifelse(count>10,TRUE,FALSE))
} else {
totals <- data %>%
group_by(Answer) %>%
group_by(Answer) %>%
summarize(count=sum(n)) %>%
mutate(valid=ifelse(count>10,TRUE,FALSE))
}
valid <<- all(totals$valid)
return(all(totals$valid))
}
# return only if enough responses exist
# return only if enough responses exist
data <- reactive(
if (is.null(input$question)) {
return(NULL)
@@ -111,15 +111,15 @@ server <- function(input, output) {
return(NULL)
}
)
# applyg filtering logic, if needed
raw <- reactive(
if (is.null(input$question)) {
return(NULL)
} else if (input$filterSelector != "None" & is.null(input$inFilterSelector)) {
return(NULL)
} else {
#initial filtering
if (input$filterSelector != "None") {
filtered <- survey %>%
@@ -130,43 +130,43 @@ server <- function(input, output) {
filter(Answer != "Unknown") %>%
filter(Question==input$question)
}
# check if results are to be compared
if (input$compareSelector != "None") {
data <- filtered %>%
count(Answer,Vars=get(input$compareSelector))
totals <- data %>%
group_by(Vars) %>%
summarize(total=sum(n))
data <- left_join(data,totals) %>%
filter(total > 20) %>%
mutate(share=round((n/total)*100,digits=2))
mutate(share=round((n/total)*100,digits=2))
} else {
data <- filtered %>%
count(Answer) %>%
mutate(share=n/sum(n)*100)
}
}
)
output$Question <- renderText({
if (is.null(input$question)) {
return()
} else {
input$question
}
})
# render plot output
output$answerPlot <- renderPlot({
if (is.null(data())) {
return()
} else {
data <- data()
chart <- ggplot(data)
if (chartType() == "Histogram") {
if (input$compareSelector != "None" && input$compareSelector != "Country") {
@@ -188,10 +188,10 @@ server <- function(input, output) {
geom_bar(aes(x=Answer,y=share),fill="#1FBEC3",position="dodge",stat="identity") +
scale_x_discrete(labels = function(x) str_wrap(x, width = 20))
}
}
}
# common chart elements
chart <- chart +
chart <- chart +
labs(y="Share (in %)", x="Answer") +
theme(legend.background=element_rect(color="#357CA5",size=0.5,linetype = "solid")) +
theme(legend.position="top") +
@@ -200,7 +200,7 @@ server <- function(input, output) {
chart
}
})
# render sample sizes table
output$totalSamples <- renderTable({
if (is.null(data())) {
@@ -214,10 +214,10 @@ server <- function(input, output) {
} else {
data() %>%
summarize(Sample=sum(n))
}
}
}
})
# render table with answers
output$answerTable <- renderTable({
if (is.null(data())) {
@@ -234,16 +234,16 @@ server <- function(input, output) {
}
}
})
# render table with answers
output$simpleTable <- renderTable({
if (is.null(data())) {
return()
}
}
data() %>%
mutate(n=format(n,format="d", big.mark=","),share=percent(share/100))
})
# render table with answers
output$valueTable <- renderTable({
if (is.null(data())) {
@@ -259,7 +259,7 @@ server <- function(input, output) {
}
}
})
# handle download
output$download <- downloadHandler(
filename = function() {
@@ -270,5 +270,5 @@ server <- function(input, output) {
write.csv(data, con)
}
)
}
@@ -0,0 +1,13 @@
run_as $USER;
server {
listen $PORT;
frame_options deny;
location / {
run_as $USER;
app_dir /srv/shiny-server/shinysurvey;
log_dir /var/log/shiny-server;
}
}
@@ -0,0 +1,13 @@
#!/bin/sh
# Make sure the directory for individual app logs exists
mkdir -p /var/log/shiny-server
sed -i -e "s/\$PORT/$PORT/g" /etc/shiny-server/shiny-server.conf
USER=`whoami`
mkhomedir_helper $USER
sed -i -e "s/\$USER/$USER/g" /etc/shiny-server/shiny-server.conf
exec shiny-server 2>&1

0 comments on commit a8cdcdf

Please sign in to comment.