Advertisement
Guest User

Untitled

a guest
Oct 28th, 2016
72
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 9.90 KB | None | 0 0
  1. # Exercise 2 - solution
  2.  
  3. library(shiny)
  4. library(gapminder)
  5. library(dplyr)
  6.  
  7. # Note: This code creates data sets to use in each tab.
  8. # It removes Kuwait since Kuwait distorts the gdp scale
  9. all_data <- filter(gapminder, country != "Kuwait")
  10. africa_data <- filter(gapminder, continent == "Africa")
  11. americas_data <- filter(gapminder, continent == "Americas")
  12. asia_data <- filter(gapminder, continent == "Asia", country != "Kuwait")
  13. europe_data <- filter(gapminder, continent == "Europe")
  14. oceania_data <- filter(gapminder, continent == "Oceania")
  15.  
  16. ui <- fluidPage(
  17. titlePanel("Gapminder"),
  18. tabsetPanel(id = "continent",
  19. tabPanel("All",
  20. plotOutput("all_plot"),
  21. sliderInput("all_year", "Select Year", value = 1952, min = 1952,
  22. max = 2007, step = 5, animate = animationOptions(interval = 500))
  23. ),
  24. tabPanel("Africa",
  25. plotOutput("africa_plot"),
  26. sliderInput("africa_year", "Select Year", value = 1952, min = 1952,
  27. max = 2007, step = 5, animate = animationOptions(interval = 500))
  28. ),
  29. tabPanel("Americas",
  30. plotOutput("americas_plot"),
  31. sliderInput("americas_year", "Select Year", value = 1952, min = 1952,
  32. max = 2007, step = 5, animate = animationOptions(interval = 500))
  33. ),
  34. tabPanel("Asia",
  35. plotOutput("asia_plot"),
  36. sliderInput("asia_year", "Select Year", value = 1952, min = 1952,
  37. max = 2007, step = 5, animate = animationOptions(interval = 500))
  38. ),
  39. tabPanel("Europe",
  40. plotOutput("europe_plot"),
  41. sliderInput("europe_year", "Select Year", value = 1952, min = 1952,
  42. max = 2007, step = 5, animate = animationOptions(interval = 500))
  43. ),
  44. tabPanel("Oceania",
  45. plotOutput("oceania_plot"),
  46. sliderInput("oceania_year", "Select Year", value = 1952, min = 1952,
  47. max = 2007, step = 5, animate = animationOptions(interval = 500))
  48. )
  49. )
  50. )
  51.  
  52. server <- function(input, output) {
  53.  
  54. # collect one year of data
  55. ydata_all <- reactive({
  56. filter(all_data, year == input$all_year)
  57. })
  58.  
  59. ydata_africa <- reactive({
  60. filter(africa_data, year == input$africa_year)
  61. })
  62.  
  63. ydata_americas <- reactive({
  64. filter(americas_data, year == input$americas_year)
  65. })
  66.  
  67. ydata_asia <- reactive({
  68. filter(asia_data, year == input$asia_year)
  69. })
  70.  
  71. ydata_europe <- reactive({
  72. filter(europe_data, year == input$europe_year)
  73. })
  74.  
  75. ydata_oceania <- reactive({
  76. filter(oceania_data, year == input$oceania_year)
  77. })
  78.  
  79. # compute plot ranges
  80. xrange_all <- range(all_data$gdpPercap)
  81. yrange_all <- range(all_data$lifeExp)
  82.  
  83. xrange_africa <- range(africa_data$gdpPercap)
  84. yrange_africa <- range(africa_data$lifeExp)
  85.  
  86. xrange_americas <- range(americas_data$gdpPercap)
  87. yrange_americas <- range(americas_data$lifeExp)
  88.  
  89. xrange_asia <- range(asia_data$gdpPercap)
  90. yrange_asia <- range(asia_data$lifeExp)
  91.  
  92. xrange_europe <- range(europe_data$gdpPercap)
  93. yrange_europe <- range(europe_data$lifeExp)
  94.  
  95. xrange_oceania <- range(oceania_data$gdpPercap)
  96. yrange_oceania <- range(oceania_data$lifeExp)
  97.  
  98. # render plots
  99. output$all_plot <- renderPlot({
  100.  
  101. # draw background plot with legend
  102. plot(all_data$gdpPercap, all_data$lifeExp, type = "n",
  103. xlab = "GDP per capita", ylab = "Life Expectancy",
  104. panel.first = {
  105. grid()
  106. text(mean(xrange_all), mean(yrange_all), input$all_year,
  107. col = "grey90", cex = 5)
  108. }
  109. )
  110.  
  111. legend("bottomright", legend = levels(all_data$continent),
  112. cex = 1.3, inset = 0.01, text.width = diff(xrange_all)/5,
  113. fill = c("#E41A1C99", "#377EB899", "#4DAF4A99", "#984EA399", "#FF7F0099")
  114. )
  115.  
  116. # Determine bubble colors
  117. cols <- c("Africa" = "#E41A1C99",
  118. "Americas" = "#377EB899",
  119. "Asia" = "#4DAF4A99",
  120. "Europe" = "#984EA399",
  121. "Oceania" = "#FF7F0099")[ydata_all()$continent]
  122.  
  123. # add bubbles
  124. symbols(ydata_all()$gdpPercap, ydata_all()$lifeExp,
  125. circles = sqrt(ydata_all()$pop), bg = cols, inches = 0.5, fg = "white",
  126. add = TRUE)
  127. })
  128.  
  129. output$africa_plot <- renderPlot({
  130.  
  131. # draw background plot with legend
  132. plot(africa_data$gdpPercap, africa_data$lifeExp, type = "n",
  133. xlab = "GDP per capita", ylab = "Life Expectancy",
  134. panel.first = {
  135. grid()
  136. text(mean(xrange_africa), mean(yrange_africa), input$africa_year,
  137. col = "grey90", cex = 5)
  138. }
  139. )
  140.  
  141. legend("bottomright", legend = levels(africa_data$continent),
  142. cex = 1.3, inset = 0.01, text.width = diff(xrange_africa)/5,
  143. fill = c("#E41A1C99", "#377EB899", "#4DAF4A99", "#984EA399", "#FF7F0099")
  144. )
  145.  
  146. # Determine bubble colors
  147. cols <- c("Africa" = "#E41A1C99",
  148. "Americas" = "#377EB899",
  149. "Asia" = "#4DAF4A99",
  150. "Europe" = "#984EA399",
  151. "Oceania" = "#FF7F0099")[ydata_africa()$continent]
  152.  
  153. # add bubbles
  154. symbols(ydata_africa()$gdpPercap, ydata_africa()$lifeExp,
  155. circles = sqrt(ydata_africa()$pop), bg = cols, inches = 0.5, fg = "white",
  156. add = TRUE)
  157. })
  158.  
  159. output$americas_plot <- renderPlot({
  160.  
  161. # draw background plot with legend
  162. plot(americas_data$gdpPercap, americas_data$lifeExp, type = "n",
  163. xlab = "GDP per capita", ylab = "Life Expectancy",
  164. panel.first = {
  165. grid()
  166. text(mean(xrange_americas), mean(yrange_americas), input$americas_year,
  167. col = "grey90", cex = 5)
  168. }
  169. )
  170.  
  171. legend("bottomright", legend = levels(americas_data$continent),
  172. cex = 1.3, inset = 0.01, text.width = diff(xrange_americas)/5,
  173. fill = c("#E41A1C99", "#377EB899", "#4DAF4A99", "#984EA399", "#FF7F0099")
  174. )
  175.  
  176. # Determine bubble colors
  177. cols <- c("Africa" = "#E41A1C99",
  178. "Americas" = "#377EB899",
  179. "Asia" = "#4DAF4A99",
  180. "Europe" = "#984EA399",
  181. "Oceania" = "#FF7F0099")[ydata_americas()$continent]
  182.  
  183. # add bubbles
  184. symbols(ydata_americas()$gdpPercap, ydata_americas()$lifeExp,
  185. circles = sqrt(ydata_americas()$pop), bg = cols, inches = 0.5, fg = "white",
  186. add = TRUE)
  187. })
  188.  
  189. output$asia_plot <- renderPlot({
  190.  
  191. # draw background plot with legend
  192. plot(asia_data$gdpPercap, asia_data$lifeExp, type = "n",
  193. xlab = "GDP per capita", ylab = "Life Expectancy",
  194. panel.first = {
  195. grid()
  196. text(mean(xrange_asia), mean(yrange_asia), input$asia_year,
  197. col = "grey90", cex = 5)
  198. }
  199. )
  200.  
  201. legend("bottomright", legend = levels(asia_data$continent),
  202. cex = 1.3, inset = 0.01, text.width = diff(xrange_asia)/5,
  203. fill = c("#E41A1C99", "#377EB899", "#4DAF4A99", "#984EA399", "#FF7F0099")
  204. )
  205.  
  206. # Determine bubble colors
  207. cols <- c("Africa" = "#E41A1C99",
  208. "Americas" = "#377EB899",
  209. "Asia" = "#4DAF4A99",
  210. "Europe" = "#984EA399",
  211. "Oceania" = "#FF7F0099")[ydata_asia()$continent]
  212.  
  213. # add bubbles
  214. symbols(ydata_asia()$gdpPercap, ydata_asia()$lifeExp,
  215. circles = sqrt(ydata_asia()$pop), bg = cols, inches = 0.5, fg = "white",
  216. add = TRUE)
  217. })
  218.  
  219. output$europe_plot <- renderPlot({
  220. stop("Error: Don't look at Europe")
  221. # draw background plot with legend
  222. plot(europe_data$gdpPercap, europe_data$lifeExp, type = "n",
  223. xlab = "GDP per capita", ylab = "Life Expectancy",
  224. panel.first = {
  225. grid()
  226. text(mean(xrange_europe), mean(yrange_europe), input$europe_year,
  227. col = "grey90", cex = 5)
  228. }
  229. )
  230.  
  231. legend("bottomright", legend = levels(europe_data$continent),
  232. cex = 1.3, inset = 0.01, text.width = diff(xrange_europe)/5,
  233. fill = c("#E41A1C99", "#377EB899", "#4DAF4A99", "#984EA399", "#FF7F0099")
  234. )
  235.  
  236. # Determine bubble colors
  237. cols <- c("Africa" = "#E41A1C99",
  238. "Americas" = "#377EB899",
  239. "Asia" = "#4DAF4A99",
  240. "Europe" = "#984EA399",
  241. "Oceania" = "#FF7F0099")[ydata_europe()$continent]
  242.  
  243. # add bubbles
  244. symbols(ydata_europe()$gdpPercap, ydata_europe()$lifeExp,
  245. circles = sqrt(ydata_europe()$pop), bg = cols, inches = 0.5, fg = "white",
  246. add = TRUE)
  247. })
  248.  
  249. output$oceania_plot <- renderPlot({
  250.  
  251. # draw background plot with legend
  252. plot(oceania_data$gdpPercap, oceania_data$lifeExp, type = "n",
  253. xlab = "GDP per capita", ylab = "Life Expectancy",
  254. panel.first = {
  255. grid()
  256. text(mean(xrange_oceania), mean(yrange_oceania), input$oceania_year,
  257. col = "grey90", cex = 5)
  258. }
  259. )
  260.  
  261. legend("bottomright", legend = levels(oceania_data$continent),
  262. cex = 1.3, inset = 0.01, text.width = diff(xrange_oceania)/5,
  263. fill = c("#E41A1C99", "#377EB899", "#4DAF4A99", "#984EA399", "#FF7F0099")
  264. )
  265.  
  266. # Determine bubble colors
  267. cols <- c("Africa" = "#E41A1C99",
  268. "Americas" = "#377EB899",
  269. "Asia" = "#4DAF4A99",
  270. "Europe" = "#984EA399",
  271. "Oceania" = "#FF7F0099")[ydata_oceania()$continent]
  272.  
  273. # add bubbles
  274. symbols(ydata_oceania()$gdpPercap, ydata_oceania()$lifeExp,
  275. circles = sqrt(ydata_oceania()$pop), bg = cols, inches = 0.5, fg = "white",
  276. add = TRUE)
  277. })
  278. }
  279.  
  280. # Run the application
  281. shinyApp(ui = ui, server = server)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement