2.1 Using k-means

1. The k-means algorithm randomly selects k data points as initial means
2. k clusters are formed by assigning each data point to its closest cluster mean using the Euclidean distance
3. Virtual means for each cluster are calculated by using all datapoints contained in a cluster

The second and third steps are iterated until a predefined number of iterations is reached or the clusters converge. The runtime for the algorithm is O(n).

2.2 Using k-medoids

1. The k-medoids algorithm randomly selects k data points as initial means out of the n data points as the medoids.
2. k clusters are formed by assigning each data point to its closest medoid by using any common distance metric methods.
3. Virtual means for each cluster are calculated by using all datapoints contained in a cluster

The second and third steps are iterated until a predefined number of iterations is reached or the clusters converge. The runtime for the algorithm is O(k * (n-k)^2).

2.3 Hierarchical Vector Quantization

The algorithm divides the dataset recursively into cells using \(k-means\) or \(k-medoids\) algorithm. The maximum number of subsets are decided by setting \(n-cells\) to, say five, in order to divide the dataset into maximum of five subsets. These five subsets are further divided into five subsets(or less), resulting in a total of twenty five (5*5) subsets. The recursion terminates when the cells either contain less than three data point or a stop criterion is reached. In this case, the stop criterion is set to when the cell error exceeds the quantization threshold.

The steps for this method are as follows :

1. Select k(number of cells), depth and quantization error threshold
2. Perform quantization (using \(k-means\) or \(k-medoids\)) on the input dataset
3. Calculate quantization error for each of the k cells
4. Compare the quantization error for each cell to quantization error threshold
5. Repeat steps 2 to 4 for each of the k cells whose quantization error is above threshold until stop criterion is reached.

The stop criterion is when the quantization error of a cell satisfies one of the below conditions

• reaches below quantization error threshold
• there are less than three data point in the cell
• the user specified depth has been attained

2.3.1 Quantization Error

Let us try to understand quantization error with an example.

Figure 1: The Voronoi tessellation for level 1 shown for the 5 cells with the points overlayed

An example of a 2 dimensional VQ is shown above.

In the above image, we can see 5 cells with each cell containing a certain number of points. The centroid for each cell is shown in blue. These centroids are also known as codewords since they represent all the points in that cell. The set of all codewords is called a codebook.

Now we want to calculate quantization error for each cell. For the sake of simplicity, let’s consider only one cell having centroid A and m data points \(F_i\) for calculating quantization error.

For each point, we calculate the distance between the point and the centroid.

\[ d = ||A - F_i||_{p} \]

In the above equation, p = 1 means L1_Norm distance whereas p = 2 means L2_Norm distance. In the package, the L1_Norm distance is chosen by default. The user can pass either L1_Norm, L2_Norm or a custom function to calculate the distance between two points in n dimensions.

\[QE = \max(||A-F_i||_{p})\]

where

• \(A\) is the centroid of the cell
• \(F_i\) represents a data point in the cell
• \(p\) is the \(p\)-norm metric. Here \(p\) = 1 represents L1 Norm and \(p\) = 2 represents L2 Norm.

Now, we take the maximum calculated distance of all m points. This gives us the furthest distance of a point in the cell from the centroid, which we refer to as Quantization Error. If the Quantization Error is higher than the given threshold, the centroid/codevector is not a good representation for the points in the cell. Now we can perform further Vector Quantization on these points and repeat the above steps.

Please note that the user can select mean or max to calculate the Quantization Error. The custom function takes a vector of m value (where each value is a distance between point in n dimensions and centroids) and returns a single value which is the Quantization Error for the cell.

If we select mean as the error metric, the above Quantization Error equation will look like this :

\[QE = \frac{1}{m}\sum_{i=1}^m||A-F_i||_{p}\]

where

• \(A\) is the centroid of the cell
• \(F_i\) represents a data point in the cell
• \(m\) is the number of points in the cell
• \(p\) is the \(p\)-norm metric. Here \(p\) = 1 represents L1 Norm and \(p\) = 2 represents L2 Norm.

3.1 Tessellations

A Voronoi diagram is a way of dividing space into a number of regions. A set of points (called seeds, sites, or generators) is specified beforehand and for each seed, there will be a corresponding region consisting of all points within proximity of that seed. These regions are called Voronoi cells. It is complementary to Delaunay triangulation.

Tessellate: Constructing Voronoi Tesselations

In this package, we use sammons from the package MASS to project higher dimensional data to a 2D space. The function hvq called from the trainHVT function returns hierarchical quantized data which will be the input for construction of the tessellations. The data is then represented in 2D coordinates and the tessellations are plotted using these coordinates as centroids. We use the package deldir for this purpose. The deldir package computes the Delaunay triangulation (and hence the Dirichlet or Voronoi tessellation) of a planar point set according to the second (iterative) algorithm of Lee and Schacter. For subsequent levels, transformation is performed on the 2D coordinates to get all the points within its parent tile. Tessellations are plotted using these transformed points as centroids. The lines in the tessellations are chopped in places so that they do not protrude outside the parent polygon. This is done for all the subsequent levels.

5.1 Import Dataset from Local

The user can provide an absolute or relative path in the cell below to access the data from his/her computer. User can set import_data_from_local variable to TRUE to upload dataset from local.
Note: For this notebook import_data_from_local has been set to FALSE as we are simulating a dataset in next section.

import_data_from_local = FALSE # expects logical input

  file_name <- " " #enter the name of the local file
  file_path <- " " #enter the path of the local file

if(import_data_from_local){
  file_load <- paste0(file_path, file_name)
  dataset_updated <- as.data.frame(fread(file_load))
  if(nrow(dataset_updated) > 0){
    paste0("File ", file_name, " having ", nrow(dataset_updated), " row(s) and ", ncol(dataset_updated), " column(s)",  " imported successfully. ") %>% cat("\n")
    dataset_updated <- dataset_updated %>% mutate_if(is.numeric, round, digits = 4)
    paste0("Code chunk executed successfully. Below table showing first 10 row(s) of the dataset.") %>% cat("\n")
    dataset_updated %>% head(10) %>%as.data.frame() %>%DT::datatable(options = options, rownames = TRUE)
  }
  
} 

5.2 Simulate Dataset

In this section, we will use a simulated dataset. If you are not using this option set simulate_dataset to FALSE. Given below is a simulated dataset called torus that contains 12000 observations and 3 features.

Let us see how to generate data for torus. We are using a library geozoo for this purpose. Geo Zoo (stands for Geometric Zoo) is a compilation of geometric objects ranging from 3 to 10 dimensions. Geo Zoo contains regular or well-known objects, eg cube and sphere, and some abstract objects, e.g. Boy’s surface, Torus and Hyper-Torus.

Here, we load the data and store into a variable dataset_updated.

simulate_dataset= TRUE

if(simulate_dataset == TRUE){
  
set.seed(257)
##torus data generation
torus <- geozoo::torus(p = 3,n = 12000)
dataset_updated <- data.frame(torus$points)
colnames(dataset_updated) <- c("x","y","z")


  if(nrow(dataset_updated) > 0){
    paste0( "Dataset having ", nrow(dataset_updated), " row(s) and ", ncol(dataset_updated), " column(s)",  "simulated successfully. ") %>% cat("\n")  
    dataset_updated <- dataset_updated %>% mutate_if(is.numeric, round, digits = 4) 
    paste0("Code chunk executed successfully. The table below is showing first 10 row(s) of the dataset.") %>% cat("\n")
    dataset_updated %>% head(10) %>%as.data.frame() %>%displayTable()
  }
}

## Dataset having 12000 row(s) and 3 column(s)simulated successfully.  
## Code chunk executed successfully. The table below is showing first 10 row(s) of the dataset.

6.1 Quick Peek of the Data

Structure of Data

In the below section we can see the structure of the data.

dataset_updated %>% str()

## 'data.frame':    12000 obs. of  3 variables:
##  $ x: num  -1 1.1 -1 1.32 1.3 ...
##  $ y: num  -2.333 -2.745 1.266 0.621 -1.247 ...
##  $ z: num  -0.842 -0.288 -0.923 -0.841 -0.98 ...

6.2 Deleting Irrelevant Columns

The cell below will allow user to drop irrelevant column.

########################################################################################
################################## User Input Needed ###################################
########################################################################################

# Add column names which you want to remove
want_to_delete_column <- "no"

    del_col<-c(" `column_name` ")  

if(want_to_delete_column == "yes"){
   dataset_updated <-  dataset_updated[ , !(names(dataset_updated) %in% del_col)]
  print("Code chunk executed successfully. Overview of data types after removed selected columns")
  str( dataset_updated)
}else{
  paste0("No Columns removed. Please enter column name if you want to remove that column") %>% cat("\n")
}

## No Columns removed. Please enter column name if you want to remove that column

6.3 Formatting and Renaming Columns

The code below contains a user defined function to rename or reformat any column that the user chooses.

########################################################################################
################################## User Input Needed ###################################
########################################################################################

# convert the column names to lower case
colnames( dataset_updated) <- colnames( dataset_updated) %>% casefold()

## rename column ?
want_to_rename_column <- "no" ## type "yes" if you want to rename a column

## renaming a column of a dataset 
rename_col_name <- " 'column_name` " ## use small letters
rename_col_name_to <- " `new_name` "

if(want_to_rename_column == "yes"){
  names( dataset_updated)[names( dataset_updated) == rename_col_name] <- rename_col_name_to
}

# remove space, comma, dot from column names
spaceless <- function(x) {colnames(x) <- gsub(pattern = "[^[:alnum:]]+",
                             replacement = ".",
                             names(x));x}
 dataset_updated <- spaceless( dataset_updated)

## below is the dataset summary
paste0("Successfully converted the column names to lower case and check the renamed column name if you changed") %>% cat("\n")

## Successfully converted the column names to lower case and check the renamed column name if you changed

str( dataset_updated) ## showing summary for updated 

## 'data.frame':    12000 obs. of  3 variables:
##  $ x: num  -1 1.1 -1 1.32 1.3 ...
##  $ y: num  -2.333 -2.745 1.266 0.621 -1.247 ...
##  $ z: num  -0.842 -0.288 -0.923 -0.841 -0.98 ...

6.4 Changing Data Type of Columns

The section allows the user to change the data type of columns of his/her choice.

########################################################################################
################################## User Input Needed ###################################
########################################################################################

# If you want to change column type, change a below variable value to "yes"
want_to_change_column_type <- "no"

# you can change column type into numeric or character only
change_column_to_type <- "character" ## numeric

if(want_to_change_column_type == "yes" && change_column_to_type == "character"){
########################################################################################
################################## User Input Needed ###################################
########################################################################################
  select_columns <- c("panel_var") ###### Add column names you want to change here #####
   dataset_updated[select_columns]<- sapply( dataset_updated[select_columns],as.character)
  paste0("Code chunk executed successfully. Datatype of selected column(s) have been changed into numerical.")
  #str( dataset_updated)
}else if(want_to_change_column_type == "yes" && change_column_to_type == "numeric"){
  select_columns <- c('gearbox_oil_temperature')
   dataset_updated[select_columns]<- sapply( dataset_updated[select_columns],as.numeric)
  paste0("Code chunk executed successfully. Datatype of selected column(s) have been changed into categorical.")
  #str( dataset_updated)
}else{
  paste0("Datatype of columns have not been changed.") %>% cat("\n")
}

## Datatype of columns have not been changed.

dataset_updated <- do.call(data.frame, dataset_updated)
str( dataset_updated)

## 'data.frame':    12000 obs. of  3 variables:
##  $ x: num  -1 1.1 -1 1.32 1.3 ...
##  $ y: num  -2.333 -2.745 1.266 0.621 -1.247 ...
##  $ z: num  -0.842 -0.288 -0.923 -0.841 -0.98 ...

6.5 Checking and Removing Duplicates

Presence of duplicate observations can be misleading, this sections helps get rid of such rows in the dataset.

want_to_remove_duplicates <- "yes"  ## type "no" for choosing to not remove duplicates

## removing duplicate observation if present in the dataset
if(want_to_remove_duplicates == "yes"){
  
   dataset_updated <-  dataset_updated %>% unique()
  paste0("Code chunk executed successfully, duplicates if present successfully removed. Updated dataset has ", nrow( dataset_updated), " row(s) and ", ncol( dataset_updated), " column(s)") %>% print()
  cat("\n")
  str( dataset_updated) ## showing summary for updated dataset
} else{
  paste0("Code chunk executed successfully, NO duplicates were removed") %>% print()
}

## [1] "Code chunk executed successfully, duplicates if present successfully removed. Updated dataset has 12000 row(s) and 3 column(s)"
## 
## 'data.frame':    12000 obs. of  3 variables:
##  $ x: num  -1 1.1 -1 1.32 1.3 ...
##  $ y: num  -2.333 -2.745 1.266 0.621 -1.247 ...
##  $ z: num  -0.842 -0.288 -0.923 -0.841 -0.98 ...

6.6 List of Numerical and Categorical Column Names

# Return the column type 
CheckColumnType <- function(dataVector) {
  #Check if the column type is "numeric" or "character" & decide type accordingly
  if (class(dataVector) == "integer" || class(dataVector) == "numeric") {
    columnType <- "numeric"
  } else { columnType <- "character" }
  #Return the result
  return(columnType)
}
### Loading the list of numeric columns in variable
numeric_cols <<- colnames( dataset_updated)[unlist(sapply( dataset_updated, 
                                                       FUN = function(x){ CheckColumnType(x) == "numeric"}))]

### Loading the list of categorical columns in variable
cat_cols <- colnames( dataset_updated)[unlist(sapply( dataset_updated, 
                                                   FUN = function(x){ 
                                                     CheckColumnType(x) == "character"|| CheckColumnType(x) == "factor"}))]

### Removing Date Column from the list of categorical column
paste0("Code chunk executed successfully, list of numeric and categorical variables created.") %>% cat()

## Code chunk executed successfully, list of numeric and categorical variables created.

paste0("Numerical Column(s): \n Count : ", length(numeric_cols), "\n") %>% cat()

## Numerical Column(s): 
##  Count : 3

paste0(numeric_cols) %>% print()

## [1] "x" "y" "z"

paste0("Categorical Column(s): \n Count : ", length(cat_cols), "\n") %>% cat()

## Categorical Column(s): 
##  Count : 0

paste0(cat_cols) %>% print()

## character(0)

6.7 Filtering Dataset for Analysis

In this section, the dataset can be filtered for required row(s) for further analysis.

want_to_filter_dataset <- "no" ## type "yes" in case you want to filter
filter_col <- " "  ## Enter Column name to filter
filter_val <- " "  ## Enter Value to exclude for the column selected

if(want_to_filter_dataset == "yes"){
   dataset_updated <- filter_at( dataset_updated
                              , vars(contains(filter_col))
                              , all_vars(. != filter_val))
  
  paste0("Code chunk executed successfully, dataset filtered successfully on required columns. Updated dataset has ", nrow( dataset_updated), " row(s) and ", ncol( dataset_updated), " column(s)") %>% print()
  cat("\n")
  str( dataset_updated) ## showing summary for updated dataset
  
} else{
  paste0("Code chunk executed successfully, entire dataset is available for analysis.") %>% print()
}

## [1] "Code chunk executed successfully, entire dataset is available for analysis."

6.8 Missing Value Analysis

Missing values in the training data can lead to a biased model because we have not analyzed the behavior and relationship of those values with other variables correctly. It can lead to a wrong calculation or classification. Missing values can be of 3 types:

• Missing Completely At Random (MCAR): When missing data are MCAR, the presence/absence of data is completely independent of observable variables and parameters of interest. This is a case when the probability of missing variables is the same for all observations. For example, respondents of the data collection process decide that they will declare they’re earning after tossing a fair coin. If a head occurs, the respondent declares his / her earnings & vice versa.
• Missing At Random (MAR): When missing data is not random but can be related to an observed variable where there is complete information. This kind of missing data can induce a bias in the analysis, especially if it unbalances the data because of many missing values in a certain category. For example, we are collecting data for age and female has higher missing value compare to male.
• Missing Depending on Unobserved Predictors: This is a case when the missing values are not random and are related to the unobserved input variable.

Missing Value on Entire dataset

na_total <- sum(is.na( dataset_updated))/prod(dim( dataset_updated))
if(na_total == 0){
  paste0("In the uploaded dataset, there is no missing value") %>% cat("\n")
}else{
  na_percentage <- paste0(sprintf(na_total*100, fmt = '%#.2f'),"%")
  paste0("Percentage of missing value in entire dataset is ",na_percentage) %>% cat("\n")
}

## In the uploaded dataset, there is no missing value

Missing Value on Column-level

The following code is to visualize the missing values (if any) using bar chart.

gg_miss_upset function are using to visualize the patterns of missingness, or rather the combinations of missingness across cases.

This function gives us(if any missing value present):

• how many variables have missing values
• which variable has the most missing values
• And give us the variables which have missing values together

# Below code gives you missing value in each column
paste0("Number of missing value in each column") %>% cat("\n")

## Number of missing value in each column

print(sapply( dataset_updated, function(x) sum(is.na(x))))

## x y z 
## 0 0 0

missing_col_names <- names(which(sapply( dataset_updated, anyNA)))

total_na <- sum(is.na( dataset_updated))
# visualize the missing values (if any) using bar chart
if(total_na > 0 && length(missing_col_names) > 1){
  paste0("Code chunk executed successfully. Visualizing the missing values using bar chart") %>% cat("\n")
  gg_miss_upset( dataset_updated,
  nsets = 10,
  nintersects = NA)
}else if(total_na > 0){
   dataset_updated %>%
  DataExplorer::plot_missing() 
}else{
  paste("Code chunk executed successfully. No missing value exist.") %>% cat("\n")
}

## Code chunk executed successfully. No missing value exist.

Missing Value Treatment

In this section user can make decisions, how to tackle missing values in dataset. Both column(s) and row(s) can be removed in the following dataset based on the user choose to do so.

Drop Column(s) with Missing Values

The below code accepts user input and deletes the specified column.

########################################################################################
################################## User Input Needed ###################################
########################################################################################

# OR do you want to drop column specific column
drop_cloumn_name_na <- "yes" ## type "yes" to drop column(s)
# write column name that you want to drop
drop_column_name <- c(" ") #enter column name
if(drop_cloumn_name_na == "yes"){
  names_df=names( dataset_updated) %in% drop_column_name
  dataset_updated <-  dataset_updated[ , which(!names( dataset_updated) %in% drop_column_name)]
  paste0("Code chunk executed, selected column(s) dropped successfully.") %>% print()
  cat("\n")
  str( dataset_updated)
} else {
  paste0("Code chunk executed, missing value not removed (if any).") %>% cat("\n")
  cat("\n")
}

## [1] "Code chunk executed, selected column(s) dropped successfully."
## 
## 'data.frame':    12000 obs. of  3 variables:
##  $ x: num  -1 1.1 -1 1.32 1.3 ...
##  $ y: num  -2.333 -2.745 1.266 0.621 -1.247 ...
##  $ z: num  -0.842 -0.288 -0.923 -0.841 -0.98 ...

Drop Row(s) with Missing Values

The below code accepts user input and deletes rows.

# Do you want to drop row(s) containing "NA"
drop_row <- "no" ## type "yes" to delete missing value observations
if(drop_row == "yes"){
   dataset_updated <-  dataset_updated %>% na.omit()
   paste0("Code chunk executed, missing values successfully identified and removed. Updated dataset has ", nrow( dataset_updated), " row(s) and ", ncol( dataset_updated), " column(s)") %>% print()
  cat("\n")
} else{
  paste0("Code chunk executed, missing value(s) not removed (if any).") %>% cat("\n")
  cat("\n")
}

## Code chunk executed, missing value(s) not removed (if any).

cat_cols <-
  colnames(dataset_updated)[unlist(sapply(
    dataset_updated,
    FUN = function(x) {
      CheckColumnType(x) == "character" ||
        CheckColumnType(x) == "factor"
    }
  ))]

apply(dataset_updated[cat_cols], 2, function(x) {
  length(unique(x))
})

## integer(0)

########################################################################################
################################## User Input Needed ###################################
########################################################################################
# Do you want to dummify the categorical variables?

dummify_cat <- FALSE ## TRUE,FALSE

# Select the columns on which dummification is to be performed
dum_cols <- c(" "," ") #enter column name in smalls

## [1] "One-Hot Encoding was not performed on dataset."

# Check data for singularity
singular_cols <- sapply(dataset_updated,function(x) length(unique(x))) %>%  # convert to dataframe
  data.frame(Unique_n = .) %>% dplyr::filter(Unique_n == 1) %>% 
  rownames() %>% data.frame(Constant_Variables = .)

if(nrow(singular_cols) != 0) {                              
  singular_cols  %>% DT::datatable()
} else {
  paste("There are no singular columns in the dataset") %>% htmltools::HTML()
}

# Display variance of columns
data <- dataset_updated %>% dplyr::summarise_if(is.numeric, var) %>% t() %>% 
  data.frame() %>% round(3) #%>% DT::datatable(colnames = "Variance")

colnames(data) <- c("Variance")
displayTable(data)

numeric_cols=as.vector(sapply(dataset_updated, is.numeric))
dataset_updated=dataset_updated[,numeric_cols]
colnames(dataset_updated)

## [1] "x" "y" "z"

6.9 Final Dataset Summary

All further operations will be performed on the following dataset.

nums <- colnames(dataset_updated)[unlist(lapply(dataset_updated, is.numeric))]
cat(paste0("Final data frame contains ", nrow( dataset_updated), " row(s) and ", ncol( dataset_updated), " column(s).","Code chunk executed. Below table showing first 10 row(s) of the dataset."))

## Final data frame contains 12000 row(s) and 3 column(s).Code chunk executed. Below table showing first 10 row(s) of the dataset.

dataset_updated <-  dataset_updated %>% mutate_if(is.numeric, round, digits = 4)

displayTable(dataset_updated[1:10,])

8.1 Model Diagnostics and Validation

8.2 Diagnostic Plots

The basic tool for examining the model fit is proximity plots and distribution of observations across centroids.

The proximity between object can be measured as distance matrix. The distances between the objects is calculated using Manhattan or Euclidean Distance and put into a matrix form. In the next step we find the minimum value for each row, excluding the diagonal values, as the diagonal elements of distance matrix are zero representing distance from an object to itself. This minimum distance value gives the proximity(distance to nearest neighbour) of other object in the datatable.

`plotModelDiagnostics() function can be used to print diagnostic plots for HVT model or HVT scoring.

The plotModelDiagnostics() function for HVT Model provides 5 diagnostic plots which are as follows:

• Mean Absolute Deviation Plot: Calibration: HVT Model | Train Data
• Minimum Intra-DataPoint Distance Plot: Train Data
• Minimum Intra-Centroid Distance Plot: HVT Model | Train Data
• Distribution of Number of Observations in Cells: HVT Model | Train Data
• Singletons Pie Chart: HVT Model | Train Data

Let’s have look at the function plotModelDiagnostics which we will use to print the diagnostic plots.

plotModelDiagnostics(hvt.results)

p3=hvt.results[[4]]$mad_plot_train+ggtitle("Mean Absolute Deviation Plot: Calibration: HVT Model | Train Data")
p3

p1=hvt.results[[4]]$datapoint_plot+ggtitle("Minimum Intra-DataPoint Distance Plot: Train Data")
p1

p2=hvt.results[[4]]$cent_plot+ggtitle("Minimum Intra-Centroid Distance Plot: HVT Model | Train Data")
p2

p4=hvt.results[[4]]$number_plot+ggtitle("Distribution of Number of Observations in Cells: HVT Model | Train Data")
p4

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

p5=hvt.results[[4]]$singleton_piechart
p5

m1=hvt.results[[5]][["mad_plot"]]+ggtitle("Mean Absolute Deviation Plot:Validation")
m1

9.1 Scoring Algorithm

The Scoring algorithm recursively calculates the distance between each point in the test dataset and the cell centroids for each level. The following steps explain the scoring method for a single point in the test dataset :

1. Calculate the distance between the point and the centroid of all the cells in the first level.
2. Find the cell whose centroid has minimum distance to the point.
3. Check if the cell drills down further to form more cells.
4. If it doesn’t, return the path. Or else repeat steps 1 to 4 till we reach a level at which the cell doesn’t drill down further.

9.2 Load Test Data

The user can provide an absolute or relative path in the cell below to access the test data from his/her computer.

load_test_data=FALSE
if(load_test_data){
  file_name <- " " #enter the name of the local file for validation
  file_path <- " " #enter the path of the local file for validation
  file_load <- paste0(file_path, file_name)
  dataset_updated_test <- as.data.frame(fread(file_load))
  
  if(nrow(dataset_updated_test) > 0){

    paste0("File ", file_name, " having ", nrow(dataset_updated_test), " row(s) and ",
ncol(dataset_updated_test), " column(s)",  " imported successfully. ") %>% cat("\n")
dataset_updated_test <- dataset_updated_test %>% mutate_if(is.numeric, round, digits = 4)
    paste0("Code chunk executed successfully. Below table showing first 10 row(s) of the dataset.") %>% cat("\n")
    dataset_updated_test %>% head(10) %>%as.data.frame() %>%DT::datatable(options = options, rownames = TRUE)
  }
  
  colnames( dataset_updated_test) <- colnames( dataset_updated_test) %>% casefold()
 dataset_updated_test <- spaceless( dataset_updated_test)
}

if(dummify_cat){
dummified_cols_test <- dataset_updated_test %>% dplyr::select(dum_cols) %>%
  dummies::dummy.data.frame(dummy.classes = "ALL", sep = "_")

names(dummified_cols_test) <- gsub(pattern = "[^[:alnum:]]+",
                             replacement = ".",
                             names(dummified_cols_test))

columns_difference=setdiff(dummified_cols,names(dummified_cols_test))
dummified_cols_test[,columns_difference]=0

dataset_updated_test <- dataset_updated_test %>% cbind(dummified_cols_test) %>%     
# append encoded columns
dplyr::select(-dum_cols)
# remove the old categorical columns
dummified_cols_test %>% head(5) %>% DT::datatable(options = options)
}

dataset_updated_test=dataset_updated_test %>% dplyr::select(nums)

9.3 Scoring on Test Data

scoreHVT(dataset,
         hvt.results,
         child.level,
         mad.threshold,
         line.width,
         color.vec,
         normalize,
         distance_metric,
         error_metric,
         yVar,
         analysis.plots, 
         names.column)

The important parameters for the function scoreHVT are as below

• dataset - A dataframe containing the test dataset. The dataframe should have all the variable(features) used for training.

• hvt.results.model - A list obtained from the trainHVT function while performing hierarchical vector quantization on training data. This list provides an overview of the hierarchical vector quantized data, including diagnostics, tessellation details, Sammon’s projection coordinates, and model input information.

• child.level - A number indicating the depth for which the heat map is to be plotted. Each depth represents a different level of clustering or partitioning of the data.

• mad.threshold - A numeric value indicating the permissible Mean Absolute Deviation which is obtained from Minimum Intra centroid plot(when diagnose is set to TRUE in trainHVT). mad.threshold value is important since it is used in anomaly detection. Default value is 0.2 NOTE: for a given datapoint, when the quantization error is above mad.threshold it is denoted as anomaly else not.

• line.width - A vector indicating the line widths of the tessellation boundaries for each layer. (Optional Parameter)

• color.vec - A vector indicating the colors of the tessellations boundaries at each layer. (Optional Parameter)

• normalize - A logical value indicating if the dataset should be normalized. When set to TRUE, the data (testing dataset) is standardized by mean and sd of the training dataset referred from the trainHVT(). When set to FALSE, the data is used as such without any changes.

• distance_metric - The distance metric can be L1_Norm(Manhattan) or L2_Norm(Euclidean). The metric is used when calculating distance between each datapoint(in test dataset) with the centroids obtained from results of trainHVT. Default is L1_Norm.

• error_metric - The error metric can be mean or max. max will return the max of m values and mean will take mean of m values where each value is a distance between the datapoint and centroid of the cell. This helps in calculating the scored quantization error. Default value is max.

• yVar - A character or a vector representing the name of the dependent variable(s)

The below given arguments are used only when character column can be mapped over the scored results. since torus doesn’t have a character column, we are not using them in this vignette.

• analysis.plots - A logical value to indicate whether to include the insight plots which are useful in viewing the contents and clusters of cells. Default is FALSE.

• names.column - The column of names of the datapoints which will be displayed as the contents of the cell in ‘scoredPlotly’. Default is NULL.

Here the mad_threshold has been selected as 0.8 which is based on Mean of Minimum Intra-Centroid Distance plot from above.

hvt.score <- scoreHVT(dataset_updated_test,
                      hvt.results,
                      child.level = 1,
                      mad.threshold = 0.8, 
                      line.width = c(0.6, 0.4, 0.2),
                      color.vec = c("navyblue", "slateblue", "lavender"),
                      distance_metric = "L1_Norm",
                      error_metric = "max")

displayTable(hvt.score[["scoredPredictedData"]], value = 0.8)

The plotModelDiagnostics() function can be called for scoring object as well. Shown below is the comparison of Mean Absolute Deviation Plot for train data and test data.

plotModelDiagnostics(hvt.score)

plotQuantErrorHistogram(hvt.results,hvt.score)

QECompareDf <- hvt.score$QECompareDf %>% filter(anomalyFlag == 1)
displayTable(QECompareDf)