rethomics / ggetho

Visualise high throughput behavioural data in R, based on ggplot2
http://rethomics.github.io
8 stars 3 forks source link

Polar coordinate plots - grey centre circle and activity lines not continuous #34

Open marywestwood opened 4 years ago

marywestwood commented 4 years ago

Hello!

I'm having some difficulties with using Rethomics to produce polar coordinate plots. The centre of the plot has a grey circle that coincides with what should be the light phase (the right side of the plot, from 0-12h). Also, the activity appears to not be continuous in that it does not fully close at 0/24 h. I've posted my code below, as well as the polar coordinate plot and actogram I produced using this code. Data and metadata are also attached in a zip (archive.zip). Any advice or help is much appreciated!

Archive.zip

rm(list=ls())

library(behavr)
library(ggetho)
library(zeitgebr)
library(lubridate)
library(ggplot2)
library(RColorBrewer)
library(tidyverse)

#load data
metadata <- fread("Your/path/to/data.csv")
df <- fread("Your/path/to/data.csv")

df <- na.omit(df)

df$time <- as.POSIXct(df$time, format="%d/%m/%Y %H:%M") 
#create a fake time that's one day earlier at ZT0
df$start.time<-paste0(date(min(df$time)-86400)," 18:00:00") #86400 is the number of seconds in one day
df$start.time <- as.POSIXct(df$start.time) 
df$t.seconds <- as.numeric(interval(df$start.time,
                                    df$time)) #rethomics wants elapsed seconds since a ZT0, so we choose the ZT0 
                                              #from the day before and put all values as elapsed seconds since then

#produce behavr table
dt <- behavr(data.table(id=df$id, #DATA TABLE
                        t=df$t.seconds,
                        activity=df$chirp80_r, 
                        key="id"),                        
             data.table(id=metadata$id, #METADATA TABLE    
                        treatment = metadata$treatment,
                        temp = metadata$temp,
                        key="id"))           

dt[is.na(dt$activity),"activity"] <- 0 #convert missing values to zero 

#actogram plot theme
ThemeActo <- theme_bw() +
  theme(
    plot.title = element_blank(),
    axis.title.x = element_blank(),
    axis.title.y = element_blank()) + 
  theme(panel.border = element_blank(), panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank()) +
  theme(legend.position="bottom", legend.text=element_text(size=7)) 

#actogram for an individual cricket
c3_acto <- ggetho(dt, aes(x=t, z=activity), multiplot = 2)+ stat_tile_etho() + 
  stat_ld_annotations(ld_colours = c("white", "black"), 
                      ypos="top") + ThemeActo + labs(fill=NULL) 

#polar coordinate theme
ThemePolCor <- theme_bw() +
  theme(title = element_text(size = 12)) +
  theme(text = element_text(family = "Helvetica")) +
  theme(axis.title.x = element_blank(),
        axis.title.y = element_blank()) +
  theme(legend.position = "none") +
  theme(panel.border = element_blank()) +
  theme(plot.title = element_text(hjust=0.5))

#colour palette
MaryPal <- brewer.pal(n=9, "Reds")

#polar coordinate plot code
c3_polcor <- ggetho(dt, aes(y=as.numeric(activity), fill=as.factor(id)), time_wrap = 86400) +
  stat_ld_annotations(height=.5,
                      alpha=.2,
                      x_limits = c(0, 86400),
                      outline = NA) +
  labs(title = "Cricket 3") +
  stat_pop_etho() + coord_polar() + ThemePolCor + 
  scale_colour_manual(values=MaryPal[8], name=NULL) + 
  guides(fill=FALSE, colour=guide_legend(override.aes=list(fill=NA)))

c3_polcor c3_acto

qgeissmann commented 4 years ago

Looking into that. it looks like two different issues.

regarding issue 1. here is a hint of what probably happens:

df <- data.frame(x=0:24, y=  0:24)
ggplot(df, aes(x,y )) +coord_polar() + 
  geom_rect(xmin=0, ymin=-5.0, xmax=12, ymax=24, alpha=.1) + 
  geom_line(colour='blue') +
  scale_x_continuous(breaks = 1:4 * 6)

image

In our case, I think the coordinate of the bottom of the annotations are not calculated properly as the ymin is probably a bit lower than the bottom of the coordinate system...

In this toy pure ggplot example, one can work around this way, using scale_y_continuous:

ggplot(df, aes(x,y )) +coord_polar() + 
  geom_rect(xmin=0, ymin=-5.0, xmax=12, ymax=24, alpha=.1) + 
  geom_line(colour='blue') +
  scale_x_continuous(breaks = 1:4 * 6)+
  scale_y_continuous(limits=c(-5, NA))

image

Applied to your example: image

c3_polcor <- ggetho(dt, aes(y=as.numeric(activity), fill=as.factor(id)), 
                    time_wrap = 86400, 
                    ) +
                stat_ld_annotations(height=.1,
                      alpha=.3,
                      ypos=.1,
                      x_limits = c(0, 86400),
                      outline = NA) +
                stat_pop_etho() 

c3_polcor + coord_polar() + scale_y_continuous(limits=c(min(dt[,activity]), NA))

It is a little bit of a hack, but that can work for now... Also, note that you can directly use geom_reactangle rather that stat_pop_etho if you are comfortable with it (as there are only two rectangles to draw in your case)... Will follow up on the other part of the issue :smile:

qgeissmann commented 4 years ago

the second point is now a separate issue (#36)