sbrlModel2arcCBARuleModel: sbrlModel2arcCBARuleModel Converts a model created by 'sbrl'...
In qCBA: Quantitative Classification by Association Rules

Description Usage Arguments Examples

View source: R/rMARC.R

Creates instance of CBAmodel class from the arc package. SBRL package is no longer in CRAN, but can be obtained from https://github.com/cran/sbrl Instance of CBAmodel can then be passed to qcba

sbrlModel2arcCBARuleModel(
  sbrl_model,
  cutPoints,
  rawDataset,
  classAtt,
  attTypes
)

`sbrl_model`	object returned by arulesCBA::CBA()
`cutPoints`	specification of cutpoints applied on the data before they were passed to `rCBA::build`
`rawDataset`	the raw data (before discretization). This dataset is used to guess attribute types if attTypes is not passed
`classAtt`	the name of the class attribute
`attTypes`	vector of attribute types of the original data. If set to null, you need to pass rawDataset.

# if (! requireNamespace("rCBA", quietly = TRUE)) {
#  message("Please install rCBA to allow for sbrl model conversion")
#   return()
# } else if (! requireNamespace("sbrl", quietly = TRUE)) {
#  message("Please install sbrl to allow for postprocessing of sbrl models")
#} else
#{
#  library(sbrl)
#  library(rCBA)
#  #sbrl handles only binary problems, iris has 3 target classes - remove one class
#  set.seed(111)
#  allData <- datasets::iris[sample(nrow(datasets::iris)),]
#  classToExclude<-"versicolor"
#  allData <- allData[allData$Species!=classToExclude, ]
#  # drop virginica level
#  allData$Species <-allData$Species [, drop=TRUE]
#  trainFold <- allData[1:50,]
#  testFold <- allData[51:nrow(allData),]
#  sbrlFixedLabel<-"label"
#  origLabel<-"Species"

#  orignames<-colnames(trainFold)
#  orignames[which(orignames == origLabel)]<-sbrlFixedLabel
#  colnames(trainFold)<-orignames
#   colnames(testFold)<-orignames

#  # to recode label to binary values:
#  # first create dict mapping from original distinct class values to 0,1 
#  origval<-levels(as.factor(trainFold$label))
#  newval<-range(0,1)
#  dict<-data.frame(origval,newval)
#  # then apply dict to train and test fold
#  trainFold$label<-dict[match(trainFold$label, dict$origval), 2]
#  testFold$label<-dict[match(testFold$label, dict$origval), 2]

#  # discretize training data
#  trainFoldDiscTemp <- discrNumeric(trainFold, sbrlFixedLabel)
#  trainFoldDiscCutpoints <- trainFoldDiscTemp$cutp
#  trainFoldDisc <- as.data.frame(lapply(trainFoldDiscTemp$Disc.data, as.factor))

#  # discretize test data
#  testFoldDisc <- applyCuts(testFold, trainFoldDiscCutpoints, infinite_bounds=TRUE, labels=TRUE)

#  # learn sbrl model
#  sbrl_model <- sbrl(trainFoldDisc, iters=30000, pos_sign="0", 
#                   neg_sign="1", rule_minlen=1, rule_maxlen=10, 
#                    minsupport_pos=0.10, minsupport_neg=0.10, 
#                   lambda=10.0, eta=1.0, alpha=c(1,1), nchain=10)
#  # apply sbrl model on a test fold
#  yhat <- predict(sbrl_model, testFoldDisc)
#  yvals<- as.integer(yhat$V1>0.5)
#  sbrl_acc<-mean(as.integer(yvals == testFoldDisc$label))
#  message("SBRL RESULT")
#  sbrl_model
#  rm_sbrl<-sbrlModel2arcCBARuleModel(sbrl_model,trainFoldDiscCutpoints,trainFold,sbrlFixedLabel) 
#  message(paste("sbrl acc=",sbrl_acc,"sbrl rule count=",nrow(sbrl_model$rs), "avg rule length", 
#  sum(rm_sbrl@rules@lhs@data)/length(rm_sbrl@rules)))
#  rmQCBA_sbrl <- qcba(cbaRuleModel=rm_sbrl,datadf=trainFold)
#  prediction <- predict(rmQCBA_sbrl,testFold)
#  acc_qcba_sbrl <- CBARuleModelAccuracy(prediction, testFold[[rmQCBA_sbrl@classAtt]])
#  if (! requireNamespace("stringr", quietly = TRUE)) {
#    message("Please install stringr to compute average rule length for QCBA")
#    avg_rule_length <- NA
#  } else
#  {
#    library(stringr)
#    avg_rule_length <- (sum(unlist(lapply(rmQCBA_sbrl@rules[1],str_count,pattern=",")))+
#                          # assuming the last rule has antecedent length zero 
#                          nrow(rmQCBA_sbrl@rules)-1)/nrow(rmQCBA_sbrl@rules)
#  }
#  message("QCBA RESULT")
#  rmQCBA_sbrl@rules
#  message(paste("QCBA after SBRL acc=",acc_qcba_sbrl,"rule count=",
#   rmQCBA_sbrl@ruleCount, "avg rule length",  avg_rule_length))
#   unlink("tdata_R.label") # delete temp files created by SBRL
#   unlink("tdata_R.out")
# }