# Relabelling observations -------------------------

obs <- c("f7", "f8", "m1", "m2", "m3", "f3", "m4", "f1", "m7", "m7", "f4", "m5", "f5", "m6", "f6", "m8", "m9", "f9", "m10", "f10", "f2")


pieces <- strsplit(obs, "")
parts <- t(sapply(pieces, function(x) c(x[1], paste(x[-1], collapse=""))))

data.frame(
	n = as.integer(parts[,2]), 
	sex = factor(parts[,1], labels=c("female","male"))
)

# Ragged longitudinal data -----------------

load("ragged.rda")

# 1
table(table(ragged$id))

# 2
parts <- split(ragged, ragged$id)
dfapply <- function(f) do.call("rbind", lapply(parts, f))

indices <- tapply(1:nrow(ragged), ragged$id, c)
dfapply2 <- function(f) do.call("rbind", lapply(indices, function(i) f(ragged[i, ])))

system.time(a <- dfapply(function(df) transform(df, seq = rank(df$visittime))))
system.time(b <- dfapply2(function(df) transform(df, seq = rank(df$visittime))))


# 3
var <- "chol"
dfapply(function(df) {
	df <- df[order(df$visittime), ]
	df[[paste(var, "diff", sep="")]] <- c(NA, diff(df[[var]]))
	df
})

# 4 
which(rowSums(table(ragged$id, ragged[["trt"]]) > 0) != 1)

# 5
first <- function(x) x[1]
last <- function(x) x[length(x)]

surrounds <- function(df, time) c(last(which(df$visittime < time)), first(which(df$visittime > time)))

surrounds_all <- function(time) dfapply(function(df) {df[surrounds(df, time), ]})

# Folding functions -------------

reduce <- function(x, operator) {
	operator <- match.fun(operator)
	if (length(x) == 1) return(x)
	res <- operator(x[1], x[2])
	if (length(x) == 2) return(res)
	
	for(a in x) res <- operator(res, a)
	res
}

accumulate <- function(x, operator) {
	res <- vector(mode = mode(x), length = length(x) - 1)
	operator <- match.fun(operator)

	res[1] <- x[1]
	
	for(i in 2:length(x)) res[i] <- operator(res[i - 1], x[i])
	res
}