heatmap_semana.R

library(shiny) # library que faz a interface interativa // https://shiny.rstudio.com
library(readxl) # library que faz a leitura de excel // https://readxl.tidyverse.org
library(dplyr) # library que ajuda na manipulacao dos dados // https://cran.r-project.org/web/packages/dplyr/vignettes/dplyr.html
library(magrittr) # library que permite encadear comandos (usados nos filtros) // https://cran.r-project.org/package=magrittr
library(ggplot2) # library que faz a criacao de diversos graficos // http://r-statistics.co/Top50-Ggplot2-Visualizations-MasterList-R-Code.html


" faz leitura do arquivo excel
---------------------------------------------------------------------------------------"
ENTRADAS <- read_xlsx("parkaz_ociosidade_de_loja.xlsx", col_names=TRUE)


" monta os components na tela
---------------------------------------------------------------------------------------"
ui <- fluidPage(

    titlePanel("Tráfego por faixa de horário"),
    
    sidebarLayout(

        sidebarPanel(
            
            helpText("Exibe a intensidade de tráfego em cada faixa de horário da semana"),
            
            selectInput("lojaInput",
                        label = "Loja",
                        choices = unique(ENTRADAS$loja),
                        selected = 1)
        ),
        
        mainPanel(
            plotOutput("HEATMAP"),
            br(),
            tableOutput("TABELA")
        )

    )
    
)


" funcao utilitaria para pegar o total de Entradas de acordo com os parametros passados
---------------------------------------------------------------------------------------"
pegarTotalDeEntradas <- function(loja, dia_semana, hora_entrada){
    data <- ENTRADAS[
            ENTRADAS$loja == loja &
            ENTRADAS$dia_semana == dia_semana &
            ENTRADAS$hora_entrada == hora_entrada
        ,]
    return(nrow(data))
}


" funcao utilitaria para pegar o total de Entradas de acordo com os parametros passados
---------------------------------------------------------------------------------------"
pegarTotaisPorHoraDoDia <- function(loja, dia_semana){
    data <- c(
        pegarTotalDeEntradas(loja, dia_semana, 7),
        pegarTotalDeEntradas(loja, dia_semana, 8),
        pegarTotalDeEntradas(loja, dia_semana, 9),
        pegarTotalDeEntradas(loja, dia_semana, 10),
        pegarTotalDeEntradas(loja, dia_semana, 11),
        pegarTotalDeEntradas(loja, dia_semana, 12),
        pegarTotalDeEntradas(loja, dia_semana, 13),
        pegarTotalDeEntradas(loja, dia_semana, 14),
        pegarTotalDeEntradas(loja, dia_semana, 15),
        pegarTotalDeEntradas(loja, dia_semana, 16),
        pegarTotalDeEntradas(loja, dia_semana, 17),
        pegarTotalDeEntradas(loja, dia_semana, 18),
        pegarTotalDeEntradas(loja, dia_semana, 19),
        pegarTotalDeEntradas(loja, dia_semana, 20),
        pegarTotalDeEntradas(loja, dia_semana, 21)
    )
    return(data)
}


" funcao server() processa os dados continuamente
-------------------------------------------------"
server <- function(input, output){


    " filtra os registros a serem calculados de acordo com o item selecionado
    ---------------------------------------------"
    ENTRADAS_FILTRADAS <- reactive({
        ENTRADAS %>%
            filter(
                loja == input$lojaInput
            )
    })


    " cria um OUTPUT com a tabela simples
    ---------------------------------------------"
    output$TABELA <- renderTable({
        ENTRADAS_FILTRADAS()
    })


    " cria um OUTPUT com o heatmap
    ---------------------------------------------"
    output$HEATMAP <- renderPlot({
        
        seg <- pegarTotaisPorHoraDoDia(input$lojaInput, 'seg')
        ter <- pegarTotaisPorHoraDoDia(input$lojaInput, 'ter')
        qua <- pegarTotaisPorHoraDoDia(input$lojaInput, 'qua')
        qui <- pegarTotaisPorHoraDoDia(input$lojaInput, 'qui')
        sex <- pegarTotaisPorHoraDoDia(input$lojaInput, 'sex')
        sab <- pegarTotaisPorHoraDoDia(input$lojaInput, 'sab')
        dom <- pegarTotaisPorHoraDoDia(input$lojaInput, 'dom')
        
        # cria uma matrix com os dados de toda a semana
        SEMANA <- data.frame(seg, ter, qua, qui, sex, sab, dom)
        
        # define os nomes de cada linha do gráfico
        row.names(SEMANA) <- c('7h', '8h', '9h', '10h', '11h', '12h', '13h', '14h', '15h', '16h', '17h', '18h', '19h', '20h', '21h')
        
        # executa a criação do gráfico
        my_heatmap <- heatmap(data.matrix(SEMANA), Rowv=NA, Colv=NA, col = cm.colors(256), scale="column")

    })
    
}

" inicia a execucao do shiny
-----------------------------"
shinyApp(ui = ui, server = server)