### fortify
#' Merge stranger/singular objects to a dataset
#'
#' \code{fortify} method for \code{anomalies}, \code{stranger} and \code{singular} objects to enrich data. Usually,
#' this is invoked on source data. For obvious precautions, this is done on an id column
#' as managed by the typical workflow (\code{crazyfy}). In case you enrich data without any
#' specific id, it is just assumed to have those data in the same order than data used in
#' anomaly detection computations -- this behavior may really needs to unwanted results.
#'
#' @param x anomalies objects as generated by a call to \code{\link{get_anomalies}}.
#' @param data data to enrich; if NULL (default), we use the data used during computation
#' @param id character - name of the id column. No need to specify this if you follow the recommended
#' process using either first \code{\link{add_id}} or \code{\link{crazyfy}}.
#' @param colname character - name of the column to be created for the flag (default: flag_anomaly).
#' @param \dots fortify generic parameter -- not used for stranger objects.
#'
#' @export
#' @rdname fortify_stranger
fortify.anomalies <- function(x,data=NULL,id=NULL,colname="flag_anomaly",...){
# if is.null(data) take from attributes/metadata
# no check here at all -> have to implement (dimension, same rownames...)
# we just use row.names
assertthat::assert_that(inherits(x,'anomalies'),msg="x must be an anomaly object.")
meta <- attr(x,"meta")
if (is.null(data)){
if (is.null(meta$data)) stop("data is NULL but can't be derived from x metadata. Is x an anomaly object?")
data <- meta$data
}
if (is.null(id)){
if (meta$crazymeta$had.id){
idcol <- meta$crazymeta$id
} else {
idcol <- '.id'
}
if (!idcol %in% colnames(data)){
warning(paste("Used source ID",idcol,"not present in provided data. We act as if 1:n was ID (ie. add_id/crazyfy used). This may lead to unexpected results.\n"))
data[[".id"]] <- 1:nrow(data)
idcol=".id"
}
} else{
idcol=id
if (!id %in% colnames(data)) stop(paste("ID",id , "not present in source data.frame"))
}
data[[colname]] <- data[[idcol]] %in% x
attr(data[[colname]],"sort") <- -1 # for plots
# print(names(meta))
meta[["anomalyflag"]] <- colname
attr(data,"meta") <- meta
class(data) <- c("fortifiedanomaly",class(data))
return(data)
}
#' @export
#' @param all.x merge parameter
#' @param all.y merge parameter
#' @rdname fortify_stranger
fortify.stranger <- function(x,data=NULL,id=NULL,all.x=TRUE, all.y=FALSE,...){
if (is.null(data)) {
data <- attr(x,"meta")$data
# reuse mapping table with eventual duplicates to enrich outliers with their eventual duplicate ID
crazymeta <- attr(data,"meta")
if (crazymeta$has.duplicates){
#<!> To be tested
# dup.id.mapping
dup <- crazymeta$duplicated.mapping
setkey(dup,.id)
data=dup[data, on=.(.id)]
data[!is.na(data[,mappedid]),][[".id"]] <- data[!is.na(data[,mappedid]),mappedid]
data[,mappedid:=NULL]
}
}
meta <- attr(x,"meta")
if (is.null(id)){
if (meta$crazymeta$had.id){
idcol <- meta$crazymeta$id
} else {
idcol <- '.id'
}
if (!idcol %in% colnames(data)){
warning(paste("Used source ID",idcol,"not present in provided data. We act as if 1:n was ID (ie. add_id/crazyfy used). This may lead to unexpected results.\n"))
data[[".id"]] <- 1:nrow(data)
idcol=".id"
}
} else{
idcol=id
if (!id %in% colnames(data)) stop(paste("ID",id , "not present in source data.frame"))
}
if (nrow(x)!= nrow(data)) warning("data do not have same number of rows that x - there may be unexpected results.")
vars <- colnames(data)
vars <- vars[!vars%in% idcol]
out <- merge(data,x, by=idcol,all.x=all.x,all.y=all.y)
meta$variables <- vars
attr(out,"meta") <- meta
cl <- class(x)
if (!"data.table"%in% class(data)) cl <- cl[cl!="data.table"]
class(out) <- c("fortifiedstranger",cl)
return(out)
}
#' @export
#' @rdname fortify_stranger
fortify.singular <- function(x,data=NULL,id=NULL,all.x=TRUE, all.y=FALSE,...){
if (is.null(data)) {
data <- attr(x,"meta")$data
crazymeta <- attr(data,"meta")
if (crazymeta$has.duplicates){
#<!> To be tested
# dup.id.mapping
dup <- crazymeta$duplicated.mapping
setkey(dup,.id)
data=dup[data, on=.(.id)]
data[!is.na(data[,mappedid]),][[".id"]] <- data[!is.na(data[,mappedid]),mappedid]
data[,mappedid:=NULL]
}
}
meta <- attr(x,"meta")
if (is.null(id)){
if (meta$crazymeta$had.id){
idcol <- meta$crazymeta$id
} else {
idcol <- '.id'
}
if (!idcol %in% colnames(data)){
warning(paste("Used source ID",idcol,"not present in provided data. We act as if 1:n was ID (ie. add_id/crazyfy used). This may lead to unexpected results.\n"))
data[[".id"]] <- 1:nrow(data)
idcol=".id"
}
} else{
idcol=id
if (!id %in% colnames(data)) stop(paste("ID",id , "not present in source data.frame"))
}
if (nrow(x)!= nrow(data)) warning("data do not have same number of rows that x - there may be unexpected results.")
vars <- colnames(data)
vars <- vars[!vars%in% idcol]
out <- merge(data,x, by=idcol,all.x=all.x,all.y=all.y)
meta$variables <- vars
attr(out,"meta") <- meta
cl <- class(x)
if (!"data.table"%in% class(data)) cl <- cl[cl!="data.table"]
class(out) <- c("fortifiedsingular",cl)
return(out)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.