In lcamus/pubstat: Gen statistical publication in HTML, PDF format

knitr::opts_chunk$set(echo = FALSE)
knitr::read_chunk("../../R/tool.R")
knitr::read_chunk("../../R/data.R")
knitr::read_chunk("../../R/ccze_init_table.R")

<<init>>
<<tool>>
<<data>>

setHeader(title=c("Les marchés de change de l'euro contre devises","The euro exchange rate"),
                    subtitle=c("(Pour un euro)","(Per euro)"))

#role variables:
role.currency <- "CURRENCY"
role.obsmethod <- "EXR_SUFFIX"
role.obsvalue <- "OBS_VALUE"

#get data & metadata:

if (!exists("data.collection"))
  data.collection <- getDataCollection()

#year 1999 time series:
data.y99.0 <- getData(data.collection,1)
meta.currencies <- data.y99.0[[1]] #metadata
data.y99.0 <- data.y99.0[[2]]

#yearly time series:
data.y.0 <- getData(data.collection,2)
data.y.0 <- data.y.0[[2]]

#monthly time series:
data.m.0 <- getData(data.collection,3)
data.m.0 <- data.m.0[[2]]

#generate selector for the time series:
x <- params$data.collection
series <- eval(parse(text=regmatches(x,regexec(paste0("(?<=",role.currency,"=).+(?=,)"),x,perl=T))[[1]]))
rm(x)
series.tmp <- c()
for (cur in series)
  series.tmp <- append(series.tmp,c(list(list(role.currency=cur,role.obsmethod="E")),
                                    list(list(role.currency=cur,role.obsmethod="A"))))
series <- series.tmp
rm(series.tmp,cur)

#filter and sort data by currency:

setData <- function(ts) {
  res <- ts[order(match(ts[,c(role.currency)],lapply(series,`[[`,1)),rev(ts[,c(role.obsmethod)]),ts$date),]
  rn <- rownames(res)
  res <- matrix(res[,c(role.obsvalue)],ncol=grep("E",ts[,c(role.obsmethod)])[1]-1,byrow=T)
  if (ncol(res)==1) #data.y99
    rownames(res) <- rn
  return(res)
}

invisible(lapply(c("data.y99","data.y","data.m"),function(x){
  eval(parse(text=paste0(x," <- setData(",paste0(x,".0"),")")),envir=parent.frame(2))
  }))
setData <- NULL

#set series title
meta <- unlist(rep(
  ifelse(params$lang=="FR",list(c("Fin de période","Moyenne sur la période")),list(c("End of period","Period average"))),
  length(data.y99)/2))

#set currencies titles order
meta.currencies <- unique(meta.currencies[rownames(data.y99),]$TITLE)
meta.currencies <- sub("/Euro","",meta.currencies,ignore.case=T)
if (params$lang=="FR")
  meta.currencies <- as.character(lapply(meta.currencies,function(x){currencynameEN2FR(x)}))

#generate datatable:

#header:
invisible(list2env(setNames(lapply(list(data.y99.0,data.y.0),function(x){sort(unique(x[!is.na(x$date),]$date))}),
                  c("col.y99","col.y")),
         envir=baseenv()))
col.m <- sort(unique(zoo::as.yearmon(as.character(data.m.0$date),"%Y-%m")))
# 
sketch = htmltools::withTags(table(
  thead(
    tr(
      th(colspan=1,rowspan=2),
      th(colspan=ncol(data.y99),rowspan=1,ifelse(params$lang=="FR","année","year"),style="border:none;"),
      th(colspan=ncol(data.y),rowspan=1,ifelse(params$lang=="FR","année","year"),style=paste0("border:none;",sep.style)),
      getTH(base::table(format(col.m,"%Y")),"Y",sep.style)
    ),
    tr(
      getTH(base::table(col.y99),"Y","","font-weight:bold;"),
      getTH(base::table(col.y),"Y",sep.style,"font-weight:bold;"),
      getTH(as.character(format(col.m,"%b")),"M",sep.style)
    )
  )
))

#end header

#data
data <- as.data.frame(cbind(data.y99,data.y,data.m), stringsAsFactors=F)

#insert currencies titles in data
index <- c()
for (i in 1:length(meta.currencies))
  index <- c(index,i,i*2+10,i*2+11)
data <- rbind(
  as.data.frame(matrix(rep("",ncol(data)*length(meta.currencies)),ncol=ncol(data),nrow=length(meta.currencies)),stringsAsFactors=F),
  data)
data <- data[index,]
meta <- c(meta.currencies,meta)[index]

#finally generate the data table
t1 <- genDataTable(data,meta,sketch,
                   countries.highlight=unique(data.y99.0$CURRENCY),
                   sep.col=c(3,5),sep.style=sep.style,subrow=T)

#ouput the table
t1

#generate footer:

footer <- htmltools::withTags(
  list()
)

footer <- setFooter(footer,source=c("Banque Centrale Européenne","European Central Bank"))

#output footer:
footer