Preparation
library(ERP);require(mnormt);require(fdrtool);library(ggplot2);library(dplyr);library(gridExtra)
library(erpR);require(akima);library(reshape2);library(boot);library(plotly)
data_select <- function(data,frames,datacol,subjcol=NULL,chancol=NULL,othvarcol=NULL,
select_subj=NULL,
select_chan=NULL,...){
subj_select <- function(data,frames,datacol,subjcol,chancol=NULL,othvarcol=NULL,
select_subj,...){
dta <- data
num <- length(select_subj)
data_list <- list()
for (i in 1:num){
data_new <- subset(dta,dta[,subjcol]==select_subj[i])
data_list[[i]] <- data_new
}
data_select <- data_list[[1]]
if (num != 1) {
for (i in 2:num) {
data_select <- rbind(data_select,data_list[[i]])
}
}
data_select <- data_select[order(data_select[,subjcol]),]
rownames(data_select) <- 1:dim(data_select)[1]
return (data_select)
}
chan_select <- function(data,frames,datacol,subjcol=NULL,chancol,othvarcol=NULL,
select_chan,...){
dta <- data
num <- length(select_chan)
data_list <- list()
for (i in 1:num){
data_new <- subset(dta,dta[,chancol]==select_chan[i])
data_list[[i]] <- data_new
}
data_select <- data_list[[1]]
if (num != 1){
for (i in 2:num){
data_select <- rbind(data_select,data_list[[i]])
}
}
rownames(data_select) <- 1:dim(data_select)[1]
return (data_select)
}
joint_select <- function(data,frames,datacol,subjcol,chancol,othvarcol=NULL,
select_subj,
select_chan,...){
dta <- data
ind_data <- subj_select(dta,frames,datacol,subjcol,chancol,othvarcol,
select_subj = select_subj)
ind_ele_data <- chan_select(ind_data,frames,datacol,subjcol,chancol,othvarcol,
select_chan = select_chan)
ind_ele_data <- ind_ele_data[order(ind_ele_data[,subjcol]),]
rownames(ind_ele_data) <- 1 :dim(ind_ele_data)[1]
return(ind_ele_data)
}
if (is.null(select_subj)==FALSE & is.null(select_chan)==FALSE){
dta <- joint_select(data = data,frames = frames,
datacol,subjcol,chancol,othvarcol,
select_subj=select_subj,
select_chan=select_chan)
} else if (is.null(select_subj)==FALSE & is.null(select_chan)== TRUE) {
dta <- subj_select(data=data,frames=frames,
datacol,subjcol,chancol,othvarcol,
select_subj=select_subj)
} else if (is.null(select_chan)==FALSE & is.null(select_subj)== TRUE) {
dta <- chan_select(data,frames,
datacol,subjcol,chancol,othvarcol,
select_chan=select_chan)
} else {
dta <- data
}
return(dta)
}
data_summarize <- function(data,frames,datacol,subjcol=NULL,chancol=NULL,othvarcol=NULL,
summarycol,
fun=mean,
select_subj=NULL,
select_chan=NULL,...){
options(warn=-1)
dta <- data_select(data,frames,datacol,subjcol,chancol,othvarcol,
select_subj,
select_chan)
agglength <- length(summarycol)
aggvar_list <- list(dta[,summarycol[1]])
if (agglength > 1){
for (i in 2:agglength ){
aggvar_list <- append(aggvar_list,list(dta[,summarycol[i]]))
}
}
aggdata <- aggregate(dta[,datacol],by=aggvar_list,
fun,...)
aggdata <- aggdata[,1:(agglength+length(datacol))]
for (i in 1: agglength){
colnames(aggdata)[i] <- colnames(dta)[summarycol[i]]
}
rownames(aggdata) <- 1:dim(aggdata)[1]
return(aggdata)
}
downsample <- function(data,
datacol,
binwidth=10,
movinginterval=NULL) {
if (is.null(movinginterval) == FALSE) {
if (movinginterval >= binwidth){stop("movinginterval should not bigger than binwidth!")}
dta <- data
dta_signal <- dta[,datacol]
dta_othvar <- dta[,-datacol]
num1 <- (dim(dta_signal)[2] - (dim(dta_signal)[2] %% binwidth)) /binwidth
num2 <- dim(dta_signal)[2] %% binwidth
dta_downsample <- data.frame(melt(apply(dta_signal[,1:binwidth],1,mean)))
i = movinginterval - 1
while ((binwidth+i) <= dim(dta_signal)[2]){
dta_downsample <- cbind(dta_downsample,melt(apply(dta_signal[,(1+i):(binwidth+i)],1,mean)))
i = i + movinginterval -1
}
if (num2 >= 1) {
dta_downsample <- cbind(dta_downsample,
value=melt(apply(dta_signal[,(1+i):dim(dta_signal)[2]],1,mean)))
}
colnames(dta_downsample) <- paste("value",1:dim(dta_downsample)[2],sep=".")
dta_final <- cbind(dta_othvar,dta_downsample)
} else {
dta <- data
dta_signal <- dta[,datacol]
dta_othvar <- dta[,-datacol]
num1 <- (dim(dta_signal)[2] - (dim(dta_signal)[2] %% binwidth))/binwidth
num2 <- dim(dta_signal)[2] %% binwidth
dta_downsample <- data.frame(melt(apply(dta_signal[,1:binwidth],1,mean)))
for (i in 1 : num1-1){
dta_downsample <- cbind(dta_downsample,
melt(apply(dta_signal[,(i*binwidth+1):((i+1)*binwidth)],
1,mean)))
}
if (num2 == 1) {
dta_downsample <- cbind(dta_downsample,
value=dta_signal[,(num1*binwidth+num2)])
}
if (num2 > 1) {
dta_downsample <- cbind(dta_downsample,
melt(apply(dta_signal[,(num1*binwidth+1):(num1*binwidth+num2)],
1,mean)))
}
dta_downsample <- dta_downsample[,-1]
colnames(dta_downsample) <- paste("value",1:dim(dta_downsample)[2],sep=".")
dta_final <- cbind(dta_othvar,dta_downsample)
}
return(dta_final)
}
edaplot <- function(data,frames=NULL,datacol,subjcol=NULL,chancol=NULL,othvarcol=NULL,
outlinesub=NULL,outcolor="red",
select_subj=c(NULL),
select_chan=c(NULL),...){
dta <- data_select(data,frames,datacol,subjcol,chancol,othvarcol,
select_subj,
select_chan)
subvar <- variable.names(dta)[subjcol]
dta$Info <- NA
for (i in 1 : dim(dta)[1]){
info1 <- paste0(as.character(dta[i,othvarcol]),collapse=";")
dta$Info[i] <- paste(dta[i,chancol],dta[i,subjcol],info1,sep=";")
}
datalong <- melt(dta,
id=c(variable.names(dta)[c(subjcol,chancol,othvarcol)],
"Info"))
datalong <- datalong[order(datalong$Info),]
datalongorder <- datalong
datalongorder$frames <- rep(frames,length(datalongorder[,1])/length(frames))
if (is.null(outlinesub) == FALSE){ # how to outline several subjects (and color)
data2 <- subset(datalongorder,datalongorder[,1]==outlinesub)
plot <- ggplot(datalongorder,
aes(x=frames,y=value,group=Info,...))+
geom_line()+
geom_line(data=data2,aes(x=frames,y=value),col=outcolor)
} else {
plot <- ggplot(datalongorder,
aes(x=frames,y=value,group=Info))+
geom_line()
}
return(plot)
}