Create a gist now

Instantly share code, notes, and snippets.

Embed
What would you like to do?
title output date
JourneyPRO - on-going summary
html_document html_notebook pdf_document
default
default
default
`r format(Sys.time(), '%d %B, %Y')`
rm(list=ls())
knitr::opts_chunk$set(fig.path='Figs/', echo=FALSE, warning=FALSE, message=FALSE)
Sys.setenv(TZ='GMT')
library(synapseClient)
synapseLogin()
library(install.load)
install_load(c('plyr', 'tidyverse', 'data.table', 'lubridate', 'ggpubr', 'zoo'))
install_load('ggthemes', 'gridExtra', 'devtools')
stringfy <- function(x){
  gsub('[\\[\"\\]]','',x, perl=T) 
}
# TODO: When is journeyPRO start date?
START_DATE = lubridate::ymd("2017-07-28")
DAYS_SINCE_LAUNCH = as.numeric(Sys.Date() - START_DATE)
WEEKS_SINCE_LAUNCH = ( (DAYS_SINCE_LAUNCH - 1) %/% 7) + 1
masterTable <- "syn10232190"  #poorly named journeyPRO-appVersion
#remove all testing users and records created before launch date (see `DAYS_SINCE_LAUNCH`) 12:00:00 AM (GMT)
userActivity <- synTableQuery(paste("select * from", masterTable, "WHERE dataGroups NOT LIKE '%test%' AND createdOn >=", as.integer(as.POSIXct(START_DATE), tz="UTC")))
userActivity <- userActivity@values
healthSurveyId <- "syn10278768"
healthSurvey <- synTableQuery(paste("select * from", healthSurveyId))@values

#Data Manipulation
userActivity <- userActivity %>% dplyr::mutate(createdOnTimeZone = as.numeric(createdOnTimeZone)/100,
                                               createdOn = lubridate::ymd_hms(createdOn, tz='UTC'))
healthSurvey <- healthSurvey %>% dplyr::mutate(createdOnTimeZone = as.numeric(createdOnTimeZone)/100,
                                               createdOn = lubridate::ymd_hms(createdOn, tz='UTC'))
#get start dates for people 
userStartDates <- userActivity %>% dplyr::group_by(healthCode) %>% 
  dplyr::summarise(participantStartDate = min(lubridate::date(createdOn)))
userActivity <- userActivity %>% inner_join(userStartDates)
healthSurvey <- healthSurvey %>% inner_join(userStartDates)

userActivity <- userActivity %>% 
  dplyr::mutate(createdOn_localTime = createdOn + lubridate::hours(createdOnTimeZone),
                participant_day = as.numeric(lubridate::date(createdOn) - participantStartDate ) + 1,
                participant_week = ((participant_day - 1) %/% 7 ) + 1,
                study_day = as.numeric(lubridate::date(createdOn) - START_DATE) + 1,
                study_week = ((study_day - 1) %/% 7 ) + 1,
                currentDate = Sys.Date()
                )
healthSurvey <- healthSurvey %>% 
  dplyr::mutate(createdOn_localTime = createdOn + lubridate::hours(createdOnTimeZone),
                participant_day = as.numeric(lubridate::date(createdOn) - participantStartDate ) + 1,
                participant_week = ((participant_day - 1) %/% 7 ) + 1,
                study_day = as.numeric(lubridate::date(createdOn) - START_DATE) + 1,
                study_week = ((study_day - 1) %/% 7 ) + 1,
                currentDate = Sys.Date()
                )
STUDY_HEALTHCODES <- unique(userActivity$healthCode)
total_journeyPRO_users <- n_distinct(userActivity$healthCode)
num_BT_patients <- userActivity %>% dplyr::filter(dataGroups %like% "beta_thalassemia") %>% .$healthCode %>% n_distinct()
num_MP_patients <- userActivity %>% dplyr::filter(dataGroups %like% "myelodysplastic_syndrome") %>% .$healthCode %>% n_distinct()
num_MF_patients <- userActivity %>% dplyr::filter(dataGroups %like% "myelofibrosis") %>% .$healthCode %>% n_distinct()
#patients_dataContrib <- round(table(userActivity$dataGroups) / nrow(userActivity) * 100, digits=2)

Summary stats

  • Weeks since launch (Jul 29, 2017): r WEEKS_SINCE_LAUNCH
  • Total users: r total_journeyPRO_users
  • Beta Thalassemia patients: r num_BT_patients
  • Myelodysplastic Syndrome patients: r num_MP_patients
  • Myelofibrosis patients: r num_MF_patients

Errors Detected

records_with_wrong_createdOn_dates <- sum(lubridate::date(lubridate::ymd_hms(userActivity$createdOn)) > Sys.Date())
#filter bad data
userActivity <- userActivity %>% dplyr::filter(lubridate::ymd_hms(createdOn)  <= Sys.Date())
  • Records with malformed timestamp - r records_with_wrong_createdOn_dates

Enrollment summary

enrollment <- userActivity %>% select(healthCode, study_week, dataGroups) 
enrollment <- enrollment[!duplicated(enrollment),]
enrollment <- plyr::ldply(1:max(enrollment$study_week), function(x){
  untilNow <- enrollment %>% filter(study_week < x) %>% .$healthCode %>% unique()
  thisWeek <- enrollment %>% filter(study_week == x) %>% .$healthCode %>% unique()
  newUsers_thisweek <- setdiff(thisWeek, untilNow)
  res <- enrollment %>% select(healthCode, dataGroups)
  res <- res[!duplicated(res),]
  res <- res %>% filter(healthCode %in% newUsers_thisweek)
  data.frame('week'=x,
             "beta_thalassemia_patients" = res %>% 
                filter(dataGroups == "beta_thalassemia") %>% nrow(),
             "myelodysplastic_syndrome_patients" = res %>%
                filter(dataGroups == "myelodysplastic_syndrome") %>% nrow(),
             "myelofibrosis_patients" = res %>%
                filter(dataGroups == "myelofibrosis") %>% nrow()) %>%
    gather(type, num, 2:4)
})

enrollment <- enrollment %>% mutate(type = factor(type))
p1 <- ggplot(data=enrollment, aes(x=week, y=num, fill=type )) + geom_bar(stat="identity", position="dodge", width = .7) + theme_bw() + scale_x_discrete(limits=seq(1,max(enrollment$week),2))  + ylab('People enrolled') + xlab('Weeks since launch')
p1 <- p1 + theme_few() + scale_fill_manual(values=c("#A5BE00", "#4286f4", "#FC4E07"),  labels=c('Beta Thalassemia', 'Myelodysplastic Syndrome', "Myelofibrosis")) + theme(legend.position = c(0.82, 0.9))
p1 <- p1 + theme(text = element_text(size=15)) + ggtitle('Users joining per week')
p1 <- p1 + geom_vline(xintercept=WEEKS_SINCE_LAUNCH, colour="grey40", size=1, linetype=3)
#People active each week since study start
activeEachWeek <- userActivity %>% dplyr::group_by(dataGroups, study_week) %>%
  dplyr::summarise(uniqUsers = n_distinct(healthCode))

p2 <- ggplot(data=activeEachWeek, aes(x=study_week, y=uniqUsers, fill=dataGroups )) + geom_bar(stat="identity", width = .5) + theme_bw() + scale_x_discrete(limits=seq(1,max(activeEachWeek$study_week),2))
p2 <- p2 +  labs(col="User type\n") + scale_fill_manual(values=c("#A5BE00", "#4286f4", "#FC4E07"),  labels=c('Beta Thalassemia', 'Myelodysplastic Syndrome', "Myelofibrosis")) 
p2 <- p2 + theme_few() + theme(legend.position = c(0.2, 0.82))
p2 <- p2 + theme(text = element_text(size=15)) + ggtitle('Users active each week') + ylab('People') + xlab('Weeks since launch')
p2 <- p2 + geom_vline(xintercept=WEEKS_SINCE_LAUNCH, colour="grey40", size=1, linetype=3)
grid.arrange(p1,p2, ncol=2)

Compliance

### This is mainly to figure out the #users that have been in study for atleast #weeks irrespective of the data contributed
user_time_in_study <- userActivity %>% dplyr::group_by(healthCode) %>%
              dplyr::mutate(currentDate = Sys.Date(),
                days_in_study =  as.numeric(currentDate - participantStartDate) + 1,
                weeks_in_study =  ((days_in_study - 1 ) %/% 7 ) + 1,
                current_days_in_study = as.numeric(lubridate::as_date(createdOn) - participantStartDate) + 1,
                current_weeks_in_study = ((current_days_in_study - 1 ) %/% 7 ) + 1)

userWeeks <- user_time_in_study %>% dplyr::group_by(weeks_in_study) %>%
  dplyr::summarise(numUsers = n_distinct(healthCode))
userWeeks <- userWeeks %>% ddply(.variables='weeks_in_study',
                    .fun = function(x){
                      tmp <- userWeeks %>% dplyr::filter(weeks_in_study >=  unique(x$weeks_in_study))
                      data.frame('totalUsersReachedThisWeek' = sum(tmp$numUsers))
                    })
allWeeks <- data.frame(weeks_in_study = 1:max(userActivity$study_week))
userWeeks <- join(allWeeks, userWeeks)
userWeeks <- na.locf(userWeeks, fromLast = TRUE)

usersWhoMadeItThisFar <- user_time_in_study %>% select(healthCode, study_week)
usersWhoMadeItThisFar <- plyr::ldply(1:max(usersWhoMadeItThisFar$study_week), function(w) {
    untilNow <- usersWhoMadeItThisFar %>% filter(study_week >= w) %>% .$healthCode %>% unique() %>% length()
    data.frame('current_weeks_in_study' = w, 'numUsersWhoMadeItThisFar' = untilNow)})

usersWhoActuallyDidSomethingThisWeek <- user_time_in_study %>% group_by(current_weeks_in_study) %>% 
  summarise(numUsersWhoDidSomething = n_distinct(healthCode))
usersWhoActuallyDidSomethingThisWeek <- plyr::rename(usersWhoActuallyDidSomethingThisWeek, replace=c("current_weeks_in_study" = "weeks_in_study"))

specificUserWeeks <- user_time_in_study %>% select(healthCode, weeks_in_study) %>% unique()
specificUserWeeks <- ddply(specificUserWeeks, .variables=.(healthCode), .fun=function(r) {
    data.frame("healthCode" = r$healthCode, "participant_week" = 1:r$weeks_in_study)
})

overallCompliance <- join(usersWhoActuallyDidSomethingThisWeek, userWeeks)
overallCompliance <- overallCompliance %>% mutate(percent = numUsersWhoDidSomething / totalUsersReachedThisWeek)
overallCompliance$percent <- round(overallCompliance$percent * 100, digits=2)
#Since the study is still going on we are not dividing by the all users rather number of unique users in each week of the study
p3 <- ggplot(data=overallCompliance, aes(x=weeks_in_study, y=percent )) + geom_bar(stat="identity", position="dodge", width = .4) + theme_bw() + scale_x_discrete(limits=seq(1,max(overallCompliance$weeks_in_study),2)) + ggtitle('Percent users active by time in study')
p3 <- p3 + theme_few() + scale_fill_manual(values=c('#00AFBB')) +  theme(text = element_text(size=15))
p3 <- p3 + xlab('Weeks enrolled') +  theme(text = element_text(size=15))
### CURRENTLY NOT PLOTTED ###
# pro_surveys <- userActivity %>% filter( ( originalTable %like% 'Schedule' | originalTable %like% 'Challenge-v6'))
# pro_surveys_compliance <- pro_surveys %>% group_by(participant_week, originalTable, healthCode) %>%
#   summarize(numRecords = n())#dplyr::summarise(num = n_distinct(healthCode))
# pro_surveys_compliance <- merge(pro_surveys_compliance, userWeeks, by.x='participant_week', by.y='weeks_in_study')
# pro_surveys_compliance <- pro_surveys_compliance %>% dplyr::mutate(percent = round((num/totalUsersReachedThisWeek) * 100, digits=2))
#  pro_surveys_compliance['Survey'] = pro_surveys_compliance$originalTable
#  pro_surveys_compliance$originalTable <- NULL
#  p4 <- ggplot(data=pro_surveys_compliance, aes(x=participant_week, y=percent, color=Survey))  + geom_point() + geom_line(size=1.5, alpha=0.6)
# p4 <- p4 + theme_few() +  scale_color_manual(values=c( "#2EC4B6", "#E71D36", "#FF9F1C", '#95C623', '#42c5f4')) 
# p4 <- p4 +  ggtitle('Percent Surveys Completed')  + xlab('Weeks enrolled') +  theme(text = element_text(size=15))
activeSensor_tasks <- userActivity %>% 
  filter( (originalTable %like% 'Visual' | originalTable %like% 'Reaction' | originalTable %like%  'Attention' | originalTable %like% 'Challenge-v6'))
allSensorCombinations <- expand.grid(
  healthCode = unique(userActivity$healthCode),
  originalTable = unique(activeSensor_tasks$originalTable))
allValidSensorCombinations <- join(specificUserWeeks, allSensorCombinations)
activeSensor_tasks_compliance <- activeSensor_tasks %>% group_by(participant_week, originalTable, healthCode) %>% 
  dplyr::summarise(numRecords = n())
activeSensor_tasks_compliance <- join(allValidSensorCombinations, activeSensor_tasks_compliance)
activeSensor_tasks_compliance$numRecords[is.na(activeSensor_tasks_compliance$numRecords)] <- 0

activeSensor_tasks_compliance <- activeSensor_tasks_compliance %>% group_by(participant_week, originalTable) %>% 
   summarise(percent = round((sum(numRecords) / n()) * 100, digits=2))
#activeSensor_tasks_compliance <- activeSensor_tasks_compliance %>% dplyr::mutate(percent = round((numRecords / 7) * 100, digits=2))
activeSensor_tasks_compliance['sensorActivity'] = activeSensor_tasks_compliance$originalTable
activeSensor_tasks_compliance$originalTable <- NULL
activeSensor_tasks_compliance['sensorActivity'] = gsub(' Activity.*', '',activeSensor_tasks_compliance$`sensorActivity`, perl=T)
activeSensor_tasks_compliance['sensorActivity'] = gsub('-.*', '',activeSensor_tasks_compliance$`sensorActivity`, perl=T)

p5 <- ggplot(data=activeSensor_tasks_compliance, aes(x=participant_week, y=percent, color=sensorActivity )) + geom_point()  + geom_line(size=1.5, alpha=0.6)
p5 <- p5 + theme_few() + scale_color_manual(values=c( "#2EC4B6", "#E71D36", "#FF9F1C", "#011627"))
p5 <- p5 +  ggtitle('Percent active (non-survey) tasks completed')  + xlab('Weeks enrolled') +  theme(text = element_text(size=15))
otherShortSurveys <-  userActivity %>% 
  filter( (originalTable == 'Check-In-v2' | originalTable %like%  'Lab Details' | originalTable %like% "Transfusion Details"))
allSurveyCombinations <- expand.grid(
  healthCode = unique(userActivity$healthCode),
  originalTable = unique(otherShortSurveys$originalTable))
allValidSurveyCombinations <- join(specificUserWeeks, allSurveyCombinations)
otherShortSurveys_compliance <- otherShortSurveys %>% group_by(participant_week, originalTable, healthCode) %>% 
  dplyr::summarise(numRecords = n())
otherShortSurveys_compliance <- join(allValidSurveyCombinations, otherShortSurveys_compliance)
otherShortSurveys_compliance$numRecords[is.na(otherShortSurveys_compliance$numRecords)] <- 0

otherShortSurveys_compliance <- otherShortSurveys_compliance %>% group_by(participant_week, originalTable) %>%
  dplyr::summarise(percent = round((sum(numRecords)/(7*n())) * 100, digits=2))
otherShortSurveys_compliance['otherSurveys'] = otherShortSurveys_compliance$originalTable
otherShortSurveys_compliance$originalTable <- NULL
otherShortSurveys_compliance['otherSurveys'] = gsub('-v\\d', '',otherShortSurveys_compliance$`otherSurveys`, perl=T)

p6 <- ggplot(data=otherShortSurveys_compliance, aes(x=participant_week, y=percent, color=otherSurveys ))  + geom_point() + geom_line(size=1.5, alpha=0.6)
p6 <- p6 + theme_few() +  scale_color_manual(values=c( "#2EC4B6", "#E71D36", "#FF9F1C", '#011627')) 
p6 <- p6 +  ggtitle('Other Short Surveys Completed')  + xlab('Weeks enrolled') +  theme(text = element_text(size=15))
sf12Compliance <- healthSurvey %>% group_by(participant_week) %>% dplyr::summarise(num = n_distinct(healthCode))
sf12Compliance <- merge(sf12Compliance, userWeeks, by.x = 'participant_week', by.y='weeks_in_study')
sf12Compliance <- sf12Compliance %>% dplyr::mutate(percent = round((num/totalUsersReachedThisWeek) * 100, digits=2))
p7 <- ggplot(data=sf12Compliance, aes(x=participant_week, y=percent)) + geom_point() + geom_line(size=1.5) + theme_few() +
        ggtitle('Weekly SF-12 Surveys Completed') + xlab('Weeks enrolled') +  theme(text = element_text(size=15))
grid.arrange(p3,p5,p6,p7, ncol=2)

checkInId <- "syn10232192"
checkIn <- synTableQuery(paste("select dataGroups, mood_sleep, mood_pain, mood_health, mood_tired from", checkInId))@values
checkIn <- checkIn %>% na.omit() %>% filter(dataGroups %in% unique(userActivity$dataGroups))
checkInGraph <- checkIn %>% gather(Category, Score, -dataGroups) %>% group_by(Category, dataGroups) %>% 
  summarise(val=mean(as.numeric(Score))) %>% 
  ggplot(aes(Category, val, fill=dataGroups)) + 
  geom_bar(stat="identity", position="dodge", width = .7) +
  theme_few() + scale_fill_manual(values=c("#A5BE00", "#4286f4", "#FC4E07"),  
                                  labels=c('Beta Thalassemia', 'Myelodysplastic Syndrome', "Myelofibrosis")) +
  ylab("Mean Score (out of 5)") + ggtitle("Daily Check-In")
labDetailsId <- "syn10245386"
labDetails <- synTableQuery(paste("select dataGroups, hgb, rbc, wbc, hct, neutrophils, platelets, ferritin from", labDetailsId))@values
labDetails <- labDetails %>% filter(dataGroups %in% unique(userActivity$dataGroups))
labDetails2 <- labDetails %>% select(dataGroups, hgb, rbc, wbc, hct, neutrophils)
labDetails <- labDetails %>% select(dataGroups, platelets, ferritin)
labDetails2 <- labDetails2[rowSums(is.na(labDetails2 %>% select(-dataGroups))) != ncol(labDetails2)-1,]
labDetails <- labDetails[rowSums(is.na(labDetails %>% select(-dataGroups))) != ncol(labDetails)-1,]
labDetailsGraph <- labDetails %>% gather(Category, Value, -dataGroups) %>%
  group_by(Category) %>%
  ggplot(aes(Category, Value, color=dataGroups)) + geom_crossbar(ymin=0, ymax=2000) +
  theme_few() + scale_color_manual(values=c("#A5BE00", "#4286f4", "#FC4E07"),
                                  labels=c('Beta Thalassemia', 'Myelodysplastic Syndrome', "Myelofibrosis")) +
                                  ggtitle("Lab Details (2)") + ylim(NA, 2000)
labDetailsGraph2 <- labDetails2 %>% gather(Category, Value, -dataGroups) %>%
  group_by(Category) %>%
  ggplot(aes(Category, Value, color=dataGroups)) + geom_crossbar(ymin=0, ymax=55) +
  theme_few() + scale_color_manual(values=c("#A5BE00", "#4286f4", "#FC4E07"),
                                  labels=c('Beta Thalassemia', 'Myelodysplastic Syndrome', "Myelofibrosis")) +
                                  ggtitle("Lab Details (1)") + ylim(NA, 55)
transfusionId <- "syn10245387"
transfusion <- synTableQuery(paste("select dataGroups, unitsBlood, infusionRate from", transfusionId))@values
transfusion <- transfusion %>% filter(dataGroups %in% unique(userActivity$dataGroups)) %>% na.omit()
transfusion <- transfusion[2:nrow(transfusion),] # drop outlier
transfusionGraph <- transfusion %>% ggplot(aes(unitsBlood, infusionRate)) + 
  geom_point(alpha=0.33, size=8, color="#ff5e5e") + theme_few() + 
  ggtitle("Transfusion Details")
grid.arrange(checkInGraph,transfusionGraph,labDetailsGraph2,labDetailsGraph, ncol=2)

Demographics Summary

dem_survey_id <- "syn10232193"
demog <-  synTableQuery(paste("select * from", dem_survey_id))@values
demog$metadata.json.dataGroups <- NULL
colnames(demog) <- gsub('.json.answer', '',colnames(demog))
colnames(demog)  <- gsub('metadata.json.', '',colnames(demog))
demog <- demog %>% dplyr::select(-appVersion, -phoneInfo, -validationErrors, -createdOn, -createdOnTimeZone, -recordId, -uploadDate, -externalId, -birthYear_unit, -ethnicity) %>%
  filter(dataGroups %in% c("beta_thalassemia", "myelodysplastic_syndrome", "myelofibrosis") & healthCode %in% STUDY_HEALTHCODES) #%>%
  #dplyr::mutate(createdOn = as.Date(lubridate::ymd_hms(startDate)))

demog <- ddply(.data = demog, .variables = c('healthCode'))
#race <- demog %>% tidyr::gather(race, value, 2:4) %>% dplyr::filter(value == 'TRUE') %>% 
#  select(healthCode, race) %>% group_by(healthCode) %>%
#  dplyr::summarise(race = paste(race, collapse=','))
#demog <- merge(demog, race) #%>% select(-c(7:16))

profile_id <- "syn10235462"
profiles <- synTableQuery(paste("select * from", profile_id))@values
profiles <- profiles %>% dplyr::filter(healthCode %in% STUDY_HEALTHCODES) %>%
  dplyr::transmute(healthCode = healthCode,
                   age = demographics.age,
                   gender = demographics.gender, height = demographics.height,
                   weight = demographics.weight, ethnicity = demographics.ethnicity,
                   yearDiagnosed = demographics.yearDiagnosed,
                   userSharingScope=NA) %>%
  dplyr::group_by(healthCode) %>%
  dplyr::summarise(
                    age = unique(age)[1], gender = unique(gender)[1], height = unique(height)[1],
                    weight = unique(weight)[1],
                    userSharingScope=unique(userSharingScope)[1])

#Add age to demog
demog <- merge(demog, profiles %>% dplyr::select(healthCode, age, gender, height, weight), all.x=T)

demog_derived_from_profiles <- profiles %>% dplyr::filter(!healthCode %in% demog$healthCode)
dataGroups <- userActivity %>% select(healthCode, dataGroups)
dataGroups <- dataGroups[!duplicated(dataGroups),]
demog_derived_from_profiles <- merge(demog_derived_from_profiles , dataGroups, all.x=T)


demog_derived_from_profiles <- demog_derived_from_profiles %>% 
  dplyr::select(healthCode, age, dataGroups, userSharingScope, gender, height,
                weight)


tmp_df <- data.frame(dataGroups = c("beta_thalassemia", "myelodysplastic_syndrome", "myelofibrosis"),
                     num = c(num_BT_patients, num_MP_patients, num_MF_patients), stringsAsFactors = F)

percent_demog_data_compliance =  round( (n_distinct(demog$healthCode)/total_journeyPRO_users) *100, digits=2)

percent_demog_data_from_profiles_compliance =  round( (n_distinct(demog_derived_from_profiles$healthCode)/total_journeyPRO_users) *100, digits=2)

demog_total <- plyr::rbind.fill(demog, demog_derived_from_profiles)
  • Demographics data available for : r n_distinct(demog_total$healthCode) individuals | r percent_demog_data_compliance %

  • Demographics data obtained from profiles : r n_distinct(demog_derived_from_profiles$healthCode) individuals | r percent_demog_data_from_profiles_compliance %

missingData <- apply(demog_total,2, function(x){
  round( (sum(is.na(x) | x == "") / nrow(demog_total)) *100, digits=2)
})[c("age", "gender", "race")]
tmp_df <- data.frame(col = names(missingData), percentMissing = as.numeric(missingData)) %>% arrange(percentMissing)

missingGraph <- ggplot(data=tmp_df, aes(x=col, y=percentMissing)) + geom_bar(stat="identity") + theme_few() + coord_flip() + scale_y_continuous(limits=c(0,100)) + xlab('Demographic Variable') + theme(text = element_text(size=15)) + ylab('Percent') + ggtitle("Percent Missing")

tmp_df <- data.frame(dataGroups = c("beta_thalassemia", "myelodysplastic_syndrome", "myelofibrosis"),
                     num = c(num_BT_patients, num_MP_patients, num_MF_patients), stringsAsFactors = F)

gender = demog_total %>% filter(gender %in% c('Female', 'Male')) %>% inner_join(tmp_df) %>% dplyr::group_by(dataGroups, gender, num) %>% dplyr::summarise(prop =n_distinct(healthCode)) %>% mutate(prop = round((prop / num)*100, digits=2))
p2 <- ggplot(data=gender, aes(x=gender, y=prop, fill=dataGroups )) + geom_bar(stat="identity", position="dodge", width = .7) + theme_bw()  + ylab("Percent")
p2 <- p2 + theme_few() + scale_fill_manual(values=c("#A5BE00", "#4286f4", "#FC4E07"),  labels=c('Beta Thalassemia', 'Myelodysplastic Syndrome', "Myelofibrosis")) + theme(legend.position = c(0.3, 0.85))
genderGraph <- p2 + theme(text = element_text(size=15)) + ggtitle('Gender') + xlab("Gender")
p3 <- ggplot(data=demog_total %>% filter(!is.na(gender)), aes(x=gender, y=age, fill=dataGroups )) + geom_boxplot(width = .7) + theme_bw()  + ylab('Age') + xlab('Gender')
p3 <- p3 + theme_few() + scale_fill_manual(values=c("#A5BE00", "#4286f4", "#FC4E07"),  labels=c('Beta Thalassemia', 'Myelodysplastic Syndrome', "Myelofibrosis")) + theme(legend.position = 'none')
ageGraph <- p3 + theme(text = element_text(size=15)) + ggtitle('Age') 
race = demog_total %>% filter(!is.na(race)) %>% dplyr::group_by(dataGroups, race) %>% dplyr::summarise(prop =n_distinct(healthCode))
#levels <- race %>% filter(dataGroups %in% unique(userActivity$dataGroups)) %>% arrange(desc(prop)) %>% .$race
#race$race <- rev(levels)
p5 <- ggplot(data=race, aes(x=race, y=prop, fill=dataGroups)) + geom_bar(stat="identity", width = .7) + theme_bw()  + ylab('Number')
p5 <- p5 + theme_few() + scale_fill_manual(values=c("#A5BE00", "#4286f4", "#FC4E07"),  labels=c('Beta Thalassemia', 'Myelodysplastic Syndrome', "Myelofibrosis")) + theme(legend.position = c(0.6, 0.5))
raceGraph <- p5 + theme(text = element_text(size=15)) + ggtitle('Race') + coord_flip() + xlab('')
grid.arrange(genderGraph,ageGraph,raceGraph,missingGraph, ncol=2)
if (!require("lbscorer",character.only = TRUE)) {
  install_github("philerooski/lbscorer", silent=TRUE)
}
library(lbscorer)
questionCols <- names(healthSurvey)[12:23]
sf <- healthSurvey[c("recordId", "healthCode", "dataGroups", questionCols)] %>% filter(dataGroups %in% unique(userActivity$dataGroups)) %>% na.omit()
sfScores <- sf12(sf[questionCols])
names(sfScores) <- c("Physical Function", "Role Physical", "Bodily Pain", "General Health", "Vitality", "Social Function", "Role Emotional", "Mental Health", "Physical Summary", "Mental Summary")
df <- cbind(sf[c("recordId", "healthCode", "dataGroups")], sfScores)
dfG <- df %>% gather(cols, value, -dataGroups, -recordId, -healthCode)
dfGBS <- dfG %>% filter(dataGroups == "beta_thalassemia")
dfGMS <- dfG %>% filter(dataGroups == "myelodysplastic_syndrome")
dfGM <- dfG %>% filter(dataGroups == "myelofibrosis")
par(cex.axis=0.8)
boxplot(sfScores, main="SF12-v2 Scores", xlab="Category", ylab="Score")
stripchart(value ~ cols, vertical = TRUE, data = dfGBS, 
    method = "jitter", add = TRUE, pch = 20, col = "#A5BE0050")
stripchart(value ~ cols, vertical = TRUE, data = dfGMS,
    method = "jitter", add = TRUE, pch = 20, col = "#4286f450")
stripchart(value ~ cols, vertical = TRUE, data = dfGMS,
    method = "jitter", add = TRUE, pch = 20, col = "#FC4E0750")

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment