gistfile1.r

# Create function to get data from weekly to monthly
weekly.monthly <- function(x){
  require(dplyr)
  if (names(x)[1]!='Week'){
    stop("The first column should be 'Week'. Check the data.")
  }
  countryname <- names(x)[2]
  x[['Week']] <- as.character(x[['Week']])
  x[['weekstart']] <- substr(x[['Week']],1,11)
  x[['weekend']] <- substr(x[['Week']],13,24)
  x[['weekstart']] <- as.Date(x[['weekstart']],format='%Y-%m-%d')
  x[['weekend']] <- as.Date(x[['weekend']],format='%Y-%m-%d')
  x[['yearstart']] <- substr(x[['weekstart']],1,4)
  x[['monthstart']] <- substr(x[['weekstart']],6,7)
  x[['daystart']] <- substr(x[['weekstart']],9,11)
  x[['yearend']] <- substr(x[['weekend']],1,4)
  x[['monthend']] <- substr(x[['weekend']],6,7)
  x[['dayend']] <- substr(x[['weekend']],9,11)
  year <- vector(mode='numeric',length=length(x[['yearstart']]))
  year[x[['yearstart']] == x[['yearend']]] <- x[['yearstart']][x[['yearstart']] == x[['yearend']]]
  year[x[['yearstart']] != x[['yearend']] & x[['daystart']] >= 28] <- x[['yearstart']][x[['yearstart']] != x[['yearend']] & x[['daystart']] >= 28]
  year[x[['yearstart']] != x[['yearend']] & x[['daystart']] < 28] <- x[['yearend']][x[['yearstart']] != x[['yearend']] & x[['daystart']] < 28]
  month <- vector(mode='numeric',length=length(x[['yearstart']]))
  month[x[['monthstart']] == x[['monthend']]] <- x[['monthstart']][x[['monthstart']] == x[['monthend']]]
  month[x[['monthstart']] != x[['monthend']] & x[['dayend']]>=4] <- x[['monthend']][x[['monthstart']] != x[['monthend']] & x[['dayend']]>=4]
  month[x[['monthstart']] != x[['monthend']] & x[['dayend']]<4] <- x[['monthstart']][x[['monthstart']] != x[['monthend']] & x[['dayend']]<4]
  x[['month']] <- as.character(month)
  x[['year']] <- as.character(year)
  monthyear <- vector(mode='character',length=length(x[['yearstart']]))
  monthyear <- paste(x[['year']],x[['month']],'01',sep='-')
  x[['month']] <- as.character(monthyear)
  x[['year']] <- NULL
  names(x)[2] <- 'value'
  x <- select(x,month,value)
  x <- summarise(group_by(x,month),value=mean(value))
  names(x)[names(x)=='value'] <- countryname
  return(x)
}

# Create function to add vector of country name and word
add.countryword <- function(x,y){
  countryname <- names(x)[2]
  country <- vector(mode='numeric',length=length(x[['month']]))
  country <- rep_len(countryname,length(country))
  country <- gsub("\\."," ",country)
  country <- tolower(country)
  x[['countryname']] <- country
  x[['month']] <- as.Date(x[['month']],format='%Y-%m-%d')
  word <- vector(mode='character',length=length(x[['month']]))
  word <- rep_len(y,length(word))
  x[['word']] <- word
  country <- vector(mode='character',length=length(primarycircuit.gbr$value))
  countrycode <- unique(data$country[data$countryname==x[['countryname']]])
  country <- rep_len('gbr',length(country))
  primarycircuit.gbr$country <- countrycode
  return(x)
}

# Create function to prepare comparison DFs
prep.comp <- function(x,y){
  require(dplyr)
  require(reshape2)
  if(names(x)=='Week'){
    weekly.monthly(x)
  }
  add.countryword(x,y)
  temp.data <- select(data,country,value,month)
  names(temp.data)[names(temp.data)=='value'] <- 'given'
  names(x)[names(x)=='value'] <- 'trends'
  x <- left_join(x,temp.data)
  x <- melt(x,id.vars=c('month','country'),variable.name='source')
  return(x)
}