inst/shiny/Rcode.R

In reza-niazi/MLRpack: Introductory Pacakge

#coef[1] = beta0
#coef[2] = beta1
#coef[3] = ...

myf = function(x,xk,coef){
  coef[1]+coef[2]*(x) + coef[3]*(x-xk)*(x-xk>0)
}

#This will give the value of R^2 as a function of xk
rsq = function(xk,data){ # data=spruce.df
  df=within(data, X<-(BHDiameter-xk)*(BHDiameter>xk))
  #df = within(data, K<-(BHDiameter-xk2)*(BHDiameter>xk2))
  lmp=lm(Height ~ BHDiameter + X, data=df)
  tmp = summary(lmp)
  tmp$r.squared
}

rsqmult = function(xk,xk2,data){
  if(xk2>xk){
    X<-(data$BHDiameter-xk)*(data$BHDiameter>xk)
    K<-(data$BHDiameter-xk2)*(data$BHDiameter>xk2)
    df=within(data, X)
    df = within(data,K)
    lmp=lm(Height ~ BHDiameter + X + K, data=df)
    tmp = summary(lmp)
    r2 = tmp$r.squared
  }
  else{
    r2 = 0
  }
}

#Calculates approximate derivative value around the point xk
rsqdash = function(xk,h,data) {
 (rsq((xk+h/2),data)-rsq((xk-h/2),data))/h
}


myf2 = function(x,xk,xk2,coef){
  coef[1]+coef[2]*(x) + coef[3]*(x-xk)*(x-xk>0)+ coef[4]*(x-xk2)*(x-xk2>0)
}

coeff = function(xk,xk2,data){ # data=spruce.df
  df=within(data, {
            X<-(BHDiameter-xk)*(BHDiameter>xk)
            X2<-(BHDiameter-xk2)*(BHDiameter>xk2)
  }
            )
  lmp=lm(Height ~ BHDiameter + X + X2, data=df)
  coef(lmp)
}

shinyddt<-function(){
  shiny::runApp(system.file("shiny", package="MLRpack"),launch.browser = TRUE)
}