diff --git a/R/aaa-auto.R b/R/aaa-auto.R index 3b179f59198..c898b605021 100644 --- a/R/aaa-auto.R +++ b/R/aaa-auto.R @@ -477,6 +477,68 @@ adjacency_impl <- function( res } +sparse_adjacency_impl <- function( + adjmatrix, + mode = c("directed", "undirected", "upper", "lower", "min", "plus", "max"), + loops = c("once", "none", "twice") +) { + # Argument checks + requireNamespace("Matrix", quietly = TRUE); adjmatrix <- as(as(as(adjmatrix, "dMatrix"), "generalMatrix"), "CsparseMatrix") + mode <- switch_igraph_arg( + mode, + "directed" = 0L, + "undirected" = 1L, + "upper" = 2L, + "lower" = 3L, + "min" = 4L, + "plus" = 5L, + "max" = 6L + ) + loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_sparse_adjacency, + adjmatrix, + mode, + loops + ) + + res +} + +sparse_weighted_adjacency_impl <- function( + adjmatrix, + mode = c("directed", "undirected", "upper", "lower", "min", "plus", "max"), + loops = c("once", "none", "twice") +) { + # Argument checks + requireNamespace("Matrix", quietly = TRUE); adjmatrix <- as(as(as(adjmatrix, "dMatrix"), "generalMatrix"), "CsparseMatrix") + mode <- switch_igraph_arg( + mode, + "directed" = 0L, + "undirected" = 1L, + "upper" = 2L, + "lower" = 3L, + "min" = 4L, + "plus" = 5L, + "max" = 6L + ) + loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_sparse_weighted_adjacency, + adjmatrix, + mode, + loops + ) + + res +} + weighted_adjacency_impl <- function( adjmatrix, mode = c("directed", "undirected", "upper", "lower", "min", "plus", "max"), @@ -1257,6 +1319,30 @@ turan_impl <- function( res } +weighted_sparsemat_impl <- function( + A, + directed, + attr, + loops = FALSE +) { + # Argument checks + requireNamespace("Matrix", quietly = TRUE); A <- as(as(as(A, "dMatrix"), "generalMatrix"), "CsparseMatrix") + directed <- as.logical(directed) + loops <- as.logical(loops) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_weighted_sparsemat, + A, + directed, + attr, + loops + ) + + res +} + barabasi_game_impl <- function( n, power = 1.0, diff --git a/src/cpp11.cpp b/src/cpp11.cpp index 686abff0506..90fb367ae42 100644 --- a/src/cpp11.cpp +++ b/src/cpp11.cpp @@ -435,6 +435,8 @@ extern SEXP R_igraph_sir(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_site_percolation(SEXP, SEXP); extern SEXP R_igraph_solve_lsap(SEXP, SEXP); extern SEXP R_igraph_spanner(SEXP, SEXP, SEXP); +extern SEXP R_igraph_sparse_adjacency(SEXP, SEXP, SEXP); +extern SEXP R_igraph_sparse_weighted_adjacency(SEXP, SEXP, SEXP); extern SEXP R_igraph_split_join_distance(SEXP, SEXP); extern SEXP R_igraph_square_lattice(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_st_edge_connectivity(SEXP, SEXP, SEXP); @@ -482,6 +484,7 @@ extern SEXP R_igraph_watts_strogatz_game(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_weighted_adjacency(SEXP, SEXP, SEXP); extern SEXP R_igraph_weighted_clique_number(SEXP, SEXP); extern SEXP R_igraph_weighted_cliques(SEXP, SEXP, SEXP, SEXP, SEXP); +extern SEXP R_igraph_weighted_sparsemat(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_wheel(SEXP, SEXP, SEXP); extern SEXP R_igraph_widest_path_widths_dijkstra(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_widest_path_widths_floyd_warshall(SEXP, SEXP, SEXP, SEXP, SEXP); @@ -1029,6 +1032,8 @@ static const R_CallMethodDef CallEntries[] = { {"R_igraph_site_percolation", (DL_FUNC) &R_igraph_site_percolation, 2}, {"R_igraph_solve_lsap", (DL_FUNC) &R_igraph_solve_lsap, 2}, {"R_igraph_spanner", (DL_FUNC) &R_igraph_spanner, 3}, + {"R_igraph_sparse_adjacency", (DL_FUNC) &R_igraph_sparse_adjacency, 3}, + {"R_igraph_sparse_weighted_adjacency", (DL_FUNC) &R_igraph_sparse_weighted_adjacency, 3}, {"R_igraph_split_join_distance", (DL_FUNC) &R_igraph_split_join_distance, 2}, {"R_igraph_square_lattice", (DL_FUNC) &R_igraph_square_lattice, 5}, {"R_igraph_st_edge_connectivity", (DL_FUNC) &R_igraph_st_edge_connectivity, 3}, @@ -1076,6 +1081,7 @@ static const R_CallMethodDef CallEntries[] = { {"R_igraph_weighted_adjacency", (DL_FUNC) &R_igraph_weighted_adjacency, 3}, {"R_igraph_weighted_clique_number", (DL_FUNC) &R_igraph_weighted_clique_number, 2}, {"R_igraph_weighted_cliques", (DL_FUNC) &R_igraph_weighted_cliques, 5}, + {"R_igraph_weighted_sparsemat", (DL_FUNC) &R_igraph_weighted_sparsemat, 4}, {"R_igraph_wheel", (DL_FUNC) &R_igraph_wheel, 3}, {"R_igraph_widest_path_widths_dijkstra", (DL_FUNC) &R_igraph_widest_path_widths_dijkstra, 5}, {"R_igraph_widest_path_widths_floyd_warshall", (DL_FUNC) &R_igraph_widest_path_widths_floyd_warshall, 5}, diff --git a/src/rinterface.c b/src/rinterface.c index 3cd99d3b354..73bf9ef3d1d 100644 --- a/src/rinterface.c +++ b/src/rinterface.c @@ -683,6 +683,96 @@ SEXP R_igraph_adjacency(SEXP adjmatrix, SEXP mode, SEXP loops) { return(r_result); } +/*-------------------------------------------/ +/ igraph_sparse_adjacency / +/-------------------------------------------*/ +SEXP R_igraph_sparse_adjacency(SEXP adjmatrix, SEXP mode, SEXP loops) { + /* Declarations */ + igraph_t c_graph; + igraph_sparsemat_t c_adjmatrix; + igraph_adjacency_t c_mode; + igraph_loops_t c_loops; + SEXP graph; + + SEXP r_result, r_names; + /* Convert input */ + Rz_SEXP_to_sparsemat(adjmatrix, &c_adjmatrix); + c_mode = (igraph_adjacency_t) Rf_asInteger(mode); + c_loops = (igraph_loops_t) Rf_asInteger(loops); + /* Call igraph */ + IGRAPH_R_CHECK(igraph_sparse_adjacency(&c_graph, &c_adjmatrix, c_mode, c_loops)); + + /* Convert output */ + PROTECT(r_result=NEW_LIST(2)); + PROTECT(r_names=NEW_CHARACTER(2)); + IGRAPH_FINALLY(igraph_destroy, &c_graph); + PROTECT(graph=Ry_igraph_to_SEXP(&c_graph)); + IGRAPH_I_DESTROY(&c_graph); + IGRAPH_FINALLY_CLEAN(1); + PROTECT(adjmatrix=Ry_igraph_sparsemat_to_SEXP(&c_adjmatrix)); + igraph_sparsemat_destroy(&c_adjmatrix); + IGRAPH_FINALLY_CLEAN(1); + SET_VECTOR_ELT(r_result, 0, graph); + SET_VECTOR_ELT(r_result, 1, adjmatrix); + SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); + SET_STRING_ELT(r_names, 1, Rf_mkChar("adjmatrix")); + SET_NAMES(r_result, r_names); + UNPROTECT(3); + + UNPROTECT(1); + return(r_result); +} + +/*-------------------------------------------/ +/ igraph_sparse_weighted_adjacency / +/-------------------------------------------*/ +SEXP R_igraph_sparse_weighted_adjacency(SEXP adjmatrix, SEXP mode, SEXP loops) { + /* Declarations */ + igraph_t c_graph; + igraph_sparsemat_t c_adjmatrix; + igraph_adjacency_t c_mode; + igraph_vector_t c_weights; + igraph_loops_t c_loops; + SEXP graph; + SEXP weights; + + SEXP r_result, r_names; + /* Convert input */ + Rz_SEXP_to_sparsemat(adjmatrix, &c_adjmatrix); + c_mode = (igraph_adjacency_t) Rf_asInteger(mode); + IGRAPH_R_CHECK(igraph_vector_init(&c_weights, 0)); + IGRAPH_FINALLY(igraph_vector_destroy, &c_weights); + weights=R_GlobalEnv; /* hack to have a non-NULL value */ + c_loops = (igraph_loops_t) Rf_asInteger(loops); + /* Call igraph */ + IGRAPH_R_CHECK(igraph_sparse_weighted_adjacency(&c_graph, &c_adjmatrix, c_mode, &c_weights, c_loops)); + + /* Convert output */ + PROTECT(r_result=NEW_LIST(3)); + PROTECT(r_names=NEW_CHARACTER(3)); + IGRAPH_FINALLY(igraph_destroy, &c_graph); + PROTECT(graph=Ry_igraph_to_SEXP(&c_graph)); + IGRAPH_I_DESTROY(&c_graph); + IGRAPH_FINALLY_CLEAN(1); + PROTECT(adjmatrix=Ry_igraph_sparsemat_to_SEXP(&c_adjmatrix)); + igraph_sparsemat_destroy(&c_adjmatrix); + IGRAPH_FINALLY_CLEAN(1); + PROTECT(weights=Ry_igraph_0orvector_to_SEXP(&c_weights)); + igraph_vector_destroy(&c_weights); + IGRAPH_FINALLY_CLEAN(1); + SET_VECTOR_ELT(r_result, 0, graph); + SET_VECTOR_ELT(r_result, 1, adjmatrix); + SET_VECTOR_ELT(r_result, 2, weights); + SET_STRING_ELT(r_names, 0, Rf_mkChar("graph")); + SET_STRING_ELT(r_names, 1, Rf_mkChar("adjmatrix")); + SET_STRING_ELT(r_names, 2, Rf_mkChar("weights")); + SET_NAMES(r_result, r_names); + UNPROTECT(4); + + UNPROTECT(1); + return(r_result); +} + /*-------------------------------------------/ / igraph_weighted_adjacency / /-------------------------------------------*/ @@ -1775,6 +1865,40 @@ SEXP R_igraph_turan(SEXP n, SEXP r) { return(r_result); } +/*-------------------------------------------/ +/ igraph_weighted_sparsemat / +/-------------------------------------------*/ +SEXP R_igraph_weighted_sparsemat(SEXP A, SEXP directed, SEXP attr, SEXP loops) { + /* Declarations */ + igraph_t c_graph; + igraph_sparsemat_t c_A; + igraph_bool_t c_directed; + const char* c_attr; + igraph_bool_t c_loops; + SEXP graph; + + SEXP r_result; + /* Convert input */ + Rz_SEXP_to_sparsemat(A, &c_A); + IGRAPH_R_CHECK_BOOL(directed); + c_directed = LOGICAL(directed)[0]; + c_attr = Rf_translateCharUTF8(STRING_ELT(attr, 0)); + IGRAPH_R_CHECK_BOOL(loops); + c_loops = LOGICAL(loops)[0]; + /* Call igraph */ + IGRAPH_R_CHECK(igraph_weighted_sparsemat(&c_graph, &c_A, c_directed, c_attr, c_loops)); + + /* Convert output */ + IGRAPH_FINALLY(igraph_destroy, &c_graph); + PROTECT(graph=Ry_igraph_to_SEXP(&c_graph)); + IGRAPH_I_DESTROY(&c_graph); + IGRAPH_FINALLY_CLEAN(1); + r_result = graph; + + UNPROTECT(1); + return(r_result); +} + /*-------------------------------------------/ / igraph_barabasi_game / /-------------------------------------------*/ @@ -13267,15 +13391,12 @@ SEXP R_igraph_read_graph_edgelist(SEXP instream, SEXP n, SEXP directed) { /-------------------------------------------*/ SEXP R_igraph_read_graph_ncol(SEXP instream, SEXP predefnames, SEXP names, SEXP weights, SEXP directed) { /* Declarations */ - igraph_t c_graph; FILE* c_instream; igraph_strvector_t c_predefnames; igraph_bool_t c_names; igraph_add_weights_t c_weights; igraph_bool_t c_directed; - SEXP graph; - SEXP r_result; /* Convert input */ c_instream = Ry_igraph_fopen_read(instream); IGRAPH_FINALLY(fclose, c_instream); @@ -13288,17 +13409,13 @@ SEXP R_igraph_read_graph_ncol(SEXP instream, SEXP predefnames, SEXP names, SEXP IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ - IGRAPH_R_CHECK(igraph_read_graph_ncol(&c_graph, c_instream, (Rf_isNull(predefnames) ? 0 : &c_predefnames), c_names, c_weights, c_directed)); + IGRAPH_R_CHECK(igraph_read_graph_ncol(c_instream, (Rf_isNull(predefnames) ? 0 : &c_predefnames), c_names, c_weights, c_directed)); /* Convert output */ - IGRAPH_FINALLY(igraph_destroy, &c_graph); - PROTECT(graph=Ry_igraph_to_SEXP(&c_graph)); - IGRAPH_I_DESTROY(&c_graph); - IGRAPH_FINALLY_CLEAN(1); - r_result = graph; - UNPROTECT(1); - return(r_result); + + + return(R_NilValue); } /*-------------------------------------------/ @@ -13306,14 +13423,11 @@ SEXP R_igraph_read_graph_ncol(SEXP instream, SEXP predefnames, SEXP names, SEXP /-------------------------------------------*/ SEXP R_igraph_read_graph_lgl(SEXP instream, SEXP names, SEXP weights, SEXP directed) { /* Declarations */ - igraph_t c_graph; FILE* c_instream; igraph_bool_t c_names; igraph_add_weights_t c_weights; igraph_bool_t c_directed; - SEXP graph; - SEXP r_result; /* Convert input */ c_instream = Ry_igraph_fopen_read(instream); IGRAPH_FINALLY(fclose, c_instream); @@ -13323,17 +13437,13 @@ SEXP R_igraph_read_graph_lgl(SEXP instream, SEXP names, SEXP weights, SEXP direc IGRAPH_R_CHECK_BOOL(directed); c_directed = LOGICAL(directed)[0]; /* Call igraph */ - IGRAPH_R_CHECK(igraph_read_graph_lgl(&c_graph, c_instream, c_names, c_weights, c_directed)); + IGRAPH_R_CHECK(igraph_read_graph_lgl(c_instream, c_names, c_weights, c_directed)); /* Convert output */ - IGRAPH_FINALLY(igraph_destroy, &c_graph); - PROTECT(graph=Ry_igraph_to_SEXP(&c_graph)); - IGRAPH_I_DESTROY(&c_graph); - IGRAPH_FINALLY_CLEAN(1); - r_result = graph; - UNPROTECT(1); - return(r_result); + + + return(R_NilValue); } /*-------------------------------------------/ diff --git a/src/rinterface.h b/src/rinterface.h index 7f77bf463e4..79a1bff7d37 100644 --- a/src/rinterface.h +++ b/src/rinterface.h @@ -101,6 +101,7 @@ igraph_error_t Rz_SEXP_to_vector_bool_copy(SEXP sv, igraph_vector_bool_t *v); igraph_error_t Rz_SEXP_to_vector_int_copy(SEXP sv, igraph_vector_int_t *v); igraph_error_t Rz_SEXP_to_hrg(SEXP shrg, igraph_hrg_t *hrg); igraph_error_t Rz_SEXP_to_hrg_copy(SEXP shrg, igraph_hrg_t *hrg); +void Rz_SEXP_to_sparsemat(SEXP sm, igraph_sparsemat_t *res); void Rz_SEXP_to_igraph_layout_drl_options(SEXP in, igraph_layout_drl_options_t *opt); igraph_error_t Rz_SEXP_to_igraph_eigen_which(SEXP in, igraph_eigen_which_t *out); void Rz_SEXP_to_igraph_arpack_options(SEXP in, igraph_arpack_options_t *opt); diff --git a/src/rinterface_extra.c b/src/rinterface_extra.c index ca1dc00f642..45e90917c8a 100644 --- a/src/rinterface_extra.c +++ b/src/rinterface_extra.c @@ -3496,6 +3496,55 @@ igraph_error_t Rz_SEXP_to_matrix_complex_copy(SEXP pakl, igraph_matrix_complex_t return IGRAPH_SUCCESS; } +void Rz_SEXP_to_sparsemat(SEXP sm, igraph_sparsemat_t *res) { + /* Assumes sm is a dgCMatrix from Matrix package (column-compressed sparse matrix). + * dgCMatrix structure has slots: i (row indices), p (column pointers), x (values), Dim (dimensions). + * We convert this to igraph's triplet format and let igraph handle the internal representation. + */ + SEXP slot_i, slot_p, slot_x, slot_dim; + int *i_ptr, *p_ptr; + double *x_ptr; + int *dim_ptr; + igraph_integer_t nrow, ncol, nzmax; + int col, idx; + + /* Get the slots from the S4 object */ + slot_i = GET_SLOT(sm, Rf_install("i")); + slot_p = GET_SLOT(sm, Rf_install("p")); + slot_x = GET_SLOT(sm, Rf_install("x")); + slot_dim = GET_SLOT(sm, Rf_install("Dim")); + + /* Extract dimensions */ + dim_ptr = INTEGER(slot_dim); + nrow = (igraph_integer_t) dim_ptr[0]; + ncol = (igraph_integer_t) dim_ptr[1]; + + /* Get number of non-zero elements */ + nzmax = (igraph_integer_t) Rf_xlength(slot_i); + + /* Initialize the sparse matrix in triplet format */ + igraph_error_t err = igraph_sparsemat_init(res, nrow, ncol, nzmax); + if (err != IGRAPH_SUCCESS) { + igraph_error("Failed to initialize sparse matrix", __FILE__, __LINE__, err); + } + + /* Get pointers to the data */ + i_ptr = INTEGER(slot_i); + p_ptr = INTEGER(slot_p); + x_ptr = REAL(slot_x); + + /* Convert from column-compressed to triplet format by iterating through columns */ + for (col = 0; col < ncol; col++) { + for (idx = p_ptr[col]; idx < p_ptr[col + 1]; idx++) { + /* Add entry (row, col, value) */ + if (igraph_sparsemat_entry(res, i_ptr[idx], col, x_ptr[idx]) != IGRAPH_SUCCESS) { + igraph_sparsemat_destroy(res); + igraph_error("Failed to add entry to sparse matrix", __FILE__, __LINE__, IGRAPH_FAILURE); + } + } + } +} + igraph_error_t Rz_SEXP_to_igraph(SEXP graph, igraph_t *res) { *res = *Rx_igraph_get_pointer(graph); diff --git a/tests/testthat/test-aaa-auto.R b/tests/testthat/test-aaa-auto.R index 50f55a7068a..1e93e63bf29 100644 --- a/tests/testthat/test-aaa-auto.R +++ b/tests/testthat/test-aaa-auto.R @@ -11126,3 +11126,115 @@ test_that("independent_vertex_sets_impl basic", { max_size = 0 )) }) + +test_that("sparse_adjacency_impl works", { + skip_if_not_installed("Matrix", minimum_version = "1.6.0") + + # Create a simple sparse adjacency matrix + mat <- Matrix::sparseMatrix( + i = c(1, 2, 3, 1), + j = c(2, 3, 1, 3), + x = c(1, 1, 1, 1), + dims = c(3, 3) + ) + mat <- as(mat, "CsparseMatrix") + + # Test the autogenerated function + result <- sparse_adjacency_impl(mat, mode = "directed", loops = "once") + + # Check that we got a graph back + expect_true(is.list(result)) + expect_true("graph" %in% names(result)) + expect_true(igraph::is_igraph(result$graph)) + + # Check the structure + expect_equal(igraph::vcount(result$graph), 3) + expect_equal(igraph::ecount(result$graph), 4) +}) + +test_that("weighted_sparsemat_impl works", { + skip_if_not_installed("Matrix", minimum_version = "1.6.0") + + # Create a weighted sparse matrix + mat <- Matrix::sparseMatrix( + i = c(1, 2, 3), + j = c(2, 3, 1), + x = c(2.5, 3.7, 1.2), + dims = c(3, 3) + ) + mat <- as(mat, "CsparseMatrix") + + # Test the autogenerated function + result <- weighted_sparsemat_impl(mat, directed = TRUE, attr = "weight", loops = FALSE) + + # Check that we got a graph back + expect_true(is.list(result)) + expect_true("graph" %in% names(result)) + expect_true(igraph::is_igraph(result$graph)) + + # Check the structure + expect_equal(igraph::vcount(result$graph), 3) + expect_equal(igraph::ecount(result$graph), 3) + + # Check that edges have weights + expect_true("weight" %in% igraph::edge_attr_names(result$graph)) +}) + +test_that("get_laplacian_sparse_impl works", { + skip_if_not_installed("Matrix", minimum_version = "1.6.0") + + # Create a simple graph + g <- igraph::make_ring(5) + + # Test the autogenerated function + result <- get_laplacian_sparse_impl( + graph = g, + mode = "out", + normalization = "unnormalized", + weights = NULL + ) + + # Check that we got a sparse matrix back + expect_true(is.list(result)) + expect_true("sparseres" %in% names(result)) + expect_true(inherits(result$sparseres, "igraph.tmp.sparse")) +}) + +test_that("get_adjacency_sparse_impl works", { + skip_if_not_installed("Matrix", minimum_version = "1.6.0") + + # Create a simple graph + g <- igraph::make_ring(4) + + # Test the autogenerated function + result <- get_adjacency_sparse_impl( + graph = g, + type = "both", + weights = NULL, + loops = "once" + ) + + # Check that we got a sparse matrix back + expect_true(is.list(result)) + expect_true("sparsemat" %in% names(result)) + expect_true(inherits(result$sparsemat, "igraph.tmp.sparse")) +}) + +test_that("get_stochastic_sparse_impl works", { + skip_if_not_installed("Matrix", minimum_version = "1.6.0") + + # Create a simple graph + g <- igraph::make_ring(4) + + # Test the autogenerated function + result <- get_stochastic_sparse_impl( + graph = g, + column_wise = FALSE, + weights = NULL + ) + + # Check that we got a sparse matrix back + expect_true(is.list(result)) + expect_true("sparsemat" %in% names(result)) + expect_true(inherits(result$sparsemat, "igraph.tmp.sparse")) +}) diff --git a/tools/stimulus/functions-R.yaml b/tools/stimulus/functions-R.yaml index 5269bed5009..d3637b4e2b1 100644 --- a/tools/stimulus/functions-R.yaml +++ b/tools/stimulus/functions-R.yaml @@ -58,13 +58,9 @@ igraph_create: # TODO: temporarily disabled igraph_adjacency: -# TODO: temporarily disabled - needs SPARSEMAT converter implementation igraph_sparse_adjacency: - IGNORE: RR, RC -# TODO: temporarily disabled - needs SPARSEMAT converter implementation igraph_sparse_weighted_adjacency: - IGNORE: RR, RC # TODO: temporarily disabled igraph_weighted_adjacency: @@ -121,10 +117,7 @@ igraph_turan: name: Turan graph GATTR-PARAM: n, r -# TODO: temporarily disabled igraph_weighted_sparsemat: - # Needs SPARSEMAT converter implementation - IGNORE: RR, RC ####################################### # Constructors, games