print and plot methods

R/coefList.R

@@ -0,0 +1,55 @@
+coefList <- function(object){
+  penalties <- object$df()
+  models.list <- list()
+  for(suffix in c("on", "after")){
+    one.df.list <- list()
+    for(prefix in c("loss", "size")){
+      one.df.list[[prefix]] <- penalties[[paste0(prefix, "_", suffix)]]
+    }
+    all.rows <- do.call(data.frame, one.df.list)
+    models.list[[suffix]] <- all.rows[0 <= all.rows$size, ]
+  }
+  models <- unique(do.call(rbind, models.list))
+  penalties$next_pen <- c(penalties$penalty[-1], NA)
+  cost <- function(loss, size, penalty){
+    loss + ifelse(size==0, 0, size*penalty)
+  }
+  pen.segs <- with(penalties[0 <= penalties$size_after, ], data.frame(
+    pen_start=penalty,
+    pen_end=next_pen,
+    loss=loss_after,
+    size=size_after,
+    cost_start=cost(loss_after, size_after, penalty),
+    cost_end=cost(loss_after, size_after, next_pen)))
+  is.break <- penalties$size_on == -1
+  break.points <- if(any(is.break))with(penalties[is.break,], data.frame(
+    penalty,
+    loss=loss_after,
+    size=size_after,
+    type="break"))
+  maybe.end <- penalties[!is.break & 0 <= penalties$size_on,]
+  end.points <- if(nrow(maybe.end))with(maybe.end, data.frame(
+    penalty,
+    loss=loss_on,
+    size=size_on,
+    type="end"))
+  maybe.help <- penalties[penalties$size_after == -3,]
+  help.points <- if(nrow(maybe.help))with(maybe.help, data.frame(
+    penalty=loss_after,
+    loss=loss_on,
+    size=size_on,
+    type="helpful"))
+  pen.points <- rbind(break.points, help.points, end.points)
+  pen.points$cost <- with(pen.points, cost(loss, size, penalty))
+  finite.cost <- with(pen.points, cost[is.finite(cost)])
+  inf.cost <- if(length(finite.cost)){
+    min(finite.cost)
+  }else{
+    0
+  }
+  pen.points[!is.finite(pen.points$cost), "cost"] <- inf.cost
+  list(
+    abline=models,
+    point=pen.points,
+    segment=pen.segs)
+}

R/loadModule.R

@@ -1 +1,57 @@
 Rcpp::loadModule("penmap_module", TRUE)
+
+setMethod(
+  "show",
+  signature(object="Rcpp_penmap"),
+  function(object){
+    cat(sprintf(
+      "Penalty map with %d breakpoints, %d optimal models, %d helpful penalties\n",
+      object$num_breakpoints(),
+      object$num_optimal(),
+      object$num_helpful()))
+  }
+)
+
+setMethod(
+  "coef",
+  signature(object="Rcpp_penmap"),
+  coefList
+)
+
+setMethod(
+  "plot",
+  signature(x="Rcpp_penmap"),
+  function(x, opt.color="red", ...){
+    param.list <- coef(x)
+    gg <- ggplot()+
+      scale_size_manual(values=c(optimal=2))+
+      xlab("penalty")+
+      ylab("loss + penalty*model_size")+
+      scale_color_manual(values=c(optimal=opt.color))+
+      scale_fill_manual(values=c(
+        "break"="black",
+        end=opt.color,
+        helpful="white"))
+    if(nrow(param.list[["segment"]])){
+      gg <- gg+geom_segment(aes(
+        pen_start, cost_start,
+        color=status, size=status,
+        xend=pen_end, yend=cost_end),
+        data=data.frame(param.list[["segment"]], status="optimal"))
+    }
+    if(nrow(param.list[["abline"]])){
+      gg <- gg+geom_abline(aes(
+        slope=size,
+        intercept=loss),
+        data=param.list[["abline"]])
+    }
+    if(nrow(param.list[["point"]])){
+      gg <- gg+geom_point(aes(
+        penalty, cost,
+        fill=type),
+        shape=21,
+        color="black",
+        data=param.list[["point"]])
+    }
+  }
+)

src/interface.cpp

@@ -43,5 +43,8 @@ RCPP_MODULE(penmap_module){
     .method("insert", &penmap::insert_loss_size)
     .method("df", &df)
     .method("helpful", &helpful)
+    .method("num_helpful", &penmap::num_helpful)
+    .method("num_optimal", &penmap::num_optimal)
+    .method("num_breakpoints", &penmap::num_breakpoints)
     ;
 }

src/penmap.cpp

@@ -278,3 +278,13 @@ void penmap::insert_loss_size(double penalty, double loss, int size){
     erase_pair(it, next(it));
   }
 }
+
+int penmap::num_breakpoints(){
+  return breakpoints.size();
+}
+int penmap::num_optimal(){
+  return optimal_list.size()-2;//UNKNOWN/BOTH.
+}
+int penmap::num_helpful(){
+  return helpful_list.size();
+}

src/penmap.h

@@ -43,4 +43,7 @@ class penmap {
   Losses::iterator new_optimal(double loss, int size);
   Losses::iterator new_helpful(double pen);
   void insert_loss_size(double penalty, double loss, int size);
+  int num_helpful();
+  int num_optimal();
+  int num_breakpoints();
 };