# MLJAR Helper Functions
#' Get json from post query
#'
#' Returns api response and parsed output from POST query given data
#'
#' @param query character with http query
#' @param data list with body data
#'
#' @importFrom httr POST add_headers content
#' @importFrom jsonlite fromJSON
#' @return list with response and parsed response from json
.get_json_from_post_query <- function(query, data){
token <- .get_token()
resp <- POST(query, add_headers(Authorization = paste("Token", token)),
body = data, encode = "form")
parsed <- jsonlite::fromJSON(content(resp, "text", encoding = "UTF-8"),
simplifyVector = FALSE)
.check_response_status(resp, 200)
return(list(resp=resp, parsed=parsed))
}
#' Get json from get query
#'
#' Returns api response and parsed output
#'
#' @param query character with http query
#'
#' @importFrom httr GET add_headers content
#' @importFrom jsonlite fromJSON
#' @return list with response and parsed response from json
.get_json_from_get_query <- function(query){
token <- .get_token()
resp <- GET(query, add_headers(Authorization = paste("Token", token)))
parsed <- jsonlite::fromJSON(content(resp, "text", encoding = "UTF-8"),
simplifyVector = FALSE)
.check_response_status(resp, 200)
return(list(resp=resp, parsed=parsed))
}
#' Get token
#'
#' Gets token from MLJAR_TOKEN env variable.
#'
#' @return returns token defined in enviromental variable MLJAR_TOKEN
#' @examples
#' .get_token()
.get_token <- function(){
token <- Sys.getenv("MLJAR_TOKEN")
if (identical(token, "")) {
stop("Specify MLJAR_TOKEN env variable", call. = FALSE)
}
return(token)
}
#' Check response status
#'
#' Verifies if response status is correct.
#' If not it stops execution with message.
#'
#' @param resp httr response
#' @param expected_code numeric with expected code e.g. 201
#' @param error_message character with error message
#'
#' @importFrom httr status_code
.check_response_status <- function(resp, expected_code,
error_message="MLJAR API request failed"){
# compares response status with expeced_code and returns error_message if not equal
if (status_code(resp) != expected_code) {
stop(
sprintf(
paste(error_message, "[%s]\n"),
status_code(resp)
),
call. = FALSE
)
}
}
#' Checks if data is in good format.
#'
#' If not it stops execution.
#'
#' @param x preferably a matrix or data frame.
#' If not, it is attempted to coerce x to a data frame.
#' @param y preferably a matrix or data frame.
#' If not, it is attempted to coerce x to a data frame.
.data_check <- function(x, y){
x <- as.data.frame(x)
y <- as.data.frame(y)
if (is.null(x) || is.null(y)){
stop("NULL data")
}
if(length(dim(y))>1 && dim(y)[2]>1){
stop("Sorry, multiple outputs are not supported in MLJAR")
}
if(dim(y)[1]!=dim(x)[1]){
stop("Sorry, there is a missmatch between X and y matrices shapes")
}
}
#' Stores data in temporary CSV file
#'
#' @param x preferably a matrix or data frame.
#' If not, it is attempted to coerce x to a data frame.
#' @param y preferably a matrix or data frame.
#' If not, it is attempted to coerce x to a data frame.
#'
#' @return tmpfilepath character with path to temporary file
#'
#' @example
#' .data_to_file(c(1,2))
.data_to_file <- function(x, y=NULL){
if (!is.null(y)){
# first we check if data is valid
.data_check(x, y)
# now it's time to convert to data frame
dataxy <- as.data.frame(x)
dataxy["target"] <- y
} else {
if (is.null(x)) stop("NULL data")
dataxy <- as.data.frame(x)
}
# temporary csv file is created
tmpfilepath <- paste0(tempfile(),".csv")
file.create(tmpfilepath)
write.csv(dataxy, file = tmpfilepath, row.names = F)
return(tmpfilepath)
}
#' Obtain task
#'
#' Determines what kind of task is that basing on y.
#' @param y target vector/data.frame
#'
#' @return "reg" or "bin_class" depending on kind of task
#' @examples
#' .obtain_task(c(1, 0, 0, 1))
.obtain_task <- function(y){
return(ifelse(nrow(as.data.frame(unique(y))) > 2, "reg", "bin_class"))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.