# 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')
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.