-
Notifications
You must be signed in to change notification settings - Fork 2
/
misc.R
168 lines (158 loc) · 6.38 KB
/
misc.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
library(RColorBrewer)
library(gplots)
library(CoRC)
library(stringr)
test_khi2 <- function(nb_points, k_val, nb_par){
# Perform Khi2 statistical test.
#
# Args:
# nb_points (int): number of data points
# k_val (float): khi2 value (cost)
# nb_par (int): number of free parameters
#
# Returns (list):
# $'khi2 value' (float): khi2 value (cost)
# $'data points' (int): number of data points
# $'fitted parameters' (int): number of free parameters
# $'degrees of freedom' (int): degrees of freedom
# $'khi2 reduced value' (float): chi2 reduced value
# $'p-value, i.e. P(X^2<=value)' (float): p value
# $conclusion (str): message indicating whether the models fits (or not) the data at 95% confidence interval
#
df <- nb_points - nb_par
p_val <- pchisq(k_val, df=df)
khi2test <- list("khi2 value" = k_val,
"data points" = nb_points,
"fitted parameters" = nb_par,
"degrees of freedom" = df,
"khi2 reduced value" = k_val/df,
"p-value, i.e. P(X^2<=value)" = p_val)
if (p_val > 0.95){
khi2test$conclusion <- "At level of 95% confidence, the model does not fit the data good enough with respect to the provided measurement SD."
}else{
khi2test$conclusion <- "At level of 95% confidence, the model fits the data good enough with respect to the provided measurement SD."
}
return(khi2test)
}
plot_points <- function(x, y, sd, col="black", offset=1.5, mode="v", cex=1){
# Scatterplot with error bars.
#
# Args:
# x (vector): x coordinates
# y (vector): y coordinates
# sd (vector): error bars
# col (color code): color of points
# offset (float): width (or height if mode = 'v') of error bars
# mode ('v' or 'h'): errors of y (if mode='v') or x (if mode='h')
#
if (mode == "v"){
segments(x0=x, y0=y-sd, x1=x, y1=y+sd)
segments(x0=x-offset, y0=y+sd, x1=x+offset, y1=y+sd)
segments(x0=x-offset, y0=y-sd, x1=x+offset, y1=y-sd)
}else if (mode == "h"){
segments(x0=x-sd, y0=y, x1=x+sd, y1=y)
segments(x0=x+sd, y0=y-offset, x1=x+sd, y1=y+offset)
segments(x0=x-sd, y0=y-offset, x1=x-sd, y1=y+offset)
}
points(x, y, pch=21, bg=col, col="black", cex=cex)
}
lines_threshold <- function(x, y, threshold, new, ...){
# Split data according to a given threshold, and plot lines for
# each set.
#
# Args:
# x (vector): x coordinates
# y (vector): y coordinates
# threshold (float): value of x at which lines should not
# be connected
# new (bool): create a new plot if TRUE, otherwise add
# lines to an existing plot
#
id_1 <- (x < threshold)
id_2 <- (x > threshold)
if (new){
plot(x[id_1], y[id_1], ...)
}else{
suppressWarnings(lines(x[id_1], y[id_1], ...))
}
suppressWarnings(lines(x[id_2], y[id_2], ...))
}
get_parameters_stats <- function(fit_results){
li <- grep("]_0", fit_results$res_par$parameter, fixed=TRUE, invert=TRUE)
tmp <- matrix(NA, nrow=length(li), ncol=6, dimnames=list(par=fit_results$res_par$parameter[li], stats=c("mean", "median", "ci95_lb", "ci95_up", "sd", "rsd")))
for (i in li){
data <- as.numeric(unlist(fit_results$res_par[i,-1]))
tmp[fit_results$res_par[i,1],] <- c(mean(data), median(data), quantile(data, probs = c(0.025, 0.975)), sd(data), sd(data)/mean(data))
}
return(tmp)
}
update_params <- function(model, rp){
setCurrentModel(model)
for (i in names(rp)){
if (grepl("_0", i, fixed = TRUE)){
next
}else if (grepl(".InitialValue", i, fixed = TRUE)){
k <- str_remove(i, ".InitialValue")
#print(getGlobalQuantities(key=k))
setGlobalQuantities(key=k, initial_value=rp[i])
#print(getGlobalQuantities(key=k))
}else{
#print(getParameters(key=i))
setParameters(key=i, value=rp[i])
#print(getParameters(key=i))
}
}
applyInitialState()
return(model)
}
plot_with_ci <- function(fit_results, cond, specie, col, ...){
if (specie %in% dimnames(fit_results[[cond]]$simulations)$specie){
specie_id <- specie
}else{
specie_id <- fit_results[[cond]]$mapping[specie]
}
plot(fit_results[[cond]]$simulations[1,,"Time"], apply(fit_results[[cond]]$simulations[,,specie_id], 2, mean), col=col, type="l", ...)
#polygon(x=c(fit_results[[cond]]$simulations[1,,"Time"], rev(fit_results[[cond]]$simulations[1,,"Time"])),
# y=c(apply(fit_results[[cond]]$simulations[,,specie_id], 2, max), rev(apply(fit_results[[cond]]$simulations[,,specie_id], 2, min))),
# col=paste(col, "33", sep=""), border=NA)
polygon(x=c(fit_results[[cond]]$simulations[1,,"Time"], rev(fit_results[[cond]]$simulations[1,,"Time"])),
y=c(apply(fit_results[[cond]]$simulations[,,specie_id], 2, max), rev(apply(fit_results[[cond]]$simulations[,,specie_id], 2, min))),
col=paste(col, "55", sep=""), border=NA)
plot_points(fit_results[[cond]]$data_exp$time,
fit_results[[cond]]$data_exp[, specie],
fit_results[[cond]]$sd[specie], offset=0.03, col=col, cex=1.2)
}
plot_with_ci_2 <- function(x1, y1, y2, x2, y3, sd_y3, col, h=NULL, ...){
plot(x1, y1, type="l", col=col, ...)
if (!is.null(h)){
abline(h=h)
}
polygon(x=c(x1, rev(x1)),
y=c(apply(y2, 2, max), rev(apply(y2, 2, min))),
col=paste(col, "55", sep=""), border=NA)
plot_points(x2, y3, sd_y3, offset=0.002, col=col)
}
plot_with_ci_3 <- function(sim_results, x, specie, col, ...){
plot(sim_results[1,,x], apply(sim_results[,,specie], 2, mean), col=col, type="l", ...)
polygon(x=c(sim_results[1,,x], rev(sim_results[1,,x])),
y=c(apply(sim_results[,,specie], 2, max), rev(apply(sim_results[,,specie], 2, min))),
col=paste(col, "55", sep=""), border=NA)
}
plot_no_ci <- function(fit_results, cond, specie, col, ...){
if (specie %in% dimnames(fit_results[[cond]]$simulations)$specie){
specie_id <- specie
}else{
specie_id <- fit_results[[cond]]$mapping[specie]
}
plot(fit_results[[cond]]$simulations[,"Time"], fit_results[[cond]]$simulations[,specie_id], col=col, type="l", ...)
plot_points(fit_results[[cond]]$data_exp$time,
fit_results[[cond]]$data_exp[, specie],
fit_results[[cond]]$sd[specie], offset=0.03, col=col, cex=1.2)
}
get_index_closest <- function(x, v){
idx <- c()
for (i in x){
idx <- c(idx, which.min(abs(v - i)))
}
return(idx)
}