tests/testthat/test-assignment.R

In MatrixExtra: Extra Methods for Sparse Matrices

library("testthat")
library("Matrix")
library("MatrixExtra")
context("Assignment")


X1d <- matrix(0, nrow=4, ncol=3)
X2d <- matrix(1, nrow=4, ncol=3)
set.seed(1)
X3d <- matrix(rnorm(12), nrow=4, ncol=3)
X4d <- matrix(c(0,0,0, 1,2,3, 0,0,0, 0,1,0), nrow=4, ncol=3, byrow=TRUE)

X1 <- as.csr.matrix(X1d)
X2 <- as.csr.matrix(X2d)
X3 <- as.csr.matrix(X3d)
X4 <- as.csr.matrix(X4d)

set.seed(1)
X5 <- rsparsematrix(111, 23, .1, repr="R")
X6 <- rsparsematrix(222, 6, .1, repr="R")
X5d <- as.matrix(X5)
X6d <- as.matrix(X6)

get_sparse_vector <- function(size) {
    set.seed(1)
    v <- rsparsematrix(size, 1, .75, repr="T")
    v <- as.sparse.vector(v)
    return(v)
}

test_that("Set single to zero", {

    run_tests <- function(X, Xd) {
        X_orig <- X
        Xd_orig <- Xd

        X[2,] <- 0
        Xd[2,] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[,2] <- 0
        Xd[,2] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[2,3] <- 0
        Xd[2,3] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[3,2] <- 0
        Xd[3,2] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[4,1] <- 0
        Xd[4,1] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[4,2] <- 0
        Xd[4,2] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig
    }

    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})

test_that("Set single to constant", {
    run_tests <- function(X, Xd) {
        X_orig <- X
        Xd_orig <- Xd

        X[2,] <- 111
        Xd[2,] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[,2] <- 111
        Xd[,2] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[2,3] <- 111
        Xd[2,3] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[3,2] <- 111
        Xd[3,2] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[4,1] <- 111
        Xd[4,1] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[4,2] <- 111
        Xd[4,2] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig
    }

    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})

test_that("Set single to dense vector", {
    run_tests <- function(X, Xd) {
        X_orig <- X
        Xd_orig <- Xd

        X[2,] <- seq(1, ncol(X))
        Xd[2,] <- seq(1, ncol(Xd))
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[3,] <- seq(1, ncol(X))
        Xd[3,] <- seq(1, ncol(Xd))
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[,2] <- seq(1, nrow(X))
        Xd[,2] <- seq(1, nrow(Xd))
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[,3] <- seq(1, nrow(X))
        Xd[,3] <- seq(1, nrow(Xd))
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        row_div2 <- nrow(X) > 2 && (nrow(X) %% 2) == 0
        row_div3 <- nrow(X) > 3 && (nrow(X) %% 3) == 0
        col_div2 <- ncol(X) > 2 && (ncol(X) %% 2) == 0
        col_div3 <- ncol(X) > 3 && (ncol(X) %% 3) == 0

        if (col_div2) {
            X[2,] <- seq(1, ncol(X)/2)
            Xd[2,] <- seq(1, ncol(Xd)/2)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig

            X[3,] <- seq(1, ncol(X)/2)
            Xd[3,] <- seq(1, ncol(Xd)/2)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
        }

        if (col_div3) {
            X[2,] <- seq(1, ncol(X)/3)
            Xd[2,] <- seq(1, ncol(Xd)/3)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig

            X[3,] <- seq(1, ncol(X)/3)
            Xd[3,] <- seq(1, ncol(Xd)/3)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
        }

        if (row_div2) {
            X[,2] <- seq(1, nrow(X)/2)
            Xd[,2] <- seq(1, nrow(Xd)/2)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig

            X[,3] <- seq(1, nrow(X)/2)
            Xd[,3] <- seq(1, nrow(Xd)/2)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
        }

        if (row_div3) {
            X[,2] <- seq(1, nrow(X)/3)
            Xd[,2] <- seq(1, nrow(Xd)/3)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig

            X[,3] <- seq(1, nrow(X)/3)
            Xd[,3] <- seq(1, nrow(Xd)/3)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
        }
    }

    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})

test_that("Set single to sparse vector", {
    assign_bytype_row <- function(X, Xd, X_orig, Xd_orig, v, i) {
        X[i,] <- as.sparse.vector(v)
        Xd[i,] <- as.numeric(v)
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[i,] <- as.csr.matrix(v)
        Xd[i,] <- as.numeric(v)
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[i,] <- as.csc.matrix(v)
        Xd[i,] <- as.numeric(v)
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[i,] <- as.coo.matrix(v)
        Xd[i,] <- as.numeric(v)
        expect_equal(unname(as.matrix(X)), unname(Xd))
    }

    assign_bytype_col <- function(X, Xd, X_orig, Xd_orig, v, j) {
        X[,j] <- as.sparse.vector(v)
        Xd[,j] <- as.numeric(v)
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[,j] <- as.csr.matrix(v)
        Xd[,j] <- as.numeric(v)
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[,j] <- as.csc.matrix(v)
        Xd[,j] <- as.numeric(v)
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[,j] <- as.coo.matrix(v)
        Xd[,j] <- as.numeric(v)
        expect_equal(unname(as.matrix(X)), unname(Xd))
    }


    run_tests <- function(X, Xd) {
        X_orig <- X
        Xd_orig <- Xd

        v <- get_sparse_vector(ncol(X))
        assign_bytype_row(X, Xd, X_orig, Xd_orig, v, 2)

        v <- get_sparse_vector(ncol(X))
        assign_bytype_row(X, Xd, X_orig, Xd_orig, v, 3)

        v <- get_sparse_vector(nrow(X))
        assign_bytype_col(X, Xd, X_orig, Xd_orig, v, 2)

        v <- get_sparse_vector(nrow(X))
        assign_bytype_col(X, Xd, X_orig, Xd_orig, v, 3)

        row_div2 <- nrow(X) > 2 && (nrow(X) %% 2) == 0
        row_div3 <- nrow(X) > 3 && (nrow(X) %% 3) == 0
        col_div2 <- ncol(X) > 2 && (ncol(X) %% 2) == 0
        col_div3 <- ncol(X) > 3 && (ncol(X) %% 3) == 0

        if (col_div2) {
            v <- get_sparse_vector(ncol(X)/2)
            assign_bytype_row(X, Xd, X_orig, Xd_orig, v, 2)

            v <- get_sparse_vector(ncol(X)/2)
            assign_bytype_row(X, Xd, X_orig, Xd_orig, v, 3)
        }

        if (col_div3) {
            v <- get_sparse_vector(ncol(X)/3)
            assign_bytype_row(X, Xd, X_orig, Xd_orig, v, 2)

            v <- get_sparse_vector(ncol(X)/3)
            assign_bytype_row(X, Xd, X_orig, Xd_orig, v, 3)
        }

        if (row_div2) {
            v <- get_sparse_vector(nrow(X)/2)
            assign_bytype_col(X, Xd, X_orig, Xd_orig, v, 2)

            v <- get_sparse_vector(nrow(X)/2)
            assign_bytype_col(X, Xd, X_orig, Xd_orig, v, 3)
        }

        if (row_div3) {
            v <- get_sparse_vector(nrow(X)/3)
            assign_bytype_col(X, Xd, X_orig, Xd_orig, v, 2)

            v <- get_sparse_vector(nrow(X)/3)
            assign_bytype_col(X, Xd, X_orig, Xd_orig, v, 3)
        }
    }

    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})

test_that("Set row sequence to constant", {
    s1 <- seq(1L, 2L)
    s2 <- seq(2L, 4L)
    s3 <- seq(3L, 1L)

    run_tests <- function(X, Xd, s) {
        X_orig <- X
        Xd_orig <- Xd

        s_large <- seq(2L, nrow(X) - 1L)

        X[s1, ] <- 0
        Xd[s1, ] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s2, ] <- 0
        Xd[s2, ] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s3, ] <- 0
        Xd[s3, ] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s_large, ] <- 0
        Xd[s_large, ] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s1, ] <- 111
        Xd[s1, ] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s2, ] <- 111
        Xd[s2, ] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s3, ] <- 111
        Xd[s3, ] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s_large, ] <- 111
        Xd[s_large, ] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig
    }

    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})

test_that("Set column sequence to constant", {
    s1 <- seq(1L, 2L)
    s2 <- seq(2L, 3L)

    run_tests <- function(X, Xd) {
        X_orig <- X
        Xd_orig <- Xd

        s_large <- seq(2L, ncol(X) - 1L)

        X[, s1] <- 0
        Xd[, s1] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s2] <- 0
        Xd[, s2] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s_large] <- 0
        Xd[, s_large] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s1] <- 111
        Xd[, s1] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s2] <- 111
        Xd[, s2] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s_large] <- 111
        Xd[, s_large] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig
    }

    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})

test_that("Set random rows to constant", {

    run_tests <- function(X, Xd) {
        s1 <- c(1L, nrow(X))
        s2 <- c(1L, 4L, 3L)
        s3 <- c(TRUE, FALSE)
        s4 <- c(FALSE, TRUE)
        set.seed(1)
        s5 <- sample(nrow(X), floor(nrow(X)/2), replace=FALSE)

        X_orig <- X
        Xd_orig <- Xd

        X[s1, ] <- 0
        Xd[s1, ] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s2, ] <- 0
        Xd[s2, ] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s3, ] <- 0
        Xd[s3, ] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s4, ] <- 0
        Xd[s4, ] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s5, ] <- 0
        Xd[s5, ] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s1, ] <- 111
        Xd[s1, ] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s2, ] <- 111
        Xd[s2, ] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s3, ] <- 111
        Xd[s3, ] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s4, ] <- 111
        Xd[s4, ] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[s5, ] <- 111
        Xd[s5, ] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig
    }

    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})

test_that("Set random columns to constant", {
    run_tests <- function(X, Xd) {
        s1 <- c(1L, ncol(X))
        s2 <- c(1L, 3L)
        s3 <- c(TRUE, FALSE)
        s4 <- c(FALSE, TRUE)
        set.seed(1)
        s5 <- sample(ncol(X), floor(ncol(X)/2), replace=FALSE)

        X_orig <- X
        Xd_orig <- Xd

        X[, s1] <- 0
        Xd[, s1] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s2] <- 0
        Xd[, s2] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s3] <- 0
        Xd[, s3] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s4] <- 0
        Xd[, s4] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s5] <- 0
        Xd[, s5] <- 0
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s1] <- 111
        Xd[, s1] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s2] <- 111
        Xd[, s2] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s3] <- 111
        Xd[, s3] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s4] <- 111
        Xd[, s4] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig

        X[, s5] <- 111
        Xd[, s5] <- 111
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig
    }

    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})

test_that("Set single col in random rows to const", {
    run_tests <- function(X, Xd) {
        s1 <- c(1L, nrow(X))
        s2 <- c(1L, 3L)
        s3 <- c(TRUE, FALSE)
        s4 <- c(FALSE, TRUE)
        set.seed(1)
        s5 <- sample(nrow(X), floor(nrow(X)/2), replace=FALSE)

        X_orig <- X
        Xd_orig <- Xd

        stry <- list(s1, s2, s3, s4, s5)
        jtry <- seq(1L, ncol(X))
        for (s in stry) {
            for (j in jtry) {
                X[s, j] <- 0
                Xd[s, j] <- 0
                expect_equal(unname(as.matrix(X)), unname(Xd))
                X <- X_orig
                Xd <- Xd_orig

                X[s, j] <- 111
                Xd[s, j] <- 111
                expect_equal(unname(as.matrix(X)), unname(Xd))
                X <- X_orig
                Xd <- Xd_orig
            }
        }
    }

    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})

test_that("Set random cols in single row to const", {
    run_tests <- function(X, Xd) {
        s1 <- c(1L, ncol(X))
        s2 <- c(1L, 3L)
        s3 <- c(TRUE, FALSE)
        s4 <- c(FALSE, TRUE)
        set.seed(1)
        s5 <- sample(ncol(X), floor(ncol(X)/2), replace=FALSE)

        X_orig <- X
        Xd_orig <- Xd

        stry <- list(s1, s2, s3, s4, s5)
        itry <- seq(1L, ncol(X))
        for (s in stry) {
            for (i in itry) {
                X[i, s] <- 0
                Xd[i, s] <- 0
                expect_equal(unname(as.matrix(X)), unname(Xd))
                X <- X_orig
                Xd <- Xd_orig

                X[i, s] <- 111
                Xd[i, s] <- 111
                expect_equal(unname(as.matrix(X)), unname(Xd))
                X <- X_orig
                Xd <- Xd_orig
            }
        }
    }

    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})

test_that("Set arbitrary rows and columns to constant", {
    run_tests <- function(X, Xd) {
        i1 <- c(1L, nrow(X))
        i2 <- c(1L, 3L)
        i3 <- c(TRUE, FALSE)
        i4 <- c(FALSE, TRUE)
        set.seed(1)
        i5 <- sample(nrow(X), floor(nrow(X)/2), replace=FALSE)

        j1 <- c(1L, ncol(X))
        j2 <- c(1L, 3L)
        j3 <- c(TRUE, FALSE)
        j4 <- c(FALSE, TRUE)
        set.seed(1)
        j5 <- sample(ncol(X), floor(ncol(X)/2), replace=FALSE)

        X_orig <- X
        Xd_orig <- Xd

        itry <- list(i1, i2, i3, i4, i5)
        jtry <- list(j1, j2, j3, j4, j5)
        for (i in itry) {
            for (j in jtry) {
                X[i, j] <- 0
                Xd[i, j] <- 0
                expect_equal(unname(as.matrix(X)), unname(Xd))
                X <- X_orig
                Xd <- Xd_orig

                X[i, j] <- 111
                Xd[i, j] <- 111
                expect_equal(unname(as.matrix(X)), unname(Xd))
                X <- X_orig
                Xd <- Xd_orig
            }
        }
    }

    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})

test_that("Set row sequence to sparse matrix", {
    run_tests <- function(X, Xd) {
        s1 <- 1:2
        s2 <- 2:3
        s3 <- 2:1
        s4 <- 3:2
        s5 <- seq(1, nrow(X))
        s6 <- seq(2, nrow(X)-1)
        s7 <- seq(3, nrow(X))

        X_orig <- X
        Xd_orig <- Xd
        s_ <- list(s1, s2, s3, s4, s5, s6, s7)
        s_ <- s_[sapply(s_, function(x) length(x) > 1)]
        for (s in s_) {
            set.seed(111)
            Y <- rsparsematrix(length(s), ncol(X), .5)

            X[s, ] <- as.csr.matrix(Y)
            Xd[s, ] <- as.matrix(Y)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig

            X[s, ] <- as.csc.matrix(Y)
            Xd[s, ] <- as.matrix(Y)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig

            X[s, ] <- as.coo.matrix(Y)
            Xd[s, ] <- as.matrix(Y)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
        }
    }

    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})

test_that("Set random rows to sparse matrix", {
    
    run_tests <- function(X, Xd) {
        X_orig <- X
        Xd_orig <- Xd
        
        assign_values <- function(X, Xd, Y, s, X_orig, Xd_orig) {
            X[s, ] <- as.coo.matrix(Y)
            Xd[s, ] <- as.matrix(Y)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
            
            X[s, ] <- as.csr.matrix(Y)
            Xd[s, ] <- as.matrix(Y)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
            
            X[s, ] <- as.csc.matrix(Y)
            Xd[s, ] <- as.matrix(Y)
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
        }
        
        set.seed(111)
        s <- sample(nrow(X), nrow(X) / 2, replace=FALSE)
        s <- s[order(s)]
        Y <- rsparsematrix(length(s), ncol(X), .5)
        assign_values(X, Xd, Y, s, X_orig, Xd_orig)
        
        set.seed(112)
        s <- sample(nrow(X), nrow(X), replace=FALSE)
        s <- s[order(s)]
        Y <- rsparsematrix(length(s), ncol(X), .5)
        assign_values(X, Xd, Y, s, X_orig, Xd_orig)
        
        set.seed(113)
        s <- sample(nrow(X), 2, replace=FALSE)
        s <- s[order(s)]
        Y <- rsparsematrix(length(s), ncol(X), .5)
        assign_values(X, Xd, Y, s, X_orig, Xd_orig)
    }
    
    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})

test_that("Set full sequences to zero", {
    run_tests <- function(X, Xd) {
        v1 <- 0
        v2 <- numeric(2)
        v3 <- as.sparse.vector(emptySparse(nrow=1, ncol=2))
        v4 <- emptySparse(nrow=1, ncol=3)
        
        v3d <- as.numeric(v3)
        v4d <- as.matrix(v4)
        
        X_orig <- X
        Xd_orig <- Xd
        
        suppressWarnings(X[1:nrow(X), 1:ncol(X)] <- v1)
        Xd[1:nrow(Xd), 1:ncol(Xd)] <- v1
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig
        
        suppressWarnings(X[rev(1:nrow(X)), rev(1:ncol(X))] <- v1)
        Xd[rev(1:nrow(Xd)), rev(1:ncol(Xd))] <- v1
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig
        
        if ((nrow(X) %% 2) == 0 || (ncol(X) %% 2) == 0) {
            suppressWarnings(X[1:nrow(X), 1:ncol(X)] <- v2)
            Xd[1:nrow(Xd), 1:ncol(Xd)] <- v2
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
            
            suppressWarnings(X[rev(1:nrow(X)), rev(1:ncol(X))] <- v2)
            Xd[rev(1:nrow(Xd)), rev(1:ncol(Xd))] <- v2
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
            
            suppressWarnings(X[1:nrow(X), 1:ncol(X)] <- v3)
            Xd[1:nrow(Xd), 1:ncol(Xd)] <- v3d
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
            
            suppressWarnings(X[rev(1:nrow(X)), rev(1:ncol(X))] <- v3)
            Xd[rev(1:nrow(Xd)), rev(1:ncol(Xd))] <- v3d
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
        }
        
        if (ncol(X) > 6) {
            X[, 1:6] <- v2
            Xd[, 1:6] <- v2
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
            
            X[, 1:6] <- v3
            Xd[, 1:6] <- v3d
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
            
            X[, 1:6] <- v4
            Xd[, 1:6] <- v4d
            expect_equal(unname(as.matrix(X)), unname(Xd))
            X <- X_orig
            Xd <- Xd_orig
        }
        
        expect_error(X[2, 1:ncol(X)] <- emptySparse(nrow=3, ncol=ncol(X)))
        
        X[2, 1:ncol(X)] <- emptySparse(nrow=1, ncol=ncol(X))
        Xd[2, 1:ncol(Xd)] <- as.matrix(emptySparse(nrow=1, ncol=ncol(Xd)))
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig
        
        X[1:3, 1:ncol(X)] <- emptySparse(nrow=3, ncol=ncol(X))
        Xd[1:3, 1:ncol(Xd)] <- as.matrix(emptySparse(nrow=3, ncol=ncol(Xd)))
        expect_equal(unname(as.matrix(X)), unname(Xd))
        X <- X_orig
        Xd <- Xd_orig
    }
    
    run_tests(X1, X1d)
    run_tests(X2, X2d)
    run_tests(X3, X3d)
    run_tests(X4, X4d)
    run_tests(X5, X5d)
    run_tests(X6, X6d)
})