R2Tooltip: RiskActive Toolkit Functions

##########################################################################################################
#' Not in function
#'
#'
#' @export
'%!in%' <- function(x,y)!('%in%'(x,y))

##########################################################################################################
#' Date yapısını standardize ediyor.
#'
#'
#' @export
m_Date <- function(x){
  res <- as.Date(format(x, "%Y-%m-%d"))
  return(res)
}

##########################################################################################################
#' Date yapısını character formata çeviriyor.
#'
#'
#' @export
m_Date_to_chr <- function(x){
  res <- format(x,"%Y-%m-%d")
  return(res)
}

##########################################################################################################
#' DateTime yapısını character formata çeviriyor.
#'
#'
#' @export
m_DateTime_to_chr <- function(x){
  res <- format(x,"%Y-%m-%d %H:%M:%S")
  return(res)
}

##########################################################################################################
#' Sistem saatini dosya isimlerinde stamp olarak kullanmak için format değiştiriliyor.
#'
#'
#' @export
m_timeLabel <- function(x){
  x <- m_DateTime_to_chr(x)
  x <- stringi::stri_replace_all_fixed(x, "-", "_")
  x <- stringi::stri_replace_all_fixed(x, " ", "_")
  res <- stringi::stri_replace_all_fixed(x, ":", "_")
  return(res)
}

##########################################################################################################
#' Verilen vektör için sql sorgusuna uygun yapı döndürüyor.
#'
#'
#' @export
m_multipleQuery <- function(queryList) {

  res <- NULL

  if(length(queryList)>0) {
    res <- ""
    for(i in 1:length(queryList)) {

      res <- paste0(res,"'",queryList[i],"'")

      if(i!=length(queryList)) {
        res <- paste0(res,",")
      }
    }
  }
  return(res)
}

##########################################################################################################
#' Verilen data.frame için sql into için uygun yapı oluşturuluyor.
#'
#'
#' @export
m_multipleInto <- function(df) {

  res <- NULL

  temp <- apply(df, 1, function(x) m_multipleQuery(x))

  if(length(temp)>0) {
    res <- ""
    for(i in 1:length(temp)) {

      res <- paste0(res,"(",temp[i],")")

      if(i!=length(temp)) {
        res <- paste0(res,",")
      }
    }
  }
  return(res)
}

##########################################################################################################
#' İstenilen 2 tarih arasındaki working day listesini döndürmektedir.
#'
#'
#' @export
m_workDays <- function(start,end){

  res <- NULL

  #import library & modules
  source("imports/library.R")

  #covert date object
  start <- as.Date(start)
  end <- as.Date(end)

  #sql
  query <- try(suppressWarnings(R2.dbQuery(sql=paste0("SELECT data_date FROM ",db.cmn_work_days," WHERE data_date >= '",start,"' and data_date <= '",end,"';"),
                                           dbConnectionList = dbConnectionList,
                                           connection = conn20)))
  if (!inherits(query, "try-error")){
    temp <- query$res
    if(nrow(temp) != 0) res <- m_Date(temp[,"data_date"])
    dbConnectionList <- query$dbConnectionList
  }

  return(res)
}

##########################################################################################################
#' İstenilen tarih için haftanın ilk gününün tarihini döndürmektedir.
#'
#'
#' @export
m_findMonday <- function(date){

  res <- NULL

  #covert date object
  date <- as.Date(date)

  #Haftanın hangi günü olduğu bulunuyor.
  wday <- lubridate::wday(date) - 1
  if(wday == 0) wday = 7

  #hafta başına dönülüyor.
  res <- date %m-% days(wday-1)

  return(res)
}

##########################################################################################################
#' istenilen iki tarih arasındaki hafta başı - hafta sonu iş günlerini getirmektedir.
#'
#'
#' @export
m_findweekSE <- function(start,end){

  source("imports/library.R")

  res <- tbl_df(data.frame(date=m_workDays(start,end))) %>%
    rowwise() %>%
    mutate(day = weekdays(date),
           week = lubridate::isoweek(date)) %>%
    ungroup() %>%
    mutate(min = if_else(row_number()>1,if_else(week==lag(week),0,1),1),
           id = cumsum(min)) %>%
    select(-min) %>%
    group_by(id) %>%
    mutate(cc = cumsum(row_number())) %>%
    filter(cc == min(cc) | cc==max(cc)) %>%
    ungroup()

  return(res)
}

##########################################################################################################
#' İstenilen tarih için holiday olup olmadığı döndürülmektedir.
#'
#'
#' @export
m_isHoliday <- function(date){

  res <- NULL

  #covert date object
  date <- as.Date(date)

  #sql
  query <- try(suppressWarnings(R2.dbQuery(sql=paste0("SELECT data_date FROM ",db.cmn_work_days," WHERE data_date = '",date,"';"),
                                           dbConnectionList = dbConnectionList,
                                           connection = conn20)))
  if (!inherits(query, "try-error")){
    temp <- query$res
    if(nrow(temp) == 0) {
      res <- TRUE
    } else {
      res <- FALSE
    }
    dbConnectionList <- query$dbConnectionList
  }

  return(res)
}

##########################################################################################################
#' İstenilen tarih için period kadar ileri veya geri business day eklenmektedir.
#'
#'
#' @export
m_addBDay <- function(date,period,type="forward"){

  res <- NULL

  if(type=="forward"){
    '%mm%' <- function(x,y) { ('%m+%'(x,y)) }
  } else if (type=="backward") {
    '%mm%' <- function(x,y) { ('%m-%'(x,y)) }
  }

  #covert date object
  date <- as.Date(date)

  count <- 0
  i <- date
  while( count <= period ){

    i <- i %mm% days(1)

    if(!m_isHoliday(date=i)){
      count <- count + 1
      if(count == period) return(i)
    }

  }

  return(res)
}

##########################################################################################################
#' İki tarih arasındaki günlük çalışma günlerini dplyr biçinde getirmektedir.
#'
#'
#' @export
m_businessdaySeqDaily <- function(start=NA,end=NA,issue=NA,neccesseryData=1){

  res <- tibble(date = NA, calc=NA)

  #start, end, issue date control ########################################################################################################
  if(is.na(start)) start <- Sys.Date()
  if(is.na(end)) end <- Sys.Date()
  if(is.na(issue)) issue <- as.Date("2000-01-01")

  #covert date objects ########################################################################################################
  startDate <- as.Date(start)
  endDate <- as.Date(end)
  currentDate <- Sys.Date()
  controlDate <- as.Date(issue) %m+% years(neccesseryData)
  lastpriceDate <- currentDate %m-% days(1)

  if(controlDate > lastpriceDate) return(res)

  if(startDate > endDate) startDate = endDate
  if(startDate >= currentDate) startDate = m_addBDay(currentDate, period = 1, type="backward")
  if(endDate >= currentDate) endDate = m_addBDay(currentDate, period = 1, type="backward")

  if(startDate > controlDate){
    startDate <- startDate
    endDate <- endDate
  } else if ( between(controlDate, startDate, endDate)){
    startDate <- controlDate
    endDate <- endDate
  } else {
    return(res)
  }

  workDays <- m_workDays(start=(startDate %m-% years(neccesseryData)), end=endDate)

  if(!any(between(workDays,startDate,endDate))) return(res)

  res <- tibble(date = workDays) %>% mutate(calc = if_else(date>=startDate,1,0))

  return(res)
}

##########################################################################################################
#' Data set içerisinde son 1 sene içerisindeki data sayısını döndürmektedir.
#'
#'
#' @export
m_getYearBasis <- function(df,limit){

  endLimit <- as.Date(limit)
  startLimit <- endLimit - lubridate::years(1)

  res <- df %>% filter(date>=startLimit, date<=endLimit) %>% nrow
  return(res)
}

##########################################################################################################
#' Rasyo hesaplama anında alınabilecek bir hatayı log'ların ratioDetail log klasörüne yazmaktadır.
#'
#'
#' @export
m_log_detail <- function(code,date,ratio,error){

  msg <- list()
  msg[["date"]] <- date
  msg[["code"]] <- code
  msg[["ratio"]] <- ratio
  msg[["error"]] <- error

  try(erer::write.list(msg, paste0("logs/ratioDetail/",code,"_",m_Date_to_chr(date),"_",ratio,"__",m_timeLabel(Sys.time()),".txt")))
}


##########################################################################################################
#' Dataset içerisinde NA olan değerleri bularak etiketlemektedir.
#'
#'
#' @export
m_findNA <- function(id,df){

  colnames(df)[1:2] <- c("dates","values")

  k <- df$dates[!is.na(df$values)]

  if(df[id,1] %in% k){
    res <- 0
  } else {
    res <- 1
  }
  return(res)
}

##########################################################################################################
#' Dataset içerisinde date'leri bulmaktadır.
#'
#'
#' @export
m_findDate <- function(id,df){

  colnames(df)[1:2] <- c("dates","values")

  k <- df$dates[!is.na(df$values)]

  if(df$dates[id] %in% k){
    res <- id
  } else {

    j.ind <- which(k>=df$dates[id])

    if(length(j.ind)==0){
      res <- tail(df,1)$id + 1
    } else {
      j <- min(which(k>=df$dates[id]))
      res <- which(df$dates==k[j])
    }
  }
  return(res)
}

##########################################################################################################
#' İstenilen 2 tarih arasındaki working day listesini döndürmektedir.(Yeni)
#'
#'
#' @export
d_workDays <- function(df, startDate, endDate){

  res <- NULL

  if(exists("df") & exists("startDate") & exists("endDate") ) {

    #covert date object
    startDate <- as.Date(startDate)
    endDate <- as.Date(endDate)

    #sql
    res <- tryCatch({
      df %>% filter(between(data_date,startDate,endDate)) %>% pull(data_date) %>% as.Date
    }, error = function(e){
      return(NULL)
    })

  }

  return(res)
}

##########################################################################################################
#' İstenilen tarih için holiday olup olmadığı döndürülmektedir. (Yeni)
#'
#'
#' @export
d_isHoliday <- function(df, date){

  res <- NULL

  if(exists("df") & exists("date") ) {

    #covert date object
    date <- as.Date(date)

    #sql
    temp_res <- tryCatch({
      df %>% filter(data_date==date) %>% pull(data_date) %>% as.Date
    }, error = function(e){
      return(NULL)
    })

    if(length(temp_res)==0)
      res <- TRUE
    else
      res <- FALSE
  }

  return(res)
}

##########################################################################################################
#' İstenilen tarih için period kadar ileri veya geri business day eklenmektedir. (Yeni)
#'
#'
#' @export
d_busday <- function(df,date,period=1,type="forward"){

  res <- NULL

  if(exists("df") & exists("date") & exists("period") & exists("type")) {

    if(type=="forward"){
      '%mm%' <- function(x,y) { ('%m+%'(x,y)) }
    } else if (type=="backward") {
      '%mm%' <- function(x,y) { ('%m-%'(x,y)) }
    }

    #covert date object
    date <- as.Date(date)

    count <- 0
    i <- date
    while( count <= period ){

      i <- i %mm% days(1)

      if(!d_isHoliday(df, date=i)){
        count <- count + 1
        if(count == period) return(i)
      }

    }
  }

  return(res)
}