#' @name classic2sym
#' @title Convert classical data frame into a symbolic data.
#' @description  A function for converting a classical data, which may
#' present as a data frame or a matrix with one entry one value, into
#' a symbolic data object, which is represented as an interval or a set in an entry.
#' Object after converting is ggInterval class containing interval
#' data and raw data(if it exist) and typically statistics.
#' @import rlang stats vctrs
#' @importFrom RSDA classic.to.sym
#' @importFrom stringr str_split
#' @importFrom tibble as_tibble rownames_to_column column_to_rownames
#' @importFrom prodlim row.match
#' @param data A classical data frame that you want to be converted into
#' interval-valued data
#' @param groupby A way to aggregate. It can be either a clustering method
#' or a variable name which exist in input data (necessary factor type)
#' . Default "kmeans".
#' @param k A number of group,which is used by clustering. Default k = 5.
#' @param minData if choose groupby parameter as 'customize',user need to define
#' which data is min data or max data.
#' @param maxData if choose groupby parameter as 'customize',user need to define
#' which data is min data or max data.
#' @param modalData list, each cell of list contain a set of column index of its
#' modal multi-valued data of the input data. the value of it is a proportion
#' presentation, and sum of each row in these column must be equal to 1.
#' ex 0,1,0  or  0.2,0.3,0.5. the input type of modalData for example is
#' modalData[[1]] = c(2, 3), modalData[[2]] = c(7:10), that 2, 3, 7, 8, 9, 10
#' columns are modal type of the data. Note: the option is only valid when
#' groupby == "customize".
#' @usage classic2sym(data=NULL,groupby = "kmeans",k=5,minData=NULL,maxData=NULL,
#' modalData = NULL)
#' @return classic2sym returns an object of class "ggInterval",which
#' has interval-valued data and related outputs as follows.
#' \itemize{
#'   \item intervalData - The Interval data after converting also known
#'   as a RSDA object.
#'   \item rawData - Classical data that user input.
#'   \item clusterResult - Cluster results .If the groupby method is
#'   a clustering method then it will exist.
#'   \item statisticsDF - A list contains data frame including some
#'   typically statistics in each group.
#' }
#' @examples
#' #classical data to symbolic data
#' classic2sym(iris)
#' classic2sym(mtcars, groupby = "kmeans", k = 10)
#' classic2sym(iris, groupby = "hclust", k = 7)
#' classic2sym(iris, groupby = "Species")
#'
#' x1<-runif(10, -30, -10)
#' y1<-runif(10, -10, 30)
#' x2<-runif(10, -5, 5)
#' y2<-runif(10, 10, 50)
#' x3<-runif(10, -50, 30)
#' y3<-runif(10, 31, 60)
#'
#' d<-data.frame(min1=x1,max1=y1,min2=x2,max2=y2,min3=x3,max3=y3)
#' classic2sym(d,groupby="customize",minData=d[,c(1,3,5)],maxData=d[,c(2,4,6)])
#' classic2sym(d,groupby="customize",minData=d$min1,maxData=d$min2)
#'
#'
#' #example for build modal data
#' #for the first modal data proportion
#' a1 <- runif(10, 0,0.4) %>% round(digits = 1)
#' a2 <- runif(10, 0,0.4) %>% round(digits = 1)
#'
#' #for the second modal data proportion
#' b1 <- runif(10, 0,0.4) %>% round(digits = 1)
#' b2 <- runif(10, 0,0.4) %>% round(digits = 1)
#'
#' #for interval-valued data
#' c1 <- runif(10, 10, 20) %>% round(digits = 0)
#' c2 <- runif(10, -50, -10) %>% round(digits = 0)
#'
#' #build simulated data
#' d <- data.frame(a1 = a1, a2 = a2, a3 = 1-(a1+a2),
#'                 c1 = c1, c2 = c2,
#'                 b1 = b1, b2 = b2, b3 = 1-(b1+b2))
#'
#' #transformation
#' classic2sym(d, groupby = "customize",
#'             minData = d$c2,
#'             maxData = d$c1,
#'             modalData = list(1:3, 6:8))#two modal data
#'
#' #extract the data
#' symObj<-classic2sym(iris)
#' symObj$intervalData       #interval data
#' symObj$rawData            #raw data
#' symObj$clusterResult      #cluster result
#' symObj$statisticsDF       #statistics

#' @export
classic2sym <- function(data = NULL,
                        groupby = "kmeans",
                        k = 5,
                        minData = NULL,
                        maxData = NULL,
                        modalData = NULL) {
  if ("ggInterval" %in% class(data) ||
      "symbolic_tbl" %in% class(data)) {
    stop("ERROR : please using classical data frame.")
  }
  pkg.env <- new.env()
  pkg.env$rawData <- data
  pkg.env$modal <- NULL
  pkg.env$statistics <- c("min", "median", "max", "mean")
  pkg.env$statisticsDF <- NULL
  pkg.env$result <- NULL
  pkg.env$intervalData <- NULL
  data <- as.data.frame(data)
  
  if (groupby == "customize" & !is.null(modalData)) {
    #1. test each of col of modalData > 2
    this.modal <- buildModal(data, modalData)
    
    #data remain numeric data
    non.modal.index <- (1:ncol(data))[-unlist(modalData)]
    
    #if no data remain numeric then return directly
    if (length(non.modal.index) == 0) {
      #there is no numeric data
      symObj <- ggInterval$new(
        rawData = pkg.env$rawData,
        statisticsDF = pkg.env$statisticsDF,
        intervalData = this.modal,
        clusterResult = pkg.env$result
      )
      return(symObj)
    } else{
      pkg.env$modal <- this.modal
    }
    #merge in the end
  }
  
  groupby <- substitute(groupby)
  numericData <- unlist(lapply(data.frame(data[1:dim(data)[2]]) , FUN = is.numeric))
  #start debug version0825-1
  for (i in c(1:dim(data)[2])[!numericData]) {
    if (!inherits(data[[i]], c("Date", "POSIXct", "POSIXt"))) {
      data[[i]] <- as.factor(data[[i]])
    }
  }
  #end debug
  numericData <- data.frame(data[, which(numericData)])
  if (isNaExist(data)[[1]]) {
    warning(paste(isNaExist(data)[[2]], "NA observations will be omit."))
    numericData <- na.omit(numericData)
    data <- na.omit(data)
  }
  pkg.env$rawData <- data
  switch(
    toString(groupby),
    kmeans = {
      tryCatch({
        pkg.env$result <- stats::kmeans(numericData, centers = k)
        cluster <- as.factor(pkg.env$result$cluster)
        d <- as.data.frame(cbind(data, cluster = as.factor(pkg.env$result$cluster)))
        
        pkg.env$statisticsDF <- lapply(
          pkg.env$statistics,
          FUN = function(x)
            aggrByGroup(
              df = d,
              group = cluster,
              method = x
            )
        )
        names(pkg.env$statisticsDF) <- pkg.env$statistics
        pkg.env$intervalData <- RSDA::classic.to.sym(d, concept = cluster)
      }, warning = function(war) {
        print(paste("WARNING in kmeans:  ", war))
      }, error = function(err) {
        print(paste("ERROR in kmeans:  ", err))
        print("Automatically using RSDA::classic.to.sym to improve.")
        finallySol(data, numericData)
      })
    },
    #case2 hirechical
    hclust = {
      tryCatch({
        pkg.env$result <- stats::hclust(stats::dist(numericData))
        cluster <- stats::cutree(pkg.env$result, k = k)
        cluster <- as.factor(as.integer(cluster))
        d <- as.data.frame(cbind(data, cluster = cluster))
        pkg.env$statisticsDF <- lapply(
          pkg.env$statistics,
          FUN = function(x)
            aggrByGroup(
              df = d,
              group = cluster,
              method = x
            )
        )
        names(pkg.env$statisticsDF) <- pkg.env$statistics
        pkg.env$intervalData <- RSDA::classic.to.sym(d, concept = cluster)
      }, warning = function(war) {
        print(paste("WARNING in hclust:  ", war))
      }, error = function(err) {
        print(paste("ERROR in hclust:  ", err))
        print("Automatically using RSDA::classic.to.sym to improve.")
        finallySol(data, numericData)
      })
    },
    customize = {
      idata <- customize(numericData, minData, maxData)
      if (is.null(pkg.env$modal)) {
        pkg.env$intervalData <- idata
      } else{
        pkg.env$intervalData <- cbind(idata, pkg.env$modal)
      }
      pkg.env$statisticsDF <- buildStatsDf(numericData = idata)
      names(pkg.env$statisticsDF) <- c("min", "median", "max")
      
    },
    #default
    {
      if (length(as.character(groupby)) > 1) {
        groupby <- as.character(groupby)[-1]
      } else{
        groupby <- as.character(groupby)[1]
      }
      
      d <- RSDA::classic.to.sym(data, groupby)
      d <- buildRowName(data, d, groupby)
      #d <- tibble::as_tibble(d)

      numericData <- unlist(lapply(data.frame(tibble::as_tibble(d)[, 1:dim(d)[2]]) , FUN = RSDA::is.sym.interval))
      numericData <- d[, numericData]
      
      pkg.env$statisticsDF <- buildStatsDf(numericData = numericData)
      names(pkg.env$statisticsDF) <- c("min", "median", "max")
      pkg.env$intervalData <- d
    }
  )
  #final
  if (!("symbolic_tbl" %in% class(data))) {
    class(pkg.env$intervalData) <- c("symbolic_tbl", class(pkg.env$intervalData))
  }
  
  symObj <- ggInterval$new(
    rawData = pkg.env$rawData,
    statisticsDF = pkg.env$statisticsDF,
    intervalData = pkg.env$intervalData,
    clusterResult = pkg.env$result
  )
  
  return(symObj)
}




aggrByGroup <- function(df = NULL,
                        group = NULL,
                        method = "mean") {
  group <- rlang::get_expr(group)#trans string to variable
  #1. select numeric data
  numericData <- unlist(lapply(df[, 1:dim(df)[2]] , FUN = is.numeric))
  nData <- as.data.frame(cbind(df[, numericData], group = group))
  #2. aggrate by method
  p <- dim(nData)[2]
  aggData <- data.frame(NULL)
  for (g in levels(group)) {
    temp <- round(t(unlist(lapply(
      as.data.frame(nData[nData$group == g, 1:p - 1]), FUN = method
    ))), 2)
    aggData <- rbind(aggData, temp)
    #aggData<-rbind(aggData,cbind(temp,cluster=g))
  }
  rownames(aggData) <- levels(group)
  return(aggData)
}

isNaExist <- function(data) {
  if (sum(is.na(data) * 1) == 0) {
    #no na
    return(FALSE)
  } else{
    N <- dim(data)[1]
    completeN <- sum(complete.cases(data) * 1)
    return(list(TRUE, N - completeN))
  }
}

finallySol <- function(data, numericData) {
  pkg.env$intervalData <- RSDA::classic.to.sym(data)
  d <- RSDA::classic.to.sym(numericData)
  mind <- data.frame(matrix(sapply(d, min), nrow = dim(d)[1]))
  maxd <- data.frame(matrix(sapply(d, max), nrow = dim(d)[1]))
  colnames(mind) <- colnames(d)
  colnames(maxd) <- colnames(d)
  pkg.env$statisticsDF <- list(mind, maxd)
  names(pkg.env$statisticsDF) <- c("min", "max")
}

buildRowName <- function(rData, iData, attrList) {
  #change to factor type
  for (i in attrList) {
    rData[, i] <- as.factor(rData[, i])
  }
  
  #all possible combination
  #1. build all attributes levels in a list
  attrLevel <- NULL
  for (i in attrList) {
    attrLevel <- append(attrLevel, list(levels(rData[, i])))
  }
  #2 find combination by attributes levels list
  combination <- NULL
  if (length(attrLevel) > 1) {
    for (i in (length(attrLevel) - 1):1) {
      temp <- NULL
      for (u in 1:length(attrLevel[[i]])) {
        if (i == (length(attrLevel) - 1)) {
          temp <- append(temp, paste(attrLevel[[i]][u], attrLevel[[i + 1]], sep =
                                       ","))
        } else{
          temp <- append(temp, paste(attrLevel[[i]][u], combination, sep = ","))
        }
      }
      combination <- temp
    }
  } else{
    combination <- attrLevel[[1]]
    iData[, "rowname"] <- combination
    iData <- tibble::column_to_rownames(iData, var = "rowname")
    return(iData)
  }
  
  #data frame combination
  df <- rData[!duplicated(rData[, attrList]), attrList]
  
  #which combination exactly exist
  notIn <- NULL
  for (comb in combination) {
    temp <- stringr::str_split(comb, ",")
    #if not exist
    if (is.na(prodlim::row.match(unlist(temp), df))) {
      notIn <- append(notIn, comb)
    }
  }
  idx <- which(unlist(lapply(combination, function(x) {
    x %in% notIn
  })))
  
  if (length(idx) > 0) {
    combination <- combination[-idx]
  }
  
  
  #build rownames by combination
  rownames(iData) <- combination
  iData <- tibble::rownames_to_column(iData)
  iData <- tibble::column_to_rownames(iData, var = "rowname")
  return(iData)
}

customize <- function(nData = NULL,
                      minList = NULL,
                      maxList = NULL) {
  if (is.null(nData)) {
    stop("ERROR : Missing data input.")
  }
  nData <- as.data.frame(nData)
  if (is.null(minList) || is.null(maxList)) {
    #default
    if (dim(nData)[2] == 2) {
      minList <- nData[, 1]
      maxList <- nData[, 2]
      warning(
        "warning : Missing min data or max data.Automatically
              convert column 1 to min data,column 2 to max data."
      )
    } else{
      stop("ERROR : Missing min data or max data.")
    }
  }
  
  minList <- as.data.frame(minList)
  maxList <- as.data.frame(maxList)
  #test whether minList len == maxList
  if (dim(minList)[1] != dim(maxList)[1] ||
      dim(minList)[2] != dim(maxList)[2]) {
    stop("ERROR : Dimension Error,cannot match min and max.")
  }
  
  #test all min smaller than all max
  if (!all(minList <= maxList)) {
    stop("ERROR : min values must smaller than all max values.")
  }
  
  p <- length(minList)
  n <- dim(minList)[1]
  allVar <- lapply(
    1:p,
    FUN = function(x)
      cbind(minList[x], maxList[x])
  )
  finalData <- matrix(NA, nrow = n)
  for (i in 1:p) {
    temp <- unlist(lapply(
      1:n,
      FUN = function(x)
        cbind(allVar[[i]][[1]][x], allVar[[i]][[2]][x])
    ))
    g = as.factor(rep(1:n, each = 2))
    data <- data.frame(temp, g)
    data <- RSDA::classic.to.sym(data, g)
    colnames(data) <- paste0("V", i)
    finalData <- cbind(finalData, data)
  }
  finalData <- tibble::as_tibble(finalData)
  finalData <- finalData[, 2:(p + 1)]
  return(finalData)
}

buildStatsDf <- function(numericData = NULL) {
  mind <- data.frame(matrix(sapply(numericData, min), nrow = dim(numericData)[1]))
  maxd <- data.frame(matrix(sapply(numericData, max), nrow = dim(numericData)[1]))
  mediand <- (mind + maxd) / 2
  colnames(mind) <- colnames(numericData)
  colnames(maxd) <- colnames(numericData)
  colnames(mediand) <- colnames(numericData)
  return(list(mind, mediand, maxd))
}

buildModal <- function(data, modalData) {
  n <- nrow(data)
  result <- data.frame(none = matrix(0, nrow = n, ncol = 1))
  if (!is.list(modalData)) {
    stop("modalData must be a list containing the column index of data.")
  }
  
  u <- 1 # for name index
  for (i in modalData) {
    if (!all(apply(data[, i], 1, sum) == 1)) {
      warning("Break off: sum of observation in each row must equal to 1.")
      return(result[, -1])
    }
    if (length(i) < 2) {
      warning("select length of column of modalData must >= 2")
      return(result[, -1])
    }
    if (!is.numeric(i)) {
      warning("select column of modalData must be index (numeric type)")
      return(result[, -1])
    }
    
    propName <- colnames(data)[i]
    modal <- list(NULL)
    for (obs in 1:n) {
      modal[[obs]] <- list(var = names(data[obs, i]), prop = as.numeric(data[obs, i]))
    }
    modal <- dplyr::tibble(vctrs::new_vctr(modal, class = "symbolic_modal"))
    colnames(modal) <- paste0("modal", u)
    u <- u + 1
    result <- cbind(result, modal)
  }
  return(dplyr::tibble(result[, -1]))
}
