Peter Haschke
Back to the Index
Political Terror Scale ShinyApp
I have been following RStudio’s Shiny project for a while. I think Shiny applications are a pretty neat way to explore data interactively. As the Political Terror Scale website currently has very little to offer in terms of an interactive way to visualize and explore the data, I thought I mess around with Shiny and see if I could make sense of it and produce anything even remotely reasonable.
It turns out that RStudio provides an incredibly useful tutorial for getting started with Shiny. All one has to do is to install the shiny package in R and follow the instructions in the tutorial. From then on out little else is required beyond basic R knowledge.
Below I reproduce the code for the little test application I wrote. The application itself is hosted on shinyapps.io and can be accessed there: PTS Shiny App.1 Please note that my code is terribly cumbersome, inefficient, and inelegant. The ShinyApp servers are also pretty slow, I think. In any case the app is probably not going to be very smooth and/or responsive. Any suggestions will be appreciated.
ui.R
library(shiny)
# Loading Data
pts <- read.csv("http://www.peterhaschke.com/files/PTS.csv")
shinyUI(pageWithSidebar(
# Application title
headerPanel("The Political Terror Scale (PTS) App"),
# Sidebar with controls
sidebarPanel(
# Changing some html settings of the user interface
tags$style(type='text/css', "h1 { color: #586e75;}"),
tags$style(type='text/css', ".well { background-color: #eee8d5; }"),
tags$style(type='text/css', ".span4 { max-width: 300px }"),
tags$style(type="text/css", "textarea { max-width: 220px }"),
tags$style(type="text/css", ".jslider { max-width: 220px; }"),
# Input selector for PTS Scales
selectInput("scale", "Choose Scale:",
choices = c("Amnesty International" = "Amnesty",
"State Department" = "StateDept")),
br(),
br(),
# Input selector for Country
selectInput("country", "Choose Country:",
unique(pts$Country)),
br(),
br(),
# Input checkboxes
checkboxInput("trend", "Show Country Trend", FALSE),
checkboxInput("world", "Show World Trend", FALSE),
br(),
br(),
# Input Slider
sliderInput("span",
"Smoothness of Fit:",
min = 0.25,
max = 1,
value = 0.75,
step= 0.05),
br(),
br(),
# Text area
helpText("Source:", a("The Political Terror Scale",
href="http://www.politicalterrorscale.org/"))
),
# Output Panel
mainPanel(
tags$style(type='text/css', "body { background-color: #fdf6e3;}"),
# separate tabs for various ouputs
tabsetPanel(
tabPanel("Plot", plotOutput("plot", height = "600px")),
tabPanel("Table", tableOutput("table")),
tabPanel("Data", tableOutput("table2"),
downloadButton('downloadData', "Download this Data"), br(), br())
)
)… and …
server.R
library(shiny)
library(ggplot2)
library(ggthemes)
theme_set(theme_solarized())
pts <- read.csv("http://www.peterhaschke.com/files/PTS.csv") # Web
shinyServer(function(input, output) {
output$plot <- renderPlot({
if (input$scale == "Amnesty") {
temp <- data.frame(Year = pts$Year, Scale = pts$Amnesty, Country = pts$Country)
world <- data.frame(Year = pts$Year, Scale = pts$Amnesty)
} else {
temp <- data.frame(Year = pts$Year, Scale = pts$StateDept, Country = pts$Country)
world <- data.frame(Year = pts$Year, Scale = pts$StateDept)
}
temp <- subset(temp, temp$Country == input$country)
if (length(temp$Scale) - sum(is.na(temp$Scale)) > 5) {
p1 <- ggplot(temp, aes(x=Year, y=Scale)) +
ggtitle(input$country) +
geom_point(size = 3, col = "black") +
labs(y = paste("PTS - ", input$scale)) +
scale_x_continuous(breaks = seq(1975, 2015, by = 5)) +
coord_cartesian(ylim = c(0.25 ,5.75), xlim = c(1974.5, 2015.5))
if(input$trend) {
p1 <- p1 +
geom_smooth(aes(col = paste(" ",Country, "Trend ")), method = "loess",
span = input$span, alpha = 0.3, size = 0.7) +
theme(legend.direction = "horizontal", legend.position = "bottom") +
guides(color = guide_legend(title = "", title.position = "top",
title.hjust=.5, keywidth = 2, keyheight = 1, , override.aes = list(alpha=0.1))) +
scale_color_manual("", values = c("#268bd2", "#d33682"))
}
} else {
p1 <- ggplot(temp, aes(x=Year, y=Scale)) +
ggtitle(input$country) +
geom_point(size = 3, col = "black") +
labs(y = paste("PTS - ", input$scale)) +
scale_x_continuous(breaks = seq(1975, 2015, by = 5)) +
coord_cartesian(ylim = c(0.25 ,5.75), xlim = c(1974.5, 2015.5))
}
if(input$world) {
p1 <- p1 +
geom_smooth(data = world, aes(x= Year, y= Scale, color = "World Trend"), alpha = 0.3) +
theme(legend.direction = "horizontal", legend.position = "bottom",
legend.background = element_rect(fill="transparent")) +
guides(color = guide_legend(title = "", title.position = "top", title.hjust=.5,
keywidth = 2, keyheight = 1, override.aes = list(alpha=0.1)))
}
print(p1)
}, bg="transparent")
# Summary Stats
output$table <- renderTable({
if (input$scale == "Amnesty") {
temp <- data.frame(Year = pts$Year, Scale = pts$Amnesty, Country = pts$Country)
world <- data.frame(Year = pts$Year, Scale = pts$Amnesty)
} else {
temp <- data.frame(Year = pts$Year, Scale = pts$StateDept, Country = pts$Country)
world <- data.frame(Year = pts$Year, Scale = pts$StateDept)
}
temp <- subset(temp, temp$Country == input$country)
m <- round(mean(temp$Scale, na.rm = TRUE), digits = 2)
if (is.nan(m) == TRUE) {m <- "NA"}
m2 <- round(median(temp$Scale, na.rm = TRUE), digits = 2)
if (is.na(m2) == TRUE) {m2 <- "NA"}
s <- round(sd(temp$Scale, na.rm = TRUE), digits = 2)
if (is.na(s) == TRUE) {s <- "NA"}
mi <- round(min(temp$Scale, na.rm = TRUE), digits = 0)
if (is.infinite(mi) == TRUE) {mi <- "NA"}
ma <- round(max(temp$Scale, na.rm = TRUE), digits = 0)
if (is.infinite(ma) == TRUE) {ma <- "NA"}
ym <- sum(is.na(temp$Scale))
foo <- c(input$scale, m, m2, s, mi, ma, ym)
word <- c("Scale", "Mean", "Median", "Standard Deviation", "Min", "Max", "Obs. Missing")
put <- data.frame(word, foo)
names(put) <- c("Country", input$country)
put
})
# Table displaying the data
output$table2 <- renderTable({
temp <- subset(pts, pts$Country == input$country)
foo <- data.frame("Year" = temp$Year, "Amnesty" = temp$Amnesty, "StateDept" = temp$StateDept)
names(foo) <- c("Year", "PTS -\nAmnesty", "PTS -\nState Dept.")
foo
})
# Download Data
output$downloadData <- downloadHandler(
filename = function() { paste(input$country, '.csv', sep='') },
content = function(file) {
write.csv(subset(pts, pts$Country == input$country)[,5:7], file)
}
)
})-
It took me a while to figure out how to deploy the shiny application I wrote. It is important that your R packages are up-to-date, that you specify an app name that is not too short and not too long (and doesn’t contain any funky characters). You also need the devtools and shinyapps R packages. They are available on GitHub. For some reason the documentation for ShinyApps and instructions for how to deploy your app to the ShinyApps servers is kind of hidden. Here’s the link: ShinyApps. ↩
Back to the Blog-Index