Skip to content
Snippets Groups Projects
Commit 62052588 authored by Antoine Lucas's avatar Antoine Lucas
Browse files

fix rbind cbind

parent cc745ae0
No related branches found
No related tags found
No related merge requests found
......@@ -566,23 +566,6 @@ SEXP biginteger_c(SEXP args)
return bigintegerR::create_SEXP(result);
}
SEXP biginteger_cbind(SEXP args)
{
// if(TYPEOF(args) != VECSXP) error(_("should be a list"));
bigvec result = bigintegerR::create_bignum(VECTOR_ELT(args,0));
if(result.nrow <= 0)
result.nrow = result.size();
for(int i = 1; i < LENGTH(args);i++)
{
bigvec v = bigintegerR::create_bignum(VECTOR_ELT(args,i));
for(unsigned int j=0; j< v.size() ; j++)
result.push_back(v[j]);
v.clear();
}
return bigintegerR::create_SEXP(result);
}
SEXP biginteger_rep(SEXP x, SEXP times)
{
......
......@@ -67,7 +67,7 @@ std::string bigvec::str(int i,int b) const
}
bigmod & bigvec::get(unsigned int row, unsigned int col) {
return (*this)[row + col*nrow];
return (*this)[row + col*nRows()];
}
......@@ -86,7 +86,7 @@ const bigmod & bigvec::operator[] (unsigned int i) const
}
void bigvec::set(unsigned int row, unsigned int col, const bigmod & val) {
set( row + col*nrow,val);
set( row + col*nRows(),val);
}
void bigvec::checkValuesMod() {
......
......@@ -57,24 +57,19 @@ bigrational & bigvec_q::operator[] (unsigned int i)
}
bigrational & bigvec_q::get(unsigned int row, unsigned int col) {
return (*this)[row + col*nrow];
bigrational & val = (*this)[row + col*nRows()];
return val;
}
void bigvec_q::set(unsigned int row, unsigned int col, const bigrational & val) {
set( row + col*nrow,val);
set( row + col*nRows(),val);
}
void bigvec_q::set(unsigned int i,const bigrational & val)
{
//DEBUG !!
if(i>=value.size())
{
Rprintf("t nul a bigvec_q_set\n");
return;
}
value[i] = val;
}
void bigvec_q::set(unsigned int i,const mpq_t & val)
......@@ -82,7 +77,7 @@ void bigvec_q::set(unsigned int i,const mpq_t & val)
if(i>=value.size())
{
Rprintf("t nul a bigvec_q_set_mpq __LINE__ \n");
Rprintf("ERROR at bigvec_q_set_mpq __LINE__ \n");
return;
}
......
......@@ -5,7 +5,7 @@
* \version 1
*
* \date Created: 19/02/06
* \date Last modified: Time-stamp: <2022-12-09 09:51:38 (antoine)>
* \date Last modified: Time-stamp: <2022-12-09 15:55:54 (antoine)>
*
* \author A. Lucas
*
......@@ -489,6 +489,45 @@ SEXP biginteger_rbind(SEXP args)
return bigintegerR::create_SEXP(result);
}
/**
* arg = v1, v2, v3.... row
* return matrix
* out =[ v1 v2 v3 ]
*/
SEXP biginteger_cbind(SEXP args)
{
int i=0,j=0;
bigvec result;
bigvec v;
vector<bigvec> source;
unsigned int maxSize=0;
for(int i = 0 ; i < LENGTH(args) ; i++){
v = bigintegerR::create_bignum(VECTOR_ELT(args,i));
if(v.size() == 0) continue;
if(v.nrow <0) v.nrow = v.size();
for(int col = 0 ; col < v.nCols(); col++){
bigvec column ;
for (int row = 0 ; row < v.nRows(); row++){
column.push_back(v.get(row,col));
}
source.push_back(column);
maxSize = std::max(maxSize,column.size());
}
}
for(int i = 0 ; i < source.size() ; i++){
bigvec u = source[i];
for (int j = 0 ; j < maxSize; j++){
if(u.size() == 0) result.push_back(bigmod());
else result.push_back(u[j % u.size()]);
}
}
result.nrow = result.size() / source.size();
return bigintegerR::create_SEXP(result);
}
namespace matrixz
......
......@@ -4,7 +4,7 @@
* \version 1
*
* \date Created: 25/05/06
* \date Last modified: Time-stamp: <2022-02-21 15:57:36 (antoine)>
* \date Last modified: Time-stamp: <2022-12-09 14:56:06 (antoine)>
*
* \author A. Lucas
*
......@@ -45,6 +45,10 @@ extern "C"
*/
SEXP biginteger_rbind(SEXP args) ;
/** \brief for function rbind
*/
SEXP biginteger_cbind(SEXP args) ;
}
......
......@@ -5,7 +5,7 @@
* \version 1
*
* \date Created: 19/02/06
* \date Last modified: Time-stamp: <2022-08-04 15:52:51 (antoine)>
* \date Last modified: Time-stamp: <2022-12-09 15:55:39 (antoine)>
*
* \author A. Lucas
*
......@@ -394,27 +394,67 @@ SEXP bigrational_rbind(SEXP args)
int i=0,j=0;
bigvec_q result;
bigvec_q v;
vector<bigvec_q> source;
unsigned int maxSize=0;
result = bigrationalR::create_bignum(VECTOR_ELT(args,0));
if(result.nrow <=0)
result.nrow = result.size();
result = matrixq::bigq_transpose(result);
for(i=1; i< LENGTH(args); i++) {
for(int i = 0 ; i < LENGTH(args) ; i++){
v = bigrationalR::create_bignum(VECTOR_ELT(args,i));
if(v.nrow == 0 )
v.nrow = v.size();
v = matrixq::bigq_transpose(v);
for(j=0; j< (int)v.size(); j++)
result.push_back(v[j]);
v.clear();
if(v.size() == 0) continue;
for (int row = 0 ; row < v.nRows(); row++){
bigvec_q line ;
for(int col = 0 ; col < v.nCols(); col++){
line.push_back(v.get(row,col));
}
source.push_back(line);
maxSize = std::max(maxSize,line.size());
}
}
for (int j = 0 ; j < maxSize; j++){
for(int i = 0 ; i < source.size() ; i++){
bigvec_q u = source[i];
if(u.size() == 0) result.push_back(bigrational());
else result.push_back(u[j % u.size()]);
}
}
result.nrow = source.size();
result = matrixq::bigq_transpose(result);
return bigrationalR::create_SEXP(result);
}
SEXP bigrational_cbind(SEXP args){
int i=0,j=0;
bigvec_q result;
bigvec_q v;
vector<bigvec_q> source;
unsigned int maxSize=0;
for(int i = 0 ; i < LENGTH(args) ; i++){
v = bigrationalR::create_bignum(VECTOR_ELT(args,i));
if(v.size() == 0) continue;
if(v.nrow <0) v.nrow = v.size();
for(int col = 0 ; col < v.nCols(); col++){
bigvec_q column ;
for (int row = 0 ; row < v.nRows(); row++){
column.push_back(v.get(row,col));
}
source.push_back(column);
maxSize = std::max(maxSize,column.size());
}
}
for(int i = 0 ; i < source.size() ; i++){
bigvec_q u = source[i];
for (int j = 0 ; j < maxSize; j++){
if(u.size() == 0) result.push_back(bigrational());
else result.push_back(u[j % u.size()]);
}
}
result.nrow = result.size() / source.size();
return bigrationalR::create_SEXP(result);
}
bigvec_q matrixq::bigq_transpose (const bigvec_q & mat)
{
......
......@@ -2,7 +2,7 @@
* \brief header for rational matrix functions set
*
* \date Created: 2005
* \date Last modified: Time-stamp: <2022-02-21 15:43:22 (antoine)>
* \date Last modified: Time-stamp: <2022-12-09 15:15:01 (antoine)>
*
*
* \note Licence: GPL (>= 2)
......@@ -31,6 +31,8 @@ extern "C"
/** \brief for function rbind
*/
SEXP bigrational_rbind(SEXP args) ;
SEXP bigrational_cbind(SEXP args) ;
}
/**
......
......@@ -122,7 +122,7 @@ namespace math{
template<class T>
unsigned int Matrix<T>::nCols() const{
if(nRows() <=0) return this->size();
return this->size() / nRows();
}
......
......@@ -39,7 +39,7 @@ test <- function(FUN, x, xlabs, out = "str", unary = FALSE)
else if(length(e) == 0)
e <- numeric()
## we don't test standard R floating operations.
if( (classNameI == "numeric" || classNameI == "integer") && ( classNameJ == "numeric" || classNameJ == "integer") && class(e) == "numeric") e <- "-"
if( (classNameI[1] == "numeric" || classNameI[1] == "integer") && ( classNameJ[1] == "numeric" || classNameJ[1] == "integer") && class(e)[1] == "numeric") e <- "-"
## ## now, for some functions also compute the corresponding numeric values
if(length(e) > 0 && is.double(e[1]) && is.finite(e[1]))
......@@ -57,7 +57,7 @@ allfunctionid <- c("as.bigz","+","-","*",
"inv.bigz", "gcd.bigz", "gcdex", "lcm.bigz",
"as.bigq",
"chooseZ",
"max","min","|","&","xor")
"max","min","|","&","xor","c","cbind","rbind")
unaryfunctionid <- c("log","log2","log10","c",
"isprime","nextprime", "factorialZ",
"sizeinbase","fibnum","fibnum2","lucnum","lucnum2",
......
......@@ -63,7 +63,7 @@ The following objects are masked from 'package:base':
+ else if(length(e) == 0)
+ e <- numeric()
+ ## we don't test standard R floating operations.
+ if( (classNameI == "numeric" || classNameI == "integer") && ( classNameJ == "numeric" || classNameJ == "integer") && class(e) == "numeric") e <- "-"
+ if( (classNameI[1] == "numeric" || classNameI[1] == "integer") && ( classNameJ[1] == "numeric" || classNameJ[1] == "integer") && class(e)[1] == "numeric") e <- "-"
+
+ ## ## now, for some functions also compute the corresponding numeric values
+ if(length(e) > 0 && is.double(e[1]) && is.finite(e[1]))
......@@ -81,7 +81,7 @@ The following objects are masked from 'package:base':
+ "inv.bigz", "gcd.bigz", "gcdex", "lcm.bigz",
+ "as.bigq",
+ "chooseZ",
+ "max","min","|","&","xor")
+ "max","min","|","&","xor","c","cbind","rbind")
> unaryfunctionid <- c("log","log2","log10","c",
+ "isprime","nextprime", "factorialZ",
+ "sizeinbase","fibnum","fibnum2","lucnum","lucnum2",
......@@ -112,8 +112,8 @@ The following objects are masked from 'package:base':
> sapply(allfunctionid, numericFunName)
as.bigz + - * divq.bigz / %% ^ inv.bigz gcd.bigz gcdex lcm.bigz
"as.bigz" "+" "-" "*" "%/%" "/" "%%" "^" "inv.bigz" "gcd" "gcdex" "lcm"
as.bigq chooseZ max min | & xor
"as.bigq" "choose" "max" "min" "|" "&" "xor"
as.bigq chooseZ max min | & xor c cbind rbind
"as.bigq" "choose" "max" "min" "|" "&" "xor" "c" "cbind" "rbind"
> sapply(unaryfunctionid, numericFunName)
log log2 log10 c isprime nextprime factorialZ sizeinbase fibnum fibnum2
"log" "log2" "log10" "c" "isprime" "nextprime" "factorial" "sizeinbase" "fibnum" "fibnum2"
......@@ -1114,11 +1114,167 @@ NULL <NA> <NA> <NA> <NA> <NA>
NA <NA> <NA> <NA> <NA> <NA>
-3L FALSE FALSE <NA> <NA> FALSE
There were 3685 warnings (use warnings() to see them)
------------------------------------------
c
-> all.equal(target = res, current = F(<numeric x>)): 'is.NA' value mismatch: 256 in current 63 in target
23 as.bigz(23) as.bigq(23) c(3,23) as.bigz(c(3,23)) as.bigq(c(3,23)) 25 2.3 -4 4
23 - 23 23 - 23 23 23 - - -
as.bigz(23) 23 23 23 23 23 23 23 23 23 23
as.bigq(23) 23 23 23 23 23 23 23 23 23 23
c(3,23) - 3 3 - 3 3 3 - - -
as.bgz((3,23)) 3 3 3 3 3 3 3 3 3 3
as.bgq((3,23)) 3 3 3 3 3 3 3 3 3 3
25 25 25 25 25 25 25 25 25 25 25
2.3 - 2.3 2.3 - 2.3 2.3 2.3 - - -
-4 - -4 -4 - -4 -4 -4 - - -
4 - 4 4 - 4 4 4 - - 4
0 - 0 0 - 0 0 0 - - -
as.bigz(34) 34 34 34 34 34 34 34 34 34 34
as.bg(32,7) 32/7 32/7 32/7 32/7 32/7 32/7 32/7 32/7 32/7 32/7
as.b(31,45) (31 %% 45) (31 %% 45) 31 (31 %% 45) (31 %% 45) 31 (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45)
NULL 23 01 01 3 02 02 25 2.3 -4 4
NA <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
-3L - -3 -3 - -3 -3 -3 - - -3
0 as.bigz(34) as.bigq(32,7) as.bigz(31,45) NULL NA -3L
23 - 23 23 23 23 23 -
as.bigz(23) 23 23 23 23 23 23 23
as.bigq(23) 23 23 23 23 23 23 23
c(3,23) - 3 3 3 3 3 -
as.bgz((3,23)) 3 3 3 3 3 3 3
as.bgq((3,23)) 3 3 3 3 3 3 3
25 25 25 25 25 25 25 25
2.3 - 2.3 2.3 2.3 2.3 2.3 -
-4 - -4 -4 -4 -4 -4 -
4 - 4 4 4 4 4 4
0 - 0 0 0 0 0 -
as.bigz(34) 34 34 34 34 34 34 34
as.bg(32,7) 32/7 32/7 32/7 32/7 32/7 32/7 32/7
as.b(31,45) (31 %% 45) (31 %% 45) 31 (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45)
NULL 0 01 01 01 <NA> <NA> -3
NA <NA> <NA> <NA> <NA> <NA> <NA> <NA>
-3L - -3 -3 -3 -3 -3 -3
------------------------------------------
cbind
-> all.equal(target = res, current = F(<numeric x>)): Mean relative difference: 0.01075094
23 as.bigz(23) as.bigq(23) c(3,23) as.bigz(c(3,23)) as.bigq(c(3,23))
23 23 23 23 23 23 23
as.bigz(23) 23 23 23 23 23 23
as.bigq(23) 23 23 23 23 23 23
c(3,23) 3 3 3 3 3 3
as.bgz((3,23)) 3 3 3 3 3 3
as.bgq((3,23)) 3 3 3 3 3 3
25 25 25 25 25 25 25
2.3 2.3 2 2589569785738035/1125899906842624 2.3 2 2589569785738035/1125899906842624
-4 -4 -4 -4 -4 -4 -4
4 4 4 4 4 4 4
0 0 0 0 0 0 0
as.bigz(34) 34 34 34 34 34 34
as.bg(32,7) 32/7 32/7 32/7 32/7 32/7 32/7
as.b(31,45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45)
NULL 23 23 23 3 3 3
NA <NA> NA NA <NA> NA NA
-3L -3 -3 -3 -3 -3 -3
25 2.3 -4 4 0 as.bigz(34) as.bigq(32,7) as.bigz(31,45)
23 23 23 23 23 23 23 23 23
as.bigz(23) 23 23 23 23 23 23 23 23
as.bigq(23) 23 23 23 23 23 23 23 23
c(3,23) 3 3 3 3 3 3 3 3
as.bgz((3,23)) 3 3 3 3 3 3 3 3
as.bgq((3,23)) 3 3 3 3 3 3 3 3
25 25 25 25 25 25 25 25 25
2.3 2.3 2.3 2.3 2.3 2.3 2 2589569785738035/1125899906842624 2
-4 -4 -4 -4 -4 -4 -4 -4 -4
4 4 4 4 4 4 4 4 4
0 0 0 0 0 0 0 0 0
as.bigz(34) 34 34 34 34 34 34 34 34
as.bg(32,7) 32/7 32/7 32/7 32/7 32/7 32/7 32/7 32/7
as.b(31,45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45)
NULL 25 2.3 -4 4 0 34 32/7 (31 %% 45)
NA <NA> <NA> <NA> <NA> <NA> NA NA NA
-3L -3 -3 -3 -3 -3 -3 -3 -3
NULL NA -3L
23 23 23 23
as.bigz(23) 23 23 23
as.bigq(23) 23 23 23
c(3,23) 3 3 3
as.bgz((3,23)) 3 3 3
as.bgq((3,23)) 3 3 3
25 25 25 25
2.3 2.3 2.3 2.3
-4 -4 -4 -4
4 4 4 4
0 0 0 0
as.bigz(34) 34 34 34
as.bg(32,7) 32/7 32/7 32/7
as.b(31,45) (31 %% 45) (31 %% 45) (31 %% 45)
NULL <NA> <NA> -3
NA <NA> <NA> <NA>
-3L -3 -3 -3
------------------------------------------
rbind
-> all.equal(target = res, current = F(<numeric x>)): Mean relative difference: 0.01075094
23 as.bigz(23) as.bigq(23) c(3,23) as.bigz(c(3,23)) as.bigq(c(3,23))
23 23 23 23 23 23 23
as.bigz(23) 23 23 23 23 23 23
as.bigq(23) 23 23 23 23 23 23
c(3,23) 3 3 3 3 3 3
as.bgz((3,23)) 3 3 3 3 3 3
as.bgq((3,23)) 3 3 3 3 3 3
25 25 25 25 25 25 25
2.3 2.3 2 2589569785738035/1125899906842624 2.3 2 2589569785738035/1125899906842624
-4 -4 -4 -4 -4 -4 -4
4 4 4 4 4 4 4
0 0 0 0 0 0 0
as.bigz(34) 34 34 34 34 34 34
as.bg(32,7) 32/7 32/7 32/7 32/7 32/7 32/7
as.b(31,45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45)
NULL 23 23 23 3 3 3
NA <NA> NA NA <NA> NA NA
-3L -3 -3 -3 -3 -3 -3
25 2.3 -4 4 0 as.bigz(34) as.bigq(32,7) as.bigz(31,45)
23 23 23 23 23 23 23 23 23
as.bigz(23) 23 23 23 23 23 23 23 23
as.bigq(23) 23 23 23 23 23 23 23 23
c(3,23) 3 3 3 3 3 3 3 3
as.bgz((3,23)) 3 3 3 3 3 3 3 3
as.bgq((3,23)) 3 3 3 3 3 3 3 3
25 25 25 25 25 25 25 25 25
2.3 2.3 2.3 2.3 2.3 2.3 2 2589569785738035/1125899906842624 2
-4 -4 -4 -4 -4 -4 -4 -4 -4
4 4 4 4 4 4 4 4 4
0 0 0 0 0 0 0 0 0
as.bigz(34) 34 34 34 34 34 34 34 34
as.bg(32,7) 32/7 32/7 32/7 32/7 32/7 32/7 32/7 32/7
as.b(31,45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45) (31 %% 45)
NULL 25 2.3 -4 4 0 34 32/7 (31 %% 45)
NA <NA> <NA> <NA> <NA> <NA> NA NA NA
-3L -3 -3 -3 -3 -3 -3 -3 -3
NULL NA -3L
23 23 23 23
as.bigz(23) 23 23 23
as.bigq(23) 23 23 23
c(3,23) 3 3 3
as.bgz((3,23)) 3 3 3
as.bgq((3,23)) 3 3 3
25 25 25 25
2.3 2.3 2.3 2.3
-4 -4 -4 -4
4 4 4 4
0 0 0 0
as.bigz(34) 34 34 34
as.bg(32,7) 32/7 32/7 32/7
as.b(31,45) (31 %% 45) (31 %% 45) (31 %% 45)
NULL <NA> <NA> -3
NA <NA> <NA> <NA>
-3L -3 -3 -3
There were 3988 warnings (use warnings() to see them)
>
> summary(warnings()) # ideally *not* platform dependent
Summary of (a total of 3685) warning messages:
3260x : In sortie(e) : NAs introduced by coercion
Summary of (a total of 3988) warning messages:
3563x : In sortie(e) : NAs introduced by coercion
35x : In FUN(x[[i]], x[[j]]) : returning NA for (modulus) 0 in RHS
5x : In `/.bigz`(x[[i]], x[[j]]) :
pow(x, -|n|) returning NA as x has no inverse wrt modulus
......@@ -1380,4 +1536,4 @@ Big Integer ('bigz') 3 x 4 matrix:
>
> proc.time()
user system elapsed
0.913 0.060 0.971
0.952 0.068 1.027
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment