Skip to content

Commit

Permalink
combination of server modules
Browse files Browse the repository at this point in the history
  • Loading branch information
konrad.kraemer committed Sep 11, 2024
1 parent d452954 commit f116a56
Show file tree
Hide file tree
Showing 13 changed files with 205 additions and 95 deletions.
Binary file modified Rplots.pdf
View file
Binary file not shown.
1 change: 0 additions & 1 deletion test.txt
View file

This file was deleted.

1 change: 0 additions & 1 deletion tsf/NAMESPACE
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
# Generated by roxygen2: do not edit by hand

export(ErrorClass)
export(batch)
export(convertToNum)
export(createPolynom)
Expand Down
15 changes: 8 additions & 7 deletions tsf/R/Errorclass.R → tsf/R/FunctionUtils.R
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
# TODO: do not export it anymores

#' ErrorClass class for handling errors
#' @description a class for handling error messages
#'
Expand All @@ -6,26 +8,25 @@
ErrorClass <- R6::R6Class(
"ErrorClass",
public = list(
#' @field message the error message
message = NULL,
#' @field message the error message
message = NULL,
#' @field object an R object which can be stored in the class instance if an error and a result should be returned together.
object = NULL,

#' @description
#' @description
#' create a new ErrorClass Object
#' @param message the string describing the error
#' @param object is optional if something besides the message should be stored
initialize = function(message, object = NULL) {
if(is.null(message)) {
if (is.null(message)) {
stop("No message object is passed. Undefined case")
} else {
self$message <- message
if(!is.null(object)) {
if (!is.null(object)) {
self$object <- object
}
}
}

)
)

Expand All @@ -43,4 +44,4 @@ addCode <- function(existingFunction, codeVector) {
updatedBody <- c(existingBody, newBody)
body(existingFunction) <- as.call(updatedBody)
existingFunction
}
}
197 changes: 139 additions & 58 deletions tsf/R/IDA_Server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,72 +36,131 @@ idaServer <- function(id, df_reactive, df_list_reactive, nclicks) {
# NOTE: Start of model specific code
# ===============================================================================
check_inputs <- function() {
rwn(input$H0 != "", "Please enter a value for the Host")
rwn(input$D0 != "", "Please enter a value for the Dye")
rwn(input$kHD != "", "Please enter a value for KaHD")
rwn(!is.na(input$npop),
"Please enter a value for number of particles")
rwn(!is.na(input$ngen),
"Please enter a value for the number of generations")
rwn(!is.na(input$threshold),
"Please enter a value for the error threshold")
rwn(input$kHG_lb != "",
"Please enter a value for the lower boundary of KaHG")
rwn(input$kHG_ub != "",
"Please enter a value for the upper boundary of KaHG")
rwn(input$IHD_lb != "",
"Please enter a value for the lower boundary of I(HD)")
rwn(input$IHD_ub != "",
"Please enter a value for the upper boundary of I(HD)")
rwn(input$ID_lb != "",
"Please enter a value for the lower boundary of I(D)")
rwn(input$ID_ub != "",
"Please enter a value for the upper boundary of I(D)")
rwn(input$I0_lb != "",
"Please enter a value for the lower boundary of I(0)")
rwn(input$I0_ub != "",
"Please enter a value for the upper boundary of I(0)")
rwn(!is_integer(input$npop),
"Please enter an integer value for number of particles")
rwn(!is_integer(input$ngen),
"Please enter an integer value for number of generations")
if (id == "IDA") {
rwn(input$H0 != "", "Please enter a value for the Host")
rwn(input$D0 != "", "Please enter a value for the Dye")
rwn(input$kHD != "", "Please enter a value for KaHD")
rwn(!is.na(input$npop),
"Please enter a value for number of particles")
rwn(!is.na(input$ngen),
"Please enter a value for the number of generations")
rwn(!is.na(input$threshold),
"Please enter a value for the error threshold")
rwn(input$kHG_lb != "",
"Please enter a value for the lower boundary of KaHG")
rwn(input$kHG_ub != "",
"Please enter a value for the upper boundary of KaHG")
rwn(input$IHD_lb != "",
"Please enter a value for the lower boundary of I(HD)")
rwn(input$IHD_ub != "",
"Please enter a value for the upper boundary of I(HD)")
rwn(input$ID_lb != "",
"Please enter a value for the lower boundary of I(D)")
rwn(input$ID_ub != "",
"Please enter a value for the upper boundary of I(D)")
rwn(input$I0_lb != "",
"Please enter a value for the lower boundary of I(0)")
rwn(input$I0_ub != "",
"Please enter a value for the upper boundary of I(0)")
rwn(!is_integer(input$npop),
"Please enter an integer value for number of particles")
rwn(!is_integer(input$ngen),
"Please enter an integer value for number of generations")
} else if(id == "GDA") {
rwn(input$H0 != "", "Please enter a value for the Host")
rwn(input$G0 != "", "Please enter a value for the Guest")
rwn(input$kHD != "", "Please enter a value for KaHD")
rwn(!is.na(input$npop),
"Please enter a value for number of particles")
rwn(!is.na(input$ngen),
"Please enter a value for the number of generations")
rwn(!is.na(input$threshold),
"Please enter a value for the error threshold")
rwn(input$kHG_lb != "",
"Please enter a value for the lower boundary of KaHG")
rwn(input$kHG_ub != "",
"Please enter a value for the upper boundary of KaHG")
rwn(input$IHD_lb != "",
"Please enter a value for the lower boundary of I(HD)")
rwn(input$IHD_ub != "",
"Please enter a value for the upper boundary of I(HD)")
rwn(input$ID_lb != "",
"Please enter a value for the lower boundary of I(D)")
rwn(input$ID_ub != "",
"Please enter a value for the upper boundary of I(D)")
rwn(input$I0_lb != "",
"Please enter a value for the lower boundary of I(0)")
rwn(input$I0_ub != "",
"Please enter a value for the upper boundary of I(0)")
rwn(!is_integer(input$npop),
"Please enter an integer value for number of particles")
rwn(!is_integer(input$ngen),
"Please enter an integer value for number of generations")
}
}

check_inputs_sensi <- function() {
rwn(input$H0 != "",
"Please enter a value for the Host")
rwn(input$D0 != "",
"Please enter a value for the Dye")
rwn(input$kHD != "",
"Please enter a value for KaHD")
rwn(!is_integer(input$sens_bounds),
"Please enter an integer value for the sensitivity boundary")
rwn(opti_result_created(),
"Please run first an optimization")
if (id == "IDA") {
rwn(input$H0 != "",
"Please enter a value for the Host")
rwn(input$D0 != "",
"Please enter a value for the Dye")
rwn(input$kHD != "",
"Please enter a value for KaHD")
rwn(!is_integer(input$sens_bounds),
"Please enter an integer value for the sensitivity boundary")
rwn(opti_result_created(),
"Please run first an optimization")
} else if (id == "GDA") {
rwn(input$H0 != "",
"Please enter a value for the Host")
rwn(input$G0 != "",
"Please enter a value for the Guest")
rwn(input$kHD != "",
"Please enter a value for KaHD")
rwn(!is_integer(input$sens_bounds),
"Please enter an integer value for the sensitivity boundary")
rwn(opti_result_created(),
"Please run first an optimization")
}
}

create_lb <- function() {
lb <- convert_all_to_num(
"lower boundaries",
input$kHG_lb, input$I0_lb, input$IHD_lb, input$ID_lb
)
lb <- ""
if (id == "IDA" || id == "GDA") {
lb <- convert_all_to_num(
"lower boundaries",
input$kHG_lb, input$I0_lb, input$IHD_lb, input$ID_lb
)
}
return(lb)
}

create_ub <- function() {
ub <- convert_all_to_num(
"upper boundaries",
input$kHG_ub, input$I0_ub, input$IHD_ub, input$ID_ub
)
ub <- ""
if (id == "IDA" || id == "GDA") {
ub <- convert_all_to_num(
"upper boundaries",
input$kHG_ub, input$I0_ub, input$IHD_ub, input$ID_ub
)
}
return(ub)
}

create_additional_parameters <- function() {
additionalParameters <- convert_all_to_num(
"Additional Parameters",
input$H0, input$D0, input$kHD
)
return(additionalParameters)
if (id == "IDA") {
additionalParameters <- convert_all_to_num(
"Additional Parameters",
input$H0, input$D0, input$kHD
)
return(additionalParameters)
} else if(id == "GDA") {
additionalParameters <- convert_all_to_num(
"Additional Parameters",
input$H0, input$G0, input$kHD
)
return(additionalParameters)
}
}

create_npop <- function() {
Expand All @@ -125,27 +184,49 @@ idaServer <- function(id, df_reactive, df_list_reactive, nclicks) {
}

get_Model <- function() {
"ida"
if (id == "IDA") {
return("ida")
} else if (id == "GDA") {
return("gda")
}
}

get_Model_capital <- function() {
"IDA"
if (id == "IDA") {
return("IDA")
} else if (id == "GDA") {
return("GDA")
}
}

get_K_param <- function() {
"K<sub>a</sub>(HG) [M]"
if (id == "IDA" || id == "GDA") {
return("K<sub>a</sub>(HG) [M]")
}
}

get_update_field <- function() {
"IDAupdateField"
if (id == "IDA") {
return("IDAupdateField")
} else if (id == "GDA") {
return("GDAupdateField")
}
}

get_update_field_sense <- function() {
"IDAupdateFieldSense"
if (id == "IDA") {
return("IDAupdateFieldSense")
} else if (id == "GDA") {
return("GDAupdateFieldSense")
}
}

get_update_field_batch <- function() {
"IDAupdateFieldBatch"
if (id == "IDA") {
return("IDAupdateFieldBatch")
} else if (id == "GDA") {
return("GDAupdateFieldBatch")
}
}
# NOTE: End of model specific code
# ===============================================================================
Expand Down
4 changes: 2 additions & 2 deletions tsf/R/RunBatch.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -113,11 +113,11 @@ batch <- function(case,
}
}

tq <- create_task_queue(
tq <- create_task_queue(
case, lowerBounds, upperBounds, list_df,
additionalParameters, seed, npop, ngen,
Topology, errorThreshold, num_rep, num_cores
)
)

# 4. assign tasks
tq$assign()
Expand Down
Loading

0 comments on commit f116a56

Please sign in to comment.