R/05c.Change_binary.R

In btrm: Bayesian Treed Regression Model for Personalized Prediction and Precision Diagnostics

Change_binary=function(ET,SIN,minsample){
  
  ####
  #1. Initial value
  ####
  n=ET$n
  q=ET$q
  y=ET$y
  x=ET$x
  
  splitVariable=ET$splitVariable
  cutoff=ET$cutoff
  marker=ET$marker
  
  node.hat=ET$node.hat
  marker.hat=ET$marker.hat
  
  internal=ET$internal
  terminal=ET$terminal
  
  eta=ET$eta
  
  ####
  # 2. Update tree structure
  ####
  #2.1. select feature
  splitVariable[SIN]=sample(1:q,1,prob = ET$dir.predictor)
  
  #2.2. all idx number in node SIN
  subTreeNode=NA
  for (i in 1:(floor(log2(max(terminal)))-floor(log2(SIN)))){
    subadd = 2^i*SIN+0:(2^i-1)
    subTreeNode=sort(c(subTreeNode,subadd))
  }
  idx=node.hat %in% subTreeNode                          # idx, i.e. those who belong to node SIN
  x.sel=unique(x[which(idx),splitVariable[SIN]])         # selected x for those belong to node SIN
  cutoff[SIN]=sample(x.sel,1)                            # define new cutoff value
  
  #2.3. tree structure with new predictor and cutoff value
  eta=eta[1]
  node.hat=rep(1,n)
  for(i in internal){
    # define index number and eta number
    idx=(node.hat==i)
    x.sel=unique(x[which(idx),splitVariable[i]])
    eta[i]=length(x.sel)
    
    # Split node i into left & right
    left=which(idx & x[,splitVariable[i]]<=cutoff[i])
    right=which(idx & x[,splitVariable[i]]>cutoff[i])
    
    node.hat[left]=2*i
    node.hat[right]=2*i+1
    
    cond1=min(table(y,node.hat))>minsample         # subgroup sample size is large enough
    cond2=length(left)>minsample                   # table above does not work if left or right is empty
    cond3=length(right)>minsample
    size.cond=cond1&cond2&cond3
    
    if(size.cond){
      marker.hat[left]=marker[2*i]               # selected marker for each subj
      marker.hat[right]=marker[2*i+1]
    }else{
      break
    }
  }
  
  ####
  # 3. summary
  ####
  ET$eta=eta
  ET$splitVariable=splitVariable
  ET$cutoff=cutoff
    
  ET$marker=marker
  ET$node.hat=node.hat
  ET$marker.hat=marker.hat
    
  ET$internal=internal
  ET$terminal=terminal
    
  ET$numNodes=length(ET$terminal)
  ET$size.cond=size.cond
  
  return(ET)
}