-2
I made an application on Shiny and I want to post it on shinyapps.io. However, I’m not getting it, it’s giving several errors every time I try to adjust.
library(Shiny) library(plotrix) library(readxl) library(ggplot2) library(plotly) library(shinydashboard) library(shinyEffects) library(rsconnect)
###################################################################
## ##
# ##
####### # # # # ####### ####### ####### #######
# # # ### # # # # # #
# # # # # # # # # ##### #######
#### # # # # # # # # # #
# # # # ## # # # # #
# ####### # # ####### ####### ####### #######
#
#
################################################################### rm(list = ls())
basedemografica <- read_excel("basedemografica.xlsx")
somamale= sum(basedemografica$Male)
somafeminine= sum(basedemografica$Feminine)
population= female + male
freqmedia=sum(demographic basis$Freq*Media)
mediapop=(freqmedia/population)
median=30+4*((10693929/2)-4870146)/808291
idp= (2229504+994613)*100/7469812
mascmais65= sum(demographics[14:21,]$Male)
femmais65= sum(demographics[14:21,]$Female)
percmais65= ((mascmais65+femmais65)/population)*100
totalmais65= mascmais65+femmais65
mascmenos15= sum(basedemografica[1:3,]$Male)
femmenos15= sum(based on demographics[1:3,]$Female)
totalless15= men15 + femin15
percmenos15= (totalmenos15/population)*100
tabelasundbarg <- data.frame( Structure_age = c("0|-15","15|-50","50+","Total"), Progressives_ou_jovens= c("40%","50%","10%","100%"), Estacionarias_ou_adultas= c("33%","50%","17%","100%"), Regressives_ou_velhas= c("20%", "50%","30%","100%") )
masc1550= sum(basedemografica[4:10,]$Male) fem1550= sum(basedemografica[4:10,]$Female) total1550= masc1550+fem1550 perc1550= (total1550/population)*100
mascm50= sum(demographic basis[11:21,]$Male) femm50= sum(demographics[11:21,]$Female) totalm50= mascm50+femm50 percm50= (totalm50/population)*100
tabelaexsundbarg <- data.frame( Structure_age = c("0|-15","15|-50","50+","Total"), Values= c(totalmenos15,total1550,totalm50, (totalmenos15+total1550+totalm50)), Percentage= c(percmenos15,perc1550, percm50,(percmenos15+perc1550+percm50)) ) ###################################################################
# # #
# # #
# # #
# # #
# # #
####### #
###################################################################
ui <- dashboardPage(
dashboardHeader(title = "Evaluation 1: Demographic Statistics 2021/1- UFRGS",
titleWidth = 600,
dropdownMenu(type = "Notifications", # to put the names of who made the app
notificationItem(
text = tags$div("2010",
style = "display: inline-block; vertical-align: Middle;"),
icon = icon("Calendar-alt"),
status = "Success"
), #notificationItem
headerText = "RS Demographic Census Data:"
) #dropdownMenu
),
dashboardSidebar( sidebarMenu( menuItem("Introduction", table = "intro", icon = icon("info-Circle")), menuItem("Exercise 1", table = "E1", icon = icon("Chart-bar")), menuItem("Exercise 2", table = "E2", icon = icon("Chart-bar")), menuItem("Exercise 3", table = "E3", icon = icon("Calculator")), menuItem("Exercise 4", table = "E4", icon = icon("Calculator")), menuItem("Exercise 5", table = "E5", icon = icon("Calculator")), menuItem("Exercise 6", table = "E6", icon = icon("Calculator")) )#sidebarMenu ), #dashboardSidebar dashboardBody( tabItems( tabItem(tabName = "intro", setZoom(id = "caixanomes"), setZoom(id = "caixae1"), setZoom(id = "caixae2"), setZoom(id = "caixae3"), setZoom(id = "caixae4"), setZoom(id = "caixae5"), setZoom(id = "caixae6"),
fluidRow(
valueBoxOutput(width = 12, outputId = "caixanomes"),
valueBoxOutput(width = 12, outputId = "caixae1"),
valueBoxOutput(width = 12, outputId = "caixae2"),
valueBoxOutput(width = 12, outputId = "caixae3"),
valueBoxOutput(width = 12, outputId = "caixae4"),
valueBoxOutput(width = 12, outputId = "caixae5"),
valueBoxOutput(width = 12, outputId = "caixae6")
),#fluidRow1
),#tabItem
tabItem(tabName = "e1",
setZoom(id = "caixa1e1"),
fluidRow(
valueBoxOutput(width = 12, outputId = "caixa1e1")
),#fluidRow1
fluidRow(
box(background = "navy", width=12,
plotOutput(outputId = "piramide"))
)#fluidRow2
),#tabItem
tabItem(tabName = "e2",
setZoom(id = "caixa1e2"),
fluidRow(
valueBoxOutput(width = 12, outputId = "caixa1e2")
),#fluidRow1
fluidRow(
box(background = "navy", width=12,
plotlyOutput(outputId = "razao"))
)#fluidRow2
),#tabItem
tabItem(tabName = "e3",
setZoom(id = "caixa1e3"),
setZoom(id = "caixafreqmed"),
setZoom(id = "caixapopulacaototal"),
setZoom(id = "caixamedia"),
fluidRow(
valueBoxOutput(width = 12, outputId = "caixa1e3")
),#fluidRow1
fluidRow(
box(
title = "Explicação", width = 12, background = "navy",
"Primeiramente, foi calculada a média (coluna Média do intervalo) e a frequência absoluta(soma da população masculina e feminina) de cada intervalo. Por linha/intervalo, esses valores foram multiplicados e colocados na coluna Freq*Media, e após isso, foi feita a soma dessa coluna. Por fim, essa soma foi dividida pela população total, resultado na média da população"
),
),#fluidRow2
fluidRow(
valueBoxOutput(width = 4, outputId = "caixafreqmed"),
valueBoxOutput(width = 4, outputId = "caixapopulacaototal"),
valueBoxOutput(width = 4, outputId = "caixamedia")
),#fluidRow3
fluidRow(
box(width=12,
DT::dataTableOutput("tabela"))
)#fluidRow4
),#tabItem
tabItem(tabName = "e4",
setZoom(id = "caixa1e4"),
setZoom(id = "intermed"),
setZoom(id = "lir"),
setZoom(id = "h"),
setZoom(id = "n"),
setZoom(id = "fant"),
setZoom(id = "fmd"),
setZoom(id = "mediana"),
fluidRow(
valueBoxOutput(width = 12, outputId = "caixa1e4")
),#fluidRow1
fluidRow(
box(width=12,
uiOutput('formula'))
),#fluidRow2
fluidRow(
valueBoxOutput(width = 6, outputId = "intermed"),
valueBoxOutput(width = 6, outputId = "lir"),
valueBoxOutput(width = 6, outputId = "h"),
valueBoxOutput(width = 6, outputId = "n"),
valueBoxOutput(width = 12, outputId = "fant"),
valueBoxOutput(width = 12, outputId = "fmd")
),#fluidRow3
fluidRow(
box(
title = "Substituindo os valores na fórmula, chegamos na resposta:", width = 6, background = "navy"),
valueBoxOutput(width = 6, outputId = "mediana")
)#fluidRow4
),#tabItem
tabItem(tabName = "e5",
setZoom(id = "caixa1e5"),
setZoom(id = "mascmais65"),
setZoom(id = "femmais65"),
setZoom(id = "poptotal"),
setZoom(id = "percmais65"),
setZoom(id = "totalmais65"),
setZoom(id = "percmais652"),
setZoom(id = "totalmenos15"),
setZoom(id = "percmenos15"),
fluidRow(
valueBoxOutput(width = 12, outputId = "caixa1e5")
),#fluidRow1
fluidPage(
h2("1°- 65 anos ou mais"),
box(
h3("+7%:Velha"),
h3("4 à 7%:Transição"),
h3("-4%:Jovem")),
box(
fluidRow(
valueBoxOutput(width = 6, outputId = "mascmais65"),
valueBoxOutput(width = 6, outputId = "femmais65"),
valueBoxOutput(width = 6, outputId = "poptotal"),
valueBoxOutput(width = 6, outputId = "percmais65")
)#fluidRow2
),
box(width=12,
h3("Como o percentual é maior que 7%, a população é classificada como velha.")
)
),#fluidPage1
fluidPage(
h2("2°- Relativamente jovem ou relativamente velha"),
box(
h3("Relativamente jovem: 40 - 45% < 15 anos e 3 - 4% 65 anos e mais"),
h3("Relativamente velha: +/- 25% < 15 anos e +/- 10% 65 anos e mais")),
box(
fluidRow(
valueBoxOutput(width = 6, outputId = "totalmais65"),
valueBoxOutput(width = 6, outputId = "percmais652"),
valueBoxOutput(width = 6, outputId = "totalmenos15"),
valueBoxOutput(width = 6, outputId = "percmenos15")
)#fluidRow2
),
box(width=12,
h3("O percentual da população acima de 65 anos se aproxima de 10% e o da população abaixo de 15 anos se aproxima de 25%. Logo, a população é classificada como relativamente velha.")
)
),#fluidPage2
fluidPage(
h2("3°- Sundbarg"),
fluidRow(
box(width=12,
DT::dataTableOutput("tabelasundbarg"))
), #fluidRow1
box(width=12,
h3("Segue a tabela com os valores e percentuais calculados de cada faixa etária:")
),
fluidRow(
box(width=12,
DT::dataTableOutput("tabelaexsundbarg"))
), #fluidRow2
box(width=12,
h3("Comparando as duas tabelas, os valores percentuais das faixas etárias calculados se aproximam dos valores da coluna regressiva. Logo,a população pode ser classificada como regressiva, ou seja, as taxas de
mortality and long-term birth rate are low.") )
),#fluidPage3
fluidPage(
h2("4°- Whipple"),
box(
h3("15 - 50 anos"),
h3("Normal 50%"),
h3("Acessiva > 50%"),
h3("Recessiva < 50%")),
box(width=12,
h3("Utilizando a mesma tabela da classificação Sundbarg, vamos analisar a linha da faixa etária 15 - 50 anos")
),
fluidRow(
box(width=12,
DT::dataTableOutput("tabela1exsundbarg"))
), #fluidRow2
box(width=12,
h3("Temos que o percentual é de 53.55425%, que é maior que 50, logo, a população é acessiva.")
)
)#fluidPage4
),#tabItem
tabItem(tabName = "e6",
setZoom(id = "caixa1e6"),
setZoom(id = "z14"),
setZoom(id = "s5m"),
setZoom(id = "qs5"),
setZoom(id = "idp"),
fluidRow(
valueBoxOutput(width = 12, outputId = "caixa1e6")
),#fluidRow1
fluidRow(
box(title="Fórmula do Índice de Dependência Potencial", width=12,
"IDP=(N°de pessoas 0-14 + N° de pessoas 65+)*100/(N° de pessoas 15-64)")
),#fluidRow2
fluidRow(
valueBoxOutput(width = 4, outputId = "z14"),
valueBoxOutput(width = 4, outputId = "s5m"),
valueBoxOutput(width = 4, outputId = "qs5")
),#fluidRow3
fluidRow(
box(
title = "Substituindo os valores na fórmula, chegamos na resposta:", width = 6, background = "navy"),
valueBoxOutput(width = 6, outputId = "idp")
)#fluidRow4
)#tabItem
)#tabItems
)#dashboardBody
)#dashboardPage
###################################################################
####### ####### ####### # # ####### #######
# # # # # # # # #
####### ##### ####### # # ##### #######
# # ### # # # ###
# # # ## # # # # ##
####### ####### # ## # ####### # ##
###################################################################
server <- Function(input, output) {
#####################################################
INTRODUCTION
#####################################################
output$caixanomes <- renderValueBox({ infobox("Students:", "there",color="Navy", icon=icon("user-Graduate")) })
output$caixae1 <- renderValueBox({ infobox("Exercise 1:","Draw up an age pyramid with data grouped by age (age groups: 0 to 4 years ; 5 to 9 years , etc.)",color="Navy", icon=icon("Chart-bar")) })
output$caixae2 <- renderValueBox({ infobox("Exercise 2:","Calculate the sex ratio by age for RS and plot;",color="Navy", icon=icon("Chart-bar")) })
output$caixae3 <- renderValueBox({ infobox("Exercise 3:","Calculate the average age of the RS population (say which assumption you used);",color="Navy", icon=icon("Calculator")) })
output$caixae4 <- renderValueBox({ infobox("Exercise 4:","Calculate the median age of the RS population;",color="Navy", icon=icon("Calculator")) })
output$caixae5 <- renderValueBox({ infobox("Exercise 5:","Classify the total population of RS according to age using all known criteria;",color="Navy", icon=icon("Calculator")) })
output$caixae6 <- renderValueBox({ infobox("Exercise 6:","Calculating the potential dependency index of the total population." ,color="Navy", icon=icon("Calculator")) })
#####################################################
Exercise 1
#####################################################
output$caixa1e1 <- renderValueBox({ infobox("Exercise 1:","Draw up an age pyramid with data grouped by age (age groups: 0 to 4 years ; 5 to 9 years , etc.)",color="Navy", icon=icon("Chart-bar")) })
output$piramide <- renderPlot({ xy.pop<-c(3.1,3.5,4.1,4.1,4.1,4.2,3.7,3.4,3.5,3.5,3.1,2.6,2.0,1.5,1.1,0.7,0.4,0.2,0.1,0.0,0.0) xx.pop<-c(3.0,3.3,4.0,4.1,4.1,4.2,3.8,3.5,3.7,3.7,3.4,2.9,2.3,1.8,1.4,1.1,0.7,0.4,0.1,0.0,0.0) agelabels<-c("0-4","5-9","10-14","15-19","20-24","25-29","30-34", "35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-74", "75-79","80-84","85-89","90-94","95-99","100+") mcol<-color.gradient(c(0,0,0.5,1),c(0,0,0.5,1),c(1,1,0.5,1),18) fcol<-color.gradient(c(1,1,0.5,1),c(0.5,0.5,0.5,1),c(0.5,0.5,0.5,1),18) par(mar=Pyramid.Plot(xy.pop,xx.pop,Labels=agelabels, main="Age pyramid of Rio Grande do Sul(2010)",lxcol=mcol,rxcol=fcol, gap=0.5,show. values=TRUE)) })
#####################################################
Exercise 2
#####################################################
output$caixa1e2 <- renderValueBox({ infobox("Exercise 2:","Calculate the sex ratio by age for RS and plot;",color="Navy", icon=icon("Chart-bar")) })
output$ratio <- renderPlotly({
graphicing<- ggplot(demographically based, aes(x=Faixa etária, y=Razão,Fill=Razão))+
geom_col()+
Labs(x="Age group", y="Sex/age ratio")+
Theme(Axis.text.x = element_text(Angle = 45, size = 8))
ggplotly(graffiti)
})
#####################################################
Exercise 3
#####################################################
output$caixa1e3 <- renderValueBox({ infobox("Exercise 3:","Calculate the average age of the RS population (say which assumption you used);",color="Navy", icon=icon("Calculator")) })
output$table = DT::renderDataTable({ demographics })
output$caixafreqmed <- renderValueBox({ valueBox(freqmedia, "Sum Frequency x Average",color="Navy" ) })
output$caixapopulacaototal <- renderValueBox({ valueBox(population, "Total population",color="Navy" ) })
output$caixamedia <- renderValueBox({ valueBox(round(mediapop,5), "RS population average",color="Navy" ) })
#####################################################
Exercise 4
#####################################################
output$caixa1e4 <- renderValueBox({ infobox("Exercise 4:","Calculate the median age of the RS population;",color="Navy", icon=icon("Calculator")) })
output$formula <- renderUI({ withMathJax(helpText('Median formula: $$Md= LIR_{Md}+h(((n/2-F_{ant})/f_{Md})$$')) })
output$Intermed <- renderValueBox({ valueBox("30-34", "Median range",color="Navy" ) })
output$Lir<- renderValueBox({ valueBox(30, "Lirmd= Real lower limit of the range that counts the median",color="Navy") })
output$h<- renderValueBox({ valueBox(4, "h= Range width",color="Navy") })
output$n<- renderValueBox({ valueBox(population, "n= Sample size",color="Navy") })
output$Fant<- renderValueBox({ valueBox(5678437, "Fant= Absolute frequency accumulated in the previous range containing the median",color="Navy") })
output$fmd<- renderValueBox({ valueBox(808291, "Fmd= simple absolute frequency in the range containing the median." ,color="Navy") })
output$median<- renderValueBox({ valueBox(round(median,5), "Median of RS population.",color="Navy") })
#####################################################
Exercise 5
#####################################################
output$caixa1e5 <- renderValueBox({ infobox("Exercise 5:","Classify the total population of RS according to age using all known criteria;",color="Navy", icon=icon("Calculator")) })
output$mascmais65<- renderValueBox({ valueBox(mascmais65, "Male population 65 years or older." ,color="Navy") })
output$femmais65<- renderValueBox({ valueBox(femmore65, "Female population 65 years or older." ,color="Navy") })
output$poptotal<- renderValueBox({ valueBox(population, "Total population 65 years or older." ,color="Navy") })
output$percmais65<- renderValueBox({ valueBox(round(percmais65,5), "Percentage of population 65 years or older." ,color="Navy") })
output$totalmais65<- renderValueBox({ valueBox(totalmore65, "Total population 65 years or older." ,color="Navy") })
output$percmais652<- renderValueBox({ valueBox(round(percmais65,5), "Percentage of population 65 years or older." ,color="Navy") })
total output$totallesss15<- renderValueBox({ valueBox(totalless15, "Total population under 15 years of age." ,color="Navy") })
output$percmenos15<- renderValueBox({ valueBox(round(percmenos15,5), "Percentage of the population under 15 years of age." ,color="Navy") })
output$tabelasundbarg = DT::renderDataTable({ tabelasundbarg })
output$tabelaexsundbarg = DT::renderDataTable({ tabelaexsundbarg })
output$table1exsundbarg = DT::renderDataTable({ tabelaexsundbarg })
#####################################################
Exercise 6
#####################################################
output$caixa1e6 <- renderValueBox({ infobox("Exercise 6:","Calculating the potential dependency index of the total population." ,color="Navy", icon=icon("Calculator")) })
output$z14<- renderValueBox({ valueBox(2229504, "Number of persons 0 - 14",color="Navy") })
output$s5m<- renderValueBox({ valueBox(994613, "Number of persons 65+",color="Navy") })
output$qs5<- renderValueBox({ valueBox(7469812, "Number of persons 15 - 64 years old",color="Navy") })
output$idp<- renderValueBox({ valueBox(round(idp,5), "IDP of RS population.",color="Navy") })
}#server
shinyApp(ui = ui, server = server)