polarolouis/mia-stage-2024
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Changing NA robustness for only uniform on a clearer structure

Browse source
This commit is contained in:
Louis Lacoste 2024-04-22 16:11:30 +02:00
parent d045a3d5fd
commit e40cfe42af
2 changed files with 51 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
code/scripts/migale_simulations_NA_robustness.sh
View file

@ -3,7 +3,7 @@
#$ -cwd
#$ -N NA_robustness_array
#$ -m besa
#$ -t 1:8
#$ -t 1:2
#$ -q short.q
#$ -pe thread 64
#$ -M louis.lacoste+migale@agroparistech.fr
@ -16,8 +16,7 @@
STRUCTA=("nested" "modular")
SAMPLINGA=("uniform" "row" "col" "rowcol")
STRUCT=${STRUCTA[$(($(($((SGE_TASK_ID - 1)) + $((SGE_TASK_ID - 1)) / 4)) % 2))]}
SAMPLING=${SAMPLINGA[$(($((SGE_TASK_ID - 1)) % 4))]}
STRUCT=${STRUCTA[$(($((SGE_TASK_ID - 1)) % 2))]}
BASE_DIR="/home/$USER/work/mia-stage-2024/"
LOG_DIR=$(echo "$BASE_DIR/logs")
@ -33,4 +32,4 @@ echo $SIMULATIONS_DIR
# Parsing sge array id
Rscript "${SIMULATIONS_DIR}/simulations_NA_robustness.R" --struct $STRUCT --sampling $SAMPLING
Rscript "${SIMULATIONS_DIR}/simulations_NA_robustness.R" --struct $STRUCT

83
code/simulations/simulations_NA_robustness.R
View file

@ -26,21 +26,12 @@ if (length(arg) == 0L) {
} else {
message("No structure provided, defaulting to modular.")
}
if ("--sampling" %in% arg) {
sampling <- arg[(which(arg == "--sampling") + 1L)]
} else {
message("No sampling provided, defaulting to uniform.")
}
}
#  Arguments checks
allowed_sampling <- c("uniform", "row", "col", "rowcol")
allowed_struct <- c("modular", "nested")
stopifnot(
"Unknown sampling, should be : uniform, row, rowcol" = (sampling %in%
allowed_sampling),
"Unknown structure, should be : modular or nested" = (struct %in% allowed_struct)
)
@ -48,27 +39,29 @@ set.seed(1234)
eps <- 0.05
M <- 4
M <- 2
# Defining parameters
nr <- 100
nc <- 150
nr1 <- 60
nc1 <- 60
nr2 <- 120
nc2 <- 120
pir <- c(0.5, 0.3, 0.2)
pic <- c(0.5, 0.3, 0.2)
alpha <- switch(struct,
"modular" = {
alpha <- matrix(c(
0.7, eps, eps,
eps, 0.4, eps,
eps, eps, 0.6
0.9, eps, eps,
eps, 0.2, eps,
eps, eps, 0.8
), byrow = TRUE, nrow = length(pir), ncol = length(pic))
},
"nested" = {
alpha <- matrix(c(
0.7, 0.4, 0.3,
0.4, 0.2, eps,
0.3, eps, eps
0.9, 0.25, 0.1,
0.3, 0.15, eps,
0.1, eps, eps
), byrow = TRUE, nrow = length(pir), ncol = length(pic))
}
)
@ -77,29 +70,49 @@ max_repetition <- 10L
# Collections
collections <- list(
"iid" = generate_bipartite_collection(nr, nc,
"iid" = c(generate_bipartite_collection(nr1, nc1,
pir, pic,
alpha, M,
alpha, 1,
model = "iid",
return_memberships = TRUE
),
"pi" = generate_bipartite_collection(nr, nc,
return_memberships = TRUE),
generate_bipartite_collection(nr2, nc2,
pir, pic,
alpha, M,
alpha, M-1,
model = "iid",
return_memberships = TRUE)
),
"pi" = c(generate_bipartite_collection(nr1, nc1,
pir, pic,
alpha, 1,
model = "pi",
return_memberships = TRUE
),
"rho" = generate_bipartite_collection(nr, nc,
return_memberships = TRUE),
generate_bipartite_collection(nr2, nc2,
pir, pic,
alpha, M,
alpha, M-1,
model = "pi",
return_memberships = TRUE)
),
"rho" = c(generate_bipartite_collection(nr1, nc1,
pir, pic,
alpha, 1,
model = "rho",
return_memberships = TRUE
),
"pirho" = generate_bipartite_collection(nr, nc,
return_memberships = TRUE),
generate_bipartite_collection(nr2, nc2,
pir, pic,
alpha, M,
alpha, M-1,
model = "rho",
return_memberships = TRUE)
),
"pirho" = c(generate_bipartite_collection(nr1, nc1,
pir, pic,
alpha, 1,
model = "pirho",
return_memberships = TRUE
return_memberships = TRUE),
generate_bipartite_collection(nr2, nc2,
pir, pic,
alpha, M-1,
model = "pirho",
return_memberships = TRUE)
)
)
@ -162,7 +175,7 @@ result_list <- parallel::mclapply(seq_len(nrow(conditions)), function(current) {
"row" = {
row_cluster_selected <- sample.int(n = length(pir), size = 1)
row_nodes_selected <- which(Z[[1]][[1]] == row_cluster_selected)
col_nodes_selected <- seq(1, nc)
col_nodes_selected <- seq(1, nc2)
NAs_selected_index_exp <- expand.grid(row = row_nodes_selected, col = col_nodes_selected)
@ -171,7 +184,7 @@ result_list <- parallel::mclapply(seq_len(nrow(conditions)), function(current) {
nrow(bipartite_collection_incidence[[1]]) + NAs_selected_index_exp[["row"]]
},
"col" = {
row_nodes_selected <- seq(1, nr)
row_nodes_selected <- seq(1, nr2)
col_cluster_selected <- sample.int(n = length(pic), size = 1)
col_nodes_selected <- which(Z[[1]][[2]] == col_cluster_selected)