inst/debiApp/server.R
In MartinGoros/debi: Dashboard Application for Biostatistics Group
####
# Author: Martin W. Goros
# UT Health San Antonio
shinyServer(function(input, output, session){
observe({
if(is.null(full_data)){
showNotification(HTML("<h4><center>No data available</center></h2>"),type='error',duration=NULL,closeButton=FALSE)
}else{
shiny::withProgress(message = 'Loading Application...', detail = "", value = 0, {
for (i in c("done")) {
cat("Loading data...")
source("dataload.r")
# Show logged in user
output$username <- shiny::renderText({
paste0("User: ",GetUserName())
})
# InfoBox Intake
output$intake <- shinydashboard::renderValueBox({
shinydashboard::valueBox(HTML(paste0("<font size='15'>",intakes," </font><font size='5'>(",round(intakes/total,2)*100,"%)</font>")), subtitle = HTML(paste0("<font size='5'>Intake</font>")), color = "yellow",icon=icon("shopping-cart"))
})
# InfoBox Active
output$active <- shinydashboard::renderValueBox({
shinydashboard::valueBox(HTML(paste0("<font size='15'>",actives," </font><font size='5'>(",round(actives/total,2)*100,"%)</font>")), subtitle = HTML(paste0("<font size='5'>Active</font>")), color = "green",icon=icon("clock-o"))
})
# InfoBox Inactive
output$inactive <- shinydashboard::renderValueBox({
shinydashboard::valueBox(HTML(paste0("<font size='15'>",inactives," </font><font size='5'>(",round(inactives/total,2)*100,"%)</font>")), subtitle = HTML(paste0("<font size='5'>Inactive</font>")), color = "red",icon=icon("eye"))
})
# InfoBox Hold
output$hold <- shinydashboard::renderValueBox({
shinydashboard::valueBox(HTML(paste0("<font size='15'>",hold," </font><font size='5'>(",round(hold/total,2)*100,"%)</font>")), subtitle = HTML(paste0("<font size='5'>Hold</font>")), color = "purple",icon=icon("remove"))
})
# InfoBox Manuscript Writing
output$manus <- shinydashboard::renderValueBox({
shinydashboard::valueBox(HTML(paste0("<font size='15'>",manus," </font><font size='5'>(",round(manus/total,2)*100,"%)</font>")), subtitle = HTML(paste0("<font size='5'>Manuscript Writing</font>")), color = "orange",icon=icon("pencil"))
})
# InfoBox Grant Writing
output$grant <- shinydashboard::renderValueBox({
shinydashboard::valueBox(HTML(paste0("<font size='15'>",grant," </font><font size='5'>(",round(grant/total,2)*100,"%)</font>")), subtitle = HTML(paste0("<font size='5'>Grant Writing</font>")), color = "blue",icon=icon("pencil"))
})
shiny::incProgress(1, detail = paste(i))
}
}) # end of progress bar
## hours graphic----------------------------------------------------------------
hourscont <- subset(work,select=c('record_id','contribution_date','hours','modifier_work'))
hourscont$contribution_date <- as.Date(hourscont$contribution_date,format='%Y-%m-%d')
if(any(hourscont$contribution_date >= (Sys.Date()-7))){
hourscont <- subset(hourscont,(contribution_date >= (Sys.Date()-7)))
}else{
hourscont <- data.frame(record_id=NA,contribution_date=NA,hours=NA,modifier_work=NA)
}
last7days <- plyr::ddply(hourscont,c('record_id','modifier_work'),function(x){
return(data.frame(hours=sum(x$hours)))
})
if(nrow(last7days)==0 | all(is.na(last7days))){
last7days <- data.frame(matrix(0,ncol=3,nrow=1))
last7days <- data.frame(record_id=0,contribution_date=0,hours=0,modifier_work="none")
}
cbbPalette <- rep(c('#545454','#696969','#7e7e7e','#939393','#a8a8a8','#bdbdbd','#d3d3d3','#2a2a2a','#E5E5E5'),times=5)
if(any(last7days$modifier_work=='none')){
mosttime <- merge(last7days,projectinfo,by='record_id',all.x=TRUE)
mosttime <- subset(mosttime,select=c('modifier_work','job_title','hours'))
mosttime$id <- 1:nrow(mosttime)
diplay_data <- mosttime
}else{
mosttime <- merge(last7days,projectinfo,by='record_id',all.x=TRUE)
mosttime <- subset(mosttime,select=c('modifier_work','job_title','hours'))
mosttime <- mosttime[order(mosttime$modifier_work),]
mosttime <- plyr::ddply(mosttime,c('modifier_work'),function(x){
x <- x[order(x$hours),]
return(x)
})
mosttime <- subset(mosttime,job_title != "")
mosttime$modifier_work <- as.character(mosttime$modifier_work)
mosttime$id <- 1:nrow(mosttime)
diplay_data <- mosttime
}
display_values <- function(x) {
if(is.null(x)) return(NULL)
row <- diplay_data[diplay_data$id == x$id, which(names(diplay_data) %in% c("job_title","hours"))]
paste0(c("Project","Hours"), ": ", format(row), collapse = "<br>")
}
mosttime %>%
ggvis::ggvis(y = ~modifier_work, fill = ~job_title, key := ~id) %>%
ggvis::add_tooltip(display_values, "hover") %>%
ggvis::compute_stack(stack_var = ~hours, group_var = ~modifier_work) %>%
ggvis::layer_rects(x = ~stack_lwr_, x2 = ~stack_upr_, height = band()) %>%
ggvis::set_options(width = "100%", height = "300px", resizable = TRUE) %>%
ggvis::hide_legend('fill') %>%
ggvis::scale_ordinal('fill', range = cbbPalette) %>%
ggvis::add_axis("y", title = "") %>%
ggvis::scale_numeric("x", domain = c(0, 45), nice = FALSE, clamp = TRUE) %>%
ggvis::bind_shiny("hours",height='320px')
## faculty assigned-------------------------------------------------------------
fac_dat <- InfoTable
fac_dat$assigned_faculty <- gsub( " .*$","",as.character(fac_dat$assigned_faculty))
fac_dat$assigned_faculty[fac_dat$assigned_faculty == ""] <- "Not assigned"
output$assigned_fac <- renderPlotly({
fac_dat %>%
dplyr::group_by(assigned_faculty) %>%
dplyr::summarize(count = n()) %>%
plot_ly(labels = ~assigned_faculty, values = ~count,insidetextfont = list(color = '#FFFFFF'),marker = list(colors = colors,
line = list(color = '#FFFFFF', width = 1))) %>%
add_pie(hole = 0.4) %>%
layout(title = "", showlegend = TRUE,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE)) %>%
config(displayModeBar = F)
})
## staff assigned---------------------------------------------------------------
staff_dat <- InfoTable
staff_dat$assigned_staff <- as.character(staff_dat$assigned_staff)
staff_dat$assigned_staff[staff_dat$assigned_staff == ""] <- "Not assigned"
output$assigned_staff <- renderPlotly({
staff_dat %>%
dplyr::group_by(assigned_staff) %>%
dplyr::summarize(count = n()) %>%
plot_ly(labels = ~assigned_staff, values = ~count,insidetextfont = list(color = '#FFFFFF'),marker = list(colors = colors,
line = list(color = '#FFFFFF', width = 1))) %>%
add_pie(hole = 0.4) %>%
layout(title = "", showlegend = TRUE,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE)) %>%
config(displayModeBar = F)
})
## intake count-----------------------------------------------------------------
intakes.raw <- subset(status,job_phase == 'Intake')
intakes.raw$month <- format(intakes.raw$job_phase_date,format='%m%y')
intakes.raw$count <- 1
out.count <- ddply(intakes.raw,'month',function(x){
counts <- sum(x$count)
return(counts)
})
names(out.count)[2] <- 'Count'
out.count$Month <- as.Date(paste0("01",out.count$month),format='%d%m%y')
out.count <- out.count[order(out.count$Month),]
output$intake_count <- renderPlotly({
plot_ly(out.count, x = ~Month, y = ~Count, type = 'bar', marker = list(color='#424242')) %>%
layout(xaxis = list(title = "",tickformat='%Y', showticklabels = TRUE, tickangle = -45),
yaxis = list(title = "",tickformat=',d'),
margin = list(b = 50)) %>%
config(displayModeBar = F)
})
## dashboard table--------------------------------------------------------------
displaydata <- plyr::join(InfoTable,subset(appt,date_appt!='',select=c('record_id','date_appt')),by='record_id')
displaydata <- displaydata[,c('job_title','job_alias','job_phase','job_phase_date','deadline_date','job_phase_comment','assigned_faculty','assigned_staff','importance','date_appt')]
displaydata <- displaydata[order(displaydata$job_title),]
displaydata$deadline_date <- as.Date(displaydata$deadline_date,format='%Y-%m-%d')
displaydata$deadline_date <- format(displaydata$deadline_date,format='%m/%d/%Y')
displaydata$job_phase_date <- as.Date(displaydata$job_phase_date,format='%Y-%m-%d')
displaydata$job_phase_date <- format(displaydata$job_phase_date,format='%m/%d/%Y')
displaydata$date_appt <- format(as.POSIXct(displaydata$date_appt,format='%Y-%m-%d %H:%M'),format='%m/%d/%Y %I:%M %p')
# names to be displayed
matchnames <- data.frame(old=c('job_title','job_alias','job_phase','job_phase_date','deadline_date','job_phase_comment','assigned_faculty','assigned_staff','importance','date_appt'),
new=c('Job','Alias','Phase','Phase Date','Deadline','Comment','Faculty','Staff','Importance','Appointment'))
names(displaydata) <- as.character(matchnames$new[match(names(displaydata),matchnames$old)])
output$table1 <- DT::renderDataTable({
datatable(displaydata
, rownames = FALSE, filter = 'top', options = list(columnDefs = list(list(className = 'dt-center', targets = c(1,3:4,6:9))),scrollX = '300px',scrollY = '350px',pageLength = 10,rowCallback = JS('
function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {
// Bold and green cells for conditions
$("td:eq(2)", nRow).css("color", "#FFFFFF");
$("td:eq(4)", nRow).css("color", "#FFFFFF");
$("td:eq(0)", nRow).css("color", "#000000");
$("td:eq(1)", nRow).css("color", "#000000");
$("td:eq(3)", nRow).css("color", "#000000");
$("td:eq(5)", nRow).css("color", "#000000");
$("td:eq(6)", nRow).css("color", "#000000");
$("td:eq(7)", nRow).css("color", "#000000");
$("td:eq(8)", nRow).css("color", "#000000");
$("td:eq(9)", nRow).css("color", "#000000");
if (aData[2] == "Completed")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Completed")
$("td:eq(2)", nRow).css("background-color", "#4B9F4B");
if (aData[2] == "Active")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Active")
$("td:eq(2)", nRow).css("background-color", "#5ec97b");
if (aData[2] == "Inactive")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Inactive")
$("td:eq(2)", nRow).css("background-color", "#E84C3D");
if (aData[2] == "Manuscript Writing")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Manuscript Writing")
$("td:eq(2)", nRow).css("background-color", "#E77E22");
if (aData[2] == "Manuscript Writing")
$("td:eq(4)", nRow).css("color", "#000000");
if (aData[2] == "Grant Writing")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Grant Writing")
$("td:eq(2)", nRow).css("background-color", "#3297DB");
if (aData[2] == "Intake")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Intake")
$("td:eq(2)", nRow).css("background-color", "#BEC3C7");
if (aData[2] == "Hold")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Hold")
$("td:eq(2)", nRow).css("background-color", "#8D44AD");
var currdtten = new Date(new Date().getTime()+(14*24*60*60*1000));
var currdt = new Date();
if (aData[2] != "Completed" & aData[2] != "Manuscript Writing" & Date.parse(aData[4]) < currdt)
$("td:eq(4)", nRow).css("font-weight", "bold");
if (aData[2] != "Completed" & aData[2] != "Manuscript Writing" & Date.parse(aData[4]) < currdt)
$("td:eq(4)", nRow).css("background-color", "#A45B5B");
if (aData[2] != "Completed" & aData[2] != "Manuscript Writing" & Date.parse(aData[4]) < currdtten & Date.parse(aData[4]) > currdt)
$("td:eq(4)", nRow).css("font-weight", "bold");
if (aData[2] != "Completed" & aData[2] != "Manuscript Writing" & Date.parse(aData[4]) < currdtten & Date.parse(aData[4]) > currdt)
$("td:eq(4)", nRow).css("background-color", "#EE5555");
if (aData[2] != "Completed" & aData[2] != "Manuscript Writing" & Date.parse(aData[4]) > currdt & Date.parse(aData[4]) > currdtten)
$("td:eq(4)", nRow).css("font-weight", "bold");
if (aData[2] != "Completed" & aData[2] != "Manuscript Writing" & Date.parse(aData[4]) > currdt & Date.parse(aData[4]) > currdtten)
$("td:eq(4)", nRow).css("background-color", "#27AE61");
}')))
},autoWidth = TRUE, scrollCollapse = TRUE, lengthMenu = c(5, 10, 20, 50, 100), pageLength = 5)
## mtable-----------------------------------------------------------------------
testdata2 <- myTimeTable
testdata2$job_phase_date <- as.Date(testdata2$job_phase_date,format='%Y-%m-%d')
testdata2$job_phase_date <- format(testdata2$job_phase_date,format='%m/%d/%Y')
testdata2$deadline_date <- as.Date(testdata2$deadline_date,format='%Y-%m-%d')
testdata2$deadline_date <- format(testdata2$deadline_date,format='%m/%d/%Y')
testdata2 <- subset(testdata2,select=c('record_id','job_title','job_alias','job_phase','assigned_faculty','assigned_staff','job_phase_comment'))
names(testdata2) <- c('Record','Title','Alias','Phase','Faculty','Staff','Note')
my_data2 <- testdata2
output$responses <- DT::renderDataTable({
datatable(my_data2, filter = 'top', selection = 'single',rownames= FALSE,
options = list(autoWidth = TRUE, searching = TRUE,pageLength = 15,columnDefs = list(list(width = '2px',className = 'dt-center', targets = c(0,3,6))),scrollY = '650px', paging = TRUE, scrollX = FALSE)
)
},server = FALSE, escape = FALSE)
## mytime----------------------------------------------------------------------
date <- reactive({
as.Date(paste0(ISOweek::ISOweek2date(paste0(input$year_num,"-W",ifelse(nchar(as.character(input$week_num))==1,paste0("0",input$week_num),input$week_num),"-1"))))
})
# weekday output
output$monday <- renderUI({HTML(paste0("Monday<br/>(",format(date(),format='%m/%d'),")"))})
output$tuesday <- renderUI({HTML(paste0("Tuesday<br/>(",format(date()+1,format='%m/%d'),")"))})
output$wednesday <- renderUI({HTML(paste0("Wednesday<br/>(",format(date()+2,format='%m/%d'),")"))})
output$thursday <- renderUI({HTML(paste0("Thursday<br/>(",format(date()+3,format='%m/%d'),")"))})
output$friday <- renderUI({HTML(paste0("Friday<br/>(",format(date()+4,format='%m/%d'),")"))})
output$saturday <- renderUI({HTML(paste0("Saturday<br/>(",format(date()+5,format='%m/%d'),")"))})
output$sunday <- renderUI({HTML(paste0("Sunday<br/>(",format(date()+6,format='%m/%d'),")"))})
output$date_today <- renderText({paste0(format(date(),format='%m/%d/%Y')," - ",format(date()+6,format='%m/%d/%Y'))})
output$sel_proj2 <- renderText({ifelse(is.null(input$responses_rows_selected),"Please select project in project table",as.character(myTimeTable[input$responses_rows_selected,]$job_title))})
output$modif <- renderUI({
if (input$submit) {
isolate({
withProgress(message = 'Saving Data...', value = 0, {
# work
rcon <- redcapAPI::redcapConnection(url=rc_url, token=rc_token)
work_check <- subset(redcapAPI::exportRecords(rcon,records=myTimeTable[input$responses_rows_selected,]$record_id,dates=FALSE),select=c('hours','job_phase','redcap_repeat_instance'))#subset(read_redcap(redcap_url=rc_url,secret_token=rc_token),record_id==myTimeTable[input$responses_rows_selected,]$record_id,select=c('hours','job_phase','redcap_repeat_instance'))#
counter2 <- 0
data2 <- NULL
for(input in which(Data()$df$hours!='')){
# required note
if(Data()$df$hours_note[input]==""){
showNotification(
h4(HTML("Note required"),align='center'),
duration = 6,
closeButton = TRUE,
type = "error"
)
}else{
counter2 <- counter2+1
work_i <- subset(work_check,!is.na(hours))$redcap_repeat_instance[nrow(subset(work_check,!is.na(hours)))]+counter2
work_i <- ifelse(length(work_i)==0,1,work_i)
data2 <- data.frame(record_id=Data()$df$record_id[input],
work_description=Data()$df$hours_note[input],
redcap_repeat_instrument='work',
redcap_repeat_instance=work_i,
hours=Data()$df$hours[input],
billable=1,
contribution_date=paste0(Data()$df$hours_date[input]," ",gsub('.* ','',Sys.time())),
modifier_work=GetUserName(),
work_complete=2)
work.OUT <- ParseRtoREDCap(data2)
cat(postForm(rc_url, data=work.OUT, token=rc_token, content="record", type="flat", format="csv",returnFormat="csv", overwriteBehavior="overwrite",.opts=curlOptions(ssl.verifypeer=FALSE, cainfo=REDCap.crt, verbose=TRUE)))
# show notification
not <- showNotification(
h4(HTML("Data saved"),align='center'),
duration = 6,
closeButton = TRUE,
type = "default",
action = h5(a(href="javascript:window.location.reload(true);","Refresh App"),align='center')
)
}
}
# phase
counter <- 0
data3 <- NULL
for(input2 in which(Data()$df$phase!='')){
# required note
if(Data()$df$phase_note[input2]==""){
showNotification(
h4(HTML("Note required"),align='center'),
duration = 6,
closeButton = TRUE,
type = "error"
)
}else{
counter <- counter+1
phase_i <- subset(work_check,!is.na(job_phase))$redcap_repeat_instance[nrow(subset(work_check,!is.na(job_phase)))]+counter
phase_i <- ifelse(length(phase_i)==0,1,phase_i)
data3 <- data.frame(record_id=Data()$df$record_id[input2],
job_phase_comment=Data()$df$phase_note[input2],
redcap_repeat_instrument='job_phase',
redcap_repeat_instance=phase_i,
job_phase=Data()$df$phase[input2],
job_phase_date=paste0(Data()$df$phase_date[input2]," ",gsub('.* ','',Sys.time())),
modifier_job_phase=GetUserName(),
job_phase_complete=2)
phase.OUT <- ParseRtoREDCap(data3)
cat(postForm(rc_url, data=phase.OUT, token=rc_token, content="record", type="flat", format="csv",returnFormat="csv", overwriteBehavior="overwrite",.opts=curlOptions(ssl.verifypeer=FALSE, cainfo=REDCap.crt, verbose=TRUE)))
# show notification
not <- showNotification(
h4(HTML("Data saved"),align='center'),
duration = 6,
closeButton = TRUE,
type = "default",
action = h5(a(href="javascript:window.location.reload(true);","Refresh App"),align='center')
)
}
}
# reset input fields
updateNumericInput(session, "mon_hours", value = '')
updateNumericInput(session, "tue_hours", value = '')
updateNumericInput(session, "wed_hours", value = '')
updateNumericInput(session, "thu_hours", value = '')
updateNumericInput(session, "fri_hours", value = '')
updateNumericInput(session, "sat_hours", value = '')
updateNumericInput(session, "sun_hours", value = '')
updateTextInput(session, "mon_hours_note", value = '')
updateTextInput(session, "tue_hours_note", value = '')
updateTextInput(session, "wed_hours_note", value = '')
updateTextInput(session, "thu_hours_note", value = '')
updateTextInput(session, "fri_hours_note", value = '')
updateTextInput(session, "sat_hours_note", value = '')
updateTextInput(session, "sun_hours_note", value = '')
# reset input fields
updateNumericInput(session, "mon_phase", value = '')
updateNumericInput(session, "tue_phase", value = '')
updateNumericInput(session, "wed_phase", value = '')
updateNumericInput(session, "thu_phase", value = '')
updateNumericInput(session, "fri_phase", value = '')
updateNumericInput(session, "sat_phase", value = '')
updateNumericInput(session, "sun_phase", value = '')
updateTextInput(session, "mon_phase_note", value = '')
updateTextInput(session, "tue_phase_note", value = '')
updateTextInput(session, "wed_phase_note", value = '')
updateTextInput(session, "thu_phase_note", value = '')
updateTextInput(session, "fri_phase_note", value = '')
updateTextInput(session, "sat_phase_note", value = '')
updateTextInput(session, "sun_phase_note", value = '')
})
})
return(NULL)
}
})
Data <- eventReactive(input$submit,{
# creating data frame with input data
df <- data.frame(record_id=myTimeTable[input$responses_rows_selected,]$record_id,
hours=as.character(c(ifelse(is.na(input$mon_hours),"",input$mon_hours),
ifelse(is.na(input$tue_hours),"",input$tue_hours),
ifelse(is.na(input$wed_hours),"",input$wed_hours),
ifelse(is.na(input$thu_hours),"",input$thu_hours),
ifelse(is.na(input$fri_hours),"",input$fri_hours),
ifelse(is.na(input$sat_hours),"",input$sat_hours),
ifelse(is.na(input$sun_hours),"",input$sun_hours))),
hours_note=c(input$mon_hours_note,input$tue_hours_note,input$wed_hours_note,input$thu_hours_note,input$fri_hours_note,input$sat_hours_note,input$sun_hours_note),
phase=c(input$mon_phase,input$tue_phase,input$wed_phase,input$thu_phase,input$fri_phase,input$sat_phase,input$sun_phase),
phase_note=c(input$mon_phase_note,input$tue_phase_note,input$wed_phase_note,input$thu_phase_note,input$fri_phase_note,input$sat_phase_note,input$sun_phase_note))
# adding hours date
df$hours_date <- date()
df$hours_date <- as.character(df$hours_date)
df$hours_date[which(df$hours=='')] <- ''
df$hours_date[which(df$hours!='')] <- as.character(as.Date(c(date()+(which(df$hours!='')-1)),format='%Y-%m-%d'))
# adding phase date
df$phase_date <- date()
df$phase_date <- as.character(df$phase_date)
df$phase_date[which(df$phase=='')] <- ''
df$phase_date[which(df$phase!='')] <- as.character(as.Date(c(date()+(which(df$phase!='')-1)),format='%Y-%m-%d'))
return(list(df=df))
})
## history----------------------------------------------------------------------
# order by recid and date
job_phase_dis <- job_phase[order(job_phase$record_id,job_phase$job_phase_date, decreasing = TRUE),]
work_dis <- work[order(work$record_id,work$contribution_date, decreasing = TRUE),]
job_phase_dis$job_phase_date <- as.Date(job_phase_dis$job_phase_date,format='%Y-%m-%d')
work_dis$contribution_date <- as.Date(work_dis$contribution_date,format='%Y-%m-%d')
fillCol(height = '100%', width = '1000', flex = c(NA, NA),
inputPanel(
selectInput("dataset", "",choices = c("Hours", "Phases"))
),
DT::dataTableOutput('history', width = "100%", height = "100%"),
h4(uiOutput('total'))
)
work_detail <- subset(work_dis,select=c('record_id','work_description','hours','contribution_date','modifier_work'))
names(work_detail) <- c('record_id','Description','Hours','Contribution Date','Modifier')
phase_detail <- subset(job_phase_dis,select=c('record_id','job_phase_comment','job_phase','job_phase_date','modifier_job_phase'))
names(phase_detail) <- c('record_id','Comment','Phase','Phase Date','Modifier')
datasetInput <- reactive({
switch(input$dataset,
"Hours" = subset(work_detail,record_id==my_data2[input$responses_rows_selected,]$Record,select=c('Description','Hours','Contribution Date','Modifier')),
"Phases" = subset(phase_detail,record_id==my_data2[input$responses_rows_selected,]$Record,select=c('Comment','Phase','Phase Date','Modifier'))
)
})
output$history <- DT::renderDataTable(server=FALSE,{DT::datatable(datasetInput(), extensions = 'Buttons', filter = list(position = 'top', clear = FALSE),
options=list(autoWidth=TRUE,search = list(regex = TRUE, caseInsensitive = FALSE, search = ''),
lengthMenu = c(5, 10, 20, 50, 100, 500),
pageLength = 10,
autoWidth = TRUE,
dom = 'lfrtBp',
buttons=list(list(
extend='excel',
#buttons=c('excel', 'pdf'),
text='Download',
filename=paste0('hours_recid_',myTimeTable[input$responses_rows_selected,]$record_id))),scrollY = '550px'),
rownames = FALSE)}
)
output$total <- renderUI({ifelse(any(names(datasetInput())=="Phase"),paste0("Last Status: ",as.character(datasetInput()$Phase[1])),paste0("Total hours: ",as.character(sum(datasetInput()$Hours,na.rm=TRUE))))})
## details----------------------------------------------------------------------
details_data <- subset(projectinfo,select=c('record_id','job_alias','job_description','job_start_date','job_end_date','assigned_faculty','assigned_staff','pi_name','pi_department','requestor_email','data_source','funding_type','estimated_hours','importance','h_index','deadline_date'))
details_data$job_start_date <- format(as.Date(details_data$job_start_date,format='%Y-%m-%d'),format='%m/%d/%Y')
details_data$job_end_date <- format(as.Date(details_data$job_end_date,format='%Y-%m-%d'),format='%m/%d/%Y')
details_data$deadline_date <- format(as.Date(details_data$deadline_date,format='%Y-%m-%d'),format='%m/%d/%Y')
rownames(details_data) <- details_data$record_id
names(details_data) <- c('Record','Alias:','Description:','Start Date:','End Date:','Assigned Faculty:',
'Assigned Staff:','PI Name:','PI Department:','PI Email:','Data Source:','Funding Type:','Estimated Hours:','Importance:','H Index:','Deadline Date:')
output$details <- renderTable({cbind(Record=names(details_data[,-which(names(details_data)=='Record')]),t(subset(details_data,Record==myTimeTable[input$responses_rows_selected,]$record_id,select=c('Alias:','Description:','Start Date:','End Date:','Assigned Faculty:',
'Assigned Staff:','PI Name:','PI Department:','PI Email:','Data Source:','Funding Type:','Estimated Hours:','Importance:','H Index:','Deadline Date:'))))},height='900px')
## report-----------------------------------------------------------------------
Data_Report <- reactive({
full_data$job_phase_date <- as.Date(as.character(full_data$job_phase_date),format="%Y-%m-%d")
full_data$contribution_date <- as.Date(as.character(full_data$contribution_date),format="%Y-%m-%d")
full_data$job_start_date <- as.Date(as.character(full_data$job_start_date),format="%Y-%m-%d")
full_data$date_appt <- as.POSIXct(as.character(full_data$date_appt),format="%Y-%m-%d %H:%M")
full_data$deadline_date <- as.Date(as.character(full_data$deadline_date),format="%Y-%m-%d")
outcometable <- data.frame(old=1:7,label=c('poster','poster','paper','grant','consult','consult','consult'))
outcome0 <- data.frame(full_data$research_product___1,full_data$research_product___2,full_data$research_product___3,
full_data$research_product___4,full_data$research_product___5,full_data$research_product___6,full_data$research_product___7)
full_data$outcome <- NULL
for(i in 1:nrow(outcome0)){
selection <- which(outcome0[i,]==1)
if(length(selection) > 0){
renumbered <- (ifelse(selection == 1, 2, ifelse(selection == 2, 2, ifelse(selection == 3, 1, ifelse(selection == 4, 1, ifelse(selection == 5, 3, ifelse(selection == 6, 3, ifelse(selection == 7, 3, NA))))))))
highest_goal <- selection[which(renumbered == min(renumbered))][1]
full_data$outcome[i] <- as.character(outcometable[which(highest_goal==outcometable$old),]$label)
}else{
full_data$outcome[i] <- NA
}
}
projectinfo <- subset(full_data,select=c('record_id','redcap_repeat_instrument','job_title','job_alias','job_description','job_start_date','job_end_date','assigned_faculty','assigned_staff','pi_name','pi_department','requestor_email','data_source','funding_type','estimated_hours','importance','h_index','modifier_job','deadline_date','outcome'))
projectinfo <- subset(projectinfo,!(redcap_repeat_instrument %in% c('job_phase','work','research_outcome')))
work <- subset(full_data,select=c('record_id','work_description','redcap_repeat_instrument','hours','billable','contribution_date','modifier_work','work_complete'))
work <- subset(work,!(redcap_repeat_instrument %in% c('','job_phase','research_outcome')))
appt <- subset(full_data,select=c('record_id','faculty_appt','date_appt','note_appt','modifier_appt'))
data_2 <- plyr::join(projectinfo,work,by='record_id')
data_3 <- plyr::join(projectinfo,appt,by='record_id')
data_out <- plyr::rbind.fill(data_2,data_3)
data_out <- data.frame(data_out,stringsAsFactors=FALSE)
data <- data_out#[!is.na(data_out$hours),]
data <- data[data$job_start_date>=input$dates[1] & data$job_start_date<=input$dates[2],]
data$job_start_date <- as.character(format(data$job_start_date,format='%m/%d/%Y'))
data$date_appt <- as.character(format(data$date_appt,format='%m/%d/%Y'))
data$deadline_date <- as.character(format(data$deadline_date,format='%m/%d/%Y'))
if (input$mod_work != "All"){
data <- data[data$modifier_work %in% input$mod_work,]
}
#if (input$staff != "All"){
# data <- data[data$assigned_staff %in% input$staff,]
#}
if (input$fac != "All"){
data <- data[data$assigned_faculty %in% input$fac,]
}
if (input$funding != "All"){
data <- data[data$funding_type %in% input$funding,]
}
return(data)
})
output$table <- DT::renderDataTable({
datatable(Data_Report(), filter = 'top', selection = 'single',rownames= FALSE,
options = list(autoWidth = TRUE, searching = TRUE,pageLength = 15,columnDefs = list(list(width = '2px',className = 'dt-center', targets = c(0,3,6))),scrollY = '650px', paging = TRUE, scrollX = FALSE)
)
},server = FALSE, escape = FALSE)
output$report_dates <- renderText({paste0("(",format(input$dates[1],format='%m/%d/%Y'),"-",format(input$dates[2],format='%m/%d/%Y'),")")})
output$report <- renderUI({
# new projects--------------------------
fund_dat <- unique(subset(Data_Report(),select=c('record_id','funding_type')))
output$funding_plot <- renderPlotly({
fund_dat %>%
dplyr::group_by(funding_type) %>%
dplyr::summarize(count = (n())) %>%
plot_ly(labels = ~funding_type, values = ~count,insidetextfont = list(color = '#FFFFFF'),marker = list(colors = colors,
line = list(color = '#FFFFFF', width = 1))) %>%
add_pie(hole = 0.4) %>%
layout(title = "", showlegend = TRUE,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE)) %>%
config(displayModeBar = F)
})
outcome_dat <- unique(subset(Data_Report(),select=c('record_id','outcome')))
output$outcome_plot <- renderPlotly({
outcome_dat %>%
dplyr::group_by(outcome) %>%
dplyr::summarize(count = (n())) %>%
plot_ly(labels = ~outcome, values = ~count,insidetextfont = list(color = '#FFFFFF'),marker = list(colors = colors,
line = list(color = '#FFFFFF', width = 1))) %>%
add_pie(hole = 0.4) %>%
layout(title = "", showlegend = TRUE,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE)) %>%
config(displayModeBar = F)
})
output$new_project <- renderTable({unique(subset(Data_Report(),select=c('record_id','job_title','job_alias','assigned_faculty','pi_name','deadline_date','job_start_date')))})
# hours spent most----------------------
hour_dat <- unique(subset(Data_Report(),!is.na(hours)))
output$hours_plot <- renderPlotly({
hour_dat %>%
dplyr::group_by(job_title) %>%
dplyr::summarize(count = (n()*hours)) %>%
plot_ly(labels = ~job_title, values = ~count,insidetextfont = list(color = '#FFFFFF'),marker = list(colors = colors,
line = list(color = '#FFFFFF', width = 1))) %>%
add_pie(hole = 0.4) %>%
layout(title = "", showlegend = TRUE,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE)) %>%
config(displayModeBar = F)
})
hour_dat_bar <- subset(Data_Report(),select=c('record_id','hours','funding_type','assigned_faculty','assigned_staff','modifier_work'))
hour_dat_bar$assigned_faculty <- as.factor(hour_dat_bar$assigned_faculty)
levels(hour_dat_bar$assigned_faculty)[which(levels(hour_dat_bar$assigned_faculty)=="")] <- NA
hour_dat_bar$assigned_staff <- as.factor(hour_dat_bar$assigned_staff)
levels(hour_dat_bar$assigned_staff)[which(levels(hour_dat_bar$assigned_staff)=="")] <- NA
hour_dat_bar2 <- hour_dat_bar %>% group_by(record_id) %>% transmute(funding_type=zoo::na.locf(funding_type, na.rm=FALSE),assigned_faculty=zoo::na.locf(assigned_faculty, na.rm=FALSE),assigned_staff=zoo::na.locf(assigned_staff, na.rm=FALSE),modifier_work,hours)
output$hours_bar <- renderPlotly({
hour_dat_bar2 %>%
dplyr::group_by(record_id,funding_type,modifier_work) %>%
#dplyr::group_by(record_id,funding_type,assigned_faculty,assigned_staff) %>%
dplyr::summarize(hours = sum(hours,na.rm=TRUE)) %>%
plot_ly(x = ~funding_type, y = ~hours, color = ~modifier_work, type = 'bar') %>% #,marker = list(color = colors)
#plot_ly(x = ~funding_type, y = ~hours, color = ~assigned_faculty, type = 'bar') %>%
#add_trace(x = ~funding_type, y = ~hours, color = ~assigned_staff, type = 'bar') %>% # It would probably make more sense to actually plot the work modifier
layout(margin = list(b = 160),
title = "", showlegend = TRUE,
xaxis = list(title='',showgrid = FALSE, zeroline = FALSE, showticklabels = TRUE),
yaxis = list(title='',showgrid = FALSE, zeroline = FALSE, showticklabels = TRUE)) %>%
config(displayModeBar = F)
})
output$hour_table <- renderTable({unique(subset(Data_Report(),select=c('record_id','job_title','assigned_faculty','assigned_staff','funding_type','hours'),!is.na(hours)))})
# appointments-------------------------
output$appt_table <- renderTable({unique(subset(Data_Report(),select=c('record_id','job_title','faculty_appt','date_appt','pi_name','requestor_email','funding_type','note_appt'),!is.na(date_appt)))})
# outcome------------------------------
#output$appt_table <- renderTable({unique(subset(Data_Report(),select=c('record_id','job_title','faculty_appt','date_appt','funding_type','note_appt'),!is.na(date_appt)))})
fillCol(height = '100%', width = '100%', flex = c(NA, NA),
wellPanel(style = "background-color: #ffffff;",
# new projects--------------------------
h4("New Projects"),
tags$hr(),
fluidRow(
column(width=4,
plotlyOutput("outcome_plot",height='200px',width='300px')
),
#column(width=1),
column(width=6,
tableOutput("new_project")
)
),
br(),br(),
# appointments-------------------------
#h4("Appointments"),
#tags$hr(),
#tableOutput("appt_table"),
#br(),br(),
# hours spent most----------------------
h4("Hours"),
tags$hr(),
fluidRow(
column(width=4,
plotlyOutput("hours_plot",height='200px',width='400px'),
plotlyOutput("hours_bar",height='350px',width='400px'),
br(),br(),br()
),
column(width=1),
column(width=6,
tableOutput("hour_table")
)
)
)
)
})
}
})
})
## end--------------------------------------------------------------------------
MartinGoros/debi documentation built on May 30, 2019, 10:46 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
####
# Author: Martin W. Goros
# UT Health San Antonio
shinyServer(function(input, output, session){
observe({
if(is.null(full_data)){
showNotification(HTML("<h4><center>No data available</center></h2>"),type='error',duration=NULL,closeButton=FALSE)
}else{
shiny::withProgress(message = 'Loading Application...', detail = "", value = 0, {
for (i in c("done")) {
cat("Loading data...")
source("dataload.r")
# Show logged in user
output$username <- shiny::renderText({
paste0("User: ",GetUserName())
})
# InfoBox Intake
output$intake <- shinydashboard::renderValueBox({
shinydashboard::valueBox(HTML(paste0("<font size='15'>",intakes," </font><font size='5'>(",round(intakes/total,2)*100,"%)</font>")), subtitle = HTML(paste0("<font size='5'>Intake</font>")), color = "yellow",icon=icon("shopping-cart"))
})
# InfoBox Active
output$active <- shinydashboard::renderValueBox({
shinydashboard::valueBox(HTML(paste0("<font size='15'>",actives," </font><font size='5'>(",round(actives/total,2)*100,"%)</font>")), subtitle = HTML(paste0("<font size='5'>Active</font>")), color = "green",icon=icon("clock-o"))
})
# InfoBox Inactive
output$inactive <- shinydashboard::renderValueBox({
shinydashboard::valueBox(HTML(paste0("<font size='15'>",inactives," </font><font size='5'>(",round(inactives/total,2)*100,"%)</font>")), subtitle = HTML(paste0("<font size='5'>Inactive</font>")), color = "red",icon=icon("eye"))
})
# InfoBox Hold
output$hold <- shinydashboard::renderValueBox({
shinydashboard::valueBox(HTML(paste0("<font size='15'>",hold," </font><font size='5'>(",round(hold/total,2)*100,"%)</font>")), subtitle = HTML(paste0("<font size='5'>Hold</font>")), color = "purple",icon=icon("remove"))
})
# InfoBox Manuscript Writing
output$manus <- shinydashboard::renderValueBox({
shinydashboard::valueBox(HTML(paste0("<font size='15'>",manus," </font><font size='5'>(",round(manus/total,2)*100,"%)</font>")), subtitle = HTML(paste0("<font size='5'>Manuscript Writing</font>")), color = "orange",icon=icon("pencil"))
})
# InfoBox Grant Writing
output$grant <- shinydashboard::renderValueBox({
shinydashboard::valueBox(HTML(paste0("<font size='15'>",grant," </font><font size='5'>(",round(grant/total,2)*100,"%)</font>")), subtitle = HTML(paste0("<font size='5'>Grant Writing</font>")), color = "blue",icon=icon("pencil"))
})
shiny::incProgress(1, detail = paste(i))
}
}) # end of progress bar
## hours graphic----------------------------------------------------------------
hourscont <- subset(work,select=c('record_id','contribution_date','hours','modifier_work'))
hourscont$contribution_date <- as.Date(hourscont$contribution_date,format='%Y-%m-%d')
if(any(hourscont$contribution_date >= (Sys.Date()-7))){
hourscont <- subset(hourscont,(contribution_date >= (Sys.Date()-7)))
}else{
hourscont <- data.frame(record_id=NA,contribution_date=NA,hours=NA,modifier_work=NA)
}
last7days <- plyr::ddply(hourscont,c('record_id','modifier_work'),function(x){
return(data.frame(hours=sum(x$hours)))
})
if(nrow(last7days)==0 | all(is.na(last7days))){
last7days <- data.frame(matrix(0,ncol=3,nrow=1))
last7days <- data.frame(record_id=0,contribution_date=0,hours=0,modifier_work="none")
}
cbbPalette <- rep(c('#545454','#696969','#7e7e7e','#939393','#a8a8a8','#bdbdbd','#d3d3d3','#2a2a2a','#E5E5E5'),times=5)
if(any(last7days$modifier_work=='none')){
mosttime <- merge(last7days,projectinfo,by='record_id',all.x=TRUE)
mosttime <- subset(mosttime,select=c('modifier_work','job_title','hours'))
mosttime$id <- 1:nrow(mosttime)
diplay_data <- mosttime
}else{
mosttime <- merge(last7days,projectinfo,by='record_id',all.x=TRUE)
mosttime <- subset(mosttime,select=c('modifier_work','job_title','hours'))
mosttime <- mosttime[order(mosttime$modifier_work),]
mosttime <- plyr::ddply(mosttime,c('modifier_work'),function(x){
x <- x[order(x$hours),]
return(x)
})
mosttime <- subset(mosttime,job_title != "")
mosttime$modifier_work <- as.character(mosttime$modifier_work)
mosttime$id <- 1:nrow(mosttime)
diplay_data <- mosttime
}
display_values <- function(x) {
if(is.null(x)) return(NULL)
row <- diplay_data[diplay_data$id == x$id, which(names(diplay_data) %in% c("job_title","hours"))]
paste0(c("Project","Hours"), ": ", format(row), collapse = "<br>")
}
mosttime %>%
ggvis::ggvis(y = ~modifier_work, fill = ~job_title, key := ~id) %>%
ggvis::add_tooltip(display_values, "hover") %>%
ggvis::compute_stack(stack_var = ~hours, group_var = ~modifier_work) %>%
ggvis::layer_rects(x = ~stack_lwr_, x2 = ~stack_upr_, height = band()) %>%
ggvis::set_options(width = "100%", height = "300px", resizable = TRUE) %>%
ggvis::hide_legend('fill') %>%
ggvis::scale_ordinal('fill', range = cbbPalette) %>%
ggvis::add_axis("y", title = "") %>%
ggvis::scale_numeric("x", domain = c(0, 45), nice = FALSE, clamp = TRUE) %>%
ggvis::bind_shiny("hours",height='320px')
## faculty assigned-------------------------------------------------------------
fac_dat <- InfoTable
fac_dat$assigned_faculty <- gsub( " .*$","",as.character(fac_dat$assigned_faculty))
fac_dat$assigned_faculty[fac_dat$assigned_faculty == ""] <- "Not assigned"
output$assigned_fac <- renderPlotly({
fac_dat %>%
dplyr::group_by(assigned_faculty) %>%
dplyr::summarize(count = n()) %>%
plot_ly(labels = ~assigned_faculty, values = ~count,insidetextfont = list(color = '#FFFFFF'),marker = list(colors = colors,
line = list(color = '#FFFFFF', width = 1))) %>%
add_pie(hole = 0.4) %>%
layout(title = "", showlegend = TRUE,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE)) %>%
config(displayModeBar = F)
})
## staff assigned---------------------------------------------------------------
staff_dat <- InfoTable
staff_dat$assigned_staff <- as.character(staff_dat$assigned_staff)
staff_dat$assigned_staff[staff_dat$assigned_staff == ""] <- "Not assigned"
output$assigned_staff <- renderPlotly({
staff_dat %>%
dplyr::group_by(assigned_staff) %>%
dplyr::summarize(count = n()) %>%
plot_ly(labels = ~assigned_staff, values = ~count,insidetextfont = list(color = '#FFFFFF'),marker = list(colors = colors,
line = list(color = '#FFFFFF', width = 1))) %>%
add_pie(hole = 0.4) %>%
layout(title = "", showlegend = TRUE,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE)) %>%
config(displayModeBar = F)
})
## intake count-----------------------------------------------------------------
intakes.raw <- subset(status,job_phase == 'Intake')
intakes.raw$month <- format(intakes.raw$job_phase_date,format='%m%y')
intakes.raw$count <- 1
out.count <- ddply(intakes.raw,'month',function(x){
counts <- sum(x$count)
return(counts)
})
names(out.count)[2] <- 'Count'
out.count$Month <- as.Date(paste0("01",out.count$month),format='%d%m%y')
out.count <- out.count[order(out.count$Month),]
output$intake_count <- renderPlotly({
plot_ly(out.count, x = ~Month, y = ~Count, type = 'bar', marker = list(color='#424242')) %>%
layout(xaxis = list(title = "",tickformat='%Y', showticklabels = TRUE, tickangle = -45),
yaxis = list(title = "",tickformat=',d'),
margin = list(b = 50)) %>%
config(displayModeBar = F)
})
## dashboard table--------------------------------------------------------------
displaydata <- plyr::join(InfoTable,subset(appt,date_appt!='',select=c('record_id','date_appt')),by='record_id')
displaydata <- displaydata[,c('job_title','job_alias','job_phase','job_phase_date','deadline_date','job_phase_comment','assigned_faculty','assigned_staff','importance','date_appt')]
displaydata <- displaydata[order(displaydata$job_title),]
displaydata$deadline_date <- as.Date(displaydata$deadline_date,format='%Y-%m-%d')
displaydata$deadline_date <- format(displaydata$deadline_date,format='%m/%d/%Y')
displaydata$job_phase_date <- as.Date(displaydata$job_phase_date,format='%Y-%m-%d')
displaydata$job_phase_date <- format(displaydata$job_phase_date,format='%m/%d/%Y')
displaydata$date_appt <- format(as.POSIXct(displaydata$date_appt,format='%Y-%m-%d %H:%M'),format='%m/%d/%Y %I:%M %p')
# names to be displayed
matchnames <- data.frame(old=c('job_title','job_alias','job_phase','job_phase_date','deadline_date','job_phase_comment','assigned_faculty','assigned_staff','importance','date_appt'),
new=c('Job','Alias','Phase','Phase Date','Deadline','Comment','Faculty','Staff','Importance','Appointment'))
names(displaydata) <- as.character(matchnames$new[match(names(displaydata),matchnames$old)])
output$table1 <- DT::renderDataTable({
datatable(displaydata
, rownames = FALSE, filter = 'top', options = list(columnDefs = list(list(className = 'dt-center', targets = c(1,3:4,6:9))),scrollX = '300px',scrollY = '350px',pageLength = 10,rowCallback = JS('
function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {
// Bold and green cells for conditions
$("td:eq(2)", nRow).css("color", "#FFFFFF");
$("td:eq(4)", nRow).css("color", "#FFFFFF");
$("td:eq(0)", nRow).css("color", "#000000");
$("td:eq(1)", nRow).css("color", "#000000");
$("td:eq(3)", nRow).css("color", "#000000");
$("td:eq(5)", nRow).css("color", "#000000");
$("td:eq(6)", nRow).css("color", "#000000");
$("td:eq(7)", nRow).css("color", "#000000");
$("td:eq(8)", nRow).css("color", "#000000");
$("td:eq(9)", nRow).css("color", "#000000");
if (aData[2] == "Completed")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Completed")
$("td:eq(2)", nRow).css("background-color", "#4B9F4B");
if (aData[2] == "Active")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Active")
$("td:eq(2)", nRow).css("background-color", "#5ec97b");
if (aData[2] == "Inactive")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Inactive")
$("td:eq(2)", nRow).css("background-color", "#E84C3D");
if (aData[2] == "Manuscript Writing")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Manuscript Writing")
$("td:eq(2)", nRow).css("background-color", "#E77E22");
if (aData[2] == "Manuscript Writing")
$("td:eq(4)", nRow).css("color", "#000000");
if (aData[2] == "Grant Writing")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Grant Writing")
$("td:eq(2)", nRow).css("background-color", "#3297DB");
if (aData[2] == "Intake")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Intake")
$("td:eq(2)", nRow).css("background-color", "#BEC3C7");
if (aData[2] == "Hold")
$("td:eq(2)", nRow).css("font-weight", "bold");
if (aData[2] == "Hold")
$("td:eq(2)", nRow).css("background-color", "#8D44AD");
var currdtten = new Date(new Date().getTime()+(14*24*60*60*1000));
var currdt = new Date();
if (aData[2] != "Completed" & aData[2] != "Manuscript Writing" & Date.parse(aData[4]) < currdt)
$("td:eq(4)", nRow).css("font-weight", "bold");
if (aData[2] != "Completed" & aData[2] != "Manuscript Writing" & Date.parse(aData[4]) < currdt)
$("td:eq(4)", nRow).css("background-color", "#A45B5B");
if (aData[2] != "Completed" & aData[2] != "Manuscript Writing" & Date.parse(aData[4]) < currdtten & Date.parse(aData[4]) > currdt)
$("td:eq(4)", nRow).css("font-weight", "bold");
if (aData[2] != "Completed" & aData[2] != "Manuscript Writing" & Date.parse(aData[4]) < currdtten & Date.parse(aData[4]) > currdt)
$("td:eq(4)", nRow).css("background-color", "#EE5555");
if (aData[2] != "Completed" & aData[2] != "Manuscript Writing" & Date.parse(aData[4]) > currdt & Date.parse(aData[4]) > currdtten)
$("td:eq(4)", nRow).css("font-weight", "bold");
if (aData[2] != "Completed" & aData[2] != "Manuscript Writing" & Date.parse(aData[4]) > currdt & Date.parse(aData[4]) > currdtten)
$("td:eq(4)", nRow).css("background-color", "#27AE61");
}')))
},autoWidth = TRUE, scrollCollapse = TRUE, lengthMenu = c(5, 10, 20, 50, 100), pageLength = 5)
## mtable-----------------------------------------------------------------------
testdata2 <- myTimeTable
testdata2$job_phase_date <- as.Date(testdata2$job_phase_date,format='%Y-%m-%d')
testdata2$job_phase_date <- format(testdata2$job_phase_date,format='%m/%d/%Y')
testdata2$deadline_date <- as.Date(testdata2$deadline_date,format='%Y-%m-%d')
testdata2$deadline_date <- format(testdata2$deadline_date,format='%m/%d/%Y')
testdata2 <- subset(testdata2,select=c('record_id','job_title','job_alias','job_phase','assigned_faculty','assigned_staff','job_phase_comment'))
names(testdata2) <- c('Record','Title','Alias','Phase','Faculty','Staff','Note')
my_data2 <- testdata2
output$responses <- DT::renderDataTable({
datatable(my_data2, filter = 'top', selection = 'single',rownames= FALSE,
options = list(autoWidth = TRUE, searching = TRUE,pageLength = 15,columnDefs = list(list(width = '2px',className = 'dt-center', targets = c(0,3,6))),scrollY = '650px', paging = TRUE, scrollX = FALSE)
)
},server = FALSE, escape = FALSE)
## mytime----------------------------------------------------------------------
date <- reactive({
as.Date(paste0(ISOweek::ISOweek2date(paste0(input$year_num,"-W",ifelse(nchar(as.character(input$week_num))==1,paste0("0",input$week_num),input$week_num),"-1"))))
})
# weekday output
output$monday <- renderUI({HTML(paste0("Monday<br/>(",format(date(),format='%m/%d'),")"))})
output$tuesday <- renderUI({HTML(paste0("Tuesday<br/>(",format(date()+1,format='%m/%d'),")"))})
output$wednesday <- renderUI({HTML(paste0("Wednesday<br/>(",format(date()+2,format='%m/%d'),")"))})
output$thursday <- renderUI({HTML(paste0("Thursday<br/>(",format(date()+3,format='%m/%d'),")"))})
output$friday <- renderUI({HTML(paste0("Friday<br/>(",format(date()+4,format='%m/%d'),")"))})
output$saturday <- renderUI({HTML(paste0("Saturday<br/>(",format(date()+5,format='%m/%d'),")"))})
output$sunday <- renderUI({HTML(paste0("Sunday<br/>(",format(date()+6,format='%m/%d'),")"))})
output$date_today <- renderText({paste0(format(date(),format='%m/%d/%Y')," - ",format(date()+6,format='%m/%d/%Y'))})
output$sel_proj2 <- renderText({ifelse(is.null(input$responses_rows_selected),"Please select project in project table",as.character(myTimeTable[input$responses_rows_selected,]$job_title))})
output$modif <- renderUI({
if (input$submit) {
isolate({
withProgress(message = 'Saving Data...', value = 0, {
# work
rcon <- redcapAPI::redcapConnection(url=rc_url, token=rc_token)
work_check <- subset(redcapAPI::exportRecords(rcon,records=myTimeTable[input$responses_rows_selected,]$record_id,dates=FALSE),select=c('hours','job_phase','redcap_repeat_instance'))#subset(read_redcap(redcap_url=rc_url,secret_token=rc_token),record_id==myTimeTable[input$responses_rows_selected,]$record_id,select=c('hours','job_phase','redcap_repeat_instance'))#
counter2 <- 0
data2 <- NULL
for(input in which(Data()$df$hours!='')){
# required note
if(Data()$df$hours_note[input]==""){
showNotification(
h4(HTML("Note required"),align='center'),
duration = 6,
closeButton = TRUE,
type = "error"
)
}else{
counter2 <- counter2+1
work_i <- subset(work_check,!is.na(hours))$redcap_repeat_instance[nrow(subset(work_check,!is.na(hours)))]+counter2
work_i <- ifelse(length(work_i)==0,1,work_i)
data2 <- data.frame(record_id=Data()$df$record_id[input],
work_description=Data()$df$hours_note[input],
redcap_repeat_instrument='work',
redcap_repeat_instance=work_i,
hours=Data()$df$hours[input],
billable=1,
contribution_date=paste0(Data()$df$hours_date[input]," ",gsub('.* ','',Sys.time())),
modifier_work=GetUserName(),
work_complete=2)
work.OUT <- ParseRtoREDCap(data2)
cat(postForm(rc_url, data=work.OUT, token=rc_token, content="record", type="flat", format="csv",returnFormat="csv", overwriteBehavior="overwrite",.opts=curlOptions(ssl.verifypeer=FALSE, cainfo=REDCap.crt, verbose=TRUE)))
# show notification
not <- showNotification(
h4(HTML("Data saved"),align='center'),
duration = 6,
closeButton = TRUE,
type = "default",
action = h5(a(href="javascript:window.location.reload(true);","Refresh App"),align='center')
)
}
}
# phase
counter <- 0
data3 <- NULL
for(input2 in which(Data()$df$phase!='')){
# required note
if(Data()$df$phase_note[input2]==""){
showNotification(
h4(HTML("Note required"),align='center'),
duration = 6,
closeButton = TRUE,
type = "error"
)
}else{
counter <- counter+1
phase_i <- subset(work_check,!is.na(job_phase))$redcap_repeat_instance[nrow(subset(work_check,!is.na(job_phase)))]+counter
phase_i <- ifelse(length(phase_i)==0,1,phase_i)
data3 <- data.frame(record_id=Data()$df$record_id[input2],
job_phase_comment=Data()$df$phase_note[input2],
redcap_repeat_instrument='job_phase',
redcap_repeat_instance=phase_i,
job_phase=Data()$df$phase[input2],
job_phase_date=paste0(Data()$df$phase_date[input2]," ",gsub('.* ','',Sys.time())),
modifier_job_phase=GetUserName(),
job_phase_complete=2)
phase.OUT <- ParseRtoREDCap(data3)
cat(postForm(rc_url, data=phase.OUT, token=rc_token, content="record", type="flat", format="csv",returnFormat="csv", overwriteBehavior="overwrite",.opts=curlOptions(ssl.verifypeer=FALSE, cainfo=REDCap.crt, verbose=TRUE)))
# show notification
not <- showNotification(
h4(HTML("Data saved"),align='center'),
duration = 6,
closeButton = TRUE,
type = "default",
action = h5(a(href="javascript:window.location.reload(true);","Refresh App"),align='center')
)
}
}
# reset input fields
updateNumericInput(session, "mon_hours", value = '')
updateNumericInput(session, "tue_hours", value = '')
updateNumericInput(session, "wed_hours", value = '')
updateNumericInput(session, "thu_hours", value = '')
updateNumericInput(session, "fri_hours", value = '')
updateNumericInput(session, "sat_hours", value = '')
updateNumericInput(session, "sun_hours", value = '')
updateTextInput(session, "mon_hours_note", value = '')
updateTextInput(session, "tue_hours_note", value = '')
updateTextInput(session, "wed_hours_note", value = '')
updateTextInput(session, "thu_hours_note", value = '')
updateTextInput(session, "fri_hours_note", value = '')
updateTextInput(session, "sat_hours_note", value = '')
updateTextInput(session, "sun_hours_note", value = '')
# reset input fields
updateNumericInput(session, "mon_phase", value = '')
updateNumericInput(session, "tue_phase", value = '')
updateNumericInput(session, "wed_phase", value = '')
updateNumericInput(session, "thu_phase", value = '')
updateNumericInput(session, "fri_phase", value = '')
updateNumericInput(session, "sat_phase", value = '')
updateNumericInput(session, "sun_phase", value = '')
updateTextInput(session, "mon_phase_note", value = '')
updateTextInput(session, "tue_phase_note", value = '')
updateTextInput(session, "wed_phase_note", value = '')
updateTextInput(session, "thu_phase_note", value = '')
updateTextInput(session, "fri_phase_note", value = '')
updateTextInput(session, "sat_phase_note", value = '')
updateTextInput(session, "sun_phase_note", value = '')
})
})
return(NULL)
}
})
Data <- eventReactive(input$submit,{
# creating data frame with input data
df <- data.frame(record_id=myTimeTable[input$responses_rows_selected,]$record_id,
hours=as.character(c(ifelse(is.na(input$mon_hours),"",input$mon_hours),
ifelse(is.na(input$tue_hours),"",input$tue_hours),
ifelse(is.na(input$wed_hours),"",input$wed_hours),
ifelse(is.na(input$thu_hours),"",input$thu_hours),
ifelse(is.na(input$fri_hours),"",input$fri_hours),
ifelse(is.na(input$sat_hours),"",input$sat_hours),
ifelse(is.na(input$sun_hours),"",input$sun_hours))),
hours_note=c(input$mon_hours_note,input$tue_hours_note,input$wed_hours_note,input$thu_hours_note,input$fri_hours_note,input$sat_hours_note,input$sun_hours_note),
phase=c(input$mon_phase,input$tue_phase,input$wed_phase,input$thu_phase,input$fri_phase,input$sat_phase,input$sun_phase),
phase_note=c(input$mon_phase_note,input$tue_phase_note,input$wed_phase_note,input$thu_phase_note,input$fri_phase_note,input$sat_phase_note,input$sun_phase_note))
# adding hours date
df$hours_date <- date()
df$hours_date <- as.character(df$hours_date)
df$hours_date[which(df$hours=='')] <- ''
df$hours_date[which(df$hours!='')] <- as.character(as.Date(c(date()+(which(df$hours!='')-1)),format='%Y-%m-%d'))
# adding phase date
df$phase_date <- date()
df$phase_date <- as.character(df$phase_date)
df$phase_date[which(df$phase=='')] <- ''
df$phase_date[which(df$phase!='')] <- as.character(as.Date(c(date()+(which(df$phase!='')-1)),format='%Y-%m-%d'))
return(list(df=df))
})
## history----------------------------------------------------------------------
# order by recid and date
job_phase_dis <- job_phase[order(job_phase$record_id,job_phase$job_phase_date, decreasing = TRUE),]
work_dis <- work[order(work$record_id,work$contribution_date, decreasing = TRUE),]
job_phase_dis$job_phase_date <- as.Date(job_phase_dis$job_phase_date,format='%Y-%m-%d')
work_dis$contribution_date <- as.Date(work_dis$contribution_date,format='%Y-%m-%d')
fillCol(height = '100%', width = '1000', flex = c(NA, NA),
inputPanel(
selectInput("dataset", "",choices = c("Hours", "Phases"))
),
DT::dataTableOutput('history', width = "100%", height = "100%"),
h4(uiOutput('total'))
)
work_detail <- subset(work_dis,select=c('record_id','work_description','hours','contribution_date','modifier_work'))
names(work_detail) <- c('record_id','Description','Hours','Contribution Date','Modifier')
phase_detail <- subset(job_phase_dis,select=c('record_id','job_phase_comment','job_phase','job_phase_date','modifier_job_phase'))
names(phase_detail) <- c('record_id','Comment','Phase','Phase Date','Modifier')
datasetInput <- reactive({
switch(input$dataset,
"Hours" = subset(work_detail,record_id==my_data2[input$responses_rows_selected,]$Record,select=c('Description','Hours','Contribution Date','Modifier')),
"Phases" = subset(phase_detail,record_id==my_data2[input$responses_rows_selected,]$Record,select=c('Comment','Phase','Phase Date','Modifier'))
)
})
output$history <- DT::renderDataTable(server=FALSE,{DT::datatable(datasetInput(), extensions = 'Buttons', filter = list(position = 'top', clear = FALSE),
options=list(autoWidth=TRUE,search = list(regex = TRUE, caseInsensitive = FALSE, search = ''),
lengthMenu = c(5, 10, 20, 50, 100, 500),
pageLength = 10,
autoWidth = TRUE,
dom = 'lfrtBp',
buttons=list(list(
extend='excel',
#buttons=c('excel', 'pdf'),
text='Download',
filename=paste0('hours_recid_',myTimeTable[input$responses_rows_selected,]$record_id))),scrollY = '550px'),
rownames = FALSE)}
)
output$total <- renderUI({ifelse(any(names(datasetInput())=="Phase"),paste0("Last Status: ",as.character(datasetInput()$Phase[1])),paste0("Total hours: ",as.character(sum(datasetInput()$Hours,na.rm=TRUE))))})
## details----------------------------------------------------------------------
details_data <- subset(projectinfo,select=c('record_id','job_alias','job_description','job_start_date','job_end_date','assigned_faculty','assigned_staff','pi_name','pi_department','requestor_email','data_source','funding_type','estimated_hours','importance','h_index','deadline_date'))
details_data$job_start_date <- format(as.Date(details_data$job_start_date,format='%Y-%m-%d'),format='%m/%d/%Y')
details_data$job_end_date <- format(as.Date(details_data$job_end_date,format='%Y-%m-%d'),format='%m/%d/%Y')
details_data$deadline_date <- format(as.Date(details_data$deadline_date,format='%Y-%m-%d'),format='%m/%d/%Y')
rownames(details_data) <- details_data$record_id
names(details_data) <- c('Record','Alias:','Description:','Start Date:','End Date:','Assigned Faculty:',
'Assigned Staff:','PI Name:','PI Department:','PI Email:','Data Source:','Funding Type:','Estimated Hours:','Importance:','H Index:','Deadline Date:')
output$details <- renderTable({cbind(Record=names(details_data[,-which(names(details_data)=='Record')]),t(subset(details_data,Record==myTimeTable[input$responses_rows_selected,]$record_id,select=c('Alias:','Description:','Start Date:','End Date:','Assigned Faculty:',
'Assigned Staff:','PI Name:','PI Department:','PI Email:','Data Source:','Funding Type:','Estimated Hours:','Importance:','H Index:','Deadline Date:'))))},height='900px')
## report-----------------------------------------------------------------------
Data_Report <- reactive({
full_data$job_phase_date <- as.Date(as.character(full_data$job_phase_date),format="%Y-%m-%d")
full_data$contribution_date <- as.Date(as.character(full_data$contribution_date),format="%Y-%m-%d")
full_data$job_start_date <- as.Date(as.character(full_data$job_start_date),format="%Y-%m-%d")
full_data$date_appt <- as.POSIXct(as.character(full_data$date_appt),format="%Y-%m-%d %H:%M")
full_data$deadline_date <- as.Date(as.character(full_data$deadline_date),format="%Y-%m-%d")
outcometable <- data.frame(old=1:7,label=c('poster','poster','paper','grant','consult','consult','consult'))
outcome0 <- data.frame(full_data$research_product___1,full_data$research_product___2,full_data$research_product___3,
full_data$research_product___4,full_data$research_product___5,full_data$research_product___6,full_data$research_product___7)
full_data$outcome <- NULL
for(i in 1:nrow(outcome0)){
selection <- which(outcome0[i,]==1)
if(length(selection) > 0){
renumbered <- (ifelse(selection == 1, 2, ifelse(selection == 2, 2, ifelse(selection == 3, 1, ifelse(selection == 4, 1, ifelse(selection == 5, 3, ifelse(selection == 6, 3, ifelse(selection == 7, 3, NA))))))))
highest_goal <- selection[which(renumbered == min(renumbered))][1]
full_data$outcome[i] <- as.character(outcometable[which(highest_goal==outcometable$old),]$label)
}else{
full_data$outcome[i] <- NA
}
}
projectinfo <- subset(full_data,select=c('record_id','redcap_repeat_instrument','job_title','job_alias','job_description','job_start_date','job_end_date','assigned_faculty','assigned_staff','pi_name','pi_department','requestor_email','data_source','funding_type','estimated_hours','importance','h_index','modifier_job','deadline_date','outcome'))
projectinfo <- subset(projectinfo,!(redcap_repeat_instrument %in% c('job_phase','work','research_outcome')))
work <- subset(full_data,select=c('record_id','work_description','redcap_repeat_instrument','hours','billable','contribution_date','modifier_work','work_complete'))
work <- subset(work,!(redcap_repeat_instrument %in% c('','job_phase','research_outcome')))
appt <- subset(full_data,select=c('record_id','faculty_appt','date_appt','note_appt','modifier_appt'))
data_2 <- plyr::join(projectinfo,work,by='record_id')
data_3 <- plyr::join(projectinfo,appt,by='record_id')
data_out <- plyr::rbind.fill(data_2,data_3)
data_out <- data.frame(data_out,stringsAsFactors=FALSE)
data <- data_out#[!is.na(data_out$hours),]
data <- data[data$job_start_date>=input$dates[1] & data$job_start_date<=input$dates[2],]
data$job_start_date <- as.character(format(data$job_start_date,format='%m/%d/%Y'))
data$date_appt <- as.character(format(data$date_appt,format='%m/%d/%Y'))
data$deadline_date <- as.character(format(data$deadline_date,format='%m/%d/%Y'))
if (input$mod_work != "All"){
data <- data[data$modifier_work %in% input$mod_work,]
}
#if (input$staff != "All"){
# data <- data[data$assigned_staff %in% input$staff,]
#}
if (input$fac != "All"){
data <- data[data$assigned_faculty %in% input$fac,]
}
if (input$funding != "All"){
data <- data[data$funding_type %in% input$funding,]
}
return(data)
})
output$table <- DT::renderDataTable({
datatable(Data_Report(), filter = 'top', selection = 'single',rownames= FALSE,
options = list(autoWidth = TRUE, searching = TRUE,pageLength = 15,columnDefs = list(list(width = '2px',className = 'dt-center', targets = c(0,3,6))),scrollY = '650px', paging = TRUE, scrollX = FALSE)
)
},server = FALSE, escape = FALSE)
output$report_dates <- renderText({paste0("(",format(input$dates[1],format='%m/%d/%Y'),"-",format(input$dates[2],format='%m/%d/%Y'),")")})
output$report <- renderUI({
# new projects--------------------------
fund_dat <- unique(subset(Data_Report(),select=c('record_id','funding_type')))
output$funding_plot <- renderPlotly({
fund_dat %>%
dplyr::group_by(funding_type) %>%
dplyr::summarize(count = (n())) %>%
plot_ly(labels = ~funding_type, values = ~count,insidetextfont = list(color = '#FFFFFF'),marker = list(colors = colors,
line = list(color = '#FFFFFF', width = 1))) %>%
add_pie(hole = 0.4) %>%
layout(title = "", showlegend = TRUE,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE)) %>%
config(displayModeBar = F)
})
outcome_dat <- unique(subset(Data_Report(),select=c('record_id','outcome')))
output$outcome_plot <- renderPlotly({
outcome_dat %>%
dplyr::group_by(outcome) %>%
dplyr::summarize(count = (n())) %>%
plot_ly(labels = ~outcome, values = ~count,insidetextfont = list(color = '#FFFFFF'),marker = list(colors = colors,
line = list(color = '#FFFFFF', width = 1))) %>%
add_pie(hole = 0.4) %>%
layout(title = "", showlegend = TRUE,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE)) %>%
config(displayModeBar = F)
})
output$new_project <- renderTable({unique(subset(Data_Report(),select=c('record_id','job_title','job_alias','assigned_faculty','pi_name','deadline_date','job_start_date')))})
# hours spent most----------------------
hour_dat <- unique(subset(Data_Report(),!is.na(hours)))
output$hours_plot <- renderPlotly({
hour_dat %>%
dplyr::group_by(job_title) %>%
dplyr::summarize(count = (n()*hours)) %>%
plot_ly(labels = ~job_title, values = ~count,insidetextfont = list(color = '#FFFFFF'),marker = list(colors = colors,
line = list(color = '#FFFFFF', width = 1))) %>%
add_pie(hole = 0.4) %>%
layout(title = "", showlegend = TRUE,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE)) %>%
config(displayModeBar = F)
})
hour_dat_bar <- subset(Data_Report(),select=c('record_id','hours','funding_type','assigned_faculty','assigned_staff','modifier_work'))
hour_dat_bar$assigned_faculty <- as.factor(hour_dat_bar$assigned_faculty)
levels(hour_dat_bar$assigned_faculty)[which(levels(hour_dat_bar$assigned_faculty)=="")] <- NA
hour_dat_bar$assigned_staff <- as.factor(hour_dat_bar$assigned_staff)
levels(hour_dat_bar$assigned_staff)[which(levels(hour_dat_bar$assigned_staff)=="")] <- NA
hour_dat_bar2 <- hour_dat_bar %>% group_by(record_id) %>% transmute(funding_type=zoo::na.locf(funding_type, na.rm=FALSE),assigned_faculty=zoo::na.locf(assigned_faculty, na.rm=FALSE),assigned_staff=zoo::na.locf(assigned_staff, na.rm=FALSE),modifier_work,hours)
output$hours_bar <- renderPlotly({
hour_dat_bar2 %>%
dplyr::group_by(record_id,funding_type,modifier_work) %>%
#dplyr::group_by(record_id,funding_type,assigned_faculty,assigned_staff) %>%
dplyr::summarize(hours = sum(hours,na.rm=TRUE)) %>%
plot_ly(x = ~funding_type, y = ~hours, color = ~modifier_work, type = 'bar') %>% #,marker = list(color = colors)
#plot_ly(x = ~funding_type, y = ~hours, color = ~assigned_faculty, type = 'bar') %>%
#add_trace(x = ~funding_type, y = ~hours, color = ~assigned_staff, type = 'bar') %>% # It would probably make more sense to actually plot the work modifier
layout(margin = list(b = 160),
title = "", showlegend = TRUE,
xaxis = list(title='',showgrid = FALSE, zeroline = FALSE, showticklabels = TRUE),
yaxis = list(title='',showgrid = FALSE, zeroline = FALSE, showticklabels = TRUE)) %>%
config(displayModeBar = F)
})
output$hour_table <- renderTable({unique(subset(Data_Report(),select=c('record_id','job_title','assigned_faculty','assigned_staff','funding_type','hours'),!is.na(hours)))})
# appointments-------------------------
output$appt_table <- renderTable({unique(subset(Data_Report(),select=c('record_id','job_title','faculty_appt','date_appt','pi_name','requestor_email','funding_type','note_appt'),!is.na(date_appt)))})
# outcome------------------------------
#output$appt_table <- renderTable({unique(subset(Data_Report(),select=c('record_id','job_title','faculty_appt','date_appt','funding_type','note_appt'),!is.na(date_appt)))})
fillCol(height = '100%', width = '100%', flex = c(NA, NA),
wellPanel(style = "background-color: #ffffff;",
# new projects--------------------------
h4("New Projects"),
tags$hr(),
fluidRow(
column(width=4,
plotlyOutput("outcome_plot",height='200px',width='300px')
),
#column(width=1),
column(width=6,
tableOutput("new_project")
)
),
br(),br(),
# appointments-------------------------
#h4("Appointments"),
#tags$hr(),
#tableOutput("appt_table"),
#br(),br(),
# hours spent most----------------------
h4("Hours"),
tags$hr(),
fluidRow(
column(width=4,
plotlyOutput("hours_plot",height='200px',width='400px'),
plotlyOutput("hours_bar",height='350px',width='400px'),
br(),br(),br()
),
column(width=1),
column(width=6,
tableOutput("hour_table")
)
)
)
)
})
}
})
})
## end--------------------------------------------------------------------------
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.