#' Create the HTML code for Logit Leaf Model visualization #' #' This function generates HTML code for a visualization of the logit leaf model. #' #' @param object An object of class logitleafmodel, as that created by the function llm. #' @param roundingnumbers An integer stating the number of decimals in the visualization. #' @param headertext Allows to provide the table with a header. #' @param footertext Allows to provide the table with a custom footer. #' @return Generates HTML code for a visualization. #' @export #' @import stringr #' @references Arno De Caigny, Kristof Coussement, Koen W. De Bock, A New Hybrid Classification Algorithm for Customer Churn Prediction Based on Logistic Regression and Decision Trees, European Journal of Operational Research (2018), doi: 10.1016/j.ejor.2018.02.009. #' @author Arno De Caigny, \email{a.de-caigny@@ieseg.fr}, Kristof Coussement, \email{k.coussement@@ieseg.fr} and Koen W. De Bock, \email{kdebock@@audencia.com} #' @seealso \code{\link{predict.llm}}, \code{\link{llm}}, \code{\link{llm.cv}} #' @examples #' ## Load PimaIndiansDiabetes dataset from mlbench package #' if (requireNamespace("mlbench", quietly = TRUE)) { #' library("mlbench") #' } #' data("PimaIndiansDiabetes") #' ## Split in training and test (2/3 - 1/3) #' idtrain <- c(sample(1:768,512)) #' PimaTrain <-PimaIndiansDiabetes[idtrain,] #' Pimatest <-PimaIndiansDiabetes[-idtrain,] #' ## Create the LLM #' Pima.llm <- llm(X = PimaTrain[,-c(9)],Y = PimaTrain$diabetes, #' threshold_pruning = 0.25,nbr_obs_leaf = 100) #' ## Save the output of the model to a html file #' Pima.Viz <- table.llm.html(object = Pima.llm, headertext = "This is an example of the LLM model", #' footertext = "Enjoy the package!") #' ## Optionaly write it to your working directory #' # write(Pima.Viz, "Visualization_LLM_on_PimaIndiansDiabetes.html") #' @export table.llm.html #' table.llm.html <- function(object, headertext= "The Logit Leaf Model", footertext= "A table footer comment", roundingnumbers = 2){ # Calculate max number of decision rules decisionrules <- 0 for (i in 1:length(object[[1]])) { decisionrules <- max(decisionrules, (stringr::str_count(object[[1]][i][[1]], "&")+1)) } # Calculate number of segments nbrsegments <- length(object[[1]]) # Create overview table decisionrulesoverview <- as.data.frame(1:(nbrsegments*decisionrules)) iii <- 1 for (i in 1:length(object[[1]])) { # Loop over segment specific rules allsegrules <-object[[1]][i][[1]] # Create decision rule overview table for (ii in 1:decisionrules) { if(is.na(strsplit(strsplit(allsegrules, split = "&")[[1]][ii], "'")[[1]])){ var <- "." sign <- "." number <- "." }else{ var <- strsplit(stringr::str_trim(strsplit(allsegrules, split = "&")[[1]][ii]), " ")[[1]][[1]] sign <- strsplit(stringr::str_trim(strsplit(allsegrules, split = "&")[[1]][ii]), " ")[[1]][[2]] # Find the value consideredstring <- strsplit(stringr::str_trim(strsplit(allsegrules, split = "&")[[1]][ii]), " ")[[1]][[3]] number <- round(as.numeric(consideredstring), roundingnumbers) } # Fill in the values decisionrulesoverview[iii,1] <- i decisionrulesoverview[iii,2] <- ii decisionrulesoverview[iii,3] <- var decisionrulesoverview[iii,4] <- sign decisionrulesoverview[iii,5] <- number iii <- iii+1 } } names(decisionrulesoverview) <- c("segment","rule", "variable", "sign","value" ) # Calculate shared variables for (i in 1:length(object[[2]])) { m <- object[[2]][i][[1]] if(i==1){ allnames <- c(names(m$coefficients)) }else{ allnames <- c(allnames,names(m$coefficients)) } } sharvars <- names(which(table(allnames)>1)) sharedvariables <- length(sharvars) # Create overview table shared variables sharedvariablesoverview <- as.data.frame(1:(nbrsegments*sharedvariables)) kkk <- 1 for (i in 1:nbrsegments) { for (ii in 1:sharedvariables) { consideredobj <- object[[2]][i][[1]] considervars <- names(consideredobj$coefficients) if(ii%in%which(sharvars%in%considervars)){ sharedvariablesoverview[kkk,1] <- i sharedvariablesoverview[kkk,2] <- ii sharedvariablesoverview[kkk,3] <- sharvars[ii] sharedvariablesoverview[kkk,4] <- round(consideredobj$coefficients[which(considervars == sharvars[ii])][[1]],roundingnumbers) }else{ sharedvariablesoverview[kkk,1] <- i sharedvariablesoverview[kkk,2] <- ii sharedvariablesoverview[kkk,3] <- "." sharedvariablesoverview[kkk,4] <- "." } kkk <- kkk+1 } } names(sharedvariablesoverview) <- c("segment", "nbrsharedvar", "varname", "value") # Calculate max unique variables univars <- names(which(table(allnames)==1)) uniquevariables <- 0 for (i in 1:length(object[[2]])) { m <- object[[2]][i][[1]] uniquevariables <- max(uniquevariables,length(which(names(m$coefficients)%in%univars))) } # Create overview table unique variables uniquevariablesoverview <- as.data.frame(1:(nbrsegments*uniquevariables)) kkk <- 1 for (i in 1:nbrsegments) { for (ii in 1:uniquevariables) { consideredobj <- object[[2]][i][[1]] considervars <- names(consideredobj$coefficients) consideredunivars <- which(univars%in%considervars) if(ii%in%0:length(consideredunivars)){ uniquevariablesoverview[kkk,1] <- i uniquevariablesoverview[kkk,2] <- ii uniquevariablesoverview[kkk,3] <- univars[consideredunivars[ii]] uniquevariablesoverview[kkk,4] <- round(consideredobj$coefficients[which(considervars == univars[consideredunivars[ii]])][[1]],roundingnumbers) }else{ uniquevariablesoverview[kkk,1] <- i uniquevariablesoverview[kkk,2] <- ii uniquevariablesoverview[kkk,3] <- "." uniquevariablesoverview[kkk,4] <- "." } kkk <- kkk+1 } } names(uniquevariablesoverview) <- c("segment", "nbruniquevar", "varname", "value") # Calculate number of columns needed nbrcols <- decisionrules + sharedvariables + uniquevariables + 1 # # Calculate number of rows needed # nbrrows <- 4 # Define table table <- "" # Create header currentrule <- "" for (i in 1:decisionrules) { addnewrule <- paste0("") currentrule <- paste0(currentrule, addnewrule) } header <- gsub(pattern = "\n",replacement = "", x = paste0("", currentrule, "")) # Body: # Number of segmentsis number of blocks that need to be constructed # First colum is always number of segment # Create number of colums dependent on rules # Create number of colums dependent on shared variables # Create number of colums # decisionrulesoverview[which(decisionrulesoverview$segment==sss & decisionrulesoverview$rule == i), "variable"] for(sss in 1:nbrsegments){ rulesforsegment <- "" for (i in 1:decisionrules) { addnewrule <- paste0("") rulesforsegment <- paste0(rulesforsegment, addnewrule) } # sharedvariablesforsegment <- "" for (i in 1:sharedvariables) { # TODO_ add ifelse if there are variables not present if(i ==1){ sharedvariablesforsegment <- paste0("") } if (i>1) { addnewrule <- paste0("") sharedvariablesforsegment <- paste0(sharedvariablesforsegment, addnewrule) } } uniquevariablesforsegment<- "" for (i in 1:uniquevariables) { if(i ==1){ uniquevariablesforsegment <- paste0("") } if (i>1) { addnewrule <- paste0("") uniquevariablesforsegment <- paste0(uniquevariablesforsegment, addnewrule) } } if(sss == 1){ body <- gsub(pattern = "\n",replacement = "", x = paste0("", rulesforsegment,sharedvariablesforsegment,uniquevariablesforsegment,"")) } if(sss > 1){ body <- gsub(pattern = "\n",replacement = "", x = paste0(body,"", rulesforsegment,sharedvariablesforsegment,uniquevariablesforsegment,"")) } } body <- gsub(pattern = "\n",replacement = "", x = paste0(body,"")) # Footer footer <- paste0("
Rule",i,"
", headertext,"
Decision Rules Logistic Regression
Segment Shared Variables Unique Variables
", decisionrulesoverview[which(decisionrulesoverview$segment==sss & decisionrulesoverview$rule == i),"variable"],"
", decisionrulesoverview[which(decisionrulesoverview$segment==sss & decisionrulesoverview$rule == i),"sign"]," ", decisionrulesoverview[which(decisionrulesoverview$segment==sss & decisionrulesoverview$rule == i),"value"], "
VarName
<= 0.50
", # VariableName sharedvariablesoverview[which(sharedvariablesoverview$segment==sss & sharedvariablesoverview$nbrsharedvar == i),"varname"], "
", # Value, sharedvariablesoverview[which(sharedvariablesoverview$segment==sss & sharedvariablesoverview$nbrsharedvar == i),"value"], "
", # Variable sharedvariablesoverview[which(sharedvariablesoverview$segment==sss & sharedvariablesoverview$nbrsharedvar == i),"varname"], "
", # Value sharedvariablesoverview[which(sharedvariablesoverview$segment==sss & sharedvariablesoverview$nbrsharedvar == i),"value"], "
", # VariableName uniquevariablesoverview[which(uniquevariablesoverview$segment==sss & uniquevariablesoverview$nbruniquevar == i),"varname"], "
", # Value uniquevariablesoverview[which(uniquevariablesoverview$segment==sss & uniquevariablesoverview$nbruniquevar == i),"value"], "
", # VariableName uniquevariablesoverview[which(uniquevariablesoverview$segment==sss & uniquevariablesoverview$nbruniquevar == i),"varname"], "
", # Value uniquevariablesoverview[which(uniquevariablesoverview$segment==sss & uniquevariablesoverview$nbruniquevar == i),"value"], "
1
",sss,"
",footertext,"
") myresult <- paste0(table, header,body, footer) return(myresult) }