#' Pipe operator

#'

#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details.

#'

#' @name %>%

#' @rdname pipe

#' @keywords internal

#' @export

#' @importFrom magrittr %>%

#' @usage lhs \%>\% rhs

#' @param lhs A value or the magrittr placeholder.

#' @param rhs A function call using the magrittr semantics.

#' @return The result of calling `rhs(lhs)`.

NULL

#' Assignment pipe

#'

#' See \code{magrittr::\link[magrittr:pipe]{\%<>\%}} for details.

#'

#' @name %<>%

#' @keywords internal

#' @export

#' @importFrom magrittr %<>%

#' @usage lhs \%<>\% rhs

#' @param lhs A value or the magrittr placeholder.

#' @param rhs A function call using the magrittr semantics.

#' @return The result of calling `rhs(lhs)`.

NULL

# flag determined by the correlation table from one table or two tables

t_flag <- \(corr){

  if (!nrow(corr) == ncol(corr)) {

    return(FALSE)

  }

  if (!all(rownames(corr) == colnames(corr))) {

    return(FALSE)

  }

  return(TRUE)

}

# 多列表是否一一对应

# test 对应的列需要跟剩下的列具有唯一映射

e_match <- function(df, test = NULL) {

  dis_df <- dplyr::distinct_all(df) %>% as.data.frame()

  if (is.null(test)) {

    return(all_same(c(nrow(dis_df), apply(dis_df, 2, \(i)length(unique(i))))))

  } else {

    return(all_same(c(nrow(dis_df), nrow(dplyr::distinct_all(dis_df[, test, drop = FALSE])))))

  }

}

all_same <- \(x){

  return(all(x == x[1]))

}

# choose the last not na value

condance <- \(aa){

  aa <- as.data.frame(aa)

  if (any(is.na(aa[, length(aa)]))) {

    res <- apply(aa, 1, \(x){

      tmp <- x[!is.na(x)]

      if (length(tmp) == 0) {

        return(NA)

      }

      return(tmp[length(tmp)])

    })

  } else {

    res <- aa[, length(aa), drop = TRUE]

  }

  res

}

# bind two df with same columns, the last df will replace first df

cbind_new <- \(df, df1){

  if (ncol(df) < 1) {

    return(df1)

  }

  if (ncol(df1) < 1) {

    return(df)

  }

  inter <- intersect(colnames(df1), colnames(df))

  la <- setdiff(colnames(df), inter)

  cbind(df[, la, drop = FALSE], df1)

}

twocol2vector <- \(df){

  if (ncol(df) < 2) {

    return(NULL)

  }

  if (!e_match(df, test = 1)) {

    stop("The columns are not one-to-one correspondence.")

  }

  df <- dplyr::distinct_all(df)

  setNames(df[, 2], df[, 1])

}

custom_sort <- function(x) {

  # 尝试将字符转换为数字并排序

  converted <- suppressWarnings(as.numeric(x))

  if (!any(is.na(converted))) {

    # 如果转换成功，则返回按数字排序的结果

    return(converted[order(converted)])

  } else {

    # 如果转换失败，则返回按字符排序的结果

    return(stringr::str_sort(x, numeric = TRUE))

  }

}

paste_df <- function(df, collapse = ",") {

  apply(df, 1, paste, collapse = collapse)

}

paste_df2pielist <- function(df, collapse = ",") {

  pcutils::strsplit2(df, split = collapse) %>%

    pcutils::t2() %>%

    as.list() %>%

    lapply(function(x) as.numeric(x))

}

deprecated <- function(old, new) {

  assign(old, new, envir = asNamespace(packageName()))

}

#' @export c_net_cal

deprecated("c_net_cal", c_net_calculate)

#' @export c_net_module

deprecated("c_net_module", module_detect)

#' @export c_net_lay

deprecated("c_net_lay", c_net_layout)

#' @export as.metanet

deprecated("as.metanet", c_net_update)