Tags:
create new tag
, view all tags, tagging instructions

SafetyGraphicsForm edit

Image

Click on image to enlarge.

Top R image

Bottom SAS image.



Title Heat map
Graph_Subgroup General Principles
Description This graph is based on the benefit-risk analysis heat map described by Jonathan Norton, Ph.D.
Contributor/Email max.2.cherny@gsk.com
Sanjay Matange (email: Sanjay.Matange@sas.com)
Background

Keywords heat mao
References

Datasets Other
CDISC_Data

CLASSIFICATIONS

Graph_Type

Variable_Relationship

Data_Types

Special_Considerations

Code_Available Yes
Software Program R, SAS
Software SAS 9.40M3
R-Code - Attachment

R-Code library(car) #initialize libraries
library(ggplot2) #initialize libraries
library(gridBase)
library(gridExtra)

# Assumptions:
# All numeric code variables are seqential
# GGPLOT is installed
# All subjects have the same number of timepoints
# There are only 3 visits. The program can be modified to handle any number of visits
# The breaks for scale_x_continuous only work for 3 visits. This would need to change to handle different number of visits
# the program is based on the following code from FDA:

#-----------------------------------------------------FDA example
#Notes: Tested in R 2.10.1. Use at your own risk.
library(graphics)
#Toy example with three 4-week time periods and two subjects
Weeks <-c(0,4,8,12)
#Subject 1 was in yellow state, then gray, then red
Subj1 <-c(2,3,4)
#Subject 2 was in green state, then yellow, then withdrew
Subj2 <-c(1,2,5)
Outcomes <-as.matrix(rbind(Subj1, Subj2))
#Sort matrix, using final period as primary key, then using second-to-last period, etc.
SortedOutcomes <-Outcomes[order(Outcomes[,3],Outcomes[,2],Outcomes[,1]),]
nsub <-dim(Outcomes)[1]
stoplightcol <-rgb(c(0,1,.8,1,.1),c(1,1,.8,0,.2),c(0,0,.8,0,.2))
image(Weeks,1:nsub,t(SortedOutcomes?),col=stoplightcol)




#Code begins here

rm(list = ls()) # clear objects
graphics.off() # close graphics windows
#-----------------------------------------------------------EXAMPLE 1
#-This example produces data for 2 subjects and matches the original example from FDA
#Run this example first and then run code below HEATMEAP line
df= data.frame(week=c(1,2,3,1,2,3),
subjid=c(1,1,1,2,2,2),
catcd=c(2,3,4,1,2,5),
group="Active",
groupcd=1)
breaks<-c (1 ,2)
#output to home directory
PDFPath = paste(Sys.getenv(c("HOME")), "/heatmap_ggplot_basic_r.pdf", sep="")


#
#-----------------------------------------------------------EXAMPLE 2
#create random data for 100 subjects
df= data.frame(
subjid=rep(1:210, each = 3),
week=c(rep(1:3, 210)),
groupcd=rep(c(1,2), each = 315) ,
group=rep(c("Active","Placebo"), each = 315)
)

#create various scenarios for categories
d01= data.frame(catcd=rep(c(1,1,1), 30) )
d02= data.frame(catcd=rep(c(1,3,3), 6) )
d03= data.frame(catcd=rep(c(3,3,4), 9) )
d04= data.frame(catcd=rep(c(2,2,5), 7) )
d05= data.frame(catcd=rep(c(2,2,4), 8) )
d06= data.frame(catcd=rep(c(4,5,5), 10) )
d07= data.frame(catcd=rep(c(1,3,5), 1) )
d08= data.frame(catcd=rep(c(3,3,5), 5) )
d09= data.frame(catcd=rep(c(2,5,5), 3) )
d10= data.frame(catcd=rep(c(4,4,5), 1) )
d11= data.frame(catcd=rep(c(2,4,5), 13) )
d12= data.frame(catcd=rep(c(1,4,5), 10) )
d13= data.frame(catcd=rep(c(1,2,3), 1) )
d14= data.frame(catcd=rep(c(5,5,5), 1) )
# combine all categories together
cat<-rbind(d01,d02,d03,d04,d05,d06,d07,d08,d09,d10,d11,d12,d13,d14)
cat<-rbind(cat,cat)
#add all data together
df<-cbind(df, cat)
#set breaks for plot. can be done dynamically with some programming
breaks<-c (10, 20,30,40,50,60,70,80,90,100,110)
#output to home directory
PDFPath = paste(Sys.getenv(c("HOME")), "/heatmap_ggplot_by_groups_r.pdf", sep="")






#------------------------------------------------------------Heatmap code
#determine number of treatment arms.
#Assume that groups code are sequential
number_of_groups<-as.numeric(max(unique(df$groupcd)))

#create empty dataset. This dataset wil be then append by counters for each subject.
#counters will control the ordering of subjects on X axis
df_t_all <- c()

#counters need to be more or less the same for each treatment. This is why it is done in the loop
for (i in 1:number_of_groups)
{
#subset by group
df_temp <- subset(df, groupcd==i )

#transpose data
df_t<-reshape(df_temp,
idvar='subjid',
drop="group",
timevar="week",
direction="wide")

#Sort matrix, using final period as primary key, then using second-to-last period, etc.
df_t <- df_t[order(df_t$catcd.3, df_t$catcd.2, df_t$catcd.3 ), ]

#use id row as row names
rownames(df_t) <- as.matrix(df_t$subjid)

#drop id column
df_t$subjid<-NULL

#create variable representing row number
for (ii in 1:nrow(df_t)) {
df_t$counter[ii]=ii
}

#drop visit columns
df_t<-df_t[c("counter")]

#Use rownames as ID
df_t$subjid<-rownames(df_t)

#Append to the dataset with counters
df_t_all <- rbind(df_t_all, df_t)
}


#Add counter to the original dataset.
df<-merge(df, df_t_all,by="subjid")

#create category text
category_format<-c("Benefit Only", "Benefit +AE", "Neither", "AE only", "Withdrew")

#color scheme
category_colors<- c("green", "yellow", "gray", "red", "black")

#Create categories as factors.
#They can be manipulated as numeric variables but display text
df$cat <- factor(df$catcd, labels = category_format )


pdf(file=PDFPath, paper="USr", width=11, height=8.5)

#plot data
qplot(main="Benefit and Risk over Time, for each Patient\n GGPLOT heatmap ",
x=week,
y=counter,
fill=cat,
data=df,
xlab="Weeks",
geom="tile",
ylab="Subjects",
facets = .~ group )+

scale_y_continuous(expand=c(0,0),
breaks=breaks )+
scale_fill_manual( values=category_colors, #use specific colors for fill
name ="")+ #supress legend title

scale_x_continuous(expand=c(0,0),
breaks=seq(.5,3.5,1), #control placement of x tickmarks
labels=0:3)+ #label x labels
opts(panel.grid.minor=theme_blank()) + #supress minor grid
opts(panel.grid.major=theme_blank()) + #supress major grid
opts(legend.position = "bottom") + #place legend below the plot
opts(panel.margin = unit(2, "lines")) #increase space between plots


dev.off()

SAS-Code - Attachment

SAS-Code %let gpath='.';
%let dpi=200;
ods listing gpath=&gpath image_dpi=&dpi;
ods html close;

/*--Build data set--*/
data HeatMap?;
do Trt='Active', 'Placebo';
Week=1;
do Subject=1 to 36; Value=1; output; end;
do Subject=37 to 45; Value=2; output; end;
do Subject=46 to 53; Value=3; output; end;
do Subject=54 to 61; Value=2; output; end;
do Subject=62 to 62; Value=1; output; end;
do Subject=63 to 67; Value=3; output; end;
do Subject=68 to 68; Value=4; output; end;
do Subject=69 to 81; Value=2; output; end;
do Subject=82 to 91; Value=1; output; end;
do Subject=92 to 101; Value=4; output; end;
do Subject=102 to 104; Value=2; output; end;
do Subject=105 to 106; Value=5; output; end;
Week=2;
do Subject=1 to 31; Value=1; output; end;
do Subject=32 to 32; Value=2; output; end;
do Subject=33 to 36; Value=3; output; end;
do Subject=37 to 45; Value=2; output; end;
do Subject=46 to 53; Value=3; output; end;
do Subject=54 to 61; Value=2; output; end;
do Subject=62 to 67; Value=3; output; end;
do Subject=68 to 91; Value=4; output; end;
do Subject=92 to 106; Value=5; output; end;
Week=3;
do Subject=1 to 30; Value=1; output; end;
do Subject=31 to 36; Value=3; output; end;
do Subject=37 to 53; Value=4; output; end;
do Subject=54 to 106; Value=5; output; end;
end;
run;

/*--Format for the Values--*/
proc format;
value benefit
1='Benefit Only'
2='Benefit+AE'
3='Neither'
4='AE Only'
5='Withdraw'
;
run;

/*--Render graph using SAS 9.40M3 SGPANEL Procedure--*/
/*--Note,: The x-axis is treated as discrete--*/

ods graphics / reset width=5in height=4in imagename='HeatMapPanel';
title 'Benefit and Risk over Time for each Subject';
title2 h=7pt 'SGPANEL HeatMap?';
proc sgpanel data=HeatMap ;
format value benefit.;
styleattrs datacolors=(cx00ff00 yellow lightgray red black);
panelby trt / novarname spacing=10 headerattrs=(size=7) headerbackcolor=lightgray;
heatmapparm x=week y=subject colorgroup=value / name='a';
colaxis integer offsetmin=0 offsetmax=0 display=(noline)
valueattrs=(size=7) labelattrs=(size=8);
rowaxis values=(10 to 100 by 10) min=1 valueshint offsetmin=0 offsetmax=0
display=(noline) valueattrs=(size=7) labelattrs=(size=8);
keylegend 'a' / valueattrs=(size=7) noborder;
run;



Stata-Code - Attachment

Stata-Code

Other Code - Attachment

Other Code

Disclaimer The views expressed within CTSpedia are those of the author and must not be taken to represent policy or guidance on the behalf of any organization or institution with which the author is affiliated.
Permission Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF ERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT OLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
Reference Image Cherny_GGPLOT_Benefit_Risk_200.png
Topic attachments
I Attachment Action Size Date Who Comment
pngpng HeatMapPanel.png manage 12.0 K 20 May 2016 - 22:29 SanjayMatange  
pngpng HeatMapPanel_200.png manage 7.4 K 20 May 2016 - 22:30 SanjayMatange  
Topic revision: r6 - 20 May 2016 - 22:30:47 - SanjayMatange
 

Copyright & by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding CTSPedia? Send feedback