tests/testthat/test-fn-Matrix.R

In matrixset: Creating, Manipulating and Annotating Matrix Ensemble

test_that("matrixset general loop works", {

  withr::local_options(lifecycle_verbosity = "quiet")

  student_results_M <- mutate_matrix(student_results,
                                     failure = Matrix::Matrix(matrix_elm(student_results, 1)),
                                     remedial = Matrix::Matrix(matrix_elm(student_results, 2)))


  student_results2 <- student_results_M
  matrix_elm(student_results2,2) <- NULL
  mn <- apply_row(student_results2, mean)
  M <- matrix_elm(student_results2,1)
  mn_ref <- list(failure=apply(M, 1, function(u) list(mean=mean(u)),simplify = FALSE))
  # mn_ref <- c(mn_ref, list(remedial=lapply(mn_ref$failure, function(u) lapply(u, function(v) NULL))))
  mn_ref <- c(mn_ref, list(remedial=NULL))

  expect_equal(mn, mn_ref)




  mn <- apply_row(student_results_M, mean)
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     M <- matrix_elm(student_results_M,m)
                     apply(M, 1, function(u) list(mean=mean(u)),simplify = FALSE)
                   })
  names(mn_ref) <- matrixnames(student_results_M)

  expect_equal(mn, mn_ref)



  mn <- apply_column(student_results_M, mean)
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     M <- matrix_elm(student_results_M,m)
                     apply(M, 2, function(u) list(mean=mean(u)),simplify = FALSE)
                   })
  names(mn_ref) <- matrixnames(student_results_M)

  expect_equal(mn, mn_ref)



  mn <- apply_row(student_results_M, mn=mean)
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     M <- matrix_elm(student_results_M,m)
                     apply(M, 1, function(u) list(mn=mean(u)),simplify = FALSE)
                   })
  names(mn_ref) <- matrixnames(student_results_M)

  expect_equal(mn, mn_ref)



  mn <- apply_column(student_results_M, mn=mean)
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     M <- matrix_elm(student_results_M,m)
                     apply(M, 2, function(u) list(mn=mean(u)),simplify = FALSE)
                   })
  names(mn_ref) <- matrixnames(student_results_M)

  expect_equal(mn, mn_ref)



  ct <- apply_row(student_results_M, mn=mean, md=~median(.i))
  ct_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     M <- matrix_elm(student_results_M,m)
                     apply(M, 1, function(u) list(mn=mean(u),
                                                  md=median(u)),
                           simplify = FALSE)
                   })
  names(ct_ref) <- matrixnames(student_results_M)

  expect_equal(ct, ct_ref)



  ct <- apply_column(student_results_M, mn=mean, md=~median(.j))
  ct_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     M <- matrix_elm(student_results_M,m)
                     apply(M, 2, function(u) list(mn=mean(u),
                                                  md=median(u)),
                           simplify = FALSE)
                   })
  names(ct_ref) <- matrixnames(student_results_M)

  expect_equal(ct, ct_ref)



  ct <- apply_row(student_results_M, mn=mean, reg = ~lm(.i ~ national_average + program))
  ct_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     M <- matrix_elm(student_results_M,m)
                     meta <- column_info(student_results_M)
                     meta <- tibble::column_to_rownames(meta, ".colname")
                     ans <- lapply(1:nrow(student_results_M),
                                   function(i) {
                                     meta$.i <- M[i,]
                                     list(mn=mean(M[i,]),
                                          reg=eval(quote(lm(.i ~ national_average + program)), envir = meta))
                                   })
                     names(ans) <- rownames(student_results_M)
                     ans
                   })
  names(ct_ref) <- matrixnames(student_results_M)

  expect_equal(ct, ct_ref, ignore_attr = TRUE)




  ct <- apply_column(student_results_M, mn=mean, reg = ~lm(.j ~ teacher + class))
  ct_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     M <- matrix_elm(student_results_M,m)
                     meta <- row_info(student_results_M)
                     meta <- tibble::column_to_rownames(meta, ".rowname")
                     ans <- lapply(1:ncol(student_results_M),
                                   function(j) {
                                     meta$.j <- M[,j]
                                     list(mn=mean(M[,j]),
                                          reg=eval(quote(lm(.j ~ teacher + class)), envir = meta))
                                   })
                     names(ans) <- colnames(student_results_M)
                     ans
                   })
  names(ct_ref) <- matrixnames(student_results_M)

  expect_equal(ct, ct_ref, ignore_attr = TRUE)




  ct <- apply_row(student_results_M, mn=mean, reg = ~lm(.i ~ national_average + program),
                  .matrix = 2)
  ct_ref <- lapply(2,
                   function(m) {
                     M <- matrix_elm(student_results_M,m)
                     meta <- column_info(student_results_M)
                     meta <- tibble::column_to_rownames(meta, ".colname")
                     ans <- lapply(1:nrow(student_results_M),
                                   function(i) {
                                     meta$.i <- M[i,]
                                     list(mn=mean(M[i,]),
                                          reg=eval(quote(lm(.i ~ national_average + program)), envir = meta))
                                   })
                     names(ans) <- rownames(student_results_M)
                     ans
                   })
  names(ct_ref) <- matrixnames(student_results_M)[2]

  expect_equal(ct, ct_ref, ignore_attr = TRUE)





  ct <- apply_column(student_results_M, mn=mean, reg = ~lm(.j ~ teacher + class),
                     .matrix = 2)
  ct_ref <- lapply(2,
                   function(m) {
                     M <- matrix_elm(student_results_M,m)
                     meta <- row_info(student_results_M)
                     meta <- tibble::column_to_rownames(meta, ".rowname")
                     ans <- lapply(1:ncol(student_results_M),
                                   function(j) {
                                     meta$.j <- M[,j]
                                     list(mn=mean(M[,j]),
                                          reg=eval(quote(lm(.j ~ teacher + class)), envir = meta))
                                   })
                     names(ans) <- colnames(student_results_M)
                     ans
                   })
  names(ct_ref) <- matrixnames(student_results_M)[2]

  expect_equal(ct, ct_ref, ignore_attr = TRUE)





  e <- apply_row(student_results_M,
                 mn = ~{
                   ii <- .i
                   mean(ii)
                 })

  e_ref <- lapply(seq(nmatrix(student_results_M)),
                  function(m) {
                    M <- matrix_elm(student_results_M,m)
                    apply(M, 1, function(u) list(mn=mean(u)),simplify = FALSE)
                  })
  names(e_ref) <- matrixnames(student_results_M)

  expect_equal(e, e_ref, ignore_attr = TRUE)





  e <- apply_column(student_results_M,
                    mn = ~{
                      jj <- .j
                      mean(jj)
                    })

  e_ref <- lapply(seq(nmatrix(student_results_M)),
                  function(m) {
                    M <- matrix_elm(student_results_M,m)
                    apply(M, 2, function(u) list(mn=mean(u)),simplify = FALSE)
                  })
  names(e_ref) <- matrixnames(student_results_M)

  expect_equal(e, e_ref, ignore_attr = TRUE)






  e <- apply_row(student_results_M,
                 s=~{
                   .i + school_average + previous_year_score
                 })

  e_ref <- lapply(seq(nmatrix(student_results_M)),
                  function(m) {
                    M <- matrix_elm(student_results_M,m)
                    row_meta <- row_info(student_results_M)
                    col_meta <- column_info(student_results_M)
                    s <- lapply(1:nrow(M), function(i) list(s=M[i,] + row_meta$previous_year_score[i] + col_meta$school_average))
                    names(s) <- rownames(student_results_M)
                    s
                  })
  names(e_ref) <- matrixnames(student_results_M)

  expect_equal(e, e_ref, ignore_attr = TRUE)





  e <- apply_column(student_results_M,
                    s=~{
                      .j + school_average + previous_year_score
                    })

  e_ref <- lapply(seq(nmatrix(student_results_M)),
                  function(m) {
                    M <- matrix_elm(student_results_M,m)
                    row_meta <- row_info(student_results_M)
                    col_meta <- column_info(student_results_M)
                    s <- lapply(1:ncol(M), function(j) list(s=M[,j] + row_meta$previous_year_score + col_meta$school_average[j]))
                    names(s) <- colnames(student_results_M)
                    s
                  })
  names(e_ref) <- matrixnames(student_results_M)

  expect_equal(e, e_ref, ignore_attr = TRUE)





  # .data
  rg <- apply_row(student_results_M, reg = ~unname(coef(lm(.i ~ .data[["national_average"]] + program))))
  rg_ref <- apply_row(student_results_M, reg = ~unname(coef(lm(.i ~ national_average + program))))
  expect_identical(rg, rg_ref)



  rg <- apply_column(student_results_M, reg = ~unname(coef(lm(.j ~ .data[["teacher"]] + class))))
  rg_ref <- apply_column(student_results_M, reg = ~unname(coef(lm(.j ~ teacher + class))))
  expect_identical(rg, rg_ref)




  previous_year_score <- 0.5
  avr <- apply_row(student_results_M, av=~mean(c(.i, previous_year_score)))
  avr_ref <- lapply(seq(nmatrix(student_results_M)),
                    function(m) {
                      M <- matrix_elm(student_results_M,m)
                      row_meta <- row_info(student_results_M)
                      s <- lapply(1:nrow(M), function(i) list(av=mean(c(M[i,], row_meta$previous_year_score[i]))))
                      names(s) <- rownames(student_results_M)
                      s
                    })
  names(avr_ref) <- matrixnames(student_results_M)
  expect_identical(avr, avr_ref)



  school_average <- 0.5
  avr <- apply_column(student_results_M, av=~mean(c(.j, school_average)))
  avr_ref <- lapply(seq(nmatrix(student_results_M)),
                    function(m) {
                      M <- matrix_elm(student_results_M,m)
                      col_meta <- column_info(student_results_M)
                      s <- lapply(1:ncol(M), function(j) list(av=mean(c(M[,j], col_meta$school_average[j]))))
                      names(s) <- colnames(student_results_M)
                      s
                    })
  names(avr_ref) <- matrixnames(student_results_M)
  expect_identical(avr, avr_ref)



  previous_year_score <- 0.5
  avr <- apply_row(student_results_M, av=~mean(c(.i, .env$previous_year_score)))
  avr_ref <- lapply(seq(nmatrix(student_results_M)),
                    function(m) {
                      M <- matrix_elm(student_results_M,m)
                      s <- lapply(1:nrow(M), function(i) list(av=mean(c(M[i,], previous_year_score))))
                      names(s) <- rownames(student_results_M)
                      s
                    })
  names(avr_ref) <- matrixnames(student_results_M)
  expect_identical(avr, avr_ref)




  school_average <- 0.5
  avr <- apply_column(student_results_M, av=~mean(c(.j, .env$school_average)))
  avr_ref <- lapply(seq(nmatrix(student_results_M)),
                    function(m) {
                      M <- matrix_elm(student_results_M,m)
                      s <- lapply(1:ncol(M), function(j) list(av=mean(c(M[,j], school_average))))
                      names(s) <- colnames(student_results_M)
                      s
                    })
  names(avr_ref) <- matrixnames(student_results_M)
  expect_identical(avr, avr_ref)





  # 1-row/1 column
  avr <- apply_column(student_results_M[,1,], avr = ~mean(.j))
  avr_ref <- lapply(seq(nmatrix(student_results_M)),
                    function(m) {
                      M <- matrix_elm(student_results_M,m)
                      apply(M[,1,drop=FALSE], 2, function(u) list(avr=mean(u)),simplify = FALSE)
                    })
  names(avr_ref) <- matrixnames(student_results_M)

  expect_equal(avr, avr_ref)




  avr <- apply_column(student_results_M[1,1,], avr = ~mean(.j))
  avr_ref <- lapply(seq(nmatrix(student_results_M)),
                    function(m) {
                      M <- matrix_elm(student_results_M,m)
                      apply(M[1,1,drop=FALSE], 2, function(u) list(avr=mean(u)),simplify = FALSE)
                    })
  names(avr_ref) <- matrixnames(student_results_M)

  expect_equal(avr, avr_ref)




  avr <- apply_row(student_results_M[1,,], avr = ~mean(.i))
  avr_ref <- lapply(seq(nmatrix(student_results_M)),
                    function(m) {
                      M <- matrix_elm(student_results_M,m)
                      apply(M[1,,drop=FALSE], 1, function(u) list(avr=mean(u)),simplify = FALSE)
                    })
  names(avr_ref) <- matrixnames(student_results_M)

  expect_equal(avr, avr_ref)



  avr <- apply_row(student_results_M[1,1,], avr = ~mean(.i))
  avr_ref <- lapply(seq(nmatrix(student_results_M)),
                    function(m) {
                      M <- matrix_elm(student_results_M,m)
                      apply(M[1,1,drop=FALSE], 1, function(u) list(avr=mean(u)),simplify = FALSE)
                    })
  names(avr_ref) <- matrixnames(student_results_M)

  expect_equal(avr, avr_ref)






  # grouuped
  #
  grmn <- apply_row(column_group_by(student_results_M, program), mean)
  grs <- column_group_meta(column_group_by(student_results_M, program))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     ans$.rows <- NULL
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results_M,m)
                       apply(M[, gr, drop = FALSE], 1, function(u) list(mean=mean(u)),simplify = FALSE)
                     })
                     ans$.vals <- grmn_ref
                     ans
                   })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, mn_ref)




  grmn <- apply_column(row_group_by(student_results_M, teacher, class), mean)
  grs <- row_group_meta(row_group_by(student_results_M, teacher, class))
  grmn_ref <- lapply(seq(nmatrix(student_results_M)), function(m) {
    ans <- grs
    ans$.rows <- NULL
    mn_ref <- lapply(grs$.rows, function(gr) {
      M <- matrix_elm(student_results_M,m)
      apply(M[gr, , drop = FALSE], 2, function(u) list(mean=mean(u)),simplify = FALSE)
    })
    ans$.vals <- mn_ref
    ans
  })
  names(grmn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, grmn_ref)




  grmn <- apply_row(column_group_by(student_results_M, program), mn=mean)
  grs <- column_group_meta(column_group_by(student_results_M, program))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     ans$.rows <- NULL
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results_M,m)
                       apply(M[, gr, drop = FALSE], 1, function(u) list(mn=mean(u)),simplify = FALSE)
                     })
                     ans$.vals <- grmn_ref
                     ans
                   })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, mn_ref)




  grmn <- apply_column(row_group_by(student_results_M, teacher, class), mn=mean)
  grs <- row_group_meta(row_group_by(student_results_M, teacher, class))
  grmn_ref <- lapply(seq(nmatrix(student_results_M)), function(m) {
    ans <- grs
    ans$.rows <- NULL
    mn_ref <- lapply(grs$.rows, function(gr) {
      M <- matrix_elm(student_results_M,m)
      apply(M[gr, , drop = FALSE], 2, function(u) list(mn=mean(u)),simplify = FALSE)
    })
    ans$.vals <- mn_ref
    ans
  })
  names(grmn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, grmn_ref)

})





test_that("matrixset 'long' loop works", {

  withr::local_options(lifecycle_verbosity = "quiet")

  student_results_M <- mutate_matrix(student_results,
                                     failure = Matrix::Matrix(matrix_elm(student_results, 1)),
                                     remedial = Matrix::Matrix(matrix_elm(student_results, 2)))


  student_results2 <- student_results_M
  matrix_elm(student_results2,2) <- NULL
  ct <- apply_row_dfl(student_results2, mn=mean, md=median)
  M <- matrix_elm(student_results2,1)
  ct_ref <- list(failure=t(apply(M, 1, function(u) c(mn=mean(u), md=median(u)),simplify = TRUE)))
  ct_ref$failure <- tibble::as_tibble(ct_ref$failure, rownames = ".rowname")
  # ct_ref$remedial <- tibble::tibble(.rowname = character(), mn = logical(), md = logical())
  ct_ref["remedial"] <- list(NULL)
  expect_identical(ct, ct_ref)



  student_results2 <- student_results_M
  matrix_elm(student_results2,2) <- NULL
  ct <- apply_column_dfl(student_results2, mn=mean, md=median)
  M <- matrix_elm(student_results2,1)
  ct_ref <- list(failure=t(apply(M, 2, function(u) c(mn=mean(u), md=median(u)),simplify = TRUE)))
  ct_ref$failure <- tibble::as_tibble(ct_ref$failure, rownames = ".colname")
  # ct_ref$remedial <- tibble::tibble(.colname = character(), mn = logical(), md = logical())
  ct_ref["remedial"] <- list(NULL)
  expect_identical(ct, ct_ref)



  ct <- apply_row_dfl(student_results_M, mn=mean, md=median)
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  ct_ref <- lapply(M,
                   function(m) tibble::tibble(.rowname = rownames(m),
                                              mn=unname(Matrix::rowMeans(m)),
                                              md = unname(apply(m,1,median))))
  expect_equal(ct, ct_ref)



  ct <- apply_column_dfl(student_results_M, mn=mean, md=median)
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  ct_ref <- lapply(M,
                   function(m) tibble::tibble(.colname = colnames(m),
                                              mn=unname(Matrix::colMeans(m)),
                                              md = unname(apply(m,2,median))))
  expect_equal(ct, ct_ref)



  # showcase > 1 length answer
  summ <- apply_row_dfl(student_results_M, mn=~c(mean(.i), median(.i)), rg=~range(.i))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  summ_ref <- lapply(M,
                     function(m) {
                       a <- list(tibble::as_tibble(t(apply(m,1, function(x) c(one=mean(x), two=median(x)))), rownames = ".rowname"),
                                 tibble::as_tibble(t(apply(m,1, function(x) setNames(range(x), c("one", "two")))), rownames = ".rowname"))
                       a <- lapply(a,
                                   function(u) tidyr::pivot_longer(u,
                                                                   names_to = "mn.name",
                                                                   values_to = "mn",
                                                                   cols = c("one", "two")))
                       colnames(a[[2]])[2:3] <- c("rg.name", "rg")
                       suppressMessages(a <- dplyr::bind_cols(a))
                       a$`.rowname...4` <- NULL
                       a <- dplyr::rename(a, `.rowname` = `.rowname...1`)
                       a$mn.name <- ifelse(a$mn.name == "one", "..1", "..2")
                       a$rg.name <- ifelse(a$rg.name == "one", "..1", "..2")
                       a
                     })
  expect_identical(summ, summ_ref)



  summ <- apply_column_dfl(student_results_M, mn=~c(mean(.j), median(.j)), rg=~range(.j))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  summ_ref <- lapply(M,
                     function(m) {
                       a <- list(tibble::as_tibble(t(apply(m,2, function(x) c(one=mean(x), two=median(x)))), rownames = ".colname"),
                                 tibble::as_tibble(t(apply(m,2, function(x) setNames(range(x), c("one", "two")))), rownames = ".colname"))
                       a <- lapply(a,
                                   function(u) tidyr::pivot_longer(u,
                                                                   names_to = "mn.name",
                                                                   values_to = "mn",
                                                                   cols = c("one", "two")))
                       colnames(a[[2]])[2:3] <- c("rg.name", "rg")
                       suppressMessages(a <- dplyr::bind_cols(a))
                       a$`.colname...4` <- NULL
                       a <- dplyr::rename(a, `.colname` = `.colname...1`)
                       a$mn.name <- ifelse(a$mn.name == "one", "..1", "..2")
                       a$rg.name <- ifelse(a$rg.name == "one", "..1", "..2")
                       a
                     })
  expect_identical(summ, summ_ref)



  summ <- apply_row_dfl(student_results_M, mn=~c(mn=mean(.i), md=median(.i)), rg=~range(.i))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  summ_ref <- lapply(M,
                     function(m) {
                       a <- list(tibble::as_tibble(t(apply(m,1, function(x) c(one=mean(x), two=median(x)))), rownames = ".rowname"),
                                 tibble::as_tibble(t(apply(m,1, function(x) setNames(range(x), c("one", "two")))), rownames = ".rowname"))
                       a <- lapply(a,
                                   function(u) tidyr::pivot_longer(u,
                                                                   names_to = "mn.name",
                                                                   values_to = "mn",
                                                                   cols = c("one", "two")))
                       colnames(a[[2]])[2:3] <- c("rg.name", "rg")
                       suppressMessages(a <- dplyr::bind_cols(a))
                       a$`.rowname...4` <- NULL
                       a <- dplyr::rename(a, `.rowname` = `.rowname...1`)
                       a$mn.name <- ifelse(a$mn.name == "one", "mn", "md")
                       a$rg.name <- ifelse(a$rg.name == "one", "..1", "..2")
                       a
                     })
  expect_identical(summ, summ_ref)




  summ <- apply_column_dfl(student_results_M, mn=~c(mn=mean(.j), md=median(.j)), rg=~range(.j))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  summ_ref <- lapply(M,
                     function(m) {
                       a <- list(tibble::as_tibble(t(apply(m,2, function(x) c(one=mean(x), two=median(x)))), rownames = ".colname"),
                                 tibble::as_tibble(t(apply(m,2, function(x) setNames(range(x), c("one", "two")))), rownames = ".colname"))
                       a <- lapply(a,
                                   function(u) tidyr::pivot_longer(u,
                                                                   names_to = "mn.name",
                                                                   values_to = "mn",
                                                                   cols = c("one", "two")))
                       colnames(a[[2]])[2:3] <- c("rg.name", "rg")
                       suppressMessages(a <- dplyr::bind_cols(a))
                       a$`.colname...4` <- NULL
                       a <- dplyr::rename(a, `.colname` = `.colname...1`)
                       a$mn.name <- ifelse(a$mn.name == "one", "mn", "md")
                       a$rg.name <- ifelse(a$rg.name == "one", "..1", "..2")
                       a
                     })
  expect_identical(summ, summ_ref)




  # error
  expect_error(apply_row_dfl(student_results_M,
                             mn=mean,
                             reg = ~lm(.i ~ national_average + program)),
               "vectors must be of the same length")




  expect_error(apply_column_dfl(student_results_M,
                                mn=mean,
                                reg = ~lm(.j ~ teacher + previous_year_score)),
               "vectors must be of the same length")




  # the trick
  summ <- apply_row_dfl(student_results_M, mn=mean, reg = ~list(lm(.i ~ national_average + program)))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  meta <- column_info(student_results_M)
  summ_ref <- lapply(M,
                     function(m) {
                       tibble::tibble(.rowname = rownames(m),
                                      mn=unname(Matrix::rowMeans(m)),
                                      reg = unname(apply(m,1,function(x) {
                                        meta$.i <- x
                                        eval(quote(lm(.i ~ national_average + program)), envir = meta)
                                      })))
                     })
  expect_equal(summ, summ_ref, ignore_attr = TRUE)




  summ <- apply_column_dfl(student_results_M, mn=mean, reg = ~list(lm(.j ~ teacher + previous_year_score)))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  meta <- row_info(student_results_M)
  summ_ref <- lapply(M,
                     function(m) {
                       tibble::tibble(.colname = colnames(m),
                                      mn=unname(Matrix::colMeans(m)),
                                      reg = unname(apply(m,2,function(x) {
                                        meta$.j <- x
                                        eval(quote(lm(.j ~ teacher + previous_year_score)), envir = meta)
                                      })))
                     })
  expect_equal(summ, summ_ref, ignore_attr = TRUE)




  summ <- apply_row_dfl(student_results_M, reg = ~list(lm(.i ~ national_average), lm(.i ~ program)))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  meta <- column_info(student_results_M)
  summ_ref <- lapply(M,
                     function(m) {
                       u <- tibble::tibble(
                         .rowname = rownames(student_results_M),
                         a=unname(apply(m,1,function(x) {
                           meta$.i <- x
                           eval(quote(lm(.i ~ national_average)), envir = meta)
                         })),
                         b=unname(apply(m,1,function(x) {
                           meta$.i <- x
                           eval(quote(lm(.i ~ program)), envir = meta)
                         })))
                       u <- tidyr::pivot_longer(u, names_to = "reg.name",
                                                values_to = "reg",
                                                cols = c("a", "b"))
                       u$reg.name <- ifelse(u$reg.name == "a", "..1", "..2")
                       u
                     })
  expect_equal(summ, summ_ref, ignore_attr = TRUE)




  summ <- apply_column_dfl(student_results_M, reg = ~list(lm(.j ~ class), lm(.j ~ teacher)))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  meta <- row_info(student_results_M)
  summ_ref <- lapply(M,
                     function(m) {
                       u <- tibble::tibble(
                         .colname = colnames(student_results_M),
                         a=unname(apply(m,2,function(x) {
                           meta$.j <- x
                           eval(quote(lm(.j ~ class)), envir = meta)
                         })),
                         b=unname(apply(m,2,function(x) {
                           meta$.j <- x
                           eval(quote(lm(.j ~ teacher)), envir = meta)
                         })))
                       u <- tidyr::pivot_longer(u, names_to = "reg.name",
                                                values_to = "reg",
                                                cols = c("a", "b"))
                       u$reg.name <- ifelse(u$reg.name == "a", "..1", "..2")
                       u
                     })
  expect_equal(summ, summ_ref, ignore_attr = TRUE)





  # this should fail
  expect_error(apply_row_dfl(student_results_M, mn=~mean(.i), rg=~range(.i)),
               "vectors must be of the same length")


  expect_error(apply_column_dfl(student_results_M, mn=~mean(.j), rg=~range(.j)),
               "vectors must be of the same length")


  expect_error(apply_column_dfl(student_results_M, .colname = mean))
  expect_error(apply_column_dfw(student_results_M, .colname = mean))
  expect_error(apply_row_dfl(student_results_M, .rowname = mean))
  expect_error(apply_row_dfw(student_results_M, .rowname = mean))




  # grouped
  grmn <- apply_row_dfl(column_group_by(student_results_M, program), mean, median)
  grs <- column_group_meta(column_group_by(student_results_M, program))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results_M,m)
                       apply(M[, gr, drop = FALSE], 1, function(u) list(mean=mean(u), median = median(u)),simplify = FALSE)
                     })
                     ans$.rows <- grmn_ref
                     ans
                   })
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest_longer(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest_wider(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) {
    u <- u[, c(1,4,2,3)]
    colnames(u)[2] <- ".rowname"
    u
  })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, mn_ref)




  grmn <- apply_column_dfl(row_group_by(student_results_M, teacher, class), mean, median)
  grs <- row_group_meta(row_group_by(student_results_M, teacher, class))
  grmn_ref <- lapply(seq(nmatrix(student_results_M)), function(m) {
    ans <- grs
    ans$.rows <- NULL
    mn_ref <- lapply(grs$.rows, function(gr) {
      M <- matrix_elm(student_results_M,m)
      apply(M[gr, , drop = FALSE], 2, function(u) list(mean=mean(u), median = median(u)),simplify = FALSE)
    })
    ans$.columns <- mn_ref
    ans
  })
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest_longer(u, .columns))
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest_wider(u, .columns))
  grmn_ref <- lapply(grmn_ref, function(u) {
    u <- u[, c(1,2,5,3,4)]
    colnames(u)[3] <- ".colname"
    u
  })
  names(grmn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, grmn_ref)




  grmn <- apply_row_dfl(column_group_by(student_results_M, program), mn=mean, md=~median(.i))
  grs <- column_group_meta(column_group_by(student_results_M, program))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results_M,m)
                       apply(M[, gr, drop = FALSE], 1, function(u) list(mn=mean(u), md = median(u)),simplify = FALSE)
                     })
                     ans$.rows <- grmn_ref
                     ans
                   })
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest_longer(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest_wider(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) {
    u <- u[, c(1,4,2,3)]
    colnames(u)[2] <- ".rowname"
    u
  })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, mn_ref)




  grmn <- apply_column_dfl(row_group_by(student_results_M, teacher, class), mn=mean, md=~median(.j))
  grs <- row_group_meta(row_group_by(student_results_M, teacher, class))
  grmn_ref <- lapply(seq(nmatrix(student_results_M)), function(m) {
    ans <- grs
    ans$.rows <- NULL
    mn_ref <- lapply(grs$.rows, function(gr) {
      M <- matrix_elm(student_results_M,m)
      apply(M[gr, , drop = FALSE], 2, function(u) list(mn=mean(u), md = median(u)),simplify = FALSE)
    })
    ans$.columns <- mn_ref
    ans
  })
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest_longer(u, .columns))
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest_wider(u, .columns))
  grmn_ref <- lapply(grmn_ref, function(u) {
    u <- u[, c(1,2,5,3,4)]
    colnames(u)[3] <- ".colname"
    u
  })
  names(grmn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, grmn_ref)



  grmn <- apply_row_dfl(column_group_by(student_results_M, program), ct=~c(mean(.i), median(.i)))
  grs <- column_group_meta(column_group_by(student_results_M, program))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results_M,m)
                       apply(M[, gr, drop = FALSE], 1, function(u) tibble::tibble(ct.name = c("..1", "..2"), ct=c(mean(u), median(u))),simplify = FALSE)
                     })
                     ans$.rows <- grmn_ref
                     ans
                   })
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest_longer(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest_wider(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest(u, c(ct.name, ct)))
  mn_ref <- lapply(mn_ref, function(u) {
    u <- u[, c(1,4,2,3)]
    colnames(u)[2] <- ".rowname"
    u
  })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, mn_ref)



  grmn <- apply_column_dfl(row_group_by(student_results_M, teacher, class), ct=~c(mean(.j), median(.j)))
  grs <- row_group_meta(row_group_by(student_results_M, teacher, class))
  grmn_ref <- lapply(seq(nmatrix(student_results_M)), function(m) {
    ans <- grs
    ans$.rows <- NULL
    mn_ref <- lapply(grs$.rows, function(gr) {
      M <- matrix_elm(student_results_M,m)
      apply(M[gr, , drop = FALSE], 2, function(u) tibble::tibble(ct.name = c("..1", "..2"), ct=c(mean(u), median(u))),simplify = FALSE)
    })
    ans$.columns <- mn_ref
    ans
  })
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest_longer(u, .columns))
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest_wider(u, .columns))
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest(u, c(ct.name, ct)))
  grmn_ref <- lapply(grmn_ref, function(u) {
    u <- u[, c(1,2,5,3,4)]
    colnames(u)[3] <- ".colname"
    u
  })
  names(grmn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, grmn_ref)

})








test_that("matrixset 'wide' loop works", {

  withr::local_options(lifecycle_verbosity = "quiet")

  student_results_M <- mutate_matrix(student_results,
                                     failure = Matrix::Matrix(matrix_elm(student_results, 1)),
                                     remedial = Matrix::Matrix(matrix_elm(student_results, 2)))


  student_results2 <- student_results_M
  matrix_elm(student_results2,2) <- NULL
  ct <- apply_row_dfw(student_results2, mn=mean, md=median)
  M <- matrix_elm(student_results2,1)
  ct_ref <- list(failure=t(apply(M, 1, function(u) c(mn=mean(u), md=median(u)),simplify = TRUE)))
  ct_ref$failure <- tibble::as_tibble(ct_ref$failure, rownames = ".rowname")
  # ct_ref$remedial <- tibble::tibble(.rowname = character(), mn = logical(), md = logical())
  ct_ref["remedial"] <- list(NULL)
  expect_identical(ct, ct_ref)



  student_results2 <- student_results_M
  matrix_elm(student_results2,2) <- NULL
  ct <- apply_column_dfw(student_results2, mn=mean, md=median)
  M <- matrix_elm(student_results2,1)
  ct_ref <- list(failure=t(apply(M, 2, function(u) c(mn=mean(u), md=median(u)),simplify = TRUE)))
  ct_ref$failure <- tibble::as_tibble(ct_ref$failure, rownames = ".colname")
  # ct_ref$remedial <- tibble::tibble(.colname = character(), mn = logical(), md = logical())
  ct_ref["remedial"] <- list(NULL)
  expect_identical(ct, ct_ref)



  ct <- apply_row_dfw(student_results_M, mn=mean, md=median)
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  ct_ref <- lapply(M,
                   function(m) tibble::tibble(.rowname = rownames(m),
                                              mn=unname(Matrix::rowMeans(m)),
                                              md = unname(apply(m,1,median))))
  expect_equal(ct, ct_ref)



  ct <- apply_column_dfw(student_results_M, mn=mean, md=median)
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  ct_ref <- lapply(M,
                   function(m) tibble::tibble(.colname = colnames(m),
                                              mn=unname(Matrix::colMeans(m)),
                                              md = unname(apply(m,2,median))))
  expect_equal(ct, ct_ref)



  # showcase > 1 length answer
  summ <- apply_row_dfw(student_results_M, mn=~c(mean(.i), median(.i)), rg=~range(.i))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  summ_ref <- lapply(M,
                     function(m) {
                       dplyr::bind_cols(tibble::as_tibble(t(apply(m,1, function(x) c(`mn ..1`=mean(x), `mn ..2`=median(x)))), rownames = ".rowname"),
                                        tibble::as_tibble(t(apply(m,1, function(x) setNames(range(x), c("rg ..1", "rg ..2"))))))
                     })
  expect_identical(summ, summ_ref)




  summ <- apply_column_dfw(student_results_M, mn=~c(mean(.j), median(.j)), rg=~range(.j))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  summ_ref <- lapply(M,
                     function(m) {
                       dplyr::bind_cols(tibble::as_tibble(t(apply(m,2, function(x) c(`mn ..1`=mean(x), `mn ..2`=median(x)))), rownames = ".colname"),
                                        tibble::as_tibble(t(apply(m,2, function(x) setNames(range(x), c("rg ..1", "rg ..2"))))))
                     })
  expect_identical(summ, summ_ref)




  summ <- apply_row_dfw(student_results_M, mn=~c(mn=mean(.i), md=median(.i)), rg=~range(.i))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  summ_ref <- lapply(M,
                     function(m) {
                       dplyr::bind_cols(tibble::as_tibble(t(apply(m,1, function(x) c(`mn mn`=mean(x), `mn md`=median(x)))), rownames = ".rowname"),
                                        tibble::as_tibble(t(apply(m,1, function(x) setNames(range(x), c("rg ..1", "rg ..2"))))))
                     })
  expect_identical(summ, summ_ref)




  summ <- apply_column_dfw(student_results_M, mn=~c(mn=mean(.j), md=median(.j)), rg=~range(.j))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  summ_ref <- lapply(M,
                     function(m) {
                       dplyr::bind_cols(tibble::as_tibble(t(apply(m,2, function(x) c(`mn mn`=mean(x), `mn md`=median(x)))), rownames = ".colname"),
                                        tibble::as_tibble(t(apply(m,2, function(x) setNames(range(x), c("rg ..1", "rg ..2"))))))
                     })
  expect_identical(summ, summ_ref)




  # error
  expect_error(apply_row_dfw(student_results_M,
                             mn=mean,
                             reg = ~lm(.i ~ national_average + program)),
               "vectors must be of the same length")




  expect_error(apply_column_dfw(student_results_M,
                                mn=mean,
                                reg = ~lm(.j ~ teacher + previous_year_score)),
               "vectors must be of the same length")




  # the trick
  summ <- apply_row_dfw(student_results_M, mn=mean, reg = ~list(lm(.i ~ national_average + program)))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  meta <- column_info(student_results_M)
  summ_ref <- lapply(M,
                     function(m) {
                       tibble::tibble(.rowname = rownames(m),
                                      mn=unname(Matrix::rowMeans(m)),
                                      reg = unname(apply(m,1,function(x) {
                                        meta$.i <- x
                                        eval(quote(lm(.i ~ national_average + program)), envir = meta)
                                      })))
                     })
  expect_equal(summ, summ_ref, ignore_attr = TRUE)




  summ <- apply_column_dfw(student_results_M, mn=mean, reg = ~list(lm(.j ~ teacher + previous_year_score)))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  meta <- row_info(student_results_M)
  summ_ref <- lapply(M,
                     function(m) {
                       tibble::tibble(.colname = colnames(m),
                                      mn=unname(Matrix::colMeans(m)),
                                      reg = unname(apply(m,2,function(x) {
                                        meta$.j <- x
                                        eval(quote(lm(.j ~ teacher + previous_year_score)), envir = meta)
                                      })))
                     })
  expect_equal(summ, summ_ref, ignore_attr = TRUE)



  summ <- apply_row_dfw(student_results_M, reg = ~list(national = lm(.i ~ national_average), program = lm(.i ~ program)))
  M <- student_results_M[,,,keep_annotation = FALSE, warn_class_change = FALSE]
  meta <- column_info(student_results_M)
  summ_ref <- lapply(M,
                     function(m) {
                       tibble::tibble(.rowname = rownames(m),
                                      `reg national` = unname(apply(m,1,function(x) {
                                        meta$.i <- x
                                        eval(quote(lm(.i ~ national_average)), envir = meta)
                                      })),
                                      `reg program` = unname(apply(m,1,function(x) {
                                        meta$.i <- x
                                        eval(quote(lm(.i ~ program)), envir = meta)
                                      })))
                     })
  expect_equal(summ, summ_ref, ignore_attr = TRUE)


  #
  # # this should fail
  expect_error(apply_row_dfw(student_results_M, mn=~mean(.i), rg=~range(.i)),
               "vectors must be of the same length")


  expect_error(apply_column_dfw(student_results_M, mn=~mean(.j), rg=~range(.j)),
               "vectors must be of the same length")







  # grouped
  grmn <- apply_row_dfw(column_group_by(student_results_M, program), mean, median)
  grs <- column_group_meta(column_group_by(student_results_M, program))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results_M,m)
                       apply(M[, gr, drop = FALSE], 1, function(u) list(mean=mean(u), median = median(u)),simplify = FALSE)
                     })
                     ans$.rows <- grmn_ref
                     ans
                   })
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest_longer(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest_wider(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) {
    u <- u[, c(1,4,2,3)]
    colnames(u)[2] <- ".rowname"
    u
  })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, mn_ref)




  grmn <- apply_column_dfw(row_group_by(student_results_M, teacher, class), mean, median)
  grs <- row_group_meta(row_group_by(student_results_M, teacher, class))
  grmn_ref <- lapply(seq(nmatrix(student_results_M)), function(m) {
    ans <- grs
    ans$.rows <- NULL
    mn_ref <- lapply(grs$.rows, function(gr) {
      M <- matrix_elm(student_results_M,m)
      apply(M[gr, , drop = FALSE], 2, function(u) list(mean=mean(u), median = median(u)),simplify = FALSE)
    })
    ans$.columns <- mn_ref
    ans
  })
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest_longer(u, .columns))
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest_wider(u, .columns))
  grmn_ref <- lapply(grmn_ref, function(u) {
    u <- u[, c(1,2,5,3,4)]
    colnames(u)[3] <- ".colname"
    u
  })
  names(grmn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, grmn_ref)




  grmn <- apply_row_dfw(column_group_by(student_results_M, program), mn=mean, md=~median(.i))
  grs <- column_group_meta(column_group_by(student_results_M, program))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results_M,m)
                       apply(M[, gr, drop = FALSE], 1, function(u) list(mn=mean(u), md = median(u)),simplify = FALSE)
                     })
                     ans$.rows <- grmn_ref
                     ans
                   })
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest_longer(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest_wider(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) {
    u <- u[, c(1,4,2,3)]
    colnames(u)[2] <- ".rowname"
    u
  })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, mn_ref)




  grmn <- apply_column_dfw(row_group_by(student_results_M, teacher, class), mn=mean, md=~median(.j))
  grs <- row_group_meta(row_group_by(student_results_M, teacher, class))
  grmn_ref <- lapply(seq(nmatrix(student_results_M)), function(m) {
    ans <- grs
    ans$.rows <- NULL
    mn_ref <- lapply(grs$.rows, function(gr) {
      M <- matrix_elm(student_results_M,m)
      apply(M[gr, , drop = FALSE], 2, function(u) list(mn=mean(u), md = median(u)),simplify = FALSE)
    })
    ans$.columns <- mn_ref
    ans
  })
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest_longer(u, .columns))
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest_wider(u, .columns))
  grmn_ref <- lapply(grmn_ref, function(u) {
    u <- u[, c(1,2,5,3,4)]
    colnames(u)[3] <- ".colname"
    u
  })
  names(grmn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, grmn_ref)



  grmn <- apply_row_dfw(column_group_by(student_results_M, program), ct=~c(mean(.i), median(.i)))
  grs <- column_group_meta(column_group_by(student_results_M, program))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results_M,m)
                       apply(M[, gr, drop = FALSE], 1, function(u) tibble::tibble(ct.name = c("ct ..1", "ct ..2"), ct=c(mean(u), median(u))),simplify = FALSE)
                     })
                     ans$.rows <- grmn_ref
                     ans
                   })
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest_longer(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest_wider(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest(u, c(ct.name, ct)))
  mn_ref <- lapply(mn_ref, function(u) tidyr::pivot_wider(u, names_from = "ct.name", values_from = "ct"))
  mn_ref <- lapply(mn_ref, function(u) {
    colnames(u)[2] <- ".rowname"
    u
  })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, mn_ref)



  grmn <- apply_column_dfw(row_group_by(student_results_M, teacher, class), ct=~c(mean(.j), median(.j)))
  grs <- row_group_meta(row_group_by(student_results_M, teacher, class))
  grmn_ref <- lapply(seq(nmatrix(student_results_M)), function(m) {
    ans <- grs
    ans$.rows <- NULL
    mn_ref <- lapply(grs$.rows, function(gr) {
      M <- matrix_elm(student_results_M,m)
      apply(M[gr, , drop = FALSE], 2, function(u) tibble::tibble(ct.name = c("d..1", "d..2"), ct=c(mean(u), median(u))),simplify = FALSE)
    })
    ans$.columns <- mn_ref
    ans
  })
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest_longer(u, .columns))
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest_wider(u, .columns))
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::unnest(u, c(ct.name, ct)))
  grmn_ref <- lapply(grmn_ref, function(u) tidyr::pivot_wider(u, names_from = "ct.name", values_from = "ct"))
  grmn_ref <- lapply(grmn_ref, function(u) {
    colnames(u)[3:5] <- c(".colname", "ct ..1", "ct ..2")
    u
  })
  names(grmn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, grmn_ref)



  grmn <- apply_row_dfw(column_group_by(student_results_M, program),
                        ct=~c(mn=mean(.i), md=median(.i)),
                        rg=range,
                        fit=~list(lm(.i ~ 1), lm(.i ~ school_average)))
  grs <- column_group_meta(column_group_by(student_results_M, program))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results_M,m)
                       meta <- column_info(student_results_M)
                       rows <- lapply(seq(nrow(M)), function(i) {
                         u <- M[i, gr]
                         info <- meta[gr, ]
                         info$.i <- u
                         tibble::tibble(ct.name = c("ct mn", "ct md"),
                                        ct=c(mean(u), median(u)),
                                        rg.name=c("rg ..1", "rg ..2"),
                                        rg=range(u),
                                        fit.name = c("fit ..1", "fit ..2"),
                                        fit=list(eval(quote(lm(.i ~ 1)), info),
                                                 eval(quote(lm(.i ~ school_average)), info)))
                       })
                       names(rows) <- rownames(student_results_M)
                       dplyr::bind_rows(rows, .id = ".rowname")
                     })
                     ans$.rows <- grmn_ref
                     ans
                   })
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) tidyr::pivot_wider(u, names_from = c("ct.name", "rg.name", "fit.name"), values_from = c("ct", "rg", "fit")))
  mn_ref <- lapply(mn_ref, function(u) {
    colnames(u)[3:8] <- c("ct mn", "ct md", "rg ..1", "rg ..2", "fit ..1", "fit ..2")
    u
  })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, mn_ref, ignore_attr = TRUE)



  grmn <- apply_column_dfw(row_group_by(student_results_M, teacher, class),
                           ct=~c(mn=mean(.j), md=median(.j)),
                           rg=range,
                           fit=~list(lm(.j ~ 1), lm(.j ~ previous_year_score)))
  grs <- row_group_meta(row_group_by(student_results_M, teacher, class))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results_M,m)
                       meta <- row_info(student_results_M)
                       cols <- lapply(seq(ncol(M)), function(j) {
                         u <- M[gr, j]
                         info <- meta[gr, ]
                         info$.j <- u
                         tibble::tibble(ct.name = c("ct mn", "ct md"),
                                        ct=c(mean(u), median(u)),
                                        rg.name=c("rg ..1", "rg ..2"),
                                        rg=range(u),
                                        fit.name = c("fit ..1", "fit ..2"),
                                        fit=list(eval(quote(lm(.j ~ 1)), info),
                                                 eval(quote(lm(.j ~ previous_year_score)), info)))
                       })
                       names(cols) <- colnames(student_results_M)
                       dplyr::bind_rows(cols, .id = ".colname")
                     })
                     ans$.rows <- grmn_ref
                     ans
                   })
  mn_ref <- lapply(mn_ref, function(u) tidyr::unnest(u, .rows))
  mn_ref <- lapply(mn_ref, function(u) tidyr::pivot_wider(u, names_from = c("ct.name", "rg.name", "fit.name"), values_from = c("ct", "rg", "fit")))
  mn_ref <- lapply(mn_ref, function(u) {
    colnames(u)[3:8] <- c("ct mn", "ct md", "rg ..1", "rg ..2", "fit ..1", "fit ..2")
    u
  })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_identical(grmn, mn_ref, ignore_attr = TRUE)

})








test_that("matrixset matrix loop works", {

  withr::local_options(lifecycle_verbosity = "quiet")

  student_results_M <- mutate_matrix(student_results,
                                     failure = Matrix::Matrix(matrix_elm(student_results, 1)),
                                     remedial = Matrix::Matrix(matrix_elm(student_results, 2)))

  student_results2 <- student_results_M
  matrix_elm(student_results2,2) <- NULL
  mn <- apply_matrix(student_results2, Matrix::mean)
  M <- matrix_elm(student_results2,1)
  # mn_ref <- list(failure=list(`Matrix::mean`=Matrix::mean(M)), remedial=list(`Matrix::mean`=NULL))
  mn_ref <- list(failure=list(`Matrix::mean`=Matrix::mean(M)), remedial=NULL)

  expect_equal(mn, mn_ref)




  mn <- apply_matrix(student_results_M, Matrix::mean)
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     M <- matrix_elm(student_results_M,m)
                     list(`Matrix::mean`=Matrix::mean(M))
                   })
  names(mn_ref) <- matrixnames(student_results_M)

  expect_equal(mn, mn_ref)



  mn <- apply_matrix(student_results_M, mn=Matrix::mean)
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     M <- matrix_elm(student_results_M,m)
                     list(mn=Matrix::mean(M))
                   })
  names(mn_ref) <- matrixnames(student_results_M)

  expect_equal(mn, mn_ref)



  ct <- apply_matrix(student_results_M, mn=Matrix::mean, md=~Matrix::mean(.m))
  ct_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     M <- matrix_elm(student_results_M,m)
                     list(mn=Matrix::mean(M), md=Matrix::mean(M))
                   })
  names(ct_ref) <- matrixnames(student_results_M)

  expect_equal(ct, ct_ref)



  e <- apply_matrix(student_results_M,
                    mn = ~{
                      mm <- .m
                      Matrix::mean(mm)
                    })

  e_ref <- lapply(seq(nmatrix(student_results_M)),
                  function(m) {
                    M <- matrix_elm(student_results_M,m)
                    list(mn=Matrix::mean(M))
                  })
  names(e_ref) <- matrixnames(student_results_M)

  expect_equal(e, e_ref, ignore_attr = TRUE)





  # grouped


  grmn <- apply_matrix(column_group_by(student_results_M, program), Matrix::mean)
  grs <- column_group_meta(column_group_by(student_results_M, program))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results_M,m)
                       list(`Matrix::mean`=Matrix::mean(M[, gr]))
                     })
                     ans$.rows <- NULL
                     ans$.vals <- grmn_ref
                     ans
                   })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_equal(grmn, mn_ref)




  grmn <- apply_matrix(column_group_by(student_results_M, program), mn=Matrix::mean)
  grs <- column_group_meta(column_group_by(student_results_M, program))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results_M,m)
                       list(mn=Matrix::mean(M[, gr]))
                     })
                     ans$.rows <- NULL
                     ans$.vals <- grmn_ref
                     ans
                   })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_equal(grmn, mn_ref)




  grmn <- apply_matrix(row_group_by(student_results_M, teacher, class), Matrix::mean, rg=range)
  grs <- row_group_meta(row_group_by(student_results_M, teacher, class))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results_M,m)
                       list(`Matrix::mean`=Matrix::mean(M[gr, ]), rg=range(M[gr, ]))
                     })
                     ans$.rows <- NULL
                     ans$.vals <- grmn_ref
                     ans
                   })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_equal(grmn, mn_ref)



  grmn <- apply_matrix(column_group_by(row_group_by(student_results_M, teacher, class), program), mn=Matrix::mean, rg=range)
  grs_row <- row_group_meta(row_group_by(student_results_M, teacher, class))
  grs_col <- column_group_meta(column_group_by(student_results_M, program))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     M <- matrix_elm(student_results_M,m)
                     grmn_ref <- lapply(grs_row$.rows, function(grr) {
                       lapply(grs_col$.rows, function(grc) {
                         list(mn=Matrix::mean(M[grr, grc]), rg=range(M[grr, grc]))
                       })
                     })
                     unlist(grmn_ref, recursive = FALSE)
                     # grmn_ref
                     # ans$.rows <- NULL
                     # ans$.mats <- grmn_ref
                     # ans
                   })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_equal(grmn$failure$.vals, mn_ref$failure)
  expect_equal(grmn$remedial$.vals, mn_ref$remedial)




  grmn <- apply_matrix_dfl(column_group_by(student_results_M, program),
                           FC = ~Matrix::colMeans(.m),
                           FC_rob = ~apply(.m, 2, median), .force_name = TRUE)
  grs <- column_group_meta(column_group_by(student_results_M, program))
  mn_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs
                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results,m)
                       Mgr <- M[, gr, drop = FALSE]
                       Matrix::colMeans(Mgr)
                     })
                     ans$FC <- grmn_ref

                     grmn_ref <- lapply(grs$.rows, function(gr) {
                       M <- matrix_elm(student_results,m)
                       Mgr <- M[, gr, drop = FALSE]
                       apply(Mgr, 2, median)

                     })
                     ans$FC_rob <- grmn_ref
                     ans$.rows <- NULL
                     ans %>% tidyr::unnest_longer(c(FC, FC_rob)) %>%
                       dplyr::select(program, FC.name = FC_id, FC,
                                     FC_rob.name = FC_rob_id, FC_rob) %>%
                       dplyr::mutate(FC = unname(FC), FC_rob = unname(FC_rob))
                   })
  names(mn_ref) <- matrixnames(student_results_M)
  expect_equal(grmn, mn_ref)






  grfc <- apply_matrix_dfl(column_group_by(row_group_by(student_results_M, teacher), program),
                           FC = ~Matrix::colMeans(.m),
                           FC_rob = ~apply(.m, 2, median), .force_name = TRUE)
  grs <- column_group_by(row_group_by(student_results_M, teacher), program)
  grs_row <- row_group_meta(grs)
  grs_col <- column_group_meta(grs)
  fc_ref <- lapply(seq(nmatrix(student_results_M)),
                   function(m) {
                     ans <- grs_row
                     M <- matrix_elm(student_results_M,m)
                     ans$.rows <- NULL
                     grmn_ref <- lapply(grs_row$.rows, function(grr) {
                       lapply(grs_col$.rows, function(grc) {
                         Matrix::colMeans(M[grr, grc, drop = FALSE])
                       })
                     })
                     ans$FC <- grmn_ref

                     grmn_ref <- lapply(grs_row$.rows, function(grr) {
                       lapply(grs_col$.rows, function(grc) {
                         apply(M[grr, grc, drop = FALSE], 2, median)
                       })
                     })
                     ans$FC_rob <- grmn_ref

                     ans %>%
                       tidyr::unnest(c(FC, FC_rob)) %>%
                       tidyr::unnest_longer(c(FC, FC_rob)) %>%
                       dplyr::left_join(column_info(student_results) %>%
                                          dplyr::select(FC_id=.colname, program),
                                        by = "FC_id") %>%
                       dplyr::select(teacher, program, FC.name=FC_id, FC,
                                     FC_rob.name=FC_rob_id, FC_rob) %>%
                       dplyr::mutate(FC=unname(FC), FC_rob=unname(FC_rob))
                   })
  names(fc_ref) <- matrixnames(student_results_M)
  expect_identical(grfc, fc_ref)




  grmn <- apply_matrix_dfw(column_group_by(student_results_M, program),
                           FC = ~Matrix::colMeans(.m),
                           FC_rob = ~apply(.m, 2, median), .force_name = TRUE)
  mn_ref <- apply_matrix_dfl(column_group_by(student_results_M, program),
                             FC = ~Matrix::colMeans(.m),
                             FC_rob = ~apply(.m, 2, median), .force_name = TRUE) %>%
    lapply(function(m) {
      m %>% tidyr::pivot_wider(names_from = c(FC.name, FC_rob.name),
                               values_from = c(FC, FC_rob),
                               names_glue = "{.value} {FC.name}")
    })
  nms <- unlist(unique(lapply(grmn, names)))
  nms_ref <- unlist(unique(lapply(mn_ref, names)))
  expect_true(all(nms %in% nms_ref))
  expect_true(all(nms_ref %in% nms))
  mn_ref <- purrr::map2(mn_ref, grmn, ~ .x[, names(.y)])
  expect_identical(grmn, mn_ref)




  ct <- apply_matrix_dfw(column_group_by(row_group_by(student_results_M, teacher), program),
                         FC = ~Matrix::colMeans(.m),
                         FC_rob = ~apply(.m, 2, median), .force_name = TRUE)
  ct_ref <- apply_matrix_dfl(column_group_by(row_group_by(student_results, teacher), program),
                             FC = ~Matrix::colMeans(.m),
                             FC_rob = ~apply(.m, 2, median), .force_name = TRUE) %>%
    lapply(function(m) {
      m %>% tidyr::pivot_wider(names_from = c(FC.name, FC_rob.name),
                               values_from = c(FC, FC_rob),
                               names_glue = "{.value} {FC.name}")
    })
  nms <- unlist(unique(lapply(ct, names)))
  nms_ref <- unlist(unique(lapply(ct_ref, names)))
  expect_true(all(nms %in% nms_ref))
  expect_true(all(nms_ref %in% nms))
  ct_ref <- purrr::map2(ct_ref, ct, ~ .x[, names(.y)])
  expect_equal(ct, ct_ref)



})