/R/tests/testdir_jira/runit_hex_2020_LR_beta_constraints.R

https://gitlab.com/alvinahmadov2/h2o-2 · R · 66 lines · 47 code · 11 blank · 8 comment · 3 complexity · dacb5ddecf6e765fa209326f142f740e MD5 · raw file 

    

  1. ## This test is to check the beta contraint argument for GLM
    2. 

  2. ## The test will import the prostate data set,
    3. 

  3. ## runs glm with and without beta contraints which will be checked
    4. 

  4. ## against glmnet's results.
    5. 

    6. 

  6. #setwd("/Users/amy/h2o/R/tests/testdir_jira")
    7. 

  7. setwd(normalizePath(dirname(R.utils::commandArgs(asValues=TRUE)$"f")))
    8. 

  8. source('../findNSourceUtils.R')
    9. 

  9. 

  10. test.LR.betaConstraints <- function(conn) {
    11. 

  11.   
    12. 

  12.   Log.info("Importing prostate dataset...")
    13. 

  13.   prostate.hex = h2o.importFile(
    14. 

  14.     object = conn,system.file("extdata", "prostate.csv", package = "h2o"))
    15. 

  15.   
    16. 

  16.   Log.info("Create beta constraints frame...")
    17. 

  17.   myX =  c("AGE","RACE", "DPROS", "DCAPS", "PSA", "VOL", "GLEASON")
    18. 

  18.   lowerbound = rep(-1, times = length(myX))
    19. 

  19.   upperbound = rep(1, times = length(myX))
    20. 

  20.   betaConstraints = data.frame(names = myX, lower_bounds = lowerbound, upper_bounds = upperbound)
    21. 

  21.   prostate.csv = as.data.frame(prostate.hex)
    22. 

  22.   
    23. 

  23.   ######## Single variable CAPSULE ~ AGE in H2O and then R
    24. 

  24.   ## actual coeff for Age without constraints = -.00823
    25. 

  25.   Log.info("Run a Linear Regression with CAPSULE ~ AGE with bound beta->[0,1] in H2O...")
    26. 

  26.   beta_age = betaConstraints[betaConstraints$names == "AGE",]
    27. 

  27.   beta_age$lower_bounds = 0
    28. 

  28.   beta_age$upper_bounds = 1
    29. 

  29.   lr.h2o = h2o.glm(x = "AGE", y = "CAPSULE", data = prostate.hex, family = "gaussian", alpha = 0, beta_constraints = beta_age, standardize = T)
    30. 

  30.   lambda = lr.h2o@model$lambda
    31. 

  31.   
    32. 

  32.   Log.info("Run a Linear Regression with CAPSULE ~ AGE with bound beta->[0,1] in R...")
    33. 

  33.   intercept = rep(0, times = nrow(prostate.hex))
    34. 

  34.   xDataFrame = data.frame(AGE = prostate.csv[,"AGE"], Intercept = intercept)
    35. 

  35.   xMatrix_age = as.matrix(xDataFrame)
    36. 

  36.   lr.R = glmnet(x = xMatrix_age, alpha = 0., lambda = lr.h2o@model$lambda, standardize = T,
    37. 

  37.                 y = prostate.csv[,"CAPSULE"], family = "gaussian", lower.limits = 0., upper.limits = 1.)
    38. 

  38.   checkGLMModel2(lr.h2o, lr.R)
    39. 

  39.   
    40. 

  40.   #### shift AGE coefficient by 0.002
    41. 

  41.   run_glm <- function(family_type) {
    42. 

  42.     Log.info("Test Beta Constraints with negative upper bound in H2O...")
    43. 

  43.     lower_bound = -0.008
    44. 

  44.     upper_bound = -0.002
    45. 

  45.     beta_age$lower_bounds = lower_bound
    46. 

  46.     beta_age$upper_bounds = upper_bound
    47. 

  47.     nrow_prior = nrow(prostate.hex)
    48. 

  48.     lr_negativeUpper.h2o = h2o.glm(x = "AGE", y = "CAPSULE", data = prostate.hex, family = family_type, alpha = 0, beta_constraints = beta_age, standardize = T)
    49. 

  49.     nrow_after = nrow(prostate.hex)
    50. 

  50.     if(!nrow_prior == nrow_after) stop("H2OParsedData object is being overwritten.")
    51. 

  51.     
    52. 

  52.     Log.info("Shift AGE column to reflect negative upperbound...")
    53. 

  53.     xDataFrame = data.frame(AGE = prostate.csv[,"AGE"]*(1+upper_bound), Intercept = intercept)
    54. 

  54.     xMatrix_age = as.matrix(xDataFrame)
    55. 

  55.     lr_negativeUpper.R = glmnet(x = xMatrix_age, alpha = 0., lambda = lr.h2o@model$lambda, standardize = T,
    56. 

  56.                                 y = prostate.csv[,"CAPSULE"], family = family_type, lower.limits = lower_bound, upper.limits = 0.)  
    57. 

  57.     checkGLMModel2(lr_negativeUpper.h2o, lr_negativeUpper.R)
    58. 

  58.   }
    59. 

  59.   
    60. 

  60.   full_test <- sapply(c("binomial", "gaussian"), run_glm)
    61. 

  61.   print(full_test)
    62. 

  62.   testEnd()
    63. 

  63. }
    64. 

  64. 

  65. doTest("GLM Test: LR w/ Beta Constraints", test.LR.betaConstraints)
    66.