Guest User

Untitled

a guest
Nov 21st, 2017
69
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.98 KB | None | 0 0
  1. #' Apply cutoff in CV
  2. #'
  3. #' Apply a cutoff learned on a cross-validated model (from cv.learn.fun)
  4. #'
  5. #' @param CVmodel
  6. #' Model from cv.learn.fun
  7. #' @param CVcutoffs
  8. #' Cutoffs from cv.learn.cutoff
  9. #' @param cutoff.whichdata
  10. #' The cutoff on which data it was learned
  11. #' @param whichdata
  12. #' On which data from CVmodel should the cutoffs be applied?
  13. #' @param cutofflabels
  14. #' How are the cutoffs named? (For 2 cutoffs: low, mid, high)
  15. #' It happens that in one step two cutoffs have the same value.
  16. #' The samples are then parted into "low" and "high"
  17. #' @param reference.cutofflabel
  18. #' The cutoff-label "in the middle" (For 2 cutoffs: mid)
  19. #' @param newname
  20. #' How should the new column be named which is concatenated to CVmodel
  21. #' @return
  22. #' @export
  23. #'
  24. #' @examples
  25. cv.apply.cutoff <- function(CVmodel
  26. ,CVcutoffs
  27. ,cutoff.whichdata = "trainResponseScaled"
  28. ,whichdata = "testResponseScaled"
  29. ,cutofflabels = c("low", "mid", "high")
  30. ,reference.cutofflabel = "mid"
  31. ,newname="testResponseScaledGroups"){
  32. if(any(names(CVmodel) != names(CVcutoffs[[cutoff.whichdata]]))){
  33. stop("Names from CVmodel and CVcutoffs[[cutoff.whichdata]] are not equal")
  34. }
  35. cutoffs <- CVcutoffs[[cutoff.whichdata]]
  36. for(CVstepX in names(CVmodel)){
  37. tmp.cutoffs <- cutoffs[[CVstepX]]$cutoff
  38. tmp.cutoff.ranges <- c(-Inf, sort(unique(tmp.cutoffs)), Inf)
  39. tmp.cutofflabels <- cutofflabels
  40. if(length(tmp.cutoff.ranges) < (length(tmp.cutoffs) + 2)){
  41. tmp.cutofflabels <- cutofflabels[c(1:(length(tmp.cutoff.ranges)-2), length(cutofflabels))]
  42. }
  43. tmp.data <- CVmodel[[CVstepX]][[whichdata]]
  44. if(!is.null(tmp.data)){
  45. tmp.testgroups <- cut( tmp.data, tmp.cutoff.ranges, labels = tmp.cutofflabels)
  46. if(!(length(tmp.cutoff.ranges) < (length(tmp.cutoffs) + 2))){
  47. tmp.testgroups <- relevel(tmp.testgroups, ref = reference.cutofflabel)
  48. }
  49. names(tmp.testgroups) <- names(tmp.data)
  50. }else{
  51. tmp.testgroups <- NULL
  52. }
  53. CVmodel[[CVstepX]][[newname]] <- tmp.testgroups
  54. }
  55. return(CVmodel)
  56. }
Add Comment
Please, Sign In to add comment