library(shiny)
#runExample("01_hello")
library(shinydashboard)
##
## Adjuntando el paquete: 'shinydashboard'
## The following object is masked from 'package:graphics':
##
## box
library(dplyr)
##
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(dslabs)
library(ggplot2)
library(plotly)
##
## Adjuntando el paquete: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(DT)
##
## Adjuntando el paquete: 'DT'
## The following objects are masked from 'package:shiny':
##
## dataTableOutput, renderDataTable
# Cargar el dataset
data(murders)
murders <- mutate(murders, rate = total / population * 100000)
#User interface
ui <- dashboardPage(title="Murders dataset",skin="green",
dashboardHeader(
title="murders dataset dashboard",
dropdownMenu(type = "messages",
messageItem(
from = "Sales Dept",
message = "Sales are steady this month."
),
messageItem(
from = "New User",
message = "How do I register?",
icon = icon("question"),
time = "13:45"
)
),
dropdownMenu(type = "notifications",
notificationItem(
text = "5 new users today",
icon("users")
)
),
dropdownMenu(type = "tasks", badgeStatus = "danger",
taskItem(value = 100, color = "lime",
"Murders Dashboard",href = NULL
),
taskItem(value = 100, color = "olive",
"My database dashboard",href = NULL
)
)
),
dashboardSidebar(
sidebarSearchForm(textId = "searchText", buttonId = "searchButton",
label = "Search..."),
menuItem("Dashboard", tabName = "dashboard", icon = icon("earth-asia")),
menuItem("Dataset", tabName = "datatable", icon = icon("table")),
menuItem("Graphs", tabName = "graphs", icon = icon("square-poll-vertical")),
menuItem("linear regression model", tabName = "linearmodel", icon = icon("line-chart"))
),
dashboardBody(
tabItems(
#First
tabItem(tabName="dashboard",
# Boxes need to be put in a row (or column)
fluidRow(
infoBoxOutput("totalMurders"),
infoBoxOutput("numStates"),
infoBoxOutput("highestRate")
),
fluidRow(
box(title = "Histogram",status = "primary",
solidHeader = TRUE, plotlyOutput("plot1", height = 250)),
box(
title = "Controls",status = "warning", solidHeader = TRUE,
sliderInput("slider", "Number of observations:", 1, nrow(murders),50)
)
)
),
#Second
tabItem(tabName = "datatable",
h2("Dataset tab content"),
fluidRow(
box(title = "Murders Dataset",status="success", solidHeader = TRUE,width = 12, # Aumenta el ancho de la caja
DTOutput("murdersTable") # Aquí se mostrará la tabla completa del dataset
)
),
fluidRow(
box(title = "Download Data",status="success", solidHeader = TRUE,
downloadButton("downloadData", "Download CSV")
)
)
),
#
tabItem(tabName = "graphs",
h2("Graphs tab content"),
fluidRow(
box(title = "Percentage of murders by region",status = "primary",
solidHeader = TRUE, plotlyOutput("plot2", height = 250)),
box(title = "rate vs region",status = "primary",
solidHeader = TRUE, plotlyOutput("plot3", height = 250)),
box(title = "US Gun Murders in 2010",status = "primary",
solidHeader = TRUE, plotlyOutput("plot4", height = 250)),
box(title = "US Gun Murders in 2010 by region",status = "primary",
solidHeader = TRUE, plotlyOutput("plot5", height = 250))
)
),
tabItem(tabName = "linearmodel",
h2("Linear regression model tab content"),
uiOutput("markdown_report")
)
)
)
)
## The `name` provided ('clock-o') does not correspond to a known icon
#Funcional
server <- function(input, output) {
output$messageMenu <- renderMenu({
# Code to generate each of the messageItems here, in a list. This assumes
# that messageData is a data frame with two columns, 'from' and 'message'.
msgs <- apply(messageData, 1, function(row) {
messageItem(from = row[["from"]], message = row[["message"]])
})
# This is equivalent to calling:
# dropdownMenu(type="messages", msgs[[1]], msgs[[2]], ...)
dropdownMenu(type = "messages", .list = msgs)
})
# Total number of murders
output$totalMurders <- renderInfoBox({
total_murders <- sum(murders$total)
infoBox("Total Murders", total_murders, icon = icon("gun"), color = "blue")
})
# Number of states
output$numStates <- renderInfoBox({
num_states <- nrow(murders)
infoBox("Number of States", num_states, icon = icon("map"), color = "green")
})
# Highest murder rate
output$highestRate <- renderInfoBox({
highest_rate <- max(murders$rate)
infoBox("Highest Murder Rate", round(highest_rate, 2), icon = icon("bar-chart"), color = "red")
})
output$plot1 <- renderPlotly({
# Filtrar los datos según el valor del slider
filtered_data <- murders[seq_len(input$slider), ]
# Crear el histograma con los datos filtrados
p <- ggplot(filtered_data, aes(x = total)) +
geom_histogram(fill = "steelblue", color = "black") +
labs(title ="Histogram of Total Murders",
x = "Total Number of Murders",
y = "Frequency")
# Convertir el gráfico ggplot a plotly para interactividad
ggplotly(p)
})
output$murdersTable <- renderDT({
datatable(murders, options = list(pageLength = 10, autoWidth = TRUE))
})
output$downloadData <- downloadHandler(
filename = function() {
paste("murders_dataset_", Sys.Date(), ".csv", sep = "")
},
content = function(file) {
write.csv(murders, file)
}
)
output$plot2 <- renderPlotly({
# Calcular proporciones
data <- murders %>%
count(region) %>%
mutate(proportion = n / sum(n),
label = paste0(region, ": ", scales::percent(proportion)))
# Definir colores pastel
pastel_colors <- c("#FBB4AE", "#B3CDE3", "#CCEBC5", "#DECBE4", "#FED9A6")
# Crear el gráfico circular con plotly usando colores pastel
p_interactivo <- plot_ly(data, labels = ~region,
values = ~proportion,
type = 'pie',
marker = list(colors = pastel_colors)) %>%
layout(showlegend = TRUE)
# Convertir el gráfico plotly a un objeto ggplotly para interactividad
ggplotly(p_interactivo)
})
output$plot3 <- renderPlotly({
q<-murders %>% ggplot(aes(region,rate,fill=region)) +
geom_boxplot(outliers = FALSE)
# Convertir el gráfico plotly a un objeto ggplotly para interactividad
ggplotly(q)
})
output$plot4 <- renderPlotly({
r<- murders %>% ggplot(aes(x = population/10^6,
y = total,color=region)) +
geom_point(aes(shape=region))+xlab("Populations in millions (log scale)") +
ylab("Total number of murders (log scale)") +
scale_x_continuous(trans = "log10") +
scale_y_continuous(trans = "log10")
# Convertir el gráfico plotly a un objeto ggplotly para interactividad
ggplotly(r)
})
output$plot5 <- renderPlotly({
q<-murders %>% ggplot(aes(x = population/10^6,
y = total,color=region,shape=region)) +
geom_point(show.legend = FALSE)+xlab("Populations in millions (log scale)") +
ylab("Total number of murders (log scale)") +
ggtitle("US Gun Murders in 2010")+
scale_x_continuous(trans = "log10") +
scale_y_continuous(trans = "log10") +
facet_wrap(~ region, nrow = 2)+
geom_smooth(show.legend = FALSE)
# Convertir el gráfico plotly a un objeto ggplotly para interactividad
ggplotly(q)
})
output$markdown_report <- renderUI({
# Renderizar el archivo RMarkdown y devolver el HTML resultante
includeHTML(rmarkdown::render("Regresion Lineal.Rmd"))
})
}
#Ejecuta aplicativo
shinyApp(ui, server)
Shiny applications not supported in static R Markdown documents