max/poet
1
0
Fork 0
mirror of https://git.gfz-potsdam.de/naaice/poet.git synced 2025-12-15 20:38:23 +01:00
Code Issues Packages Projects Releases Wiki Activity

refactor: apply changes from MDL

Browse Source
This commit is contained in:
Marco De Lucia 2022-12-15 16:08:58 +01:00 committed by Max Lübke
parent 2e675d8139
commit a3bd0cef6d
2 changed files with 9 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
app/poet.cpp
View File

@ -126,8 +126,7 @@ int main(int argc, char *argv[]) {
/*Loading Dependencies*/ /*Loading Dependencies*/
// TODO: kann raus // TODO: kann raus
std::string r_load_dependencies = "suppressMessages(library(RedModRphree));" std::string r_load_dependencies = "source('../R_lib/kin_r_library.R');";
"source('../R_lib/kin_r_library.R');";
R.parseEvalQ(r_load_dependencies); R.parseEvalQ(r_load_dependencies);
SimParams params(world_rank, world_size); SimParams params(world_rank, world_size);

22
util/data_evaluation/RFun_Eval.R
View File

@ -1,6 +1,6 @@
## Simple library of functions to assess and visualize the results of the coupled simulations ## Simple library of functions to assess and visualize the results of the coupled simulations
## Time-stamp: "Last modified 2020-02-04 23:21:37 delucia" ## Time-stamp: "Last modified 2022-12-15 11:30:55 delucia"
require(RedModRphree) require(RedModRphree)
require(Rmufits) ## essentially for PlotCartCellData require(Rmufits) ## essentially for PlotCartCellData
@ -25,8 +25,7 @@ ReadAllDHT <- function(dir) {
} }
## function which reads one .dht file and gives a matrix ## function which reads one .dht file and gives a matrix
ReadDHT <- function(file) ReadDHT <- function(file) {
{
conn <- file(file, "rb") ## open for reading in binary mode conn <- file(file, "rb") ## open for reading in binary mode
if (!isSeekable(conn)) if (!isSeekable(conn))
stop("Connection not seekable") stop("Connection not seekable")
@ -51,8 +50,7 @@ ReadDHT <- function(file)
} }
## Scatter plots of each variable in the iteration ## Scatter plots of each variable in the iteration
PlotScatter <- function(sam1, sam2, which=NULL, labs=c("NO DHT", "DHT"), pch=".", cols=3, ...) PlotScatter <- function(sam1, sam2, which=NULL, labs=c("NO DHT", "DHT"), pch=".", cols=3, ...) {
{
if ((!is.data.frame(sam1)) & ("T" %in% names(sam1))) if ((!is.data.frame(sam1)) & ("T" %in% names(sam1)))
sam1 <- sam1$C sam1 <- sam1$C
if ((!is.data.frame(sam2)) & ("T" %in% names(sam2))) if ((!is.data.frame(sam2)) & ("T" %in% names(sam2)))
@ -104,8 +102,7 @@ AppliedFun <- function(a, b, .fun) mapply(.fun, as.list(a$C), as.list(b$C))
## Compute the diffs between two simulation, iter by iter, ## Compute the diffs between two simulation, iter by iter,
## with a given metric (passed in form of function name to this function) ## with a given metric (passed in form of function name to this function)
ComputeErrors <- function(sim1, sim2, FUN=RMSE) ComputeErrors <- function(sim1, sim2, FUN=RMSE) {
{
if (length(sim1)!= length(sim2)) { if (length(sim1)!= length(sim2)) {
cat("The simulations do not have the same length, subsetting to the shortest\n") cat("The simulations do not have the same length, subsetting to the shortest\n")
a <- min(length(sim1), length(sim2)) a <- min(length(sim1), length(sim2))
@ -121,8 +118,7 @@ ComputeErrors <- function(sim1, sim2, FUN=RMSE)
} }
## Function to display the error progress between 2 simulations ## Function to display the error progress between 2 simulations
ErrorProgress <- function(mat, ignore, colors, metric, ...) ErrorProgress <- function(mat, ignore, colors, metric, ...) {
{
if (missing(colors)) if (missing(colors))
colors <- sample(rainbow(ncol(mat))) colors <- sample(rainbow(ncol(mat)))
@ -145,7 +141,7 @@ ErrorProgress <- function(mat, ignore, colors, metric, ...)
## Function which exports all simulations to ParaView's .vtu Requires ## Function which exports all simulations to ParaView's .vtu Requires
## package RcppVTK ## package RcppVTK
ExportToParaview <- function(vtu, nameout, results){ ExportToParaview <- function(vtu, nameout, results) {
require(RcppVTK) require(RcppVTK)
n <- length(results) n <- length(results)
vars <- colnames(results[[1]]) vars <- colnames(results[[1]])
@ -165,8 +161,7 @@ ExportToParaview <- function(vtu, nameout, results){
## "breaks" for color coding of 2D simulations ## "breaks" for color coding of 2D simulations
Plot2DCellData <- function (data, grid, nx, ny, contour = TRUE, Plot2DCellData <- function (data, grid, nx, ny, contour = TRUE,
nlevels = 12, breaks, palette = "heat.colors", nlevels = 12, breaks, palette = "heat.colors",
rev.palette = TRUE, scale = TRUE, ...) rev.palette = TRUE, scale = TRUE, ...) {
{
if (!missing(grid)) { if (!missing(grid)) {
xc <- unique(sort(grid$cell$XCOORD)) xc <- unique(sort(grid$cell$XCOORD))
yc <- unique(sort(grid$cell$YCOORD)) yc <- unique(sort(grid$cell$YCOORD))
@ -174,8 +169,7 @@ Plot2DCellData <- function (data, grid, nx, ny, contour = TRUE,
ny <- length(yc) ny <- length(yc)
if (!length(data) == nx * ny) if (!length(data) == nx * ny)
stop("Wrong nx, ny or grid") stop("Wrong nx, ny or grid")
} } else {
else {
xc <- seq(1, nx) xc <- seq(1, nx)
yc <- seq(1, ny) yc <- seq(1, ny)
} }