The R Project SVN R-packages

Rev

Rev 4529 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 4529 Rev 4560
Line 148... Line 148...
148 
    dims[0] = nrow;
 148 
    dims[0] = nrow;
149 
    dims[1] = length(GET_SLOT(x, Matrix_pSym)) - 1;
 149 
    dims[1] = length(GET_SLOT(x, Matrix_pSym)) - 1;
150 
    return x;
 150 
    return x;
151 
}
 151 
}
152 
 
 152 
 
153 
 
 - 
 
154 
#if 0
 - 
 
155 
/**  The following two csc_ functions are identically usable for rcs__
 - 
 
156 
 *
 - 
 
157 
 * Check for unsorted columns in the row indices
 - 
 
158 
 *
 - 
 
159 
 * @param ncol number of columns
 - 
 
160 
 * @param p column pointers
 - 
 
161 
 * @param i row indices
 - 
 
162 
 *
 - 
 
163 
 * @return 0 if all columns are sorted, otherwise 1
 - 
 
164 
 */
 - 
 
165 
int csc_unsorted_columns(int ncol, const int p[], const int i[])
 - 
 
166 
{
 - 
 
167 
    int j;
 - 
 
168 
    for (j = 0; j < ncol; j++) {
 - 
 
169 
	int ind, lst = p[j+1] - 1;
 - 
 
170 
	for (ind = p[j]; ind < lst; ind++) {
 - 
 
171 
	    if (i[ind] > i[ind+1]) return 1;
 - 
 
172 
	}
 - 
 
173 
    }
 - 
 
174 
    return 0;
 - 
 
175 
}
 - 
 
176 
 
 - 
 
177 
/**
 - 
 
178 
 * Sort the columns in a sparse column-oriented matrix so that each
 - 
 
179 
 * column is in increasing order of row index.
 - 
 
180 
 *
 - 
 
181 
 * @param ncol number of columns
 - 
 
182 
 * @param p column pointers
 - 
 
183 
 * @param i row indices
 - 
 
184 
 * @param x values of nonzero elements
 - 
 
185 
 */
 - 
 
186 
void csc_sort_columns(int ncol, const int p[], int i[], double x[])
 - 
 
187 
{
 - 
 
188 
    int j, maxdiff, *ord;
 - 
 
189 
    double *dd = (double *) NULL;
 - 
 
190 
 
 - 
 
191 
    maxdiff = -1;
 - 
 
192 
    for (j = 0; j < ncol; j++) {
 - 
 
193 
	int diff = p[j+1] - p[j];
 - 
 
194 
	if (diff > maxdiff) maxdiff = diff;
 - 
 
195 
    }
 - 
 
196 
    ord = Calloc(maxdiff, int);
 - 
 
197 
    if (x) dd = Calloc(maxdiff, double);
 - 
 
198 
    for (j = 0; j < ncol; j++) {
 - 
 
199 
	int cLen = p[j+1] - p[j];
 - 
 
200 
	if (cLen > 1) {
 - 
 
201 
	    int k, offset = p[j];
 - 
 
202 
	    for (k = 0; k < cLen; k++) ord[k] = k;
 - 
 
203 
	    R_qsort_int_I(i + offset, ord, 1, cLen);
 - 
 
204 
	    if (x) {
 - 
 
205 
		for (k = 0; k < cLen; k++) dd[k] = x[ord[k] + offset];
 - 
 
206 
		Memcpy(x + offset, dd, cLen);
 - 
 
207 
	    }
 - 
 
208 
	}
 - 
 
209 
    }
 - 
 
210 
    Free(ord);
 - 
 
211 
    if (x) Free(dd);
 - 
 
212 
}
 - 
 
213 
#endif
 - 
 
214 
 
 - 
 
215 
#if 0
 - 
 
216 
/**
 - 
 
217 
 * Check for sorted columns in an object that inherits from the
 - 
 
218 
 * dgCMatrix class.  Resort the columns if necessary.
 - 
 
219 
 *
 - 
 
220 
 * @param m pointer to an object that inherits from the dgCMatrix class
 - 
 
221 
 *
 - 
 
222 
 * @return m with the columns sorted by increasing row index
 - 
 
223 
 */
 - 
 
224 
SEXP csc_check_column_sorting(SEXP m)
 - 
 
225 
{
 - 
 
226 
    int *mp = INTEGER(GET_SLOT(m, Matrix_pSym)),
 - 
 
227 
	*mi = INTEGER(GET_SLOT(m, Matrix_iSym)),
 - 
 
228 
	ncol = INTEGER(GET_SLOT(m, Matrix_DimSym))[1];
 - 
 
229 
 
 - 
 
230 
    if (csc_unsorted_columns(ncol, mp, mi))
 - 
 
231 
	csc_sort_columns(ncol, mp, mi, REAL(GET_SLOT(m, Matrix_xSym)));
 - 
 
232 
    return m;
 - 
 
233 
}
 - 
 
234 
#endif
 - 
 
235 
 
 - 
 
236 
/* Fill in the "trivial remainder" in  n*m  array ;
 153 
/* Fill in the "trivial remainder" in  n*m  array ;
237 
 *  typically the 'x' slot of a "dtrMatrix" :
 154 
 *  typically the 'x' slot of a "dtrMatrix" :
238 
 * But should be usable for double/logical/int/complex : */
 155 
 * But should be usable for double/logical/int/complex : */
239 
 
 156 
 
240 
#define MAKE_TRIANGULAR_BODY(_TO_, _FROM_, _ZERO_, _ONE_)	\
 157 
#define MAKE_TRIANGULAR_BODY(_TO_, _FROM_, _ZERO_, _ONE_)	\
Line 315... Line 232...
315 
SEXP check_scalar_string(SEXP sP, char *vals, char *nm)
 232 
SEXP check_scalar_string(SEXP sP, char *vals, char *nm)
316 
{
 233 
{
317 
    SEXP val = ScalarLogical(1);
 234 
    SEXP val = ScalarLogical(1);
318 
    char *buf;
 235 
    char *buf;
319 
    /* only allocate when needed: in good case, none is needed */
 236 
    /* only allocate when needed: in good case, none is needed */
320 
#define SPRINTF buf = Calloc(Matrix_Error_Bufsiz, char); sprintf
 237 
#define SPRINTF buf = Alloca(Matrix_Error_Bufsiz, char); R_CheckStack(); sprintf
321 
 
 238 
 
322 
    if (length(sP) != 1) {
 239 
    if (length(sP) != 1) {
323 
	SPRINTF(buf, _("'%s' slot must have length 1"), nm);
 240 
	SPRINTF(buf, _("'%s' slot must have length 1"), nm);
324 
    } else {
 241 
    } else {
325 
	const char *str = CHAR(STRING_ELT(sP, 0));
 242 
	const char *str = CHAR(STRING_ELT(sP, 0));
Line 334... Line 251...
334 
	    SPRINTF(buf, _("'%s' must be in '%s'"), nm, vals);
 251 
	    SPRINTF(buf, _("'%s' must be in '%s'"), nm, vals);
335 
	}
 252 
	}
336 
    }
 253 
    }
337 
    /* 'error' returns : */
 254 
    /* 'error' returns : */
338 
    val = mkString(buf);
 255 
    val = mkString(buf);
339 
    Free(buf);
 - 
 
340 
    return val;
 256 
    return val;
341 
#undef SPRINTF
 257 
#undef SPRINTF
342 
}
 258 
}
343 
 
 259 
 
344 
SEXP dense_nonpacked_validate(SEXP obj)
 260 
SEXP dense_nonpacked_validate(SEXP obj)