Rshiny_population/ui.R at master · ctapen/Rshiny_population · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
# UI
shinyUI(

  # Dashboard Page
  dashboardPage(

    # DashboardHeader
    dashboardHeader(
      title = "Population Insights",
      titleWidth = 200
    ),

    # DashboardSidebar
    dashboardSidebar(
      width = 200,
      sidebarMenu(

        # Menu bars w/Tabs
        menuItem("Overview", tabName = "Overview", icon = icon("info"))
        , menuItem("Total Population", tabName = "Total_Pop", icon = icon("globe"))
        , menuItem("Life Expectancy", tabName = "Life_Expectancy_Boxplot", icon = icon("heartbeat"))
        , menuItem("Fertility Rate", tabName = "Fertility_Rate", icon = icon("leaf"))
        , menuItem("Babies Per Year", tabName = "Babies_Per_Year", icon = icon("child"))
        , menuItem("Age", tabName = "Age", icon = icon("calendar"),
                   menuSubItem(icon = NULL, "Youth Waterfall", tabName="youth_waterfall")
                   , menuSubItem(icon = NULL, "Age Roseplot", tabName="age_roseplot")
        )
      )
    ),

    # Dashboard Body
    dashboardBody(

      tabItems(

        # Overview
        tabItem(tabName = "Overview"
                , titlePanel("Overview")

                # Rundown box
                , box(title="Rundown / The Why", height=340
                      , "The future of population will shape how we create businesses, develop social services, grow our infrastructure, build institutions, provide health care, and the like.", tags$br(), tags$br(), tags$i("Understanding the future of population will help equip us to be prepared for opportunities and challenges ahead!"))

                # Findings box
                , box(title="Findings", height=340
                      , "1) Africa's population will take off.  Asia's will start declining ~2055.", tags$br(), tags$br()
                      , "2) While life expectancy remains lower in Africa, further improvements will increase population.", tags$br(), tags$br()
                      , "3) Fertility rates will significantly shape future population (Africa's higher rates).", tags$br(), tags$br()
                      , "4) Illustration of future: There are more babies born in a year in Nigeria than in all of Europe.", tags$br(), tags$br()
                      , "5) Nearly all of the world's youth reside in developing nations.  The world's population will age considerably.")

                # Contents box
                , box(title="Contents", height=270
                      , "This dashboard shows different facets of population projections, often broken down by continent or subregion.", tags$br(), tags$br(), tags$b("Topics include: "), tags$br(), "-total population", tags$br(), "-life expectancy", tags$br(), "-fertility rate", tags$br(), "-babies per year", tags$br(), "-age")

                # Data sources box
                , box(title="Data", height=270
                      , "Data Sources Include:", tags$br(), tags$br(), "-UN World Population Prospects 2017", tags$br(), tags$br(), "-Gapminder")
                )
        ,

        # Total Population
        tabItem(tabName = "Total_Pop"
                # Title
                , titlePanel("Aggregate Population Projections")

                # Selector
                , selectizeInput(inputId = "category",
                               label = "Select Category",
                               choices = unique(df_1_TotalPopSex_1$category[df_1_TotalPopSex_1$category != 'country_territory']))

                # Plot
                , plotOutput("pop_over_time")

                # Source
                , tags$br(), "Source: UN World Population Prospects"
                ),

        # Life Expectancy Boxplot
        tabItem(tabName = "Life_Expectancy_Boxplot"
                # Title
                , titlePanel("Life Expectancy")

                # Selector
                , selectizeInput(inputId = "year_life_expectancy",
                                 label = "Select Year",
                                 choices = unique(gapminder$year),
                                 selected=2007)

                # Plot
                , plotOutput("life_expectancy_boxplot")

                # Source
                , tags$br(), "Source: Gapminder"
                ),

        # Fertility Rate
        tabItem(tabName = "Fertility_Rate"
                # Title
                , titlePanel("Fertility Rate, by Country")

                # Plot
                , htmlOutput("birth_rate") # used htmlOutput b/c gvis' syntax

                # Source
                , tags$br(), "Source: UN World Population Prospects"
                ),

        # Babies Per Year
        tabItem(tabName = "Babies_Per_Year"
                # Title
                , titlePanel("Babies Per Year")

                # Plots and Selector
                , tabPanel("Babies Per Year"
                           , fluidRow(box(plotOutput("babies_born_per_year_bar_graph", height = 350), width=410))
                           )

                # Source
                , "Source: UN World Population Prospects; Year: 2020"
                ),

        # Youth
        tabItem(tabName = "youth_waterfall"
                # Title
                , titlePanel("Youth Waterfall by Continent")

                # Selector
                , sliderInput(inputId="year_youth_waterfall", label="Year:", min=1990, max=2100, value=2020, step=10, sep = "")

                #Plot
                , plotOutput("youth")

                # Source
                , tags$br(), "Source: UN World Population Prospects"
                ),

        # Age Grouping
        tabItem(tabName = "age_roseplot"
                , titlePanel("Age Group Changes from 1900 to 2100 (projected)")

                # Selector
                , selectizeInput(inputId = "category_age",
                                 label = "Select Category",
                                 choices = unique(df_1_TotalPopSex_1$category[!df_1_TotalPopSex_1$category %in% c('country_territory','development', 'subcontinent')]))

                # Plot
                , plotOutput("age_rose_plot")

                # Source
                , tags$br(), "Source: UN World Population Prospects"
                )

      # Close Tab Items
      )
    # Close dashboardBody
    )
  # Close dashboardPage
  )
# Close ShinyUI
)