Merge branch 'integration'

functions.R

@@ -1,3 +1,11 @@
+# ---- Small Utility Functions ----
+# p1 and p2 are proportions between 0 and 1
+# in our case, p2 corresponds to the overall population and p2 to
+# a cohort of interest
+or <- function(p1,p2){p2*(1-p1)/(p1*(1-p2))};
+# given a p1, calculate the p2 needed for a target odds ratio
+otherpr <- function(p1,target=1.5){target/(1/p1+target-1)};
+
 # ---- Rename/Remap ----
 #' Usage: `xx<-mapnames(xx,lookup)` where lookup is a named character vector
 #' the names of the elements in the character vector are what you are renaming
@@ -132,7 +140,8 @@ selectcodegrps <- function(data,codemap,groups
   # dynamic selectors-- only the prefix is set, and which variables
   # to include determined by ChiSq, OR, and N
   seldn <- bind_rows(lapply(prefix,function(ii){
-    subset(codemap,is.na(CCD) & PREFIX==ii)}))[,c('PREFIX','Category')];
+    subset(codemap,is.na(CCD) & PREFIX==ii)}))[,c('PREFIX','Category')] %>%
+    subset(!grepl('^CUSTOM=',PREFIX));
   oost <- if(nrow(selst)>0) left_join(selst,data) else c();
   oodn <- if(nrow(seldn)>0) left_join(seldn,chifilter(data,groups,...)) else c();
   for(ii in grep('^CUSTOM=',prefix,val=T)){
@@ -165,7 +174,8 @@ quickpoints <- function(
   data,groups,labels='NAME',colprefix='FRC_'
   ,yy=paste0(colprefix,'All'),xs
   #,cols=setNames(brewer_pal(type='qua')(length(groups)),groups)
-  ,alpha=0.5,other=c('Category','NAME',yy)
+  ,alpha=0.5,other=c('Category','NAME',yy),targetodds=1.5
+  ,bandclr='red'
   # tooltip template
   ,ttemplate='<b>%s</b><br>All Urology: %s<br>%s: %s'
   ,...){
@@ -185,9 +195,13 @@ quickpoints <- function(
                                       ,Cohort,percent(FRC)));
   out <- ggplot(data0,aes(y=FRC_REF,x=FRC,color=Cohort,text=tooltip)
                 ,alpha=alpha) + geom_point(alpha=alpha);
-  maxy <- max(c(data0$FRC_REF,data0$FRC));
+  maxy <- max(c(data0$FRC_REF,data0$FRC),na.rm = T);
+  bands <- data.frame(pr=seq(0,maxy,len=40)) %>% 
+    mutate(ub=otherpr(pr,targetodds),lb=otherpr(pr,1/targetodds)
+           ,tooltip=paste0('Odds Ratio >',targetodds));
   out + geom_abline(slope=1,intercept = 0) +
-    #scale_color_manual(name='Group',values=cols,guide=guide_legend()) +
+    geom_line(aes(x=pr,y=ub),data=bands,linetype=2,color=bandclr) +
+    geom_line(aes(x=pr,y=lb),data=bands,linetype=2,color=bandclr) +
     scale_x_continuous(trans=log1p_trans(),limits = c(0,maxy),labels=percent) +
     scale_y_continuous(trans=log1p_trans(),limits = c(0,maxy),labels=percent) +
     xlab('Percent of each Cohort') + ylab('Percent of All Urology');

global.R

@@ -1,3 +1,5 @@
+# for environments needing user-space packages
+if(dir.exists('R-lib')) .libPaths(c(normalizePath('R-lib'),.libPaths()));
 library(readr);
 # selected prefixes and concept codes 
 demogcodes <- read_csv('demogcodes.csv');

server.R

@@ -87,7 +87,8 @@ shinyServer(function(input, output, session) {
     #rcolrs <- setNames(brewer_pal(type='qua')(length(rv$rgroups)),rv$rgroups);
     #rv$rcolrs <- rcols;
     if(any(rv$rdat$PREFIX %in% subset(demogcodes,is.na(CCD))$PREFIX)){
-      out <- quickpoints(rv$rdat,groups=rv$rgroups,alpha=0.3) + 
+      out <- quickpoints(rv$rdat,groups=rv$rgroups,alpha=0.3
+                         ,targetodds=rv$roddscut) + 
         theme(plot.margin=margin(15,15,30,20),aspect.ratio=1);
       txtMainVar <- txtMainVarDynamic;
     } else {

uitext.R

@@ -1,4 +1,4 @@
 txtMainVarCommon <- "This plot allows you to see how prevalent various values of '%s' are for each cohort compared to the overall patient pool."
 txtMainVarStatic <- "The left-most columns represent the total patients ever seen by the department. The other columns are cohorts within that patient pool."
-txtMainVarDynamic <- "The y-axis represents the fraction of the total patients ever seen by the department who have at least one occurence of a particular code. The x-axis represents the same thing but as a fraction of the corresponding cohort within this patient pool. Points above/left of the diagnoal line represent codes that are less common in their respective cohorts than in the overall patient pool, and points below/left are more common."
-txtMainHelp <- "Please mouse-over the plot to see more information. Clicking the color on the legend will hide the cohort/population of that color from the plot. There are also some useful controls in the top right of the plot, including ones for rescaling it and for downloading it as an image. Please note that patients can be in more than one of the cohorts, and can multiple different values recorded during different visits, so the columns are not mutually exclusive with each other. There are currently two different kinds of plots, and the one you are looking at was auto-selected based on the class of variable you chose."
+txtMainVarDynamic <- "The y-axis represents the fraction of the total patients ever seen by the department who have at least one occurence of a particular code. The x-axis represents the same thing but as a fraction of the corresponding cohort within this patient pool. Points above/left of the diagonal line represent codes that are less common in their respective cohorts than in the overall patient pool, and points below/right are more common."
+txtMainHelp <- "Please mouse-over the plot to see more information. Clicking the color on the legend will hide the cohort/population of that color from the plot. There are also some useful controls in the top right of the plot, including ones for zooming it and for downloading it as an image. Please note that patients can be in more than one of the cohorts, and can multiple different values recorded during different visits, so the columns are not mutually exclusive with each other. There are currently two different kinds of plots, and the one you are looking at was auto-selected based on the class of variable you chose."