print_header = function(ind, ind_min, ind_max, ind_n, param_names, param_values,
state_names, state_values, multiple_states) {
if (multiple_states) {
state_values = recycle(state_values)
glue::glue(
"<<ind>> = seq(<<ind_min>>, <<ind_max>>, length.out = <<ind_n>>)\n",
"parameters = c(<<paste(param_names, '=', param_values, collapse = ', ')>>)\n",
"<<paste(state_names, '=',
sapply(state_values, function(x) paste0('c(' , paste(x, collapse = ', '), ')')),
collapse = '\n')>>\n",
.open = "<<", .close = ">>"
)
} else {
glue::glue(
"<<ind>> = seq(<<ind_min>>, <<ind_max>>, length.out = <<ind_n>>)\n",
"parameters = c(<<paste(param_names, '=', param_values, collapse = ', ')>>)\n",
"state = c(<<paste(state_names, '=', state_values, collapse = ', ')>>)\n",
.open = "<<", .close = ">>"
)
}
}
print_odefun = function(ind, state_names, equations) {
glue::glue(
"ode_function = function(<<ind>>, state, parameters) {\n",
" with(as.list(c(state, parameters)), {\n",
"<<paste0(' ', paste(paste0('d', state_names), equations, sep = ' = '), collapse = '\n')>>\n",
" list(c(<<paste(paste0('d', state_names), collapse = ', ')>>))\n",
" })\n",
"}", .open = "<<", .close = ">>"
)
}
print_solver = function(ind, ind_n, state_values, state_names, multiple_states) {
if (multiple_states) {
max_len = max(vapply(state_values, length, integer(1)))
col_n = length(state_values) + 2 # 1 for the i.v. and other for the group
col_names = paste0("'", state_names, "'", collapse = ", ")
txt = glue::glue(
"output_df = data.frame(matrix(nrow = <<ind_n>> * <<max_len>>, ncol = <<col_n>>))\n",
"names(output_df) = c('time', <<col_names>>, 'param_group')\n\n",
"for (i in 1:<<max_len>>) {\n",
" state = c(<<paste0(state_names, ' = ', state_names, '[[i]]', collapse = ', ')>>)\n",
" ode_output = ode(func = ode_function, y = state, times = <<ind>>, parms = parameters)\n",
" ode_output = as.data.frame(ode_output)\n",
" ode_output$param_group = paste('group', i)\n",
" replace_idxs = ((i - 1) * <<ind_n>> + 1):(i * <<ind_n>>)\n",
" output_df[replace_idxs, ] = ode_output\n",
"}\n",
.open = "<<", .close = ">>"
)
} else {
txt = glue::glue(
"ode_output = ode(func = ode_function, y = state, times = {ind}, parms = parameters)\n",
"output_df = as.data.frame(ode_output)"
)
}
return(txt)
}
print_ggplot = function(independent, states, multiple_states) {
if (length(states) > 1) {
cols = paste0(paste0("'", states, "'", collapse = ", "))
data_transform = glue::glue(
"output_df_long = tidyr::pivot_longer(\n",
" data = output_df,\n",
" cols = c({cols}),\n",
" names_to = 'State',\n",
" values_to = 'Value',\n",
")"
)
if (multiple_states) {
ggplot_code = glue::glue(
"ggplot(output_df_long) +\n",
" geom_line(aes(x = time, y = Value, color = param_group, linetype = State), size = 1.5) +\n",
" scale_color_viridis_d()",
.trim = FALSE
)
} else {
ggplot_code = glue::glue(
"ggplot(output_df_long) +\n",
" geom_line(aes(x = time, y = Value, color = State), size = 1.5) +\n",
" scale_color_viridis_d()",
.trim = FALSE
)
}
return(paste(data_transform, ggplot_code, sep = "\n\n", collapse = "\n"))
} else {
if (multiple_states) {
ggplot_code = ""
for (state in states) {
ggplot_code = paste0(
ggplot_code,
glue::glue(
"ggplot(output_df) +\n",
" geom_line(aes(x = time, y = {state}, color = param_group), size = 1.5) +\n",
" scale_color_viridis_d() +\n",
" labs(title = '{paste('State', state)}') +\n",
" theme(legend.position = 'none')",
.trim = FALSE
),
sep = "\n\n"
)
}
} else {
ggplot_code = ""
for (state in states) {
ggplot_code = paste0(
ggplot_code,
glue::glue(
"ggplot(output_df) +\n",
" geom_line(aes(x = time, y = {state}), size = 1.5) +\n",
" labs(title = '{paste('State', state)}')",
.trim = FALSE
)
)
}
}
return(ggplot_code)
}
}
get_code_td = function(equation_components, param_values, state_values, state_selected,
independent, multiple_states) {
ind = equation_components$independent
ind_min = independent$min
ind_max = independent$max
ind_n = independent$n
state_names = equation_components$state
param_names = equation_components$params
equations = equation_components$eqs
imports = "#library(deSolve)\n#library(ggplot2)"
header = print_header(ind, ind_min, ind_max, ind_n, param_names, param_values,
state_names, state_values, multiple_states)
odefun = print_odefun(ind, state_names, equations)
solver = print_solver(ind, ind_n, state_values, state_names, multiple_states)
ggplot = print_ggplot(ind, state_selected, multiple_states)
paste(imports, header, odefun, solver, ggplot, sep = "\n\n", collapse = "\n")
}
get_df_td = function(.equation_components, param_values, state_values, independent, multiple_states) {
ind = .equation_components$independent
ind_min = independent$min
ind_max = independent$max
ind_n = independent$n
state_names = .equation_components$state
param_names = .equation_components$params
equations = .equation_components$eqs
# Evaluate header
eval(parse(text = print_header(
ind, ind_min, ind_max, ind_n, param_names, param_values,
state_names, state_values, multiple_states
)))
# Evaluate `ode_function`
# This defines `ode_function` within the execuition environment of this function.
eval(parse(text = print_odefun(ind, state_names, equations)))
# Evaluate solver
eval(parse(text = print_solver(ind, ind_n, state_values, state_names, multiple_states)))
eval(parse(text = "return(output_df)"))
}
get_plot_td = function(df, independent, selected_states, multiple_states) {
output_df = df
eval(parse(text = print_ggplot(independent, selected_states, multiple_states)))
}
print_flowfield = function(state_names, ind_range, state1_range, state2_range = NULL) {
if (length(state_names) == 2) {
system = "two.dim"
state_names = paste0("c(", paste0("'", state_names, "'", collapse = ", "), ")")
xlim = paste0("c(", paste0(state1_range, collapse = ", "), ")")
ylim = paste0("c(", paste0(state2_range, collapse = ", "), ")")
} else {
system = "one.dim"
state_names = paste0("'", state_names, "'")
xlim = paste0("c(", paste0(ind_range, collapse = ", "), ")")
ylim = paste0("c(", paste0(state1_range, collapse = ", "), ")")
}
glue::glue(
"system_flowField = flowField(\n",
" deriv = ode_function,\n",
" parameters = parameters,\n",
" state.names = {state_names},\n",
" system = '{system}',\n",
" xlim = {xlim},\n",
" ylim = {ylim},\n",
" col = '#7f8c8d',\n",
" lwd = 2.5,\n",
" add = FALSE\n",
")"
)
}
print_nullclines = function(state_names, ind_range, state1_range, state2_range = NULL) {
colors = c("#c0392b", "#2980b9")
if (length(state_names) == 2) {
system = "two.dim"
state_names = paste0("c(", paste0("'", state_names, "'", collapse = ", "), ")")
xlim = paste0("c(", paste0(state1_range, collapse = ", "), ")")
ylim = paste0("c(", paste0(state2_range, collapse = ", "), ")")
colors = paste0("c(", paste0("'", colors, "'", collapse = ", "), ")")
} else {
system = "one.dim"
state_names = paste0("'", state_names, "'")
xlim = paste0("c(", paste0(ind_range, collapse = ", "), ")")
ylim = paste0("c(", paste0(state1_range, collapse = ", "), ")")
colors = paste0("'", colors[1], "'")
}
glue::glue(
"system_nullclines = nullclines(\n",
" deriv = ode_function,\n",
" parameters = parameters,\n",
" state.names = {state_names},\n",
" system = '{system}',\n",
" points = 300,\n",
" xlim = {xlim},\n",
" ylim = {ylim},\n",
" col = {colors},\n",
" lwd = 3,\n",
" add.legend = FALSE\n",
")"
)
}
print_nullclines_legend = function(state_names) {
colors = c("#c0392b", "#2980b9")
if (length(state_names) == 2) {
labels = paste0("c(", paste0("'", state_names, " Nullclines'", collapse = ", "), ")")
colors = paste0("c(", paste0("'", colors, "'", collapse = ", "), ")")
} else {
labels = paste0("'", state_names, " Nullclines'")
colors = paste0("'", colors[1], "'")
}
glue::glue(
"legend(\n",
" x = 'topright',\n",
" legend = {labels},\n",
" col = {colors},\n",
" lty = 1,\n",
" lwd = 3,\n",
" bg = 'white',\n",
" inset = 0.025,\n",
" cex = 1.1\n",
")"
)
}
print_trajectory = function(state_names, ind_range, state1_vals, state2_vals = NULL) {
tlim = paste0("c(", paste0(ind_range, collapse = ", "), ")")
if (length(state_names) == 2) {
system = "two.dim"
state_names = paste0("c(", paste0("'", state_names, "'", collapse = ", "), ")")
y = paste0(paste0(state1_vals, ", "), state2_vals, collapse = ", ")
y0 = glue::glue(
"y0 = matrix(\n",
" data = {paste0('c(', y, ')')},\n",
" ncol = 2,\n",
" byrow = TRUE\n",
")"
)
} else {
system = "one.dim"
state_names = paste0("'", state_names, "'")
y0 = paste0("y0 = c(", paste0(state1_vals, collapse = ", "), ")")
}
glue::glue(
"{y0}\n\n",
"system_trajectory = trajectory(\n",
" deriv = ode_function,\n",
" parameters = parameters,\n",
" state.names = {state_names},\n",
" system = '{system}',\n",
" y0 = y0,\n",
" tlim = {tlim},\n",
" lwd = 2.5\n",
")"
)
}
print_header_2 = function(ind, ind_min, ind_max, ind_n, param_names, param_values) {
glue::glue(
"<<ind>> = seq(<<ind_min>>, <<ind_max>>, length.out = <<ind_n>>)\n",
"parameters = c(<<paste(param_names, '=', param_values, collapse = ', ')>>)\n",
.open = "<<", .close = ">>"
)
}
get_code_pp = function(equation_components, param_values, ind_settings,
state1_list, state2_list = NULL,
return_type = c('all', 'settings', 'plot')) {
ind = equation_components$independent
ind_min = ind_settings$min
ind_max = ind_settings$max
ind_n = ind_settings$n
state_names = equation_components$state
param_names = equation_components$params
equations = equation_components$eqs
if (is.null(state2_list)) {
state_names_ = state1_list$name
state1_r = state1_list$range
state1_v = state1_list$value
state2_r = NULL
state2_v = NULL
} else {
state_names_ = c(state1_list$name, state2_list$name)
state1_r = state1_list$range
state1_v = state1_list$value
state2_r = state2_list$range
state2_v = state2_list$value
}
imports = "# library(phaseR)"
header = print_header_2(ind, ind_min, ind_max, ind_n, param_names, param_values)
odefun = print_odefun(ind, state_names, equations)
flowfield = print_flowfield(state_names_, c(ind_min, ind_max), state1_r, state2_r)
nullclins = print_nullclines(state_names_, c(ind_min, ind_max), state1_r, state2_r)
trajectry = print_trajectory(state_names_, c(ind_min, ind_max), state1_v, state2_v)
nullclins_lgnd = print_nullclines_legend(state_names_)
if (return_type == 'all') {
return(paste(imports, header, odefun, flowfield, nullclins, trajectry, nullclins_lgnd,
sep = "\n\n", collapse = "\n"))
}
if (return_type == 'settings') {
return(paste(header, odefun, sep = "\n\n", collapse = "\n"))
}
if (return_type == 'plot') {
return(paste(flowfield, nullclins, trajectry, nullclins_lgnd,
sep = "\n\n", collapse = "\n"))
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.