# funcsForShiny.r


  b <- function(x) 
    paste0("<B>", x, "</B>")
  
  u <- function(x) 
    paste0("<U>", x, "</U>")
  
  outputCampaign <- function(DT, select)  {
   if (is.null(select) || select=="-")
     return(NULL)

   O <- with(DT[.(select)],
          paste(
            " Info for CampaignID :", unique(CampaignID)  , "\n"
          , "\t===================================="  , "\n"
          , "Campaign Name (Short):", unique(CampShort)  , "\n"
          , "Campaign Name (Full) :", unique(Campaign)  , "\n"
          , paste(
            "             LabelID :", unique(LabelID)  , "\n"
          , "          Label Info :", unique(Label), collapse="\n")  , "\n"
          , ""  , "\n"
          , "This campaign contains the following Ads:"  , "\n"
          , "\t-----------------------------------"  , "\n"
          , paste(AdID, " : ", Ad, collapse="\n ")  , "\n"
          ,""  , "\n"
          )
        )

   return(HTML(O))
  }



  getTopBot <- function(Q, howMany) {
    Categ <- key(Q)
    Categ <- rmDupIDs(Categ, preserveID=TRUE)
    Categ <- orderStandardized(Categ, dontFail=TRUE)

    info <- paste("The following are extreme values for ", paste(Categ, collapse=" / "), "\n")

    Tops <- unique(Q[(HIGH)][order(RATIO, decreasing=TRUE)]  [, Categ, with=FALSE])[1:howMany]
    Bots <- unique(Q[(LOW) ][order(RATIO, decreasing=FALSE)] [, Categ, with=FALSE])[1:howMany]

    list(Top=Tops, Bot=Bots)
  }


  getExtremesInfo <- function(categ, qtls, howManyTopBot) {
    ## Assuming we've already made a selection  

    ## categ might be a name already
    if (categ %in% names(DTs))  {
      nm <- categ
      categ <- parseAggName(categ)$aggdBy
    }
    else { 
      nm <- makeAggName(categ, date=TRUE)
      if (!(nm %in% names(DTs)))
        stop ("could not find nor formulate name from input, \n\t", paste(categ, sep=", ", collapse=",  "))
    }

    DT <- DTs[[nm]]
  
    # Cols.To.Check.For.Extremes <- c("Impressions", "Spend", "Clicks", "CTR", "CPM", "CPC")
    Q <- TopBotQTLS(DT, qtls, sdcols=c("Clicks", "Spend"))
    TB <- getTopBot(Q, howManyTopBot)
  
    paste("Check the following", topropper(paste0(categ, "s", collapse=", ")), "\n", pasteR("_", 30), "\n\n  ",
          "Potential HIGH values:\n   ",
               paste(unlist(TB$Top, FALSE), collapse="\t     "), "\n\n  ",
          "Potential LOW values:\n   ",
               paste(unlist(TB$Bot, FALSE), collapse="\t     "), "\n"
         ) 
  }



  TopBotQTLS <- function(DT, qtls, sdcols, rmDate=TRUE, byCols=key(DT)) {
    # error check
    if (!  (all(qtls < 1) ||  length(qtls) ==2)  )
      stop("\nqtls should have length exactly 2,\nand have values between [0, 1]\n")
    if (!  length(sdcols) ==2 )  
      stop("\nsdcols should be length exactly 2.\n")
    if (is.null(byCols))
      stop("byCols cannot be NULL for TopBotQTLS.\n   Check that DT `", substitute(DT), "` has a valide key.")

    if(rmDate)
      byCols <- setdiff(byCols, c("Date", "date"))

    DT[!is.na(get(byCols[[1]])), {RATIO <- sum(.SD[[1]])/sum(.SD[[2]]); 
          Qs <- quantile(RATIO, qtls, na.rm=TRUE, names=FALSE)
          list(LOW =RATIO <= Qs[[1]], 
               HIGH=RATIO >= Qs[[2]],
               RATIO=RATIO,
               ROW = .I   # ignore ROW if byCols is not null. 
               )  
        }, .SDcols=sdcols, keyby=byCols]
  }


  orderStandardized <- function(x, StandardOrder=NULL, dontFail) {
  # returns x ordered according to StandardOrder. 
  #  Any values in x not in StandardOrder are sent to the back
  #   in the same order they appeared originally
  #
  # If dontFail && Standard order not found, simply returns x back in the original order 

    if (missing(StandardOrder) && exists(".StandardOrder"))
      StandardOrder <- .StandardOrder
    if (is.null(StandardOrder)) {
      if (dontFail)
        return(x)
      # else, fail
      stop("Missing StandardOrder & no default found.")
    }
    x.ord <- intersect(StandardOrder, x)
    
    c(x.ord, setdiff(x, x.ord))
  } 

  rmDupIDs <- function(x, preserveID=FALSE)  {
    ## removes from x any ID word where "Word" & "WordID" both exist
    
    if (preserveID)
      dups.nonID.rev <- duplicated(rev(x))

    dups.nonID <- duplicated(x)

    ## have to sort x first in case the ID name comes before the plain name, `duplicated` will pick up the wrong one.
    ord  <- order(x)
    x.ord <- x[ord]

    dups <- duplicated(gsub("ID$", "", x.ord))

    x.ord[dups] <- gsub("ID$", "", x.ord[dups])
    
    x <- x.ord[ order(ord) ]

    # now with the ID removed, we'll be able to identify duplicates to drop
    #   but we want to exclude those that were previously duplicates
    dups.yesID <- duplicated(x) & !dups.nonID

    if (!preserveID) {
      x <- x[!dups.yesID]
    } else {
      dups.rev <- duplicated(rev(x)) & !dups.nonID.rev
      x[dups.yesID] <- paste0(x[dups.yesID], "ID")
      x <- x[!rev(dups.rev)]
    }

    return(x)
  }



# -------- FORMAT FUNCTIONS ------------ # 
  pasteR <- function(x, n) {
    ## allow for `pasteR(n)`
    if (missing(n) && is.numeric(x)) {
      n <- x
      x <- "-"
    }

    # if n is not a single number, iterate
    if (length(n) > 1) {
      if (length(n) == length(x))
        return(mapply(pasteR, x, n))
      return( sapply(n, function(n1) pasteR(x, n1)) )
    }
    # otehrwise, siple return
    pasteC(rep(unlist(x), n))
  }

pasteC <- function (..., C = "")
    paste(..., collapse = C)



parseAggName <- function(nm, splitOn="_", base=c("fb","agg")) {
  ## escape a standalone dot
  if (splitOn==".")
    splitOn <- "\\."

  if(!is.atomic(nm))
    stop ("`nm` must be atomic")
  aggdBy <- setdiff(strsplit(nm, splitOn)[[1]], base)

  ret <- list(aggdBy=setdiff(aggdBy, "date"), hasDate=("date" %in% aggdBy))
  if (!length(ret[["aggdBy"]]))
    ret[["aggdBy"]] <- ""
  return(ret)
}

topropper <- function(x)
  gsub("\\b([a-z])([a-z]+)", "\\U\\1\\E\\2", x, perl=TRUE)