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

initial commit

  • Loading branch information...
portsideanalytics committed Apr 25, 2018
1 parent 9d122f8 commit 169a0ce91d98695f0f425ae35978db2d033c9d8c
Showing with 47,199 additions and 0 deletions.
  1. +91 −0 functions.R
  2. +274 −0 server.R
  3. +46,620 −0 survey.csv
  4. +95 −0 ui.R
  5. +110 −0 www/about.md
  6. BIN www/mozilla.png
  7. +9 −0 www/styles.css
View
@@ -0,0 +1,91 @@
getSurvey <- function() {
library(tidyverse)
library(lubridate)
library(stringr)
raw <- read_csv("survey.csv")
# sample size to work with the data
#raw <- raw[1:1000,]
# handle NAs
raw[is.na(raw)] <- "Unknown"
# format data
data <- raw %>%
mutate(`Date Submitted`=mdy_hms(`Date Submitted`),
`Time Started`=mdy_hms(`Time Started`),
Age=as.factor(`Age (optional)`),
`Frequency of Use`=case_when(
str_detect(`How often do you use Facebook?`,"I’m not on Facebook") ~ "Not on Facebook",
str_detect(`How often do you use Facebook?`,"constantly") ~ "Constant User",
str_detect(`How often do you use Facebook?`,"day") ~ "Daily User",
TRUE ~ "Occasional User"),
`Tech Knowledge` = as.factor(`I consider myself:`),
`Facebook Users and Non-users` = case_when(
`Frequency of Use` == "Not on Facebook" ~ "Non-user",
TRUE ~ "User"),
`I know how to: Change Facebook privacy settings` = case_when(
str_detect(`Change your Facebook privacy settings:Check all the items you currently know how to do:`,"Unknown") ~ "No",
TRUE ~ "Yes"),
`I know how to: Opt out of allowing third-party apps to track me and my friends` = case_when(
str_detect(`Opt out of allowing third-party apps to track you and your friends:Check all the items you currently know how to do:`,"Unknown") ~ "No",
TRUE ~ "Yes"),
`I know how to: Publish something so only a few of my friends can see it` = case_when(
str_detect(`Publish something so only a few of your friends can see it:Check all the items you currently know how to do:`,"Unknown") ~ "No",
TRUE ~ "Yes"),
`I know how to: Browse Facebook while limiting its ability to track me` = case_when(
str_detect(`Browse Facebook while limiting its ability to track you:Check all the items you currently know how to do:`,"Unknown") ~ "No",
TRUE ~ "Yes"),
`I know how to: Delete my Facebook page` = case_when(
str_detect(`Delete your Facebook page:Check all the items you currently know how to do:`,"Unknown") ~ "No",
TRUE ~ "Yes"),
`I know how to: Create a targeted Facebook ad` = case_when(
str_detect(`Create a targeted Facebook ad:Check all the items you currently know how to do:`, "Unknown") ~ "No",
TRUE ~ "Yes"),
`I know how to: Find out all the data Facebook has collected on me` = case_when(
str_detect(`Find out all the data Facebook has collected on me already:Check all the items you currently know how to do:`,"Unknown") ~ "No",
TRUE ~ "Yes"),
`I know how to: Make a backup of all of my content on Facebook (photos, videos, etc.)` = case_when(
str_detect(`Make a backup of all my content on Facebook (photos, videos, etc):Check all the items you currently know how to do:`, "Unknown") ~ "No",
TRUE ~ "Yes")
) %>%
select(c(`Response ID`:Country),
`Link Name`,
c(Age:`Facebook Users and Non-users`),
c(`I consider myself:`:`Do you know what types of personal information Facebook collects about you?`),
`Would you consider paying for a version of Facebook that doesnt make money off you by collecting and selling your data?`,
`Have you made any changes on Facebook as a result of the recent Cambridge Analytica and Facebook revelations?`,
c(`I know how to: Change Facebook privacy settings`:`I know how to: Make a backup of all of my content on Facebook (photos, videos, etc.)`)
) %>%
gather(`I consider myself:`:`I know how to: Make a backup of all of my content on Facebook (photos, videos, etc.)`,key="Question",value="Answer") %>%
mutate(Chart = case_when(
str_detect(Question,"How concerned are you") ~ "Histogram",
str_detect(Question,"what types of personal information") ~ "Stacked",
str_detect(Question,"Have you made any changes") ~ "Stacked",
TRUE ~ "Stacked"
))
return(data)
}
getDownloadableSurvey <- function() {
library(tidyverse)
library(lubridate)
library(stringr)
raw <- read_csv("survey.csv")
# sample size to work with the data
#raw <- raw[1:1000,]
# handle NAs
raw[is.na(raw)] <- "Unknown"
data <- raw %>%
select(c(`Response ID`),
Country,
c(`I consider myself:`:`Would you consider paying for a version of Facebook that doesnt make money off you by collecting and selling your data?`),
`Age (optional)`
)
return(data)
}
View
274 server.R
@@ -0,0 +1,274 @@
library(shiny)
library(tidyverse)
library(lubridate)
library(stringr)
library(ggthemes)
library(scales)
source("functions.R")
survey <- getSurvey()
# Define server logic required to draw a histogram
server <- function(input, output) {
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()
} 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))
}
})
output$message <- renderUI({
if (is.null(input$question)) {
return(NULL)
} else if (input$filterSelector != "None" & is.null(input$inFilterSelector)) {
return(NULL)
} else {
if(checkValidity()) {
return(NULL)
} else {
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 %>%
filter(Question==input$question) %>%
select(Chart) %>%
head(1)
)
# check if enough responses are gathered
checkValidity <- function() {
data <- raw()
if (input$compareSelector != "None") {
totals <- data %>%
group_by(Answer,Vars) %>%
summarize(count=sum(n)) %>%
mutate(valid=ifelse(count>10,TRUE,FALSE))
} else {
totals <- data %>%
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
data <- reactive(
if (is.null(input$question)) {
return(NULL)
} else if (input$filterSelector != "None" & is.null(input$inFilterSelector)) {
return(NULL)
} else if (checkValidity()) {
raw()
} else {
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 %>%
filter(Answer != "Unknown") %>%
filter(Question==input$question,get(input$filterSelector)==input$inFilterSelector)
} else {
filtered <- survey %>%
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))
} 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") {
chart <- chart +
geom_bar(aes(x=as.integer(Answer),y=share,fill=Vars),position="dodge",stat="identity") +
scale_x_continuous()
} else {
chart <- chart +
geom_bar(aes(x=as.integer(Answer),y=share),fill="#1FBEC3",position="dodge",stat="identity") +
scale_x_continuous()
}
} else {
if (input$compareSelector != "None" && input$compareSelector != "Country") {
chart <- chart +
geom_bar(aes(x=Answer,y=share,fill=Vars),position="dodge",stat="identity") +
scale_x_discrete(labels = function(x) str_wrap(x, width = 20))
} else {
chart <- chart +
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 +
labs(y="Share (in %)", x="Answer") +
theme(legend.background=element_rect(color="#357CA5",size=0.5,linetype = "solid")) +
theme(legend.position="top") +
theme_hc(base_size = 18,base_family="Helvetica") +
guides(fill=guide_legend(nrow=4,byrow=TRUE,title="Categories",title.position = "top"))
chart
}
})
# render sample sizes table
output$totalSamples <- renderTable({
if (is.null(data())) {
return()
} else {
if (input$compareSelector != "None" && input$compareSelector != "Country") {
data <- data()
data %>%
group_by(Categories = Vars) %>%
summarize(Sample=sum(n),Share=str_c(round(Sample/sum(data$n)*100,digits=2),"%"))
} else {
data() %>%
summarize(Sample=sum(n))
}
}
})
# render table with answers
output$answerTable <- renderTable({
if (is.null(data())) {
return()
} else {
if (input$compareSelector != "None" && input$compareSelector != "Country") {
data() %>%
select(-n,-total) %>%
mutate(share=percent(share/100)) %>%
spread(Vars,share)
} else {
data() %>%
mutate(n=format(n,format="d",big.mark = ","),share=percent(share/100))
}
}
})
# 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())) {
return()
} else {
if (input$compareSelector != "None" && input$compareSelector != "Country") {
data() %>%
select(-share,-total) %>%
mutate(n=format(n,format="d",big.mark=",")) %>%
spread(Vars,n)
} else {
return()
}
}
})
# handle download
output$download <- downloadHandler(
filename = function() {
"facebook_survey.csv"
},
content = function(con) {
data <- getDownloadableSurvey()
write.csv(data, con)
}
)
}
Oops, something went wrong.

0 comments on commit 169a0ce

Please sign in to comment.