Start up and show original Keras plot.

library("ggplot2")
library("cdata")
## Loading required package: wrapr
library("seplyr")
library("keras")
library("kableExtra")
options(knitr.table.format = "html") 

h <- readRDS("historyobject.rds")
plot(h)

dOrig <- readRDS("metricsframe.rds")
dOrig$epoch <- seq_len(nrow(dOrig))


d <- dOrig
d$loss <- -d$loss
d$val_loss <- -d$val_loss
cR <- d %.>%
  head(.) 
cR %.>%
  knitr::kable(.) %.>%
  kable_styling(., full_width = F) %.>%
  row_spec(., 0:nrow(cR), background = "lightgrey")
val_loss val_acc loss acc epoch
-0.3769818 0.8722 -0.5067290 0.7852000 1
-0.2996994 0.8895 -0.3002033 0.9040000 2
-0.2963943 0.8822 -0.2165675 0.9303333 3
-0.2779052 0.8899 -0.1738829 0.9428000 4
-0.2842501 0.8861 -0.1410933 0.9545333 5
-0.3119754 0.8817 -0.1135626 0.9656000 6

Or with a bit more color:

cR %.>%
  knitr::kable(.) %.>%
  kable_styling(., full_width = F) %.>%
  row_spec(., 0:nrow(cR), background = "lightgrey") %.>%
  row_spec(., 0, background = "lightgreen") %.>%
  column_spec(., 1:4, background = "yellow")
val_loss val_acc loss acc epoch
-0.3769818 0.8722 -0.5067290 0.7852000 1
-0.2996994 0.8895 -0.3002033 0.9040000 2
-0.2963943 0.8822 -0.2165675 0.9303333 3
-0.2779052 0.8899 -0.1738829 0.9428000 4
-0.2842501 0.8861 -0.1410933 0.9545333 5
-0.3119754 0.8817 -0.1135626 0.9656000 6

Reproducing the first plot

First plot: reproduce the original with bulk-renaming of columns (via the new cdata::map_fieldsD() function).

First we perform the equivalent of a “shred”, “un-pivot”, or “gather”:

cT <- build_unpivot_control(
  nameForNewKeyColumn= 'origColName',
  nameForNewValueColumn= 'performance',
  columnsToTakeFrom= c('val_loss',
                       'val_acc',
                       'loss',
                       'acc' ))
dT <- rowrecs_to_blocks(
  d,
  controlTable = cT,
  columnsToCopy = "epoch")
cR <- dT %.>%
  head(.) 
cR %.>%
  knitr::kable(.) %.>%
  kable_styling(., full_width = F) %.>%
  row_spec(., 0:nrow(cR), background = "lightgrey")
epoch origColName performance
1 val_loss -0.3769818
1 val_acc 0.8722000
1 loss -0.5067290
1 acc 0.7852000
2 val_loss -0.2996994
2 val_acc 0.8895000

Then we define a value mapping table to build the new value key columns that we need.

mp <- data.frame(
  origColName = qc(val_loss, val_acc, 
                     loss, acc),
  dataset = qc("validation", "validation", 
               "training", "training"),
  measure = qc("minus binary cross entropy", "accuracy",
               "minus binary cross entropy", "accuracy"),
  stringsAsFactors = FALSE)
mp %.>%
  knitr::kable(.) %.>%
  kable_styling(., full_width = F)  %.>%
  row_spec(., 0:nrow(mp), background = "lightgrey") %.>%
  column_spec(., 1, background = "lightgreen") %.>%
  column_spec(., 2:ncol(mp), background = "yellow")
origColName dataset measure
val_loss validation minus binary cross entropy
val_acc validation accuracy
loss training minus binary cross entropy
acc training accuracy

We apply that key map and we are ready to plot:

dT <- map_fields(dT, 
                 "origColName",
                 mp)
dT$measure <- factor(dT$measure, 
                     levels = c("minus binary cross entropy",
                                "accuracy"))
cR <- dT %.>%
  head(.)
cR %.>%
  knitr::kable(.) %.>%
  kable_styling(., full_width = F)  %.>%
  row_spec(., 0:nrow(cR), background = "lightgrey") %.>%
  column_spec(., 2, background = "lightgreen") %.>%
  column_spec(., c(4,5), background = "yellow")
epoch origColName performance dataset measure
1 val_loss -0.3769818 validation minus binary cross entropy
1 val_acc 0.8722000 validation accuracy
1 loss -0.5067290 training minus binary cross entropy
1 acc 0.7852000 training accuracy
2 val_loss -0.2996994 validation minus binary cross entropy
2 val_acc 0.8895000 validation accuracy 
pick <- dT %.>%
  filter_se(.,
            qe(measure == "minus binary cross entropy",
               dataset == "validation")) %.>%
  .$epoch[[which.max(.$performance)]]

ggplot(data = dT, 
       aes(x = epoch, 
           y = performance,
           color = dataset)) +
  geom_point() +
  stat_smooth(geom = "line", se = FALSE, method = "loess", alpha = 0.5) +
  facet_wrap(~measure, ncol=1, scales = "free_y") +
  geom_vline(xintercept = pick, alpha=0.7, color='darkgreen') +
  scale_color_brewer(palette = "Dark2") + 
  ggtitle("model performance by epoch, dataset, and measure")