R/utils-dataviz.R

In oncrawlR: Machine Learning for S.E.O

#' Create a dashboard
#'
#' @param dataset Dataset with 3 columns : date, unique name of metric, value
#' @param namefile Filename for the export
#' @param width Width of your picture
#' @param pathfile string. Optional. If not specified, the intermediate files are created under \code{TEMPDIR}, with the assumption that directory is granted for written permission.
#'
#' @examples
#' \dontrun{
#' oncrawlCreateDashboard(res, "metric.png", 500, ".")
#' }
#'
#' @return a graph
#' @author Vincent Terrasi
#' @export
#' @importFrom formattable formattable as.htmlwidget formatter style icontext
#' @importFrom sparkline sparkline
oncrawlCreateDashboard <- function(dataset, namefile, width, pathfile=tempdir()) {

  # spread data
  resDate <- tidyr::spread(dataset, .data$date, .data$value)

  if (ncol(resDate)<3) stop("You must have at least two different dates in your dataset.")

  resDate['change'] <-  round(((resDate[,ncol(resDate)]-resDate[,2])/resDate[,2])*100,2)

  # create sparkline with only column date
  posChange <- grep("change", colnames(resDate))
  resDate$sparkline = apply(resDate[, 2:(posChange-1)], 1,
                            FUN = function(x) as.character(htmltools::as.tags(sparkline::sparkline(as.numeric(x), type = "line"))))

  # put sparklines in col 2
  resDate <- resDate[,c(1,ncol(resDate),2:(ncol(resDate)-1))]
  names(resDate)[2] = "&nbsp&nbsp"

  resDateNew <- resDate[, c(1, 2, 3, (ncol(resDate)-1), ncol(resDate))]

  colnames(resDateNew)[1] <- c("&nbsp;&nbsp;")
  colnames(resDateNew)[ncol(resDateNew)] <- c("%")

  # x ~ function(x) percent(x / 100, digits = 0)

  out <- formattable::as.htmlwidget(
            formattable::formattable(resDateNew,
                              align = c("l",rep("r", ncol(resDate) - 1)),
                              list(
                                   metric = formattable::formatter("span", style = ~ formattable::style(color = "grey", font.weight = "bold")),
                                    `%` = formattable::formatter("span", style = x ~ formattable::style(color = ifelse(x < 0, "red", ifelse(x == 0,"blue","green"))),
                                        # arrow-left
                                        x ~ formattable::icontext(ifelse(x < 0, "arrow-down", ifelse(x == 0,"arrow-right","arrow-up")), x))
                                  )
            )
  )

  #out$dependencies = c(out$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))

  filepath <- file.path(pathfile, namefile)

  export_formattableWidget(out, filepath, width=width)

  return(out)


}

#' Transform HTML widget into picture
#'
#' @param w HTML content to print
#' @param file A vector of names of output files. Should end with .png, .pdf, or .jpeg. If several screenshots have to be taken and only one filename is provided, then the function appends the index number of the screenshot to the file name.
#' @param width Viewport width. This is the width of the browser "window".
#' @param background Background color for web page
#' @param delay Time to wait before taking screenshot, in seconds. Sometimes a longer delay is needed for all assets to display properly.
#'
#' @importFrom htmltools html_print
#' @importFrom webshot webshot
export_formattableWidget <- function(w, file, width=400, background = "white", delay = 0.2)
{
  path <- htmltools::html_print(w, background = background, viewer = NULL)
  url <- paste0("file:///", gsub("\\\\", "/", normalizePath(path)))
  webshot::webshot(url,
          file = file,
          vwidth = width,
          selector = ".formattable_widget",
          delay = delay)
}


#' Create a graph
#'
#' @param dataset dataset generated by DALEX package
#' @param namefile the filename for the export
#' @param width width of your picture
#' @param height height of your picture
#' @param pathfile string. Optional. If not specified, the intermediate files are created under \code{TEMPDIR}, with the assumption that directory is granted for written permission.
#'
#' @examples
#' \dontrun{
#' oncrawlCreateGraph(res, "metric.png", width=5, height=4, ".")
#' }
#'
#' @return file
#' @author Vincent Terrasi
#' @export
#' @importFrom stats lag
#' @importFrom utils head
oncrawlCreateGraph <- function(dataset, namefile, width, height, pathfile=tempdir()) {

  # round x-axis
  if (max(dataset[[1]][["x"]]) <= 1) {
    X <- round(dataset[[1]][["x"]],1)
  } else {
    X <- round(dataset[[1]][["x"]])
  }

  # round y-axis
  Y <- round(dataset[[1]][["y"]],2)
  name <- dataset[[1]][["name"]]

  # group by x-axis and compute means
  newDT <- data.frame(x=X,y=Y)

  curve <- newDT
  curve <- dplyr::group_by(curve, .data$x)
  curve <- dplyr::summarise(curve, y = mean(.data$y) )
  curve <- dplyr::mutate(curve, diff = round(.data$y - lag(.data$y, default = dplyr::first(.data$y)),3))
  curve <- dplyr::ungroup(curve)

  # filter too more results
  if (nrow(curve)>10)
    curve <- dplyr::filter(curve, .data$x==0 | diff!=lag(.data$diff,default = dplyr::first(.data$diff)) )

  if (nrow(curve)>15)
    curve <- dplyr::filter(curve, .data$diff!=0 )

  # find max diff
  ablinePos <- curve[which(abs(curve$diff)==max(abs(curve$diff))),]$x

  # build graph
  hh <- ggplot2::ggplot(curve, ggplot2::aes(.data$x, .data$y)) + ggplot2::theme_minimal()

  if (max(dataset[[1]][["x"]]) <= 1) {
    hh <- hh + ggplot2::geom_line(linetype = 1) + ggplot2::coord_cartesian(xlim = c(0,max(curve$x)), ylim = c(min(curve$y),max(curve$y)))
  }
  else {
    hh <- hh + ggplot2::geom_line(linetype = 1) + ggplot2::coord_cartesian(xlim = c(1,max(curve$x)+min(curve$x)), ylim = c(min(curve$y),max(curve$y)))
  }

  hh <- hh + ggplot2::scale_y_continuous(labels = scales::percent)

  if (length(curve$x)<20) {
    hh <- hh + ggplot2::scale_x_discrete(limits=curve$x)
  }

  if (length(curve$x)<20) {
    hh <- hh + ggplot2::geom_point() + ggplot2::geom_label(ggplot2::aes(label = scales::percent(curve$y)))
  }

  hh <- hh +  ggplot2::geom_vline(xintercept = utils::head(ablinePos,1), linetype="dashed", color = "red")

  hh <- hh + ggplot2::labs(x=name,y="Prediction")

  ggplot2::ggsave(file.path(pathfile,namefile), hh, width = width, height= height, units="in", dpi=100)

  return(hh)

}