Commit c0c81844 authored by Antoine Lucas's avatar Antoine Lucas
Browse files

fix u[,i] <- v

parent 72830e26
......@@ -131,6 +131,7 @@ print.bigz <- function(x, quote = FALSE, initLine = is.null(modulus(x)), ...)
invisible(x)
}
as.bigz <- function(a, mod = NA)
{
if(isZ <- missing(mod) && inherits(a, "bigz"))
......@@ -478,16 +479,19 @@ solve.bigz <- function(a, b,...)
`[.bigz` <- function(x, i=NULL, j=NULL, drop=TRUE)
{
## mdrop <- missing(drop)
## Narg <- nargs() - (!mdrop)
mdrop <- missing(drop)
Narg <- nargs() - (!mdrop)
# matrix access [i,j] [,j] [i,]
# vector access [i]
matrixAccess = Narg > 2
has.j <- !missing(j)
if(!is.null(attr(x, "nrow"))) { ## matrix
## FIXME x[i,] vs. x[,j] vs. x[i]
if(!is.null(attr(x, "nrow")) & matrixAccess) { ## matrix
.Call(matrix_get_at_z, x, i,j)
} else { ## non-matrix
if(has.j) stop("invalid vector subsetting")
## ugly "workaround"
r <- .Call(matrix_get_at_z, x, i, NULL)
r <- .Call(biginteger_get_at, x, i)
attr(r,"nrow") <- NULL
r
}
......@@ -495,14 +499,18 @@ solve.bigz <- function(a, b,...)
`[<-.bigz` <- function(x, i=NULL, j=NULL, value)
{
# matrix access [i,j] [,j] [i,]
# vector access [i]
matrixAccess = nargs() > 3
has.j <- !missing(j)
if(!is.null(attr(x, "nrow"))) { ## matrix
## FIXME x[i,] vs. x[,j] vs. x[i]
if(!is.null(attr(x, "nrow")) & matrixAccess) { ## matrix
.Call(matrix_set_at_z, x, value, i,j)
} else { ## non-matrix -- ugly workaround:
} else { ## non-matrix
if(has.j) stop("invalid vector subsetting")
r <- .Call(matrix_set_at_z, x, value, i, 1) # '1' or does NULL work ??
attr(r,"nrow") <- NULL
r <- .Call(biginteger_set_at, x, i, value)
attr(r,"nrow") <- attr(x, "nrow")
r
}
}
......
......@@ -353,14 +353,18 @@ solve.bigq <- function(a,b,...)
`[.bigq` <- function(x, i=NULL, j=NULL, drop=TRUE)
{
mdrop <- missing(drop)
Narg <- nargs() - (!mdrop)
# matrix access [i,j] [,j] [i,]
# vector access [i]
matrixAccess = Narg > 2
has.j <- !missing(j)
if(!is.null(attr(x, "nrow"))) { ## matrix
## FIXME x[i,] vs. x[,j] vs. x[i]
if(!is.null(attr(x, "nrow")) & matrixAccess) { ## matrix
.Call(matrix_get_at_q, x, i,j)
} else { ## non-matrix
if(has.j) stop("invalid vector subsetting")
## ugly "workaround"
r <- .Call(matrix_get_at_q, x, i, NULL)
r <- .Call(bigrational_get_at, x, i)
attr(r,"nrow") <- NULL
r
}
......@@ -369,14 +373,14 @@ solve.bigq <- function(a,b,...)
`[<-.bigq` <- function(x,i=NULL,j=NULL,value)
{
matrixAccess = nargs() > 3
has.j <- !missing(j)
if(!is.null(attr(x, "nrow"))) { ## matrix
## FIXME x[i,] vs. x[,j] vs. x[i]
.Call(matrix_set_at_q, x, value,i,j )
if(!is.null(attr(x, "nrow")) & matrixAccess) { ## matrix
.Call(matrix_set_at_q, x, value,i,j )
} else { ## non-matrix -- ugly workaround:
if(has.j) stop("invalid vector subsetting")
r <- .Call(matrix_set_at_q, x, value,i,j ) # '1' or does NULL work ??
attr(r,"nrow") <- NULL
r <- .Call(bigrational_set_at, x, i, value )
attr(r,"nrow") <- attr(x, "nrow")
r
}
}
......
......@@ -60,16 +60,6 @@ SEXP matrix_get_at_z(SEXP A,SEXP INDI, SEXP INDJ)
SEXP matrix_set_at_z(SEXP A, SEXP VAL, SEXP INDI, SEXP INDJ)
{
bigvec mat = bigintegerR::create_bignum(A);
if(TYPEOF(INDI) != LGLSXP ) {
if(!length(INDI)) return(A);
std::vector<int> vidx = bigintegerR::create_int(INDI);
for(std::vector<int>::const_iterator it = vidx.begin();
it != vidx.end();
++it)
if(*it >= static_cast<int>(mat.size())) // in this case: we extend the vector
return( biginteger_set_at(A,INDI,VAL) );
}
bigvec val = bigintegerR::create_bignum(VAL);
extract_gmp_R::set_at( mat,val,INDI,INDJ);
return(bigintegerR::create_SEXP(mat));
......@@ -80,17 +70,6 @@ SEXP matrix_set_at_z(SEXP A, SEXP VAL, SEXP INDI, SEXP INDJ)
SEXP matrix_set_at_q(SEXP A,SEXP VAL ,SEXP INDI, SEXP INDJ)
{
bigvec_q mat = bigrationalR::create_bignum(A);
if(TYPEOF(INDI) != LGLSXP ) {
if(!length(INDI)) return(A);
std::vector<int> vidx = bigintegerR::create_int(INDI);
for(std::vector<int>::const_iterator it = vidx.begin();
it != vidx.end();
++it)
if(*it >= static_cast<int>(mat.size())) // in this case: we extend the vector
return( bigrational_set_at(A,INDI,VAL) );
}
bigvec_q val = bigrationalR::create_bignum(VAL);
extract_gmp_R::set_at( mat,val,INDI,INDJ);
......@@ -111,45 +90,47 @@ std::vector<bool> extract_gmp_R::indice_set_at (unsigned int n , SEXP & IND)
std::vector<bool> result (n,false);
if(TYPEOF(IND) != NILSXP)
//LOCICAL
if (TYPEOF(IND) == LGLSXP)
{
for(unsigned int i = 0; i< n; ++i)
result[i] = static_cast<bool>( vidx[i % vidx.size() ] );
}
else
//INTEGERS
{
//negatives integers: all except indices will be modified
if (vidx[0] < 0)
{
for (std::vector<bool>::iterator it = result.begin(); it != result.end(); ++it)
*it = true;
for (std::vector<int>::const_iterator jt = vidx.begin(); jt != vidx.end(); ++jt)
{
if(*jt > 0)
error(_("only 0's may mix with negative subscripts"));
if( (*jt != 0) && (*jt >= - static_cast<int>(n)))
result[-(*jt)-1] = false;
}
}
else
if(TYPEOF(IND) == NILSXP){
//LOCICAL: return true
for (std::vector<bool>::iterator it = result.begin(); it != result.end(); ++it)
*it = true;
}
else if (TYPEOF(IND) == LGLSXP)
{
for(unsigned int i = 0; i< n; ++i)
result[i] = static_cast<bool>( vidx[i % vidx.size() ] );
}
else
//INTEGERS
{
vidx.erase(std::remove(vidx.begin(), vidx.end(), 0L), vidx.end()); // remove all zeroes
//negatives integers: all except indices will be modified
if (vidx[0] < 0)
{
for (std::vector<bool>::iterator it = result.begin(); it != result.end(); ++it)
*it = true;
for (std::vector<int>::const_iterator jt = vidx.begin(); jt != vidx.end(); ++jt)
{
if(*jt > 0)
error(_("only 0's may mix with negative subscripts"));
if( (*jt != 0) && (*jt >= - static_cast<int>(n)))
result[-(*jt)-1] = false;
}
}
else
{
//INTEGERS (and positive)
for (std::vector<int>::const_iterator jt = vidx.begin(); jt != vidx.end(); ++jt)
{
if(*jt < 0)
error(_("only 0's may mix with negative subscripts"));
if((*jt != 0) && (*jt <= static_cast<int>(n)))
result[*jt-1] = true;
}
}
else
// NILSXP: return true
for (std::vector<bool>::iterator it = result.begin(); it != result.end(); ++it)
*it = true;
}
}
return(result);
......
......@@ -25,6 +25,8 @@
#include "bigvec_q.h"
#include "bigintegerR.h"
#include <stdio.h>
extern "C"
{
......@@ -418,7 +420,7 @@ namespace extract_gmp_R
unsigned int ncol = src.size() / src.nrow; // number of col
std::vector<bool> vidx = indice_set_at ( src.nrow, IDX);
std::vector<bool> vjdx = indice_set_at ( ncol, JDX);
unsigned int k=0;
for(unsigned int j = 0 ; j < ncol; ++j)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment