Survey analysis use Dalex and new Cluster

dn <- read.csv("d:/UPWORK-SHINY/dclean-new.csv")
ddn <- dn %>% dplyr::select(Firstryprod_Response,Science_Response,Supplement_Response,Age_Response,Veva_response,
      SpendCostsupplement_Response,Hincome_Response,Region_Response)              

Analysis

rfs <- randomForest(Firstryprod_Response~.,data=ddn)

Explainer

erfs <- DALEX::explain(rfs,data=ddn[,2:8],y=ddn$Firstryprod_Response)

## Preparation of a new explainer is initiated
##   -> model label       :  randomForest  (  default  )
##   -> data              :  206  rows  7  cols 
##   -> target variable   :  206  values 
##   -> predict function  :  yhat.randomForest  will be used (  default  )
##   -> predicted values  :  numerical, min =  1.422096 , mean =  4.929782 , max =  8.92598  
##   -> model_info        :  package randomForest , ver. 4.6.14 , task regression (  default  ) 
##   -> residual function :  difference between y and yhat (  default  )
##   -> residuals         :  numerical, min =  -2.757598 , mean =  0.007111201 , max =  3.039215  
##   A new explainer has been created! 

plot(rfs)#ok

Performance

mp_rf <- model_performance(erfs)
#plot(mp_rf)

Variable important

vi_lm <- variable_importance(erfs, loss_function = loss_root_mean_square)
plot(vi_lm)

Detail analysis

Firstryprod_Response = 1,detail response for Firstryprod_Response = 1,the meaning "1 - Never"

dn <- read.csv("d:/UPWORK-SHINY/dclean-new.csv")
ddn <- dn %>% select(Firstryprod_Response,Science_Response,Supplement_Response,Age_Response,Veva_response,
      SpendCostsupplement_Response,Hincome_Response,Region_Response)  
library(ceterisParibus)

## Loading required package: gower

## Registered S3 methods overwritten by 'ceterisParibus':
##   method                            from       
##   plot.ceteris_paribus_explainer    ingredients
##   plot.ceteris_paribus_oscillations ingredients
##   print.ceteris_paribus_explainer   ingredients

erfs <- DALEX::explain(rfs,data=ddn[,2:8],y=ddn$Firstryprod_Response)

## Preparation of a new explainer is initiated
##   -> model label       :  randomForest  (  default  )
##   -> data              :  206  rows  7  cols 
##   -> target variable   :  206  values 
##   -> predict function  :  yhat.randomForest  will be used (  default  )
##   -> predicted values  :  numerical, min =  1.422096 , mean =  4.929782 , max =  8.92598  
##   -> model_info        :  package randomForest , ver. 4.6.14 , task regression (  default  ) 
##   -> residual function :  difference between y and yhat (  default  )
##   -> residuals         :  numerical, min =  -2.757598 , mean =  0.007111201 , max =  3.039215  
##   A new explainer has been created! 

cp_rf1 <- ceteris_paribus(erfs, ddn[2,])
plot(cp_rf1, alpha = 0.5, color = "_label_", size_points = 4)

Firstryprod_Response = 10, detail response for Firstryprod_Response = 10, the meaning "10 - Always"

dn <- read.csv("d:/UPWORK-SHINY/dclean-new.csv")
ddn <- dn %>% select(Firstryprod_Response,Science_Response,Supplement_Response,Age_Response,Veva_response,
      SpendCostsupplement_Response,Hincome_Response,Region_Response) 
erfs <- DALEX::explain(rfs,data=ddn[,2:8],y=ddn$Firstryprod_Response)

## Preparation of a new explainer is initiated
##   -> model label       :  randomForest  (  default  )
##   -> data              :  206  rows  7  cols 
##   -> target variable   :  206  values 
##   -> predict function  :  yhat.randomForest  will be used (  default  )
##   -> predicted values  :  numerical, min =  1.422096 , mean =  4.929782 , max =  8.92598  
##   -> model_info        :  package randomForest , ver. 4.6.14 , task regression (  default  ) 
##   -> residual function :  difference between y and yhat (  default  )
##   -> residuals         :  numerical, min =  -2.757598 , mean =  0.007111201 , max =  3.039215  
##   A new explainer has been created! 

cp_rf10 <- ceteris_paribus(erfs, ddn[16,])                   
plot(cp_rf10, alpha = 0.5, color = "_label_", size_points = 4)

Create Cluster

plot for variable: Firstryprod_Response,Science_Response,Supplement_Response,Age_Response,Veva_response, SpendCostsupplement_Response,Hincome_Response,Region_Response

dt <- optbin(ddn)
mdl <- OneR(dt,verbose = TRUE)

## Warning in OneR.data.frame(dt, verbose = TRUE): data contains unused factor
## levels

## 
##     Attribute                    Accuracy
## 1 * Supplement_Response          27.67%  
## 2   Science_Response             26.21%  
## 3   Firstryprod_Response         24.27%  
## 4   SpendCostsupplement_Response 23.3%   
## 5   Age_Response                 22.82%  
## 6   Hincome_Response             20.39%  
## 7   Veva_response                19.9%   
## ---
## Chosen attribute due to accuracy
## and ties method (if applicable): '*'

plot(mdl)