SH:

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: caracas
-Version: 2.1.2.9001
+Version: 2.1.2.9004
 Title: Computer Algebra
 Authors@R: c(
     person(given = "Mikkel Meyer", family = "Andersen",
@@ -25,6 +25,7 @@ Suggests:
   Ryacas,
   testthat (>= 2.1.0),
   knitr,
+  nlme,
   lme4,
   rmarkdown,
   tinytex,

NAMESPACE

@@ -57,6 +57,7 @@ export(basis_leftnull)
 export(basis_null)
 export(basis_orthcomp)
 export(basis_row)
+export(bdiag_)
 export(c_)
 export(cancel)
 export(colSums_)

R/expr_to_fun.R

@@ -36,12 +36,6 @@ as_func <- function(x, order=NULL, vec_arg=FALSE){
     stopifnot_symbol(x)
 
     x <- as_expr(x)
-    ## if (vec_arg){
-    ##     doBy::expr_to_fun(x, order=order, vec_arg=TRUE)
-    ## } else {
-    ##     doBy::expr_to_fun(x, order=order, vec_arg=FALSE)
-    ## }
-
     doBy::expr_to_fun(x, order=order, vec_arg=vec_arg)
 }
 
@@ -50,5 +44,5 @@ as_func <- function(x, order=NULL, vec_arg=FALSE){
 #' @param \dots not used
 #' @export
 as.function.caracas_symbol <- function(x, ...) {
-  as_func(x, ...)
+  as_func(x, vec_arg = TRUE)
 }

R/lin_alg_blockinv.R

@@ -16,41 +16,45 @@
 #' }
 ##' @importFrom blockmatrix as.blockmatrix
 ##' @export
-inv_block <- function(x) {
-    if (!inherits(x, c("caracas_symbol", "matrix", "sparseMatrix")))
-        stop("'x' must be caracas_symbol, matrix or sparseMatrix")
-    if (inherits(x, "carcas_symbol")){
-        stopifnot_symbol(x)
-        stopifnot(symbol_is_matrix(x))
+inv_block <- function(x){
+    inv(x, method="block")
+}
+
+## inv_block <- function(x) {
+##     if (!inherits(x, c("caracas_symbol", "matrix", "sparseMatrix")))
+##         stop("'x' must be caracas_symbol, matrix or sparseMatrix")
+##     if (inherits(x, "carcas_symbol")){
+##         stopifnot_symbol(x)
+##         stopifnot(symbol_is_matrix(x))
 
-        xx1 <- as_character_matrix(x)
-        xx. <- as.blockmatrix(xx1)
-        xx.$value <- NULL
-        end <- cumsum(sapply(xx., nrow))
-        start <- c(1, end[-length(end)]+1)
+##         xx1 <- as_character_matrix(x)
+##         xx. <- as.blockmatrix(xx1)
+##         xx.$value <- NULL
+##         end <- cumsum(sapply(xx., nrow))
+##         start <- c(1, end[-length(end)]+1)
 
-        ddd <- mapply(function(s,e){
-            seq(s,e)
-        },  start, end, SIMPLIFY = FALSE)
+##         ddd <- mapply(function(s,e){
+##             seq(s,e)
+##         },  start, end, SIMPLIFY = FALSE)
 
-        uxx. <- unique(xx.)
-        ## This is only done on the unique elements:
-        uai <-lapply(uxx., function(z) as_character_matrix(inv_yac(as_sym(z))))
+##         uxx. <- unique(xx.)
+##         ## This is only done on the unique elements:
+##         uai <-lapply(uxx., function(z) as_character_matrix(inv_yac(as_sym(z))))
 
-        mmm <- sapply(xx., paste0, collapse=" ")
-        uuu <- sapply(unique(xx.), paste0, collapse=" ")
-        ppp <- sapply(mmm, match, uuu)
+##         mmm <- sapply(xx., paste0, collapse=" ")
+##         uuu <- sapply(unique(xx.), paste0, collapse=" ")
+##         ppp <- sapply(mmm, match, uuu)
 
-        for (i in seq_along(ddd)) {
-            idx <- ddd[[i]]
-            xx1[idx, idx] <- uai[[ppp[i]]]   
-        }
+##         for (i in seq_along(ddd)) {
+##             idx <- ddd[[i]]
+##             xx1[idx, idx] <- uai[[ppp[i]]]   
+##         }
 
-        as_sym(xx1)
-    } else {
-        solve(x)
-    }
-}
+##         as_sym(xx1)
+##     } else {
+##         solve(x)
+##     }
+## }
 
 
 ##' @title Inverse using woodburys matrix identity

R/subs.R

@@ -36,10 +36,10 @@ subs <- function(sym, nms, vls) {
     stopifnot_symbol(sym)
 
     ## FIXME sorenh: is this good
-
-    ## if (is.vector(nms)){
-    ##     nms <- as.list(nms)
-    ## }
+    ## Must catch case where nms is a character vector
+    if (is.vector(nms) && !is.null(names(nms))){
+        nms <- as.list(nms)
+    }
 
     ## subs() from named list
     if (inherits(nms, "list")) {

vignettes/.#a16-mixed-models.Rmd

@@ -0,0 +1 @@
+sorenh@AAU137879.97122:1740760429