TMB Documentation  v1.9.10
convert.hpp
Go to the documentation of this file.
1 // Copyright (C) 2013-2015 Kasper Kristensen
2 // License: GPL-2
3 
8 #ifdef WITH_LIBTMB
9 double asDouble(int x);
10 double asDouble(double x);
11 double asDouble(AD<double> x);
12 double asDouble(AD<AD<double> > x);
13 double asDouble(AD<AD<AD<double> > > x);
14 #ifdef TMBAD_FRAMEWORK
15 double asDouble(TMBad::ad_aug x);
16 #endif
17 #else
18 double asDouble(int x){return double(x);}
19 double asDouble(double x){return x;}
20 double asDouble(AD<double> x){return CppAD::Value(x);}
21 double asDouble(AD<AD<double> > x){return CppAD::Value(CppAD::Value(x));}
22 double asDouble(AD<AD<AD<double> > > x){return CppAD::Value(CppAD::Value(CppAD::Value(x)));}
23 #ifdef TMBAD_FRAMEWORK
24 double asDouble(TMBad::ad_aug x){return x.Value();}
25 #endif
26 #endif
27 
29 template<class Type>
30 SEXP asSEXP(const matrix<Type> &a)
31 {
32  R_xlen_t nr = a.rows();
33  R_xlen_t nc = a.cols();
34  SEXP val;
35  PROTECT(val = Rf_allocMatrix(REALSXP, nr, nc));
36  double *p = REAL(val);
37  for(R_xlen_t j=0; j<nc; j++)
38  for(R_xlen_t i=0; i<nr; i++)
39  p[i + j * nr] = asDouble(a(i,j));
40  UNPROTECT(1);
41  return val;
42 }
43 
44 // Report vector of numeric types: Make R-vector
45 #define asSEXP_VECTOR_OF_NUMERIC(Type, ns) \
46 SEXP asSEXP(const ns::vector<Type> &a) CSKIP( \
47 { \
48  R_xlen_t size = a.size(); \
49  SEXP val; \
50  PROTECT(val = Rf_allocVector(REALSXP,size)); \
51  double *p = REAL(val); \
52  for (R_xlen_t i = 0; i < size; i++) \
53  p[i] = asDouble(a[i]); \
54  UNPROTECT(1); \
55  return val; \
56 })
57 asSEXP_VECTOR_OF_NUMERIC(int, tmbutils)
58 asSEXP_VECTOR_OF_NUMERIC(double, tmbutils)
59 asSEXP_VECTOR_OF_NUMERIC(double, std)
60 #ifdef TMBAD_FRAMEWORK
61 asSEXP_VECTOR_OF_NUMERIC(TMBad::ad_aug, tmbutils)
62 #endif
63 template<class Type>
64 asSEXP_VECTOR_OF_NUMERIC(AD<Type>, tmbutils)
65 #undef asSEXP_VECTOR_OF_NUMERIC
66 // Report vector of anything else: Make R-list
67 template<class Type>
68 SEXP asSEXP(const vector<Type> &a)
69 {
70  R_xlen_t size = a.size();
71  SEXP val;
72  PROTECT(val = Rf_allocVector(VECSXP, size));
73  for (R_xlen_t i = 0; i < size; i++)
74  SET_VECTOR_ELT(val, i, asSEXP(a[i]));
75  UNPROTECT(1);
76  return val;
77 }
78 
79 SEXP asSEXP(const double &a) CSKIP(
80 {
81  SEXP val;
82  PROTECT(val=Rf_allocVector(REALSXP,1));
83  REAL(val)[0]=a;
84  UNPROTECT(1);
85  return val;
86 })
87 SEXP asSEXP(const int &a) CSKIP(
88 {
89  SEXP val;
90  PROTECT(val=Rf_allocVector(INTSXP,1));
91  INTEGER(val)[0]=a;
92  UNPROTECT(1);
93  return val;
94 })
95 // EXPERIMENT
96 template<class Type>
97 SEXP asSEXP(const AD<Type> &a){
98  return asSEXP(CppAD::Value(a));
99 }
100 #ifdef TMBAD_FRAMEWORK
101 SEXP asSEXP(const TMBad::ad_aug &a) CSKIP( {
102  return asSEXP(a.Value());
103 } )
104 #endif
105 
107 template <class Type>
109 {
110  if(!Rf_isReal(x)) Rf_error("NOT A VECTOR!");
111  R_xlen_t n = XLENGTH(x);
112  typedef Eigen::Map<Eigen::Matrix<double,Eigen::Dynamic,1> > MapVector;
113  MapVector tmp(REAL(x), n);
114  vector<Type> y = tmp.cast<Type>();
115  return y;
116 }
117 
119 template<class Type>
120 matrix<Type> asMatrix(const vector<Type> &x, int nr, int nc)
121 {
122  matrix<Type> xm = x.matrix();
123  xm.resize(nr, nc);
124  return xm;
125 }
126 
128 template <class Type>
130 {
131  if (!Rf_isMatrix(x))
132  Rf_error("x must be a matrix in 'asMatrix(x)'");
133  R_xlen_t nr = Rf_nrows(x); // nrows is int
134  R_xlen_t nc = Rf_ncols(x); // ncols is int
135  matrix<Type> y(nr, nc);
136  double *p = REAL(x);
137  for(R_xlen_t j=0; j<nc; j++)
138  for(R_xlen_t i=0; i<nr; i++)
139  y(i, j) = Type(p[i + nr * j]);
140  return y;
141 }
142 
143 template<class Type>
144 SEXP asSEXP(const tmbutils::array<Type> &a)
145 {
146  SEXP val;
147  PROTECT( val = asSEXP( vector<Type> ( a ) ) );
148  SEXP dim;
149  PROTECT(dim = Rf_allocVector(INTSXP, a.dim.size()));
150  for(int i=0; i<a.dim.size(); i++)
151  INTEGER(dim)[i] = a.dim[i];
152  Rf_setAttrib(val, R_DimSymbol, dim);
153  UNPROTECT(2);
154  return val;
155 }
156 
158 template<class Type>
159 SEXP asSEXP(Eigen::SparseMatrix<Type> x){
160  typedef typename Eigen::SparseMatrix<Type>::InnerIterator Iterator;
161  // Allocate return object
162  R_xlen_t nnz = x.nonZeros();
163  SEXP ans = PROTECT(R_do_new_object(R_do_MAKE_CLASS("dgTMatrix")));
164  SEXP dim = PROTECT(Rf_allocVector(INTSXP, 2));
165  SEXP dimnames = PROTECT(Rf_allocVector(VECSXP, 2));
166  SEXP values = PROTECT(Rf_allocVector(REALSXP, nnz));
167  SEXP i = PROTECT(Rf_allocVector(INTSXP, nnz));
168  SEXP j = PROTECT(Rf_allocVector(INTSXP, nnz));
169  SEXP factors = PROTECT(Rf_allocVector(VECSXP, 0));
170  R_do_slot_assign(ans, Rf_install("i"), i);
171  R_do_slot_assign(ans, Rf_install("j"), j);
172  R_do_slot_assign(ans, Rf_install("Dim"), dim);
173  R_do_slot_assign(ans, Rf_install("Dimnames"), dimnames);
174  R_do_slot_assign(ans, Rf_install("x"), values);
175  R_do_slot_assign(ans, Rf_install("factors"), factors);
176  // Insert
177  INTEGER(dim)[0] = x.rows();
178  INTEGER(dim)[1] = x.cols();
179  R_xlen_t k = 0;
180  for (R_xlen_t cx=0; cx<x.outerSize(); cx++)
181  {
182  for (Iterator itx(x,cx); itx; ++itx)
183  {
184  INTEGER(i)[k] = itx.row();
185  INTEGER(j)[k] = itx.col();
186  REAL(values)[k] = asDouble(itx.value());
187  k++;
188  }
189  }
190  UNPROTECT(7);
191  return ans;
192 }
Vector class used by TMB.
Definition: vector.hpp:17
Array class used by TMB.
Definition: tmbutils.hpp:23
Augmented AD type.
Definition: global.hpp:2831
Matrix class used by TMB.
Definition: vector.hpp:101
Scalar Value() const
Return the underlying scalar value of this ad_aug.
Definition: TMBad.cpp:2188
vector< Type > asVector(SEXP x)
Construct c++-vector from SEXP object.
Definition: convert.hpp:108
SEXP asSEXP(const matrix< Type > &a)
Convert TMB matrix, vector, scalar or int to R style.
Definition: convert.hpp:30
matrix< Type > asMatrix(const vector< Type > &x, int nr, int nc)
Vector <-> Matrix conversion (for row-major matrices)
Definition: convert.hpp:120
Utility functions for TMB (automatically included)
Definition: concat.hpp:5
License: GPL v2