diff options
Diffstat (limited to 'contrib/TOM/R/tom.R')
| -rw-r--r-- | contrib/TOM/R/tom.R | 238 |
1 files changed, 238 insertions, 0 deletions
diff --git a/contrib/TOM/R/tom.R b/contrib/TOM/R/tom.R new file mode 100644 index 00000000..a9e00ff2 --- /dev/null +++ b/contrib/TOM/R/tom.R @@ -0,0 +1,238 @@ +# ---------------------------------------------------------------------- +# title: TOM R API +# description: Machine Learning-Based Test Results Analysis +# author: Alassane Samba (alassane.samba@orange.com) +# Copyright (c) 2017 Orange +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the Apache License, Version 2.0 +# which accompanies this distribution, and is available at +# http://www.apache.org/licenses/LICENSE-2.0 +# ---------------------------------------------------------------------- +# Load useful fonctions +source("R/explainer.R") +source("R/boostedBoxPlot.R") +# init +tomData<-NULL +tomAnalysis<-NULL +#* Read new file (to change to post) +#* @get /read +tomRead<-function(file,res){ + file_ok <- as.character(file) + if (is.na(file_ok)){ + res$status <- 400 + res$body <- "val parameter must be a number" + return(res) + } + st=Sys.time() + tomData<<-read.table(file = file_ok, sep=',', header=TRUE, quote = "\"", comment.char = "") + et=Sys.time() + #save(tomData,file = "tom.rdata") + list(result="success", durationInSeconds=as.numeric((et-st), units = "secs")) +} +#* Analyze correlations +#* @get /analyze +tomAnalyze<-function(input="pod_name:deploy_scenario:version:runner_id",output="bandwidth.MBps.",res){ + if(is.null(tomData)){ + res$status <- 400 + res$body <- "please read data first : url/read" + return(res) + } + input_ok<-as.character(input) + input_ok<-unlist(strsplit(input_ok,split = ":")) + if(sum(is.na(input_ok))>0){ + res$status <- 400 + res$body <- "input parameter must be a string including data context parameters separatd by a double dot (:)" + return(res) + } + if(sum(!input_ok%in%colnames(tomData))==length(input_ok)){ + res$status <- 400 + res$body <- "input parameter items must all be inluded in data header" + return(res) + } + output_ok <- as.character(output) + if(is.na(output_ok)){ + res$status <- 400 + res$body <- "output parameter must be a string inluded in data header" + return(res) + } + if(!output_ok%in%colnames(tomData)){ + res$status <- 400 + res$body <- "output parameter must be inluded in data header" + return(res) + } + st=Sys.time() + tomAnalysis<<-genericBestPredictor(dataset = tomData, targetName = output_ok, independantVariableNames = input_ok, plot = F) + et=Sys.time() + list(result="success", durationInSeconds=as.numeric((et-st), units = "secs")) +} +#* Get bivariate R2 values +#* @get /correlation +tomBivariateR2<-function(res){ + if(is.null(tomAnalysis)){ + res$status <- 400 + res$body <- "please analyze data first : url/analyze" + return(res) + } + return(as.list(tomAnalysis$bivariateR2)) +} +#* Get bivariate R2 values +#* @get /explain +tomExplain<-function(res){ + if(is.null(tomAnalysis)){ + res$status <- 400 + res$body <- "please analyze data first : url/analyze" + return(res) + } + return(as.list(tomAnalysis$orderedBestR2)) +} +#* Get bivariate R2 values +#* @png +#* @get /explainGraph +tomExplainGraph<-function(res){ + if(is.null(tomAnalysis)){ + res$status <- 400 + res$body <- "please analyze data first : url/analyze" + return(res) + } + maxmargin=20 + bottomheigth=0.5*max(nchar(names(tomAnalysis$orderedBestR2)),na.rm=T) + if(bottomheigth>maxmargin) bottomheigth<-maxmargin + op=par(mar=c(bottomheigth, 4.1, 4.1, 2.1)) + barplot(unlist(tomAnalysis$orderedBestR2), names.arg = names(tomAnalysis$orderedBestR2), las=2, ylab="R squared correlation coef.",main=paste("Correlation with",tomAnalysis$targetName)) + par(op) +} +#* Get the head contexts cases having highest KPI values +#* @get /head +tomHead<-function(input="pod_name",output="bandwidth.MBps.",limit=5,res){ + if(is.null(tomData)){ + res$status <- 400 + res$body <- "please read data first : url/read" + return(res) + } + input_ok<-as.character(input) + input_ok<-unlist(strsplit(input_ok,split = ":")) + if(sum(is.na(input_ok))>0){ + res$status <- 400 + res$body <- "input parameter must be a string including data context parameters separatd by a double dot (:)" + return(res) + } + if(sum(!input_ok%in%colnames(tomData))==length(input_ok)){ + res$status <- 400 + res$body <- "input parameter items must all be inluded in data header" + return(res) + } + output_ok <- as.character(output) + if(is.na(output_ok)){ + res$status <- 400 + res$body <- "output parameter must be a string inluded in data header" + return(res) + } + if(!output_ok%in%colnames(tomData)){ + res$status <- 400 + res$body <- "output parameter must be inluded in data header" + return(res) + } + limit=as.integer(limit) + if(is.na(limit)){ + res$status <- 400 + res$body <- "limit parameter must be an integer" + return(res) + } + varFactor=apply(as.data.frame(tomData[,input_ok]),1,paste,collapse=":") + sorted=sort(tapply(tomData[,output_ok],varFactor,median, na.rm=T),decreasing = TRUE)[1:limit] + return(as.list(sorted)) +} +#* Get the tail contexts cases having lowest KPI values +#* @get /tail +tomTail<-function(input="pod_name",output="bandwidth.MBps.",limit=5,res){ + if(is.null(tomData)){ + res$status <- 400 + res$body <- "please read data first : url/read" + return(res) + } + input_ok<-as.character(input) + input_ok<-unlist(strsplit(input_ok,split = ":")) + if(sum(is.na(input_ok))>0){ + res$status <- 400 + res$body <- "input parameter must be a string including data context parameters separatd by a double dot (:)" + return(res) + } + if(sum(!input_ok%in%colnames(tomData))==length(input_ok)){ + res$status <- 400 + res$body <- "input parameter items must all be inluded in data header" + return(res) + } + output_ok <- as.character(output) + if(is.na(output_ok)){ + res$status <- 400 + res$body <- "output parameter must be a string inluded in data header" + return(res) + } + if(!output_ok%in%colnames(tomData)){ + res$status <- 400 + res$body <- "output parameter must be inluded in data header" + return(res) + } + limit=as.integer(limit) + if(is.na(limit)){ + res$status <- 400 + res$body <- "limit parameter must be an integer" + return(res) + } + varFactor=apply(as.data.frame(tomData[,input_ok]),1,paste,collapse=":") + sorted=sort(tapply(tomData[,output_ok],varFactor,median,na.rm=T),decreasing = FALSE)[1:limit] + return(as.list(sorted)) +} +#* Get the comparison graph +#* @png +#* @get /comparGraph +tomComparGraph<-function(input="pod_name",output="bandwidth.MBps.",limit=10,plotmean=TRUE,textfreq=TRUE,res){ + if(is.null(tomData)){ + res$status <- 400 + res$body <- "please read data first : url/read" + return(res) + } + input_ok<-as.character(input) + input_ok<-unlist(strsplit(input_ok,split = ":")) + if(sum(is.na(input_ok))>0){ + res$status <- 400 + res$body <- "input parameter must be a string including data context parameters separatd by a double dot (:)" + return(res) + } + if(sum(!input_ok%in%colnames(tomData))==length(input_ok)){ + res$status <- 400 + res$body <- "input parameter items must all be inluded in data header" + return(res) + } + output_ok <- as.character(output) + if(is.na(output_ok)){ + res$status <- 400 + res$body <- "output parameter must be a string inluded in data header" + return(res) + } + if(!output_ok%in%colnames(tomData)){ + res$status <- 400 + res$body <- "output parameter must be inluded in data header" + return(res) + } + limit=as.integer(limit) + if(is.na(limit)){ + res$status <- 400 + res$body <- "n parameter must be an integer" + return(res) + } + varFactor=as.factor(apply(as.data.frame(tomData[,input_ok]),1,paste,collapse=":")) + maxmargin=20 + bottomheigth=0.5*max(nchar(levels(varFactor)),na.rm=T) + if(bottomheigth>maxmargin) bottomheigth<-maxmargin + leftwidth=0.5*nchar(as.character(max(tomData[,output_ok],na.rm=T))) + if(leftwidth>maxmargin) leftwidth<-maxmargin + op=par(mar=c(bottomheigth, leftwidth+1, 4.1, 2.1)) + boostedBoxplot(tomData[,output_ok],varFactor,decreasing=T,las=2,main=input,laby="",labx="",limitVisibleModalities=limit,dynamic=F,plot.mean=plotmean, text.freq=textfreq) + title(ylab = output_ok, line = leftwidth) + par(op) +} +# # to run it, do: +# library(plumber) +# r<-plumb("tom.r") +# r$run(port=8000) |