man/examples/train.R

In ondrej-klima/growthfd: Fitting FPCA-based growth curve model

data <- read.table("D:/Growth/playground/data/bgs_07.txt", header=TRUE, sep="\t", na.strings="NA", dec=".")
#data <- data[!(data$id %in% growthfd.bgs.dropoutsIds.Height()) & data$sex == "1",]
data <- data[!(data$id %in% growthfd.bgs.dropoutsIds.Height()),]
gather <- growthfd.bgs.gather(data)
interp <- growthfd.bgs.interpolateNAs(gather)
resampled <- growthfd.bgs.resample(interp)
#smoothed <- growthfd.bgs.smooth(resampled)
smoothed <- growthfd.bgs.smooth(resampled, F)

#age <- seq(10, 18, 0.05)
#m<-growthfd.bgs.evalMonotone(smoothed$fd,age,1)
#apvs<-growthfd.bgs.apvs(age,m)
#ids <- unique(data$id)

age <- seq(10, 18, 0.05)
m<-growthfd.bgs.eval(smoothed$fd,age,1)
apvs<-growthfd.bgs.apvs(age,m)
ids <- unique(data$id)

# Fix individuals with apv lower than 10
age <- seq(7, 18, 0.05)
m<-growthfd.bgs.evalMonotone(smoothed,age,1)
apvs.na <- which(is.na(apvs))
apvs[apvs.na]<-growthfd.bgs.apvs(age,m[,apvs.na])

#age <- seq(0, 18, 0.05)
#values <- growthfd.bgs.evalMonotone(smoothed,age)
#vel <- growthfd.bgs.evalMonotone(smoothed,age,1)
#acc <- growthfd.bgs.evalMonotone(smoothed,age,2)
#growthfd.bgs.plotIndividuals(age, ids, apvs, values, vel, acc, gather)
#growthfd.bgs.plotAll(age,acc, ylimit = c(-25, 25))

age <- seq(0, 18, 0.05)
values <- growthfd.bgs.eval(smoothed$fd,age)
vel <- growthfd.bgs.eval(smoothed$fd,age,1)
acc <- growthfd.bgs.eval(smoothed$fd,age,2)
growthfd.bgs.plotIndividuals(age, ids, apvs, values, vel, acc, gather, 'plot_weight.pdf')


resampled.new <- values
dim(resampled.new) <- c(prod(dim(values)), 1)
resampled.new <- cbind(rep(ids, each=dim(values)[1]), rep(age, dim(values)[2]), resampled.new[,1])
colnames(resampled.new) <- colnames(resampled)
smoothed.new <- growthfd.bgs.smooth(resampled.new, F)

tw <- growthfd.bgs.registerCurvesToApvs(smoothed, apvs)
amp<-fda::register.newfd(smoothed.new$fd,tw)
itw <- growthfd.bgs.invertTw(age, tw)

model <- growthfd.bgs.model(amp, itw$fd)

plDf <- data.frame('phasePC1'=model$warpfpca$scores[,1], 'amplitudePC1'=model$growthfpca$scores[,1], sex=factor(data$sex))
ggplot2::ggplot(data = plDf, ggplot2::aes(x=phasePC1, y=amplitudePC1, colour=sex)) +
  ggplot2::geom_point() +
  ggplot2::stat_ellipse(geom = "polygon",linetype = 2,ggplot2::aes(fill = sex),alpha = 0.15) +
  ggplot2::geom_rug() +
  ggplot2::stat_smooth(method = "lm", fullrange = TRUE) +
  ggplot2::scale_colour_manual(name = "Sex", values = c('blue', 'red'), labels=c('Male', 'Female')) +
  ggplot2::scale_fill_manual(name = "Sex", values = c('blue', 'red'), labels=c('Male', 'Female'))