From dd09e199c7abb2eb2a8e9b4e3190d392c80d218a Mon Sep 17 00:00:00 2001 From: sastoudt Date: Thu, 28 Nov 2019 16:26:13 -0800 Subject: [PATCH 1/4] get framework set up --- DESCRIPTION | 4 +- NAMESPACE | 1 + R/runDashboard.R | 9 ++ .../shiny-examples/dashboard_example/server.R | 99 +++++++++++++++++++ inst/shiny-examples/dashboard_example/ui.R | 90 +++++++++++++++++ 5 files changed, 201 insertions(+), 2 deletions(-) create mode 100644 R/runDashboard.R create mode 100644 inst/shiny-examples/dashboard_example/server.R create mode 100644 inst/shiny-examples/dashboard_example/ui.R diff --git a/DESCRIPTION b/DESCRIPTION index 4b6598a..9ec3f11 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,8 +14,8 @@ Description: Data on killings and suicides of trans people recorded for observan License: CC0 Encoding: UTF-8 LazyData: true -Depends: R (>= 2.10) -RoxygenNote: 6.1.1 +Depends: R (>= 2.10), shiny, shinydashboard, leaflet +RoxygenNote: 7.0.1 Suggests: dplyr, gganimate, diff --git a/NAMESPACE b/NAMESPACE index 6ae9268..a266304 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,2 +1,3 @@ # Generated by roxygen2: do not edit by hand +export(runDashboard) diff --git a/R/runDashboard.R b/R/runDashboard.R new file mode 100644 index 0000000..ac880a4 --- /dev/null +++ b/R/runDashboard.R @@ -0,0 +1,9 @@ +#' @export +runDashboard <- function() { + appDir <- system.file("shiny-examples", "dashboard_example", package = "tdor") + if (appDir == "") { + stop("Could not find example directory. Try re-installing `tdor`.", call. = FALSE) + } + + shiny::runApp(appDir, display.mode = "normal") +} \ No newline at end of file diff --git a/inst/shiny-examples/dashboard_example/server.R b/inst/shiny-examples/dashboard_example/server.R new file mode 100644 index 0000000..380eaa4 --- /dev/null +++ b/inst/shiny-examples/dashboard_example/server.R @@ -0,0 +1,99 @@ +server <- function(input, output) { + + + #renderWidgetframe + #renderPlot + output$map <- renderLeaflet({ + if(input$selectCountry=="All"){ + data=tdor + names(data)=gsub(" ",".",names(tdor)) + data=subset(data,Date >= input$selectDate[1] & Date <=input$selectDate[2]) + data$photoURL=paste("https://bytebucket.org/annajayne/tdor_data/raw/default/Data/TDoR%20",data$Year,"/photos/",data$Photo,sep="") + + }else{ + data=subset(tdor,Country==input$selectCountry) + names(data)=gsub(" ",".",names(tdor)) + data=subset(data,Date >= input$selectDate[1] & Date <=input$selectDate[2]) + data$photoURL=paste("https://bytebucket.org/annajayne/tdor_data/raw/default/Data/TDoR%20",data$Year,"/photos/",data$Photo,sep="") + } + + # plot <- suppressWarnings( + # figure( + # width = 800, height = 450, + # padding_factor = 0) %>% + # ly_map("world", col = "gray") %>% + # ly_points(Longitude, Latitude, data = data, size = 5, + # hover = c(Name, Age,Date,Location,Cause.of.death ))) + # plot + + + + ## add images + ## https://github.com/CaRdiffR/tdor/issues/3 + + + p <- leaflet(data =data) %>% + addProviderTiles(providers$CartoDB.Positron) %>% + addMarkers(~Longitude, ~Latitude, + popup=paste( + "", data$Name,"
", + "Age ", data$Age, "
", + data$Date, "
", + data$Location, "
", + data$Cause.of.death, "
", + "", ## will display an icon if no photo + + sep="") + ) + p + + + }) + + output$overTime <- renderPlot({ + + ggplot(tdor, aes(Year)) + geom_bar() + + ggtitle("Deaths by year") + + }) + + output$byAge <- renderPlot({ + tdor %>% + filter(Age_min > 0 & Age_max > 0) %>% + ggplot(aes(x = (Age_min + Age_max)/2)) + + geom_bar() + + ggtitle("Deaths by age") + + labs(y = "Deaths") + }) + + output$byAge2<- renderPlot({ + tdor %>% + filter(Age_min > 0 & Age_max > 0) %>% + ggplot(aes(x = (Age_min + Age_max)/2)) + + geom_histogram(binwidth = 5) + + ggtitle("Deaths by age") + + labs(y = "Deaths") + }) + + output$top10 <- renderPlot({ + tdor %>% + group_by(Country) %>% + summarise(n = n()) %>% + arrange(desc(n)) -> by_country + ggplot(by_country[1:10,], + aes(x = Country, + y = n)) + + theme_bw() + + labs(y = "Deaths", x = "") + + geom_bar(stat="identity") + + theme(axis.text.x = element_text(angle=45, hjust=1)) + + ggtitle("Ten countries with the most reported deaths") + + }) + + + +} ## end server diff --git a/inst/shiny-examples/dashboard_example/ui.R b/inst/shiny-examples/dashboard_example/ui.R new file mode 100644 index 0000000..87cba8b --- /dev/null +++ b/inst/shiny-examples/dashboard_example/ui.R @@ -0,0 +1,90 @@ +library(shiny) +library(shinydashboard) +#https://bhaskarvk.github.io/user2017.geodataviz/notebooks/03-Interactive-Maps.nb.html#using_rbokeh +#library(maps) +#library(rbokeh) +#library(widgetframe) +library(dplyr) +library(leaflet) +library(ggplot2) +library(ggthemes) + + +header <- dashboardHeader( + + title = "Trans Lives Matter" + +) + +sidebar <- dashboardSidebar( + sidebarMenu( + menuItem("Trigger Warning", tabName = "triggerWarning", icon = icon("exclamation-triangle")), + menuItem("Map",tabName="map",icon=icon("globe")), + menuItem("Summaries",tabName="summaries",icon=icon("clipboard-list")), + menuItem("How to Contribute", tabName = "contribute", icon = icon("hand-holding-heart")) + ) +) + +body <- dashboardBody( + tabItems( + tabItem(tabName="triggerWarning", + h1("TRIGGER WARNING: VIOLENCE. MURDER"), + h4("This dashboard provides a way to interactively explore the data on killings + and suicides of transgender people, as memorialized in the Transgender Day of Remembrance + 2007-2018."), + h4("This data can be accessed via the R package tdor: https://github.com/CaRdiffR/tdor"), + h4("More information can be found here: https://tdor.translivesmatter.info/") + ), + + tabItem(tabName="map", + + selectInput("selectCountry", + h3("Select country"), + c("All",sort(unique(tdor$Country)))), + HTML("
"), + HTML("
"), + HTML("
"), + dateRangeInput("selectDate",h3("Select date range"), + start = min(tdor$Date), end = max(tdor$Date), + min = min(tdor$Date), max = max(tdor$Date)), + #widgetframeOutput("plot1") + #plotOutput("plot1") + leafletOutput("map",height=500,width=750) + ), + + tabItem(tabName="summaries", + # from https://github.com/CaRdiffR/tdor/blob/master/vignettes/exploring_data_set.Rmd + plotOutput("overTime"), + plotOutput("byAge"), + #plotOutput("byAge2"), + plotOutput("top10"), + plotOutput("animate") + ), + + tabItem(tabName="contribute", + h2("How to Contribute to This Dashboard"), + h4("1. Fork the repository: https://github.com/rlgbtq/TDoR2018"), + h4("2. Clone the fork to your workspace."), + h4("3. Make changes to shinyDashboard/app.R"), + h4("3a. Create a new menuItem in the sidebar function."), + h4("3b. Create a new tabItem in the body function. Make sure tabName is + equivalent to the tabName you specified in menuItem."), + h4("3c. Add plots to server function."), + h4("4. Submit a pull request."), + h4("More guidance on shinydashboard here: https://rstudio.github.io/shinydashboard/"), + h4("More guidance on GitHub logistics here: + https://help.github.com/articles/creating-a-pull-request-from-a-fork/"), + h2("How to Contribute in Other Ways"), + h4("Check out the issues here: https://github.com/rlgbtq/TDoR2018") + ) ## end tabItem + + ) #end tabItems +) # dashboardBody + +ui <- dashboardPage( + header, + sidebar, + body, + skin="red" + +) \ No newline at end of file From 534ffef3c61ac55ffb5c5bb57bb1a5498dad03d1 Mon Sep 17 00:00:00 2001 From: sastoudt Date: Thu, 28 Nov 2019 16:34:43 -0800 Subject: [PATCH 2/4] fix age names --- inst/shiny-examples/dashboard_example/server.R | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/inst/shiny-examples/dashboard_example/server.R b/inst/shiny-examples/dashboard_example/server.R index 380eaa4..9cf0266 100644 --- a/inst/shiny-examples/dashboard_example/server.R +++ b/inst/shiny-examples/dashboard_example/server.R @@ -61,7 +61,10 @@ server <- function(input, output) { }) output$byAge <- renderPlot({ - tdor %>% + data = tdor + names(data)[which(names(data)=="Age min")]="Age_min" + names(data)[which(names(data)=="Age max")]="Age_max" + data %>% filter(Age_min > 0 & Age_max > 0) %>% ggplot(aes(x = (Age_min + Age_max)/2)) + geom_bar() + @@ -70,7 +73,10 @@ server <- function(input, output) { }) output$byAge2<- renderPlot({ - tdor %>% + data = tdor + names(data)[which(names(data)=="Age min")]="Age_min" + names(data)[which(names(data)=="Age max")]="Age_max" + data %>% filter(Age_min > 0 & Age_max > 0) %>% ggplot(aes(x = (Age_min + Age_max)/2)) + geom_histogram(binwidth = 5) + From a6ff245a6ed59ff7ec590d62315252fb618fe8d5 Mon Sep 17 00:00:00 2001 From: sastoudt Date: Thu, 28 Nov 2019 16:36:50 -0800 Subject: [PATCH 3/4] update documentation --- R/runDashboard.R | 2 +- inst/shiny-examples/dashboard_example/ui.R | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/runDashboard.R b/R/runDashboard.R index ac880a4..ca1555a 100644 --- a/R/runDashboard.R +++ b/R/runDashboard.R @@ -4,6 +4,6 @@ runDashboard <- function() { if (appDir == "") { stop("Could not find example directory. Try re-installing `tdor`.", call. = FALSE) } - + #https://deanattali.com/2015/04/21/r-package-shiny-app/ shiny::runApp(appDir, display.mode = "normal") } \ No newline at end of file diff --git a/inst/shiny-examples/dashboard_example/ui.R b/inst/shiny-examples/dashboard_example/ui.R index 87cba8b..505c2b8 100644 --- a/inst/shiny-examples/dashboard_example/ui.R +++ b/inst/shiny-examples/dashboard_example/ui.R @@ -31,7 +31,7 @@ body <- dashboardBody( h1("TRIGGER WARNING: VIOLENCE. MURDER"), h4("This dashboard provides a way to interactively explore the data on killings and suicides of transgender people, as memorialized in the Transgender Day of Remembrance - 2007-2018."), + 2007-2019."), h4("This data can be accessed via the R package tdor: https://github.com/CaRdiffR/tdor"), h4("More information can be found here: https://tdor.translivesmatter.info/") ), @@ -63,9 +63,9 @@ body <- dashboardBody( tabItem(tabName="contribute", h2("How to Contribute to This Dashboard"), - h4("1. Fork the repository: https://github.com/rlgbtq/TDoR2018"), + h4("1. Fork the repository: https://github.com/CaRdiffR/tdor"), h4("2. Clone the fork to your workspace."), - h4("3. Make changes to shinyDashboard/app.R"), + h4("3. Make changes to files in inst/shiny-examples/dashboard_example/"), h4("3a. Create a new menuItem in the sidebar function."), h4("3b. Create a new tabItem in the body function. Make sure tabName is equivalent to the tabName you specified in menuItem."), @@ -75,7 +75,7 @@ body <- dashboardBody( h4("More guidance on GitHub logistics here: https://help.github.com/articles/creating-a-pull-request-from-a-fork/"), h2("How to Contribute in Other Ways"), - h4("Check out the issues here: https://github.com/rlgbtq/TDoR2018") + h4("Check out the issues here: https://github.com/CaRdiffR/tdor") ) ## end tabItem ) #end tabItems From 5da697eb96ff4d9ece3bc066af435f42165286f2 Mon Sep 17 00:00:00 2001 From: sastoudt Date: Thu, 28 Nov 2019 16:45:24 -0800 Subject: [PATCH 4/4] add documentation for launch function --- R/runDashboard.R | 3 +++ man/runDashboard.Rd | 11 +++++++++++ 2 files changed, 14 insertions(+) create mode 100644 man/runDashboard.Rd diff --git a/R/runDashboard.R b/R/runDashboard.R index ca1555a..e213b4c 100644 --- a/R/runDashboard.R +++ b/R/runDashboard.R @@ -1,3 +1,6 @@ +#' Launch Shiny Dashboard +#' +#' \code{runDashboard} launches the Shiny Dashboard displaying the data contained in this package #' @export runDashboard <- function() { appDir <- system.file("shiny-examples", "dashboard_example", package = "tdor") diff --git a/man/runDashboard.Rd b/man/runDashboard.Rd new file mode 100644 index 0000000..54a844a --- /dev/null +++ b/man/runDashboard.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/runDashboard.R +\name{runDashboard} +\alias{runDashboard} +\title{Launch Shiny Dashboard} +\usage{ +runDashboard() +} +\description{ +\code{runDashboard} launches the Shiny Dashboard displaying the data contained in this package +}