R/functions.R

Defines functions do_something download_data create_dash_server create_dash_server_simple run_all_tasks

Documented in create_dash_server create_dash_server_simple download_data run_all_tasks

# Define the packages requierd for the project
library("fiery")
library("routr")
library("reqres")
library("htmltools")
library("base64enc")
library("plotly")
library("mime")
library("crayon")
library("devtools")
library("dash")
library("dashHtmlComponents")
library("dashCoreComponents")
library("dashTable")
library("lintr")
library("docopt")
library("devtools")
library("logger")
library("iterators")
library("tictoc")
library("pingr")
library("assertthat")
library("testthat")
library("RCurl")

#' @import fiery
#' @import routr
#' @import reqres
#' @import htmltools
#' @import base64enc
#' @import plotly
#' @import mime
#' @import crayon
#' @import devtools
#' @import dash
#' @import dashHtmlComponents
#' @import dashCoreComponents
#' @import dashTable
#' @import lintr
#' @import docopt
#' @import devtools
#' @import logger
#' @import iterators
#' @import tictoc
#' @import pingr
#' @import assertthat
#' @import testthat
#' @import RCurl

# Install packages that we need from GitHub
devtools::install_github("plotly/dashR", upgrade = TRUE)
devtools::install_github('r-lib/styler', upgrade = TRUE)

# Apply operations to an input DataFrame
do_something <- function(input){
  # This function is a placeholder for future operations that
  # might take place in the future.
  log_info("Executing do_something()")
  tic()
  # Insert code here
  run_time <- toc(quiet = TRUE)
  log_info(paste("do_something() completed in",
                 as.character(round(run_time$toc - run_time$tic, 3)),
                 "seconds"))
  return(input)
}


# Extract data from a given url (the url must point to a .csv file)
#' @export
download_data <- function(url = 'https://www.football-data.co.uk/mmz4281/1920/E0.csv') {
  log_info(paste("Executing download_data()"))
  # Start timing
  tic()
  # Test that the input url is the correct format
  assert_that(is.character(url),
              msg=paste0("Url is ",class(url),", not character, aborting."))
  # Download data from url
  output_table <- read.csv(url, stringsAsFactors = FALSE)
  # Log dimensions of downloaded table (for debugging)
  log_debug(paste0("Table downloaded. Downloaded table has ",
                   nrow(output_table)," rows and ", ncol(output_table), " columns."))
  # Test that the number of rows in the dataFrame is not less than 1
  assert_that(nrow(output_table) > 1,
              msg="Rows of downloaded table less than 1, aborting.")
  # Perform some operations
  output_table <- do_something(output_table)
  # Log dimensions of edited table (for debugging)
  log_debug(paste0("After applying do_something(), output_table has ",
                   nrow(output_table)," rows and ", ncol(output_table), " columns."))
  # Test that the number of rows in the dataFrame is not less than 1
  assert_that(nrow(output_table) > 1,
              msg="Rows of output_table less than 1 after returning from do_something(), aborting.")
  # Log the time taken to run the function
  run_time <- toc(quiet = TRUE)
  log_info(paste("download_data() completed in",
                 as.character(round(run_time$toc - run_time$tic, 3)),
                 "seconds"))
  # Return the output
  return(output_table)
}

# Given an input data frame, create a dash server to display it
#' @export
create_dash_server <- function(input_table, host) {
  log_info(paste("Executing create_dash_server()"))
  log_info(paste("Input data has",nrow(input_table),"rows"))
  # Create an app object
  app <- Dash$new()
  # Define the layout (including the table)
  app$layout(
    dashDataTable(
      id = "table",
      columns = lapply(colnames(input_table),
                       function(colName) {
                         list(id = colName, name = colName)
                       }),
      data = df_to_list(input_table),
      # Enable sorting
      sort_action = 'native',
      # Enable filtering
      filter_action = 'native',
    )
  )
  # Check if the default port (8050) is in use. If it is, try other ports
  # that are known to be free (might be system dependent)
  port <- 8050
  i <- 1
  alt_ports <- c(8124, 8125, 8126, 8051)
  port_available <- is.na(pingr::ping_port(host, port = port, count = 1))
  # While the chosen port is in use, keep running the loop
  while(port_available == FALSE){
    log_info(paste("Port", port, 'is in use, trying another port...'))
    port <- alt_ports[i]
    port_available <- is.na(pingr::ping_port(host, port = port, count = 1))
    i <- i + 1
    if(i > length(alt_ports))
      stop("No ports available to deploy the app!")
  }
  # Start the server
  log_info(paste("Hosting the server on port:", port))
  app$run_server(port = port, host=host)
}


# Given an input data frame, create a dash server to display it
#' @export
create_dash_server_simple <- function(input_table, host) {
  # Create an app object
  app <- Dash$new()
  # Define the layout (including the table)
  app$layout(
    dccInput(id = "graphTitle",
             value = "Let's Dance!",
             type = "text"),
    htmlDiv(id = "outputID"),
    dccGraph(id = "giraffe",
             figure = list(
               data = list(x = c(1,2,3), y = c(3,2,8), type = 'bar'),
               layout = list(title = "Let's Dance!")
             )
    )
  )
  # Check if the default port (8050) is in use. If it is, try other ports
  # that are known to be free (might be system dependent)
  port <- 8050
  i <- 1
  alt_ports <- c(8124, 8125, 8126, 8051)
  port_available <- is.na(pingr::ping_port(host, port = port, count = 1))
  # While the chosen port is in use, keep running the loop
  while(port_available == FALSE){
    log_info(paste("Port", port, 'is in use, trying another port...'))
    port <- alt_ports[i]
    port_available <- is.na(pingr::ping_port(host, port = port, count = 1))
    i <- i + 1
    if(i > length(alt_ports))
      stop("No ports available to deploy the app!")
  }
  # Start the server
  log_info(paste("Hosting the server on port:", port))
  app$run_server(port = port, host=host)
}

# Run all functions, downlading the data and creating the dash server
#' @export
run_all_tasks <- function(){
  df <- download_data()
  create_dash_server(df, host='0.0.0.0')
}
qemtek/footballTableDemo documentation built on Nov. 5, 2019, 1:57 a.m.