R/validateVec.R

In sontron/ZJDRG: ZJDRG deal the data grouping using ZJ-DRG rules

#' validateVec
#' 
#' from madis package
#' 
#' @export


validateVec<-function(x,
                      L,
                      method=c('ranges','substrs','elements')[1],
                      mode=c('numeric','character','datetime')[1],
                      type=c('fixed','regex')[1],
                      tsFormat='ymd'){
  
  stopifnot(method%in%c('elements','substrs','ranges')|mode%in%c('numeric','character','datetime'))
  require('stringi')
  
  ## numeric and datetime value within a given range
  if(method=='ranges'){
    len<-length(L)
    sapply(1:len,function(i){
      if(grepl(',',L[i])){
        unlist(strsplit(L[i],",",fixed=T))->l
        if(mode=='numeric'){
          
          if(grepl("(",l[1],fixed=T)) {as.numeric(gsub("(^[[:punct:]]|[[:punct:]]$)","",l[1]))->range_l;x>range_l->ind.l}
          if(grepl(")",l[2],fixed=T)) {as.numeric(gsub("(^[[:punct:]]|[[:punct:]]$)","",l[2]))->range_r;x<range_r->ind.r}
          if(grepl("[",l[1],fixed=T)) {as.numeric(gsub("(^[[:punct:]]|[[:punct:]]$)","",l[1]))->range_l;x>=range_l->ind.l}
          if(grepl("]",l[2],fixed=T)) {as.numeric(gsub("(^[[:punct:]]|[[:punct:]]$)","",l[2]))->range_r;x<=range_r->ind.r}
        }
        
        if(mode=='datetime'){
          parse_date_time(x,orders=tsFormat)->x
          if(grepl("(",l[1],fixed=T)) {as.numeric(parse_date_time(gsub("(^[[:punct:]]|[[:punct:]]$)","",l[1]),orders=tsFormat))->range_l;x>range_l->ind.l}
          if(grepl(")",l[2],fixed=T)) {as.numeric(parse_date_time(gsub("(^[[:punct:]]|[[:punct:]]$)","",l[2]),orders=tsFormat))->range_r;x<range_r->ind.r}
          if(grepl("[",l[1],fixed=T)) {as.numeric(parse_date_time(gsub("(^[[:punct:]]|[[:punct:]]$)","",l[1]),orders=tsFormat))->range_l;x>=range_l->ind.l}
          if(grepl("]",l[2],fixed=T)) {as.numeric(parse_date_time(gsub("(^[[:punct:]]|[[:punct:]]$)","",l[2]),orders=tsFormat))->range_r;x<=range_r->ind.r}
        }
        ifelse(ind.l&ind.r,T,F)->res
      } else {
        
        if(mode=='numeric'){
          gsub("(^[[:punct:]]|[[:punct:]]$)","",L[i])->l
          as.numeric(l)->range_p
        }
        
        if(mode=='datetime'){
          gsub("(^[[:punct:]]|[[:punct:]]$)","",L[i])->l
          parse_date_time(x,orders=tsFormat)->x
          as.numeric(parse_date_time(l,orders=tsFormat))->range_p
        }
        
        ifelse(x==range_p,T,F)->res
      }
      return(res)
    })->res
    apply(matrix(res,nc=len),1,any)->res
  }
  
  # discrete numeric values or characters within a given set.
  if(method=='elements'){
    ifelse(is.element(x,L),T,F)->res
  }
  
  # subset of character strings within a given set.
  if(method=='substrs'){
    #paste(L,collapse=';')->pattern
    len<-length(L)
    if(type=='fixed'){
      sapply(L,function(i){
        stri_detect_fixed(x,i)->res
        return(res)
      })->res
    }
    
    if(type=='regex'){
      sapply(L,function(i){
        stri_detect_regex(x,i)->res
        return(res)
      })->res
    }
    apply(matrix(res,nc=len),1,any)->res
  }
  return(res)
}