# Hello, world!
#
# This is an example function named 'hello'
# which prints 'Hello, world!'.
#
# You can learn more about package authoring with RStudio at:
#
# http://r-pkgs.had.co.nz/
#
# Some useful keyboard shortcuts for package authoring:
#
# Build and Reload Package: 'Ctrl + Shift + B'
# Check Package: 'Ctrl + Shift + E'
# Test Package: 'Ctrl + Shift + T'
library(lubridate)
translate <- function(data,code,output){
data[substr(data,1,nchar(code)) %in% code]=output
data
}
#Extend function Translate to a vector, and interpret to "Other" for codes not mentioned
recode <- function(data,code_list,output_list,other="Other"){
data=as.character(data)
for (i in 1:length(code_list)){
data=translate(data,code_list[i],output_list[i])
}
data[!data %in% output_list]=other
data
}
set_level <- function(data,base=default){
data <- as.character(data)
default=names(which.max(table(data)))
relevel(as.factor(data),ref=base)
}
duplicates <- function(dataFrame,var){
temp=dataFrame[duplicated(dataFrame[var]) | duplicated(dataFrame[var],fromLast = TRUE),]
temp=temp[order(temp[var]),]
temp
}
deduplicates <- function(dataFrame,var,all=FALSE){
if (all) return(dataFrame[!(duplicated(dataFrame[var])|duplicated(dataFrame[var],fromLast = TRUE)),])
if (!all) return(dataFrame[!duplicated(dataFrame[var]),])
}
get_next_Tue<-function(date){
date=as.Date(date)
dow=wday(date)
if(dow<=3) return(date+3-dow)
if(dow>3) return(date+10-dow)
}
get_last_Tue<-function(date){
date=as.Date(date)-7
dow=wday(date)
if(dow<=3) return(date+3-dow)
if(dow>3) return(date+10-dow)
}
date_to_ymd <- function(date){
y=year(date)
m=month(date)
d=day(date)
if (m<10) m=paste('0',m,sep='')
if (d<10) d=paste('0',d,sep='')
return(paste(y,m,d,sep=''))
}
get_historical_status <- function(stsp_history, SUB_RRN, date){
if (class(date)!="Date") stop("input 'date' is not Date format")
temp_history=stsp_history[stsp_history$SUB_RRN==SUB_RRN,]
temp_history=temp_history[temp_history$STSP_EFF_DT<=date,]
temp_history=temp_history[order(temp_history$STSP_EFF_DT,decreasing = TRUE),]
if (dim(temp_history)[1]==0) return ('Active')
if (temp_history$STSP_TYPE_CD[1]=="P") return ('Former')
if (temp_history$STSP_TYPE_CD[1]=="S") return ('Active')
}
copy <- function(datatable){
write.table(datatable,"clipboard",sep="\t",row.names = F)
}
date_to_ymd <- function(date){
y=year(date)
m=month(date)
d=day(date)
if (m<10) m=paste('0',m,sep='')
if (d<10) d=paste('0',d,sep='')
return(paste(y,m,d,sep=''))
}
get_historical_status <- function(stsp_history, SUB_RRN, date){
if (class(date)!="Date") stop("input 'date' is not Date format")
temp_history=stsp_history[stsp_history$SUB_RRN==SUB_RRN,]
temp_history=temp_history[temp_history$STSP_EFF_DT<=date,]
temp_history=temp_history[order(temp_history$STSP_EFF_DT,decreasing = TRUE),]
if (dim(temp_history)[1]==0) return (1)
if (temp_history$STSP_TYPE_CD[1]=="P") return (0)
if (temp_history$STSP_TYPE_CD[1] %in% c("S","R")) return (1)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.