Commit a5dce7f9 authored by numeroteca's avatar numeroteca
Browse files

fix date in table

parent dcee1d20
......@@ -21,6 +21,9 @@ ui <- fluidPage(
.control-label, p {
font-size: 12px !important;
}
.form-group {
margin-bottom: 6px;
}
.shiny-input-container {
color: #474747;
}"))
......@@ -33,6 +36,17 @@ ui <- fluidPage(
# Sidebar panel for inputs ----
sidebarPanel(
# TODO set limits to chart
dateInput("date1", "Fecha transcripción", value = "2018-04-04" ),
# dateInput("date2", "Date ends", value = "2012-02-29"),
# # select period limits
# sliderInput("DatesMerge",
# "Dates:",
# min = as.Date("2016-01-01","%Y-%m-%d"),
# max = as.Date("2016-12-01","%Y-%m-%d"),
# value=as.Date("2016-12-01"),
# timeFormat="%Y-%m-%d"),
actionButton("go", "Aplica filtros",style="color: #fff; background-color: #337ab7; border-color: #2e6da4"),
......@@ -50,29 +64,27 @@ ui <- fluidPage(
min = 60, max = 360, value = 120
),
# TODO set limits to chart
dateInput("date1", "Fecha transcripción", value = "2018-04-04" ),
# dateInput("date2", "Date ends", value = "2012-02-29"),
# # select period limits
# sliderInput("DatesMerge",
# "Dates:",
# min = as.Date("2016-01-01","%Y-%m-%d"),
# max = as.Date("2016-12-01","%Y-%m-%d"),
# value=as.Date("2016-12-01"),
# timeFormat="%Y-%m-%d"),
sliderInput(inputId = "dias",
label = "Particiones (días)",
sliderInput(inputId = "datebreaks",
label = "nº Particiones",
min = 1, max = 365, value = 1
),
selectInput(inputId = "breaks",
label = "Particiones",
c(
"Día" = "day",
"Mes" = "month",
"Semana" = "week",
"Año" = "year"
),
selected = "day"
),
sliderInput(inputId = "xlabelsize",
label = "Tamaño etiqueta eje x ",
min = 1, max = 20, value = 9
),
selectInput("label", "Etiqueta días",
selectInput("label", "Etiqueta",
c(
"Día" = "%d",
"Día / mes" = "%d/%m",
......@@ -143,8 +155,12 @@ server <- function(input, output) {
})
# select breaks in x axis
dias <- eventReactive(input$go, {
input$dias
datebreaks <- eventReactive(input$go, {
input$datebreaks
})
# select type of breaks in x axis
breaks <- eventReactive(input$go, {
input$breaks
})
# select label in x axis
......@@ -157,7 +173,7 @@ server <- function(input, output) {
})
# select date for transcripts
date1 <- eventReactive(input$go, {
date1 <- reactive({
input$date1
})
......@@ -241,7 +257,7 @@ server <- function(input, output) {
# geom_point( aes(x = date2, y = start_time/60), alpha = 0.8, size=2) + #, color=caso
geom_hline(aes(yintercept=0), size=0.1) +
theme_minimal(base_family = "Roboto Condensed", base_size = 18) +
scale_x_datetime(date_breaks = paste(dias(),"day"),
scale_x_datetime(date_breaks = paste(datebreaks(),breaks()),
date_labels = label(),
# date_labels = "%d",
expand= c(0.01,0.05),
......@@ -270,65 +286,75 @@ server <- function(input, output) {
facet_wrap( ~telediario, ncol=1)
})
# Plot columns ------------
output$barPlot <- renderPlot({
mydata() %>%
# elimina los que está npor encima de 70min
filter ( ! ( start_time/60 > 70 ) ) %>%
ggplot( ) +
# bars
geom_bar(aes( x=date2), fill = "#555555") + # si hay clasificación por caso: fill=caso
# selected date
# tengo que hacerlo así porque no me deja seleccionar solamente una fecha TODO: investigar por qué
geom_bar( data = mydata() %>% filter( date > date1() - 1 & date < date1() + 2 ), # %>% filter( date == date1() )
aes(x=date2),
# width = 1,
fill = "#cc001f"
) +
# selected date
geom_bar( data = mydata() %>% filter( date > date1() - 0 & date < date1() + 3 ), # %>% filter( date == date1() )
aes(x=date2),
# width = 1,
fill = "#555555"
) +
theme_minimal(base_family = "Roboto Condensed", base_size = 22) +
# scale_x_datetime(date_breaks = "1 day", date_labels = "%d") +
scale_x_datetime(date_breaks = paste(datebreaks(),breaks()),
date_labels = label(),
expand= c(0.00,0.00),
#secondary axis to add months
sec.axis = sec_axis(~ .,
labels = scales::time_format("%b/%y"))
) +
labs(title = paste0("Cuánto hablan de ",input$variable, " en los telediarios"),
subtitle = paste0(subtitle_text,
"Periodo: ",
substr( min(mydata()$date2),1,10),
" - ",
substr( max(mydata()$date2),1,10),
"."
),
x = "fecha",
y = "nº de frases",
caption = caption_text) +
theme(
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
axis.ticks = element_line(color = "#777777"),
axis.text.x = element_text(size = xlabelsize() ),
axis.text.y = element_text(size = 10 ),
legend.position = "top"
) +
facet_wrap( ~telediario, ncol=1)
})
# Table ----------
output$quotes <- renderTable({
mydata() %>% select(content,start_time,date,telediario) %>%
mutate (start_time = start_time / 60,
date = as.character( as.Date(date, origin = lubridate::origin) )
date = as.character( as.Date(date, origin = lubridate::origin) ),
date_tmp = as.character( as.Date(date, origin = lubridate::origin) )
) %>%
# filter by selected date
filter( date == date1())
filter( date_tmp == date1())
})
# Plot columns ------------
output$barPlot <- renderPlot({
mydata() %>%
# elimina los que está npor encima de 70min
filter ( ! ( start_time/60 > 70 ) ) %>%
ggplot( ) +
geom_bar(aes( x=date2)) + # si hay clasificación por caso: fill=caso
# selected date
geom_bar( data = mydata() %>% filter( date == date1() ),
aes(x=date2),
width = 1,
colour = "#cc001f",
fill = "#cc001f"
) +
theme_minimal(base_family = "Roboto Condensed", base_size = 22) +
# scale_x_datetime(date_breaks = "1 day", date_labels = "%d") +
scale_x_datetime(date_breaks = paste(dias(),"day"),
date_labels = label(),
expand= c(0.00,0.00),
#secondary axis to add months
sec.axis = sec_axis(~ .,
labels = scales::time_format("%b/%y"))
) +
labs(title = paste0("Cuánto hablan de ",input$variable, " en los telediarios"),
subtitle = paste0(subtitle_text,
"Periodo: ",
substr( min(mydata()$date2),1,10),
" - ",
substr( max(mydata()$date2),1,10),
"."
),
x = "fecha",
y = "nº de frases",
caption = caption_text) +
theme(
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
axis.ticks = element_line(color = "#777777"),
axis.text.x = element_text(size = xlabelsize() ),
axis.text.y = element_text(size = 10 ),
legend.position = "top"
) +
facet_wrap( ~telediario, ncol=1)
})
}
shinyApp(ui, server)
\ No newline at end of file
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment