R/multipleheatmap.R

In PASenseWear: Summarize Daily Physical Activity from 'SenseWear' Accelerometer Data

#' multipleheatmap
#'
#' Generate heatmap to show activity intensity (in MET) of multiple participants grouped by specified factor (age, gender, etc.).
#' @param data  Combined csv file from SenseWear with multiple participants, participants are distinguished by ID. Refer to sampledata_multiple.rda for sample format.
#' @param demography Demographic data includes the required factor(s) (e.g. age and/or gender) of the corresponding participant.
#' @param f The factor (age, gender, etc.) user wants to group data by.
#' @param category TRUE or FALSE for categorical factor. Default is TRUE.
#' @return \code{Graph}	A heatmap generated by ggplot with x axis Time and y axis factor.
#' @return \code{Table} A table summarizes the number of records of each participant on each day.
#' @importFrom  ggplot2 ggplot aes geom_tile scale_x_discrete scale_y_discrete scale_fill_manual theme_bw scale_fill_distiller ylab
#' @details The mean of METs of available days/groups are calculated and used in the heatmap.

#' @examples
#' # Continuous factor example
#' multipleheatmap(sampledata_multiple,demography,Age,category=FALSE)
#' # Categorical factor example
#' multipleheatmap(sampledata_multiple,demography,Gender,category=TRUE)

#' @export
#'

multipleheatmap=function(data,demography,f,category=TRUE)
 {

  mergedata=function(data,demography)
  {
    data1=merge(data,demography)
    data1=data1[order(data1$Time),]


    #data=rbind(s1,s2,s3,s4)

    #data1=merge(data,demography)

    Time=0
    Date=0
    #data1=cbind(data1,Time,Date)
    data1=cbind(data1,Time,Date)

    data1$Time=as.POSIXct(data1$Time1)
    data1$Date <- as.Date(data1$Time1, format = "%Y-%m-%d")
    lab <- with(data1, paste(format(data1$Time, "%H"), "00", sep = ":"))
    data1$Time <- format(data1$Time, "%H:%M")

    data1=data1[order(data1$Time),]
    data1=data1[,-2]
    print( table(data1$ID,data1$Date))
    return(data1)
  }

  data1=mergedata(data,demography)
  # data11=aggregate(METs~Time+ID,data1,mean)
    arguments <- as.list(match.call())
    axis_label=deparse(substitute(f))
    fac = eval(arguments$f,data1)
#
#     data1byfactor=aggregate(data1[,2],list(data1[,5],data1[,n]),mean)
# colnames(data1byfactor)=c("Time",colnames(data1)[n],"METs")
    data1=cbind(data1,fac)
    METs=data1$METs
    Time=data1$Time
   data1byfactor=aggregate(METs~Time+fac,data1,mean)
    ####by age####

#     data1byfactor[data1byfactor$METs<1,]$METs=1
#     data1byfactor[data1byfactor$METs<2 & data1byfactor$METs>1,]$METs=2
#     data1byfactor[data1byfactor$METs<3 &data1byfactor$METs>2,]$METs=3
#     if (nrow(data1byfactor[data1byfactor$METs<4 &data1byfactor$METs>3,])!=0)
#
#     {data1byfactor[data1byfactor$METs<4 &data1byfactor$METs>3,]$METs=4
#     }
#     if (nrow(data1byfactor[data1byfactor$METs<5 &data1byfactor$METs>4,])!=0)
#     {
#       data1byfactor[data1byfactor$METs<5 &data1byfactor$METs>4,]$METs=5
#     }
#     if (nrow(data1byfactor[data1byfactor$METs<6 &data1byfactor$METs>5,])!=0)
#     {
#       data1byfactor[data1byfactor$METs<6 &data1byfactor$METs>5,]$METs=6}
#     if (nrow(data1byfactor[data1byfactor$METs>6,])!=0)
#     {data1byfactor[data1byfactor$METs>6,]$METs=7
#     }
#     METs=0
#     data1byfactor=cbind(data1byfactor,METs)
#     data1byfactor$METs=factor(data1byfactor$METs)
#     data1byfactor$METs=factor(data1byfactor$METs)
#     color_palette <- colorRampPalette(c("#31a354","#2c7fb8", "#fcbfb8", "#f03b20"))(length((levels(factor(data1byfactor$METs)))))

   if (category){data1byfactor$fac=factor(data1byfactor$fac)}
    ggplot(data = data1byfactor) +
      geom_tile( aes(x = Time, y =fac, fill = METs))+scale_x_discrete(breaks = c("00:00","06:00","12:00","18:00","23:00"))+scale_fill_distiller(palette = "Spectral",limits=c(0,4))+  theme_bw()+ ylab(axis_label)
    #+scale_y_discrete(breaks=c("(0,40]" , "(40,50]" ,"(50,60]", "(60,70]" ,"(70,80]"),labels=c("0-40","40-50","50-60","60-70","70-80"))

}