Skip to content

DF compilation #5

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
x3lll wants to merge 4 commits into
base: main
Choose a base branch
from
Open

DF compilation #5

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
e4b4771
Add files via upload
x3lll May 1, 2023
3abbca6
Update r34-app.R
x3lll May 1, 2023
d96d43c
Update r34_cleaning.R
x3lll May 1, 2023
664fe20
Update r34-app.R
x3lll May 1, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
72 changes: 50 additions & 22 deletions r34-app.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,9 +5,10 @@ if (!require(shiny)) install.packages("shiny")
if (!require(dplyr)) install.packages("dplyr")
if(!require(DT)) install.packages("DT")
if(!require(rclipboard)) install.packages("rclipboard")
if(!require(openxlsx)) install.packages("openxlsx")

#load libraries
library(shiny); library(dplyr); library(DT); library(rclipboard)
library(shiny); library(dplyr); library(DT); library(rclipboard); library(openxlsx)

# source some data cleaning functions
source("r34_cleaning.R")
Expand Down Expand Up @@ -46,7 +47,10 @@ ui <- navbarPage("Partner Services Network Canvas Data Upload",
# has the text "Next" on it, and has width 200px
actionButton('jumpToVenues','Next',width='200px')
),
downloadButton("download_data", "Download excel file")

),

)


Expand Down Expand Up @@ -209,13 +213,14 @@ server <- function(input, output) {
# data table with all sexual behavior for the past 12 months in it
output$sexbehav12m <- renderDT({
req(input$all_data)
data <- graph_dat()$sexbehav12m
#louis changed
data <- graph_dat()$sexbehav12m[,c(2,as.numeric(input$Contact)+2)]
# add a column with a "Copy" button - this is super finnicky and I don't
# understand how the rclipButton function works - I guess it's outputting
# HTML for the clip button, and then because we use "escape=FALSE" below
# that HTML gets rendered into a clip button...
data$Copy <- unlist(lapply(data$Responses,
names(data)[2] <- "Responses"
data$Copy <- unlist(lapply(data[,1],
function(x) {
rclipButton(
# not sure what this does
Expand Down Expand Up @@ -252,17 +257,18 @@ server <- function(input, output) {
#if statement, if choice is 90 days, render 90 days, etc

if (input$IP == "3 months") {
data <- graph_dat()$sexbehav90days
data <- graph_dat()$sexbehav90days[,c(2,as.numeric(input$Contact)+2)]
}
# Not adding the new here works for some reason?
if (input$IP == "7 months"){
data <- graph_dat()$sexbehav7mo
}
if (input$IP == "12 months"){
data <- graph_dat()$sexbehav12m
data <- graph_dat()$sexbehav12m[,c(2,as.numeric(input$Contact)+2)]
}

names(data)[2] <- "Responses"
# add a column with a "Copy" button
data$Copy <- unlist(lapply(data$Responses,
data$Copy <- unlist(lapply(data[,1],
function(x) {
rclipButton(
# not sure what this does
Expand Down Expand Up @@ -295,18 +301,19 @@ server <- function(input, output) {
# This one is basically identical to the sexbehav12m one but for druguse12m
output$druguse12m <- renderDT({
req(input$all_data)

data <- graph_dat()$druguse12m
data$Copy <- unlist(lapply(data$Responses,
#louischanged
data <- graph_dat()$druguse12m[,c(2,as.numeric(input$Contact)+2)]
names(data)[2] <- "Responses"
data$Copy <- unlist(lapply(data[,1],
function(x) {
rclipButton(
inputId = "clipbtn",
label = "Copy",
clipText = x,
icon = icon("clipboard")
) %>% as.character()
rclipButton(
inputId = "clipbtn",
label = "Copy",
clipText = x,
icon = icon("clipboard")
) %>% as.character()
}))

#louisended
data <- DT::datatable(data,
options = list(pageLength = 25),
class = "cell-border stripe",
Expand Down Expand Up @@ -399,9 +406,9 @@ server <- function(input, output) {

# choosing to only display the contact_referral columns 1 ("Responses" column)
# and as.numeric(input$Contact)+1 which is using the dropdown menu input
data <- graph_dat()$contact_referral[,c(1,as.numeric(input$Contact)+1)]
data <- graph_dat()$contact_referral[,c(2,as.numeric(input$Contact)+2)]
names(data)[2] <- "Responses"
data$Copy <- unlist(lapply(data[,2],
data$Copy <- unlist(lapply(data[,1],
function(x) {
rclipButton(
inputId = "clipbtn",
Expand All @@ -426,9 +433,11 @@ server <- function(input, output) {

#choosing to display venues columns 1 ("Responses" column)
# and as.numeric(input$Venues)+1 which is using the dropdown menu input
data <- graph_dat()$venues[,c(1,as.numeric(input$Venues)+1)]

data <- graph_dat()$venue[, c(2, as.numeric(input$Venues)+2)]
names(data)[2] <- "Responses"
data$Copy <- unlist(lapply(data[,2],

function(x) {
rclipButton(
inputId = "clipbtn",
Expand All @@ -447,7 +456,26 @@ server <- function(input, output) {

return(data)
})


output$download_data <- downloadHandler(
filename = paste("compileddata_", Sys.Date(), ".xlsx", sep=""),
content = function(file) {
wb <- createWorkbook()
sheets <- c("Venue", "Sexual Behavior 3 months", "Sexual Behavior 7 months", "Sexual behavior 12 months", "Drug Use 12 Months", "Referral contacts")
data <- list(graph_dat()$venue, graph_dat()$sexbehav90days, graph_dat()$sexbehav7mo, graph_dat()$sexbehav12m, graph_dat()$druguse12m, graph_dat()$contact_referral)
# Remove <b> and </b> tags from data frames
for (i in seq_along(data)) {
data[[i]] <- as.data.frame(lapply(data[[i]], function(x) gsub("<b>|</b>", "", x)))
}

for (i in 1:length(sheets)) {
addWorksheet(wb, sheets[i])
writeDataTable(wb, sheets[i], data[[i]])
}

saveWorkbook(wb, file)
}
)
}
# Run the app
shinyApp(ui, server)
Expand Down
Loading