scale.own <- function(x) {
x <- x - min(x, na.rm=T)
x <- x / max(x, na.rm=T)
return(x)
}
compute.sel.curve <- function(x, type='max') {
res <- rep(NA, length(x))
for (i in 1:length(x)) {
if (is.na(x[i])) break
if (type=='max') {
res[i] <- max(x[1:i])
} else if (type=='mean') {
res[i] <- mean(x[1:i])
} else stop('invalid type')
}
return(res)
}
get.linear.fit <- function(y, x, x.new) {
y.new <- rep(NA, length(x.new))
for (i in 1:length(x.new)) {
ind.last <- which(x>=x.new[i])[1]
ind.first <- tail(which(x<=x.new[i]),1)
y.new[i] <-  (y[ind.last]+y[ind.first])/2
}
# tmp<-get.linear.fit(c(y),x,x.new)
# x11()
# plot(tmp$x, tmp$y, type='l')
# points(x, c(y), type='l')
return(list(x=x.new, y=y.new))
}
# drop excess dimension
merged.final.test.wec <- lapply(merged.final.test.wec, drop.param.dims)
# look at the results
to.plot <- simplify2array(merged.final.test.wec)
to.plot
to.plot[,1:4]
matplot(to.plot[,1:4])
matplot(to.plot[,1:4], type='l')
colMeans(to.plot[,1:4])
anywork <- which(apply(to.plot[,1:4]>0),1,any))
anywork <- which(apply(to.plot[,1:4]>0),1,any)
anywork <- which(apply(to.plot[,1:4]>0),1,any))
anywork <- which(apply(to.plot[,1:4]>0,1,any)
)
anywork
colMeans(to.plot[anywork,1:4])
172/144
colMeans(to.plot[,1:4])
110/132
132/110
q()
anywork <- which(apply(to.plot[,1:4]>0,1,any)
)
version()
source('/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/r_e_pb17.R')
source('/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/r_e_pb17.R')
source('/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/r_e_pb17.R')
source("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/r_e_pb17.R")
load("/m/cs/scratch/fidipro_hm/data_sets/fidipro/almost_final_data.RData")
rm(list=ls())
load("/m/cs/scratch/fidipro_hm/data_sets/fidipro/almost_final_data.RData")
ls()
dimnames(weather.array)
source('/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/r_e_pb17.R')
View()
View(generate.data.matrices)
source('/m/cs/scratch/fidipro_hm/CODE_BASE/fidipro/general/generate_data_matrices2.R')
model.inputs.new <- generate.data.matrices(setup = setup, validation.fold=validation.fold, test.fold = test.fold, gauss.par=gauss.par, env.data.mod = e.d.m, raw.data.path =  experiment$paths$raw.data.path, inds.save.path= experiment$paths$inds.path, pheno=pheno)
dimnames(data.matrices$organized.weather$temperature.matrix)
dimnames(data.matrices$organized.weather$rain.matrix)
dimnames(data.matrices$organized.weather$rain.matrix)[[2]]
dimnames(data.matrices$organized.weather$temperature.matrix)[[2]]
source('/m/cs/scratch/agriml/EXPERIMENTS/e_cr1/r_e_cr1.R')
options(error=recover)
source('/m/cs/scratch/agriml/EXPERIMENTS/e_cr1/r_e_cr1.R')
7
genotype.matrix
str(genotype.matrix)
dim(genotype.matrix)
ls()
possible.combs
possible.combs
ls()
possible.combs
source('/m/cs/scratch/agriml/EXPERIMENTS/e_cr1/r_e_cr1.R')
genotype.matrix <- matrix(rnorm(length(current.ids)^2), nrow=length(current.ids))
genotype.matrix
rownames(genotype.matrix) <- current.ids
colnames(genotype.matrix) <- paste('cov', 1:length(current.ids), sep='')
dimnames(genotype.matrix)
library(lattice)
levelplot(genotype.matrix%*%t(genotype.matrix))
?rbinom
rbinom(prob=rep(MAFs, each=length(current.ids)))
MAFs <- runif(length(current.ids))
MAFs <- rep(MAFs, each=length(current.ids))
MAFs
rbinom(n=lenght(MAFs), prob=MAFs)
MAFs <- rep(MAFs, each=lenght(current.ids))
length(current.ids)
MAFs <- rep(MAFs, each=length(current.ids))
MAFs
rbinom(n=lenght(MAFs), prob=MAFs)
rbinom(n=length(MAFs), prob=MAFs)
rbinom(n=length(MAFs), size=2, prob=MAFs)
genotype.matrix <- matrix(rbinom(n=length(MAFs), size=2, prob=MAFs), nrow(length(current.ids)))
genotype.matrix <- matrix(rbinom(n=length(MAFs), size=2, prob=MAFs), nrow=length(current.ids))
rownames(genotype.matrix) <- current.ids
colnames(genotype.matrix) <- paste('cov', 1:length(current.ids), sep='')
dim(genotype.matrix)
MAFs <- runif(length(current.ids))
MAFs <- rep(MAFs, each=length(current.ids))
genotype.matrix <- matrix(rbinom(n=length(MAFs), size=2, prob=MAFs), nrow=length(current.ids))
dim(genotype.matrix)
rownames(genotype.matrix) <- current.ids
colnames(genotype.matrix) <- paste('cov', 1:length(current.ids), sep='')
genotype.matrix
colMeans(genotype.matrix)/2
rownames(genotype.matrix)
cv.inds.3d <- get.3d.cv.inds(data.matrices=data.matrices, pheno.array.all=data.matrices$pheno.array.all, genotype.matrix=genotype.matrix, set.table=set.table, setup=setup, pheno=pheno, e.d.m = env.data.mod)
set.table
source('/m/cs/scratch/agriml/EXPERIMENTS/e_cr1/r_e_cr1.R')
sets.to.break
sets
set.matr <- matrix(sets, nrow=nrow(pheno.obs.tmp ), ncol=ncol(pheno.obs.tmp ))
set.matr
ls()
3*12.5*3.5*1.7
source('/m/cs/scratch/agriml/EXPERIMENTS/e_pb17/r_e_pb17.R')
source('/m/cs/scratch/agriml/EXPERIMENTS/e_pb17/r_e_pb17.R')
source('/m/cs/scratch/agriml/EXPERIMENTS/e_pb17/r_e_pb17.R')
source('/m/cs/scratch/agriml/EXPERIMENTS/e_pb17/r_e_pb17.R')
source('/m/cs/scratch/agriml/EXPERIMENTS/e_pb17/r_e_pb17.R')
source('/m/cs/scratch/agriml/EXPERIMENTS/e_pb17/r_e_pb17.R')
1e6/30
(1e6-86822)/30
source('/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/r_e_pb17.R')
rm(list=ls())
# load data
load("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/indexes/model_inputs_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_e.d.m_1_validation.fold_1.RData")
# functions
source(paste(experiment$paths$base.codes.path,'/process_kernels.R', sep=''))
#
# data structure for storing model and other parameters
learnt.params <- list()
# normalize environment kernels wrt summed variance
learnt.params$kernel.normalizers.env <- unlist(lapply(model.inputs$env.kernels$train, function(x){sqrt(1/sum(apply(x,2,var)))}))
# same for genotypes
learnt.params$kernel.normalizers.geno <- unlist(lapply(model.inputs$geno.kernels$train, function(x){sqrt(1/sum(apply(x,2,var)))}))
experiment$paths$base.codes.path
source('/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/r_e_pb17.R')
experiment$paths$base.codes.path
source(paste(experiment$paths$base.codes.path,'/process_kernels.R', sep=''))
learnt.params <- list()
load("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/indexes/model_inputs_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_e.d.m_1_validation.fold_1.RData")
learnt.params$kernel.normalizers.env <- unlist(lapply(model.inputs$env.kernels$train, function(x){sqrt(1/sum(apply(x,2,var)))}))
learnt.params$kernel.normalizers.geno <- unlist(lapply(model.inputs$geno.kernels$train, function(x){sqrt(1/sum(apply(x,2,var)))}))
pars <- list()
pars$ker.sel <- g.ker.sel
pars$weight.bias <- NULL
Kx <- process.kernels(kernels.to.normalize=model.inputs$geno.kernels$train, kernel.normalizers=learnt.params$kernel.normalizers.geno, pars=pars)
pars <- list()
if (exists('e.ker.sel')) {
pars$ker.sel <- e.ker.sel
pars$weight.bias <- NULL
} else pars$weight.bias <- 0
Kz <- process.kernels(kernels.to.normalize=model.inputs$env.kernels$train, kernel.normalizers=learnt.params$kernel.normalizers.env, pars=pars)
# Re-normalize in case '_1k'
if (length(grep(x=method, pattern='_1k'))>0) {
learnt.params$kernel.normalizer.1k <- sqrt(1/sum(apply(drop(Kz),2,var)))
Kz <- Kz * learnt.params$kernel.normalizer.1k
}
learnt.params$pheno.variables <- unique(model.inputs$pheno.data$train$column.key['fenotyyppi', ])
varargin <- set.parameters(method, seed, pheno.matr=model.inputs$pheno.data$train$pheno.matrix, learnt.params, filenames.list=experiment$current.run$filenames.list, column.key=model.inputs$pheno.data$train$column.key)
source(paste0(experiment$paths$base.codes.path, 'source_demo_code.R'))
experiment$paths$base.codes.path <- '/u/85/lgillber/unix/Desktop/bioinformatics_koodit/general'
source(paste0(experiment$paths$base.codes.path, 'source_demo_code.R'))
source(paste0(experiment$paths$base.codes.path, '/source_demo_code.R'))
experiment$paths$kbmf_v2
rm(list=ls())
experiment <- list()
experiment$paths <- list()
experiment$paths$base.codes.path <- '/u/85/lgillber/unix/Desktop/bioinformatics_koodit/general'
experiment$paths$kbmf <- '/u/85/lgillber/unix/Desktop/bioinformatics_koodit/kbmf'
# load data
load("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/indexes/model_inputs_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_e.d.m_1_validation.fold_1.RData")
# source all functions
source(paste0(experiment$paths$base.codes.path, '/source_demo_code.R'))
source.code()
# data structure for storing model and other parameters
learnt.params <- list()
# normalize environment kernels wrt summed variance
learnt.params$kernel.normalizers.env <- unlist(lapply(model.inputs$env.kernels$train, function(x){sqrt(1/sum(apply(x,2,var)))}))
# same for genotypes
learnt.params$kernel.normalizers.geno <- unlist(lapply(model.inputs$geno.kernels$train, function(x){sqrt(1/sum(apply(x,2,var)))}))
# Genotype: process the kernels into the KBMF format
pars <- list()
pars$ker.sel <- g.ker.sel
pars$weight.bias <- NULL
Kx <- process.kernels(kernels.to.normalize=model.inputs$geno.kernels$train, kernel.normalizers=learnt.params$kernel.normalizers.geno, pars=pars)
rm(list=ls())
experiment <- list()
experiment$paths <- list()
experiment$paths$base.codes.path <- '/u/85/lgillber/unix/Desktop/bioinformatics_koodit/general'
experiment$paths$kbmf <- '/u/85/lgillber/unix/Desktop/bioinformatics_koodit/kbmf'
# load data
load("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/indexes/model_inputs_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_e.d.m_1_validation.fold_1.RData")
# source all functions
source(paste0(experiment$paths$base.codes.path, '/source_demo_code.R'))
source.code()
# data structure for storing model and other parameters
learnt.params <- list()
# normalize environment kernels wrt summed variance
learnt.params$kernel.normalizers.env <- unlist(lapply(model.inputs$env.kernels$train, function(x){sqrt(1/sum(apply(x,2,var)))}))
# same for genotypes
learnt.params$kernel.normalizers.geno <- unlist(lapply(model.inputs$geno.kernels$train, function(x){sqrt(1/sum(apply(x,2,var)))}))
# Genotype: process the kernels into the KBMF format
pars <- list()
pars$ker.sel <- g.ker.sel
pars$weight.bias <- NULL
Kx <- process.kernels(kernels.to.normalize=model.inputs$geno.kernels$train, kernel.normalizers=learnt.params$kernel.normalizers.geno, pars=pars)
source('/m/home/home8/85/lgillber/unix/Desktop/bioinformatics_koodit/example_script.R')
source('/m/home/home8/85/lgillber/unix/Desktop/bioinformatics_koodit/example_script.R')
source('/m/home/home8/85/lgillber/unix/Desktop/bioinformatics_koodit/example_script.R')
source('/m/home/home8/85/lgillber/unix/Desktop/bioinformatics_koodit/example_script.R')
source('/m/home/home8/85/lgillber/unix/Desktop/bioinformatics_koodit/example_script.R')
source('/m/home/home8/85/lgillber/unix/Desktop/bioinformatics_koodit/example_script.R')
source('/m/home/home8/85/lgillber/unix/Desktop/bioinformatics_koodit/example_script.R')
load.path
options(error=recover)
source('/m/home/home8/85/lgillber/unix/Desktop/bioinformatics_koodit/example_script.R')
View(process.kernels)
load("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_1/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_1way_g_2way_fe_1k/learnt_params_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_1way_g_2way_fe_1k_K_2_var.coef_0.4_PTVE.1.way.Z_0.95_PTVE.1.way.X_0.95_PTVE.2.way_0.5_n.iter_500_init.mode_3_validation.fold_10.RData")
learnt.params$state$parameters$fix.ez
View(learn.GBLUP.pars)
load("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_1/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/GBLUP_REML_FE/learnt_params_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_GBLUP_REML_FE_method.sel_REML_validation.fold_1.RData")
learnt.params$GBLUP.preds
c(learnt.params$GBLUP.preds)
rm(list=ls())
experiment <- list()
experiment$paths <- list()
experiment$paths$base.codes.path <- '/u/85/lgillber/unix/Desktop/bioinformatics_koodit/general'
experiment$paths$kbmf <- '/u/85/lgillber/unix/Desktop/bioinformatics_koodit/kbmf'
experiment$paths$GBLUP_MOD <- '/u/85/lgillber/unix/Desktop/bioinformatics_koodit/GBLUP_exps/'
0
rm(list=ls())
experiment <- list()
experiment$paths <- list()
experiment$paths$base.codes.path <- '/u/85/lgillber/unix/Desktop/bioinformatics_koodit/general'
experiment$paths$kbmf <- '/u/85/lgillber/unix/Desktop/bioinformatics_koodit/kbmf'
experiment$paths$GBLUP_MOD <- '/u/85/lgillber/unix/Desktop/bioinformatics_koodit/GBLUP_exps/'
load("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/indexes/model_inputs_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_e.d.m_1_validation.fold_1.RData")
source(paste0(experiment$paths$base.codes.path, '/source_demo_code.R'))
source(paste0(experiment$paths$base.codes.path, '/set_dummy_parameters.R'))
source.code(experiment)
learnt.params <- list()
method <- 'GBLUP_REML_FE'
learnt.params <- learn.GBLUP.pars(model.inputs, g.ker.sel, method)
preds1<- learnt.params$GBLUP.preds
learnt.params.new <- learnt.params$GBLUP.preds
load("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_1/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/GBLUP_REML_FE/learnt_params_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_GBLUP_REML_FE_method.sel_REML_validation.fold_1.RData")
learnt.params$GBLUP.preds-learnt.params.new
sum(abs(learnt.params$GBLUP.preds-learnt.params.new))
mean(abs(learnt.params$GBLUP.preds-learnt.params.new))
my.path <- '/u/85/lgillber/unix/Desktop/bioinformatics_koodit/'
?save
test.fold <- 1
validation.fold <- 1
save(learnt.params, file=paste0(my.path, 'tf_', test.fold, '/', 'vf_', validation.fold, '/GBLUP/GBLUP_preds.RData'))
?save
path.tmp <- paste0(my.path, 'runs/tf_', test.fold, '/', 'vf_', validation.fold, '/GBLUP')
path.tmp
?mkdir
?dir.create
?file.exists
path.tmp <- paste0(my.path, 'runs/tf_', test.fold, '/', 'vf_', validation.fold, '/GBLUP')
file.exists(path.tmp)
if (!file.exists(path.tmp)) dir.create(path.tmp, recursive = TRUE)
save(learnt.params, file=paste0(path.tmp, '/GBLUP_preds.RData'))
load("/u/85/lgillber/unix/Desktop/bioinformatics_koodit/runs/tf_1/vf_1/GBLUP/GBLUP_preds.RData")
learnt.params
learnt.params$feno
load("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_1/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/learnt_params_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_1_n.iter_1000_validation.fold_3.RData")
test.fold
validation.fold
load(paste0("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_",test.fold,"/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/learnt_params_setup_1_test.fold_",test.fold,"_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_1_n.iter_1000_validation.fold_",validation.fold,".RData"))
learnt.params$state$parameters$seed
seeds <- list()
seeds$KBMF_weights <- list()
seeds$KBMF_weights$ncv <- matrix(NA, 41,10)
seeds$KBMF_weights$cv <- rep(NA, 41)
View(set.parameters.lw)
seeds$KBMF_weights$ncv[test.fold, validation.fold] <- learnt.params$state$parameters$seed
seeds$KBMF_weights$ncv[test.fold, validation.fold]
load(paste0("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_",test.fold,"/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/learnt_params_setup_1_test.fold_",test.fold,"_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_1_n.iter_1000.RData"))
load(paste0("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_",test.fold,"/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/final_learnt_params_setup_1_test.fold_",test.fold,"_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_1_n.iter_1000.RData"))
load('/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_1/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/final_learnt_params_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_0_n.iter_1000.RData')
load(paste0("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_",test.fold,"/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/final_learnt_params_setup_1_test.fold_",test.fold,"_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_0_n.iter_1000.RData"))
for (test.fold in 1:41) {
for (validation.fold in 1:10) {
load(paste0("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_",test.fold,"/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/learnt_params_setup_1_test.fold_",test.fold,"_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_0_n.iter_1000_validation.fold_",validation.fold,".RData"))
seeds$KBMF_weights$ncv[test.fold, validation.fold] <- learnt.params$state$parameters$seed
}
load(paste0("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_",test.fold,"/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/final_learnt_params_setup_1_test.fold_",test.fold,"_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_0_n.iter_1000.RData"))
seeds$KBMF_weights$ncv[test.fold] <- learnt.params$state$parameters$seed
}
# collect seeds
seeds <- list()
seeds$KBMF_weights <- list()
seeds$KBMF_weights$ncv <- matrix(NA, 41,10)
seeds$KBMF_weights$cv <- rep(NA, 41)
for (test.fold in 1:41) {
for (validation.fold in 1:10) {
tmp.path <- paste0("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_",test.fold,"/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/learnt_params_setup_1_test.fold_",test.fold,"_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_0_n.iter_1000_validation.fold_",validation.fold,".RData")
if (file.exists(tmp.path)) {
load(tmp.path)
seeds$KBMF_weights$ncv[test.fold, validation.fold] <- learnt.params$state$parameters$seed
}
}
tmp.path <- paste0("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_",test.fold,"/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/final_learnt_params_setup_1_test.fold_",test.fold,"_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_0_n.iter_1000.RData")
if (file.exists(tmp.path)) {
load(tmp.path)
seeds$KBMF_weights$ncv[test.fold] <- learnt.params$state$parameters$seed
}
}
seeds$KBMF_weights$cv
tmp.path
file.exists(tmp.path)
load(tmp.path)
ls()
learnt.params$state$parameters$seed
learnt.params$state$parameters$seed
file.exists(tmp.path)
for (test.fold in 1:41) {
for (validation.fold in 1:10) {
tmp.path <- paste0("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_",test.fold,"/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/learnt_params_setup_1_test.fold_",test.fold,"_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_0_n.iter_1000_validation.fold_",validation.fold,".RData")
if (file.exists(tmp.path)) {
load(tmp.path)
seeds$KBMF_weights$ncv[test.fold, validation.fold] <- learnt.params$state$parameters$seed
}
}
tmp.path <- paste0("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_",test.fold,"/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/final_learnt_params_setup_1_test.fold_",test.fold,"_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_0_n.iter_1000.RData")
if (file.exists(tmp.path)) {
load(tmp.path)
seeds$KBMF_weights$cv[test.fold] <- learnt.params$state$parameters$seed
}
}
seeds$KBMF_weights$cv
test.fold<-1
validation.fold <- 1
seed <- seeds$KBMF_weights$ncv[test.fold, validation.fold]
set.seed(seed=seed)
learnt.params$kernel.normalizers.env <- unlist(lapply(model.inputs$env.kernels$train, function(x){sqrt(1/sum(apply(x,2,var)))}))
learnt.params$kernel.normalizers.geno <- unlist(lapply(model.inputs$geno.kernels$train, function(x){sqrt(1/sum(apply(x,2,var)))}))
pars <- list()
pars$ker.sel <- g.ker.sel
pars$weight.bias <- NULL
Kx <- process.kernels(kernels.to.normalize=model.inputs$geno.kernels$train, kernel.normalizers=learnt.params$kernel.normalizers.geno, pars=pars)
pars <- list()
e.ker.sel <- 1
rm(e.ker.sel)
e.ker.sel
if (exists('e.ker.sel')) {
pars$ker.sel <- e.ker.sel
pars$weight.bias <- NULL
} else pars$weight.bias <- 0
Kz <- process.kernels(kernels.to.normalize=model.inputs$env.kernels$train, kernel.normalizers=learnt.params$kernel.normalizers.env, pars=pars)
library(abind)
Kz <- process.kernels(kernels.to.normalize=model.inputs$env.kernels$train, kernel.normalizers=learnt.params$kernel.normalizers.env, pars=pars)
method
method <- 'KBMF_weights'
parameters <- set.parameters.lw(method, seed)#, pheno.matr=model.inputs$pheno.data$train$pheno.matrix, learnt.params, filenames.list=experiment$current.run$filenames.list, column.key=model.inputs$pheno.data$train$column.key)
ytrain <- colMeans(model.inputs$pheno.data$train$pheno.matrix, na.rm = TRUE)
time.start <- proc.time()[[3]]
#perform training
state <- bemkl_supervised_regression_variational_train(Km=Kz, y=ytrain, parameters=parameters)
time.finished <- proc.time()[[3]]
run.time <- time.finished - time.start
experiment$paths$learn_weights <- '/u/85/lgillber/unix/Desktop/bioinformatics_koodit/BMKL/'
wd.old <- getwd()
wd.old
setwd(experiment$paths$learn_weights)
source("bemkl_supervised_regression_variational_train.R")
source("bemkl_supervised_regression_variational_test.R")
time.start <- proc.time()[[3]]
#source("kbmf1k1mkl/kbmf1k1mkl_semisupervised_regression_variational_train.R")
state <- kbmf_regression_train(Kx=Kx, Kz=Kz, Y=model.inputs$pheno.data$train$pheno.matrix, R=K, varargin=varargin)
time.finished <- proc.time()[[3]]
run.time <- time.finished - time.start
learnt.params$state <- state
time.start <- proc.time()[[3]]
#perform training
state <- bemkl_supervised_regression_variational_train(Km=Kz, y=ytrain, parameters=parameters)
time.finished <- proc.time()[[3]]
ytrain
dim(Kz)
state <- bemkl_supervised_regression_variational_train(Km=Kz, y=ytrain, parameters=parameters)
View(set.parameters.lw)
par.comb <- 2
var.A <- 0.1
bias <- 0
n.iter <- 1000
parameters <- set.parameters.lw(method, seed)#, pheno.matr=model.inputs$pheno.data$train$pheno.matrix, learnt.params, filenames.list=experiment$current.run$filenames.list, column.key=model.inputs$pheno.data$train$column.key)
time.start <- proc.time()[[3]]
#perform training
state <- bemkl_supervised_regression_variational_train(Km=Kz, y=ytrain, parameters=parameters)
time.finished <- proc.time()[[3]]
learnt.params$state$a
dim(learnt.params$state$a)
str(learnt.params$state$a)
learnt.params.new <- learnt.params
test.fold
validation.fold
load("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_1/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/learnt_params_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_0_n.iter_1000_validation.fold_1.RData")
View(bemkl_supervised_regression_variational_test())
View(bemkl_supervised_regression_variational_test
)
sum(abs(learnt.params$state$a$mu-learnt.params.new$state$a$mu))
dim(learnt.params$state$a$mu)
dim(learnt.params.new$state$a$mu)
dim(model.inputs$env.kernels$train$env.kernel)
dim(Kz)
learnt.params<-list()
time.start <- proc.time()[[3]]
#perform training
state <- bemkl_supervised_regression_variational_train(Km=Kz, y=ytrain, parameters=parameters)
time.finished <- proc.time()[[3]]
run.time <- time.finished - time.start
learnt.params$state <- state
learnt.params.new <- learnt.params
load("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_1/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_weights/learnt_params_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_weights_par.comb_2_var.A_0.1_bias_0_n.iter_1000_validation.fold_1.RData")
sum(abs(learnt.params$state$a$mu-learnt.params.new$state$a$mu))
path.tmp <- paste0(my.path, 'runs/tf_', test.fold, '/', 'vf_', validation.fold, '/BEMKL_weights')
path.tmp
if (!file.exists(path.tmp)) dir.create(path.tmp, recursive = TRUE)
save(learnt.params, file=paste0(path.tmp, '/BEMKL_weights.RData'))
method <- 'KBMF_1way_g_2way_fe_1k'
learnt.params$kernel.normalizers.env <- unlist(lapply(model.inputs$env.kernels$train, function(x){sqrt(1/sum(apply(x,2,var)))}))
learnt.params$kernel.normalizers.geno <- unlist(lapply(model.inputs$geno.kernels$train, function(x){sqrt(1/sum(apply(x,2,var)))}))
pars <- list()
pars$ker.sel <- g.ker.sel
pars$weight.bias <- NULL
Kx <- process.kernels(kernels.to.normalize=model.inputs$geno.kernels$train, kernel.normalizers=learnt.params$kernel.normalizers.geno, pars=pars)
pars <- list()
if (exists('e.ker.sel')) {
pars$ker.sel <- e.ker.sel
pars$weight.bias <- NULL
} else pars$weight.bias <- 0
Kz <- process.kernels(kernels.to.normalize=model.inputs$env.kernels$train, kernel.normalizers=learnt.params$kernel.normalizers.env, pars=pars)
options(error=recover)
Kz <- process.kernels(kernels.to.normalize=model.inputs$env.kernels$train, kernel.normalizers=learnt.params$kernel.normalizers.env, pars=pars)
load.path
experiment$current.run$filenames.list$model.filename
path.tmp
load("/media/lgillber/6701-5068/BU/e_pb17/collectors/edm1/collector_KBMF_1way_g_2way_fe_hst_1k_1.RData")
dim(test.set.scores.tables$KBMF_1way_g_2way_fe_hst_1k$MSE)
dimnames(drop(test.set.scores.tables$KBMF_1way_g_2way_fe_hst_1k$MSE))
load("/media/lgillber/6701-5068/BU/e_pb17/collectors/edm1/collector_FINAL_runs.RData")
dimnames(drop(final.param.scores.tables$KBMF_1way_g_2way_fe_1k$within.exp.cors))
load("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_1/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_1way_g_2way_fe_1k/learnt_params_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_1way_g_2way_fe_1k_K_2_var.coef_0.4_PTVE.1.way.Z_0.95_PTVE.1.way.X_0.95_PTVE.2.way_0.5_n.iter_500_init.mode_1_validation.fold_1.RData")
seeds$KBMF_1way_g_2way_fe_1k <- list()
seeds$KBMF_1way_g_2way_fe_1k$ncv <- array(NA, dim=c(length(ranks), length(var.coefs), length(PTVE.2.ways)), dimnames = list(paste0('K=', ranks), paste0('var.coef=', var.coefs), paste0('PTVE.2.way=', PTVE.2.ways)))
ranks <- c(3,4,5)
var.coefs <- c(0.4,0.8,1.2)
PTVE.2.ways <- c(0.5, 1)
seeds$KBMF_1way_g_2way_fe_1k$ncv <- array(NA, dim=c(length(ranks), length(var.coefs), length(PTVE.2.ways)), dimnames = list(paste0('K=', ranks), paste0('var.coef=', var.coefs), paste0('PTVE.2.way=', PTVE.2.ways)))
dim(seeds$KBMF_1way_g_2way_fe_1k$ncv)
dimnames(seeds$KBMF_1way_g_2way_fe_1k$ncv)
load("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_1/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_1way_g_2way_fe_1k/learnt_params_setup_1_test.fold_1_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_1way_g_2way_fe_1k_K_2_var.coef_0.4_PTVE.1.way.Z_0.95_PTVE.1.way.X_0.95_PTVE.2.way_0.5_n.iter_500_init.mode_1_validation.fold_1.RData")
K<-3
var.coef<-0.4
PTVE.2.way <- 0.5
tmp.path <- paste0("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_", test.fold, "/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_1way_g_2way_fe_1k/learnt_params_setup_1_test.fold_", test.fold,"_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_1way_g_2way_fe_1k_K_", K,"_var.coef_", var.coef, "_PTVE.1.way.Z_0.95_PTVE.1.way.X_0.95_PTVE.2.way_", PTVE.2.way, "_n.iter_500_init.mode_1_validation.fold_", validation.fold, ".RData")
file.exists(tmp.path)
load(tmp.path)
learnt.params$state$parameters$seed
dimnames(seeds$KBMF_1way_g_2way_fe_1k$ncv)[[3]]
dimnames(seeds$KBMF_1way_g_2way_fe_1k$ncv)
seeds$KBMF_1way_g_2way_fe_1k <- list()
seeds$KBMF_1way_g_2way_fe_1k$ncv <- array(NA, dim=c(41, 10, length(ranks), length(var.coefs), length(PTVE.2.ways)), dimnames = list(paste0('K=', ranks), paste0('var.coef=', var.coefs), paste0('PTVE.2.way=', PTVE.2.ways)))
seeds$KBMF_1way_g_2way_fe_1k <- list()
seeds$KBMF_1way_g_2way_fe_1k$ncv <- array(NA, dim=c(41, 10, length(ranks), length(var.coefs), length(PTVE.2.ways)), dimnames = list('tf', 'vf', paste0('K=', ranks), paste0('var.coef=', var.coefs), paste0('PTVE.2.way=', PTVE.2.ways)))
ranks <- c(3,4,5)
var.coefs <- c(0.4,0.8,1.2)
PTVE.2.ways <- c(0.5, 1)
seeds$KBMF_1way_g_2way_fe_1k <- list()
seeds$KBMF_1way_g_2way_fe_1k$ncv <- array(NA, dim=c(41, 10, length(ranks), length(var.coefs), length(PTVE.2.ways)), dimnames = list('tf', 'vf', paste0('K=', ranks), paste0('var.coef=', var.coefs), paste0('PTVE.2.way=', PTVE.2.ways)))
ranks <- c(3,4,5)
var.coefs <- c(0.4,0.8,1.2)
PTVE.2.ways <- c(0.5, 1)
seeds$KBMF_1way_g_2way_fe_1k <- list()
seeds$KBMF_1way_g_2way_fe_1k$ncv <- array(NA, dim=c(41, 10, length(ranks), length(var.coefs), length(PTVE.2.ways)), dimnames = list(paste0('tf=', 1:41), paste0('vf=', 1:10), paste0('K=', ranks), paste0('var.coef=', var.coefs), paste0('PTVE.2.way=', PTVE.2.ways)))
dimnames(seeds$KBMF_1way_g_2way_fe_1k$ncv)
tmp.path <- paste0("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_", test.fold, "/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_1way_g_2way_fe_1k/learnt_params_setup_1_test.fold_", test.fold,"_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_1way_g_2way_fe_1k_K_", K,"_var.coef_", var.coef, "_PTVE.1.way.Z_0.95_PTVE.1.way.X_0.95_PTVE.2.way_", PTVE.2.way, "_n.iter_500_init.mode_1_validation.fold_", validation.fold, ".RData")
K<-3
var.coef<-0.4
PTVE.2.way <- 0.5
tmp.path <- paste0("/m/cs/scratch/fidipro_hm/EXPERIMENTS/e_pb17/runs/pheno_sato/setup_1/test_fold_", test.fold, "/e_ds.f_1/g_ds.f_1/e_d.m_1/gauss_par_1/g_ker.sel_1/KBMF_1way_g_2way_fe_1k/learnt_params_setup_1_test.fold_", test.fold,"_g.ds.f_1_e.ds.f_1_gauss.par_1_pheno_sato_g.ker.sel_1_e.d.m_1_method_KBMF_1way_g_2way_fe_1k_K_", K,"_var.coef_", var.coef, "_PTVE.1.way.Z_0.95_PTVE.1.way.X_0.95_PTVE.2.way_", PTVE.2.way, "_n.iter_500_init.mode_1_validation.fold_", validation.fold, ".RData")
load(tmp.path)
K.ind <- which(dimnames(seeds$KBMF_1way_g_2way_fe_1k$ncv)[[3]] == paste0("K=", K))
K.ind
var.coef.ind <- which(dimnames(seeds$KBMF_1way_g_2way_fe_1k$ncv)[[4]] == paste0("var.coef=", var.coef))
var.coef.ind
PTVE.2.ind <- which(dimnames(seeds$KBMF_1way_g_2way_fe_1k$ncv)[[5]] == paste0("PTVE.2.way=", PTVE.2.way))
seeds$KBMF_1way_g_2way_fe_1k$ncv[test.fold, validation.fold, K.ind, var.coef.ind, PTVE.2.ind]
seeds$KBMF_1way_g_2way_fe_1k$ncv[test.fold, validation.fold, K.ind, var.coef.ind, PTVE.2.ind] <- learnt.params$state$parameters$seed
seeds$KBMF_1way_g_2way_fe_1k$ncv[test.fold, validation.fold, K.ind, var.coef.ind, PTVE.2.ind]
source('/m/home/home8/85/lgillber/unix/Desktop/bioinformatics_koodit/example_script.R')
View(PTVE.2.way)
View(kbmf_regression_train())
View(kbmf_regression_train
)
