R/dplyr_triangular.R

In statisticiansix/demonstrandum:

triangular <- function(data,x_column_name,y_column_name,tri_matrix='lower',diag=TRUE,full=FALSE){
  tri_matrix <- match.arg(tri_matrix,c('upper','lower'))
  if(!full){
    names <- colnames(data)
    names[rev(which(names%in%c(x_column_name,y_column_name)))] <- c(x_column_name,y_column_name)
    reversed <- data %>% set_colnames(names)%>%
      select(colnames(data))

    data <- data %>%
      bind_rows(reversed)%>%
      distinct_all()
  }

  out <- data %>%
    mutate_at(c(x_column_name,y_column_name),as.character)%>%
    arrange(!!!ensyms(x_column_name,y_column_name))%>%
    group_by(!!ensym(x_column_name))%>%
    mutate('Row'=row_number())%>%
    ungroup%>%
    mutate('Column'=cumsum(Row==1))%>%
    filter(!!!ifelse(diag,quos(Row<=Column),quos(Row<Column)))

  if(tri_matrix=='upper'){
    out <- out %>%
      rename('Y'='X','X'='Y')
  }
    out%>%
      select(colnames(data))
}