library(tidyverse)
library(caret)

# annotation
ann <- readRDS(file="~/")


# Create split data folders for each primary site -------------------------
set.seed(1)

library(strex)
library(filesstrings)
library(readxl)

base_dir <- "~/"
# Coding filename -> patient ID
code <- read_xlsx(path= "~/")

#select cases with primary site tumor sample
pattern <- "-01"
code$cases <- substr(code$cases,0,16)
prim <- grepl(pattern,code$cases)
prim_code <- code[prim,]


# HNSC --------------------------------------------------------------------
ann <- readRDS(file="~/")

# list of IDAT files
HNSC_files <- list.files(path = file.path("~/"))
HNSC_is <- intersect(HNSC_files,prim_code$file_name)

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/", x) )
}
lapply(HNSC_is,move_files)

set.seed(1)
#Oropharynx

fn_oro <- ann[ann$Primary_Site == "Oropharynx",][,2]
fn_oro <- fn_oro[complete.cases(fn_oro),] 
fn_oro <- fn_oro$file_name

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/", x) )
}

lapply(fn_oro,move_files)

#oral cavity

fn_oc <- ann[ann$Primary_Site == "Oral_Cavity",][,2]
fn_oc <- fn_oc[complete.cases(fn_oc),] 
fn_oc <- fn_oc$file_name

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/", x) )
}

lapply(fn_oc,move_files)

#Larynx


fn_la <- ann[ann$Primary_Site == "Larynx",][,2]
fn_la <- fn_la[complete.cases(fn_la),] 
fn_la <- fn_la$file_name

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/", x) )
}

lapply(fn_la,move_files)
# CSCC --------------------------------------------------------------------

CSCC_files <- list.files(path = file.path("~/"))
CSCC_is <- intersect(HNSC_files,prim_code$file_name)

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/", x) )
}

lapply(HNSC_is,move_files)


# ESCC --------------------------------------------------------------------
ann <- readRDS(file="~/")

ESCC <- list.files(path = file.path("~/"))
ESCC <- intersect(HNSC_files,prim_code$file_name)

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/", x) )
}

fn_escc <- ann[ann$Primary_Site == "Esophagus",][,2]
fn_escc <- fn_escc[complete.cases(fn_escc),]
fn_escc <- fn_escc$file_name

lapply(fn_escc,move_files)

# LUSC --------------------------------------------------------------------

ann <- readRDS(file="~/")

LUSC <- list.files(path = file.path("~/"))

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/", x) )
}

fn_lusc <- ann[ann$Primary_Site == "Lung",][,2]
fn_lusc <- fn_lusc[complete.cases(fn_lusc),]
fn_lusc <- fn_lusc$file_name

lapply(fn_lusc,move_files)

# Split data 2/3 training - 1/3 validation --------------------------------------------------------------

# CSCC --------------------------------------------------------------------

fn_cscc<- list.files(path=file.path("~/"))

fn_cscc_short <- str_sub(fn_cscc,end=-10L) %>% unique()

fn_cscc_unique <- sample(fn_cscc_short,round(1/3*length(fn_cscc_short),0)) 
x <- str_detect(fn_cscc, str_c(fn_cscc_unique, collapse = '|'))
fn_cscc[x]

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/1:3", x) )
}
lapply(fn_cscc[x],move_files)

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/2:3", x) )
}
lapply(fn_cscc[!x],move_files)

# HNSC --------------------------------------------------------------------

#Larynx

fn_cscc<- list.files(path=file.path("~/"))

fn_cscc_short <- str_sub(fn_cscc,end=-10L) %>% unique()

fn_cscc_unique <- sample(fn_cscc_short,round(1/3*length(fn_cscc_short),0)) 
x <- str_detect(fn_cscc, str_c(fn_cscc_unique, collapse = '|'))
fn_cscc[x]

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/1:3", x) )
}
lapply(fn_cscc[x],move_files)

move_files <- function(x){
  file.rename( from =  file.path("~/", x) ,
               to = file.path("~/2:3", x) )
}
lapply(fn_cscc[!x],move_files)

#Oropharynx 
fn_cscc<- list.files(path=file.path("~/"))

fn_cscc_short <- str_sub(fn_cscc,end=-10L) %>% unique()

fn_cscc_unique <- sample(fn_cscc_short,round(1/3*length(fn_cscc_short),0)) 
x <- str_detect(fn_cscc, str_c(fn_cscc_unique, collapse = '|'))
fn_cscc[x]

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/1:3", x) )
}
lapply(fn_cscc[x],move_files)

move_files <- function(x){
  file.rename( from =  file.path("~/", x) ,
               to = file.path("~/2:3", x) )
}
lapply(fn_cscc[!x],move_files)

#Oral cavity 
fn_cscc<- list.files(path=file.path("~/"))

fn_cscc_short <- str_sub(fn_cscc,end=-10L) %>% unique()

fn_cscc_unique <- sample(fn_cscc_short,round(1/3*length(fn_cscc_short),0)) 
x <- str_detect(fn_cscc, str_c(fn_cscc_unique, collapse = '|'))
fn_cscc[x]

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/1:3", x) )
}
lapply(fn_cscc[x],move_files)

move_files <- function(x){
  file.rename( from =  file.path("~/", x) ,
               to = file.path("~/2:3", x) )
}
lapply(fn_cscc[!x],move_files)


# ESCC --------------------------------------------------------------------
fn_cscc<- list.files(path=file.path("~/"))

fn_cscc_short <- str_sub(fn_cscc,end=-10L) %>% unique()

fn_cscc_unique <- sample(fn_cscc_short,round(1/3*length(fn_cscc_short),0)) 
x <- str_detect(fn_cscc, str_c(fn_cscc_unique, collapse = '|'))
fn_cscc[x]

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/1:3", x) )
}
lapply(fn_cscc[x],move_files)

move_files <- function(x){
  file.rename( from =  file.path("~/", x) ,
               to = file.path("~/2:3", x) )
}
lapply(fn_cscc[!x],move_files)

# LUSC --------------------------------------------------------------------

fn_cscc<- list.files(path=file.path("~/"))

fn_cscc_short <- str_sub(fn_cscc,end=-10L) %>% unique()

fn_cscc_unique <- sample(fn_cscc_short,round(1/3*length(fn_cscc_short),0)) 
x <- str_detect(fn_cscc, str_c(fn_cscc_unique, collapse = '|'))
fn_cscc[x]

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/1:3", x) )
}
lapply(fn_cscc[x],move_files)

move_files <- function(x){
  file.rename( from =  file.path("~/", x) ,
               to = file.path("~/2:3", x) )
}
lapply(fn_cscc[!x],move_files)

# DLBC --------------------------------------------------------------------

fn_cscc<- list.files(path=file.path("~/"))

fn_cscc_short <- str_sub(fn_cscc,end=-10L) %>% unique()

fn_cscc_unique <- sample(fn_cscc_short,round(1/3*length(fn_cscc_short),0)) 
x <- str_detect(fn_cscc, str_c(fn_cscc_unique, collapse = '|'))
fn_cscc[x]

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/1:3", x) )
}
lapply(fn_cscc[x],move_files)

move_files <- function(x){
  file.rename( from =  file.path("~/", x) ,
               to = file.path("~/2:3", x) )
}
lapply(fn_cscc[!x],move_files)


# Leitheiser --------------------------------------------------------------

#Larynx

fn_cscc<- list.files(path=file.path("~/"))

fn_cscc_short <- str_sub(fn_cscc,end=10L) %>% unique()

larynx <- ann[ann$Primary_Site=='Larynx',]
fn_cscc_short <- intersect(larynx$file_name,fn_cscc_short)

fn_cscc_unique <- sample(fn_cscc_short,round(1/3*length(fn_cscc_short),0)) 
x <- str_detect(fn_cscc, str_c(fn_cscc_unique, collapse = '|'))
fn_cscc[x]

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/1:3", x) )
}
lapply(fn_cscc[x],move_files)

move_files <- function(x){
  file.rename( from =  file.path("~/", x) ,
               to = file.path("~/2:3", x) )
}
x <- str_detect(fn_cscc, str_c(fn_cscc_short, collapse = '|'))
lapply(fn_cscc[x],move_files)

#Oropharynx 
fn_cscc<- list.files(path=file.path("~/"))

fn_cscc_short <- str_sub(fn_cscc,end=10L) %>% unique()

oropharynx <- ann[ann$Primary_Site=='Oropharynx',]
fn_cscc_short <- intersect(oropharynx$file_name,fn_cscc_short)

fn_cscc_unique <- sample(fn_cscc_short,round(1/3*length(fn_cscc_short),0)) 
x <- str_detect(fn_cscc, str_c(fn_cscc_unique, collapse = '|'))
fn_cscc[x]

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/1:3", x) )
}
lapply(fn_cscc[x],move_files)

move_files <- function(x){
  file.rename( from =  file.path("~/", x) ,
               to = file.path("~/2:3", x) )
}
x <- str_detect(fn_cscc, str_c(fn_cscc_short, collapse = '|'))
lapply(fn_cscc[x],move_files)


#Oral cavity 
fn_cscc<- list.files(path=file.path("~/"))

fn_cscc_short <- str_sub(fn_cscc,end=10L) %>% unique()

oral_cavity <- ann[ann$Primary_Site=='Oral_Cavity',]
fn_cscc_short <- intersect(oral_cavity$file_name,fn_cscc_short)

fn_cscc_unique <- sample(fn_cscc_short,round(1/3*length(fn_cscc_short),0)) 
x <- str_detect(fn_cscc, str_c(fn_cscc_unique, collapse = '|'))
fn_cscc[x]

move_files <- function(x){
  file.rename( from = file.path("~/", x) ,
               to = file.path("~/1:3", x) )
}
lapply(fn_cscc[x],move_files)

move_files <- function(x){
  file.rename( from =  file.path("~/", x) ,
               to = file.path("~/2:3", x) )
}
x <- str_detect(fn_cscc, str_c(fn_cscc_short, collapse = '|'))
lapply(fn_cscc[x],move_files)



# Methylation preprocessing -------------------------------------------------------------

library(tidyverse)
library(BiocManager)
library(minfi)
library(minfiData)
library(caret)

# run with 1/3 split and repeat with 2/3 split
# 450k files
baseDir <- "~/"
RGSet <- read.metharray.exp(baseDir,recursive = TRUE, force = TRUE)

# EPIC files
baseDir <- "~/"
RGSet1 <- read.metharray.exp(baseDir,recursive = TRUE, force = TRUE)

RGSet<- combineArrays(RGSet,RGSet1,
                      outType = c("IlluminaHumanMethylation450k",
                                  "IlluminaHumanMethylationEPIC"),
                      verbose = TRUE)
rm(RGSet1)
GRset <- preprocessNoob(RGSet, offset = 15, dyeCorr = TRUE, verbose = FALSE,
                        dyeMethod=c("single", "reference")) 

beta <- getBeta(GRset)
saveRDS(beta,file="~/")