Skip to content

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