Alternative risk-scaling functions
Created by: famuvie
Currently, the only scaling functions are linear, with the option to be reversed.
Please add radio buttons to choose various links for standardization (see code at the end of this post, as a suggestion only)
Feature requested by @vporphyre in #19 (closed)
# function link_fun (à integrer dans risk_layer à la place de lin_fun) BETA VERSION (V.Porphyre) ####
# arg invert à associer au bouton 'Inverser'
# x1 and x2 Threshold values
lin_fun <- function(r, type="linear", invert=FALSE, x1=0, x2=0, source=scale_source, target=scale_target){
if (type=="linear"){
slope <- diff(target)/diff(source)
ans <- target[1] + slope * (r - source[1])
}
if (type=="crisp"){ tmp <- r
if (invert==FALSE) {
tmp[tmp<x1] <- target[1]
tmp[tmp>=x1] <- target[2]
}
if (invert==TRUE){
tmp[tmp<x1] <- target[2]
tmp[tmp>=x1] <- target[1]
}
ans <- tmp
}
if (type=="double"){ tmp <- r
if(invert==FALSE){
tmp[tmp<x1] <- target[1]
tmp[tmp>=x1 & tmp<x2] <- target[2]
tmp[tmp>=x2] <- target[1]}
if(invert==TRUE){
tmp[tmp<x1] <- target[2]
tmp[tmp>=x1 & tmp<x2] <- target[1]
tmp[tmp>=x2] <- target[2]
}
ans <- tmp
}
# if (type=="fuzzy"){} # to be developped
# if (type=="sigmoid"){
# #ans <- target[2]*(1/(1 + ((1/target[1])-1)*exp(-x1*r)))
# } # WRONG
return(ans)
}
Edited by Facundo Muñoz