"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "lib/src/matrix_extra.c" between
gretl-2020a.tar.xz and gretl-2020b.tar.xz

About: gretl (Gnu Regression, Econometrics and Time-series Library) is a cross-platform statistical package mainly for econometric analysis.

matrix_extra.c  (gretl-2020a.tar.xz):matrix_extra.c  (gretl-2020b.tar.xz)
skipping to change at line 780 skipping to change at line 780
} }
} }
if (X == NULL && *err == 0) { if (X == NULL && *err == 0) {
*err = E_ALLOC; *err = E_ALLOC;
} }
return X; return X;
} }
static void vname_from_colname (char *targ, const char *src,
int i)
{
gchar *s, *p, *tmp = g_strdup(src);
int n, err = 0;
s = tmp;
/* skip any invalid leading bytes */
while (*s && !isalpha(*s)) {
s++;
}
n = strlen(s);
p = s;
if (n == 0) {
err = 1;
} else {
/* check for invalid embedded bytes */
while (*s) {
if (*s == ' ') {
*s = '_';
} else if (!isalnum(*s) && *s != ' ') {
err = 1;
break;
}
s++;
}
}
if (err) {
sprintf(targ, "v%d", i);
} else {
*targ = '\0';
strncat(targ, p, VNAMELEN-1);
}
g_free(tmp);
}
static void check_matrix_varnames (DATASET *dset)
{
int i, j, err = 0;
for (i=1; i<dset->v; i++) {
for (j=1; j<i; j++) {
if (!strcmp(dset->varname[i], dset->varname[j])) {
err = 1;
break;
}
}
}
if (err) {
for (i=1; i<dset->v; i++) {
sprintf(dset->varname[i], "v%d", i);
}
}
}
/** /**
* gretl_dataset_from_matrix: * gretl_dataset_from_matrix:
* @m: source matrix. * @m: source matrix.
* @list: list of columns (1-based) to include, or NULL. * @list: list of columns (1-based) to include, or NULL.
* @opt: may include OPT_B to attempt "borrowing" of data, * @opt: may include OPT_B to attempt "borrowing" of data;
* OPT_N to use plain numbers as variable names, OPT_R to * OPT_N to use plain numbers as variable names; OPT_R to
* experiment with handling row-names, if present. * use row-names as observation markers, if present; OPT_S
* when called from the "store" command.
* @err: location to receive error code. * @err: location to receive error code.
* *
* Creates a gretl dataset from matrix @m, either using the * Creates a gretl dataset from matrix @m, either using the
* columns specified in @list or using all columns if @list * columns specified in @list or using all columns if @list
* is NULL. * is NULL.
* *
* Returns: pointer to new dataset information struct on success, * Returns: pointer to new dataset information struct on success,
* or NULL on failure. * or NULL on failure.
*/ */
DATASET *gretl_dataset_from_matrix (const gretl_matrix *m, DATASET *gretl_dataset_from_matrix (const gretl_matrix *m,
const int *list, const int *list,
gretlopt opt, gretlopt opt,
int *err) int *err)
{ {
DATASET *dset = NULL; DATASET *dset = NULL;
gretlopt dsopt = OPT_NONE;
const char **cnames = NULL; const char **cnames = NULL;
const char **rnames = NULL; const char **rnames = NULL;
double x; int use_rownames;
int i, t, col, nv, T; int i, t, col, nv, T;
if (gretl_is_null_matrix(m)) { if (gretl_is_null_matrix(m)) {
*err = E_DATA; *err = E_DATA;
return NULL; return NULL;
} }
use_rownames = opt & (OPT_R | OPT_S);
T = m->rows; T = m->rows;
nv = m->cols; nv = m->cols;
if (list != NULL) { if (list != NULL) {
for (i=1; i<=list[0]; i++) { for (i=1; i<=list[0]; i++) {
col = list[i]; col = list[i];
if (col < 1 || col > nv) { if (col < 1 || col > nv) {
gretl_errmsg_sprintf("Variable number %d is out of bounds", col); gretl_errmsg_sprintf("Variable number %d is out of bounds", col);
*err = E_DATA; *err = E_DATA;
break; break;
} }
} }
nv = list[0]; nv = list[0];
} }
if (!*err) { if (!*err) {
gretlopt dsopt = OPT_NONE;
if (opt & OPT_B) { if (opt & OPT_B) {
dsopt |= OPT_B; dsopt |= OPT_B;
} }
if (opt & OPT_R) { if (use_rownames) {
rnames = gretl_matrix_get_rownames(m); rnames = gretl_matrix_get_rownames(m);
if (rnames != NULL) { if (rnames != NULL) {
dsopt |= OPT_M; dsopt |= OPT_M;
} }
} }
dset = create_auxiliary_dataset(nv + 1, T, dsopt); dset = create_auxiliary_dataset(nv + 1, T, dsopt);
if (dset == NULL) { if (dset == NULL) {
*err = E_ALLOC; *err = E_ALLOC;
} }
} }
if (*err) { if (*err) {
return NULL; return NULL;
} }
cnames = gretl_matrix_get_colnames(m); cnames = gretl_matrix_get_colnames(m);
for (i=1; i<=nv; i++) { for (i=1; i<=nv; i++) {
double *src;
col = (list != NULL)? list[i] - 1 : i - 1; col = (list != NULL)? list[i] - 1 : i - 1;
src = m->val + T * col;
if (opt & OPT_B) { if (opt & OPT_B) {
dset->Z[i] = m->val + T * col; /* "borrowing" */
dset->Z[i] = src;
} else { } else {
for (t=0; t<T; t++) { /* copying */
x = gretl_matrix_get(m, t, col); memcpy(dset->Z[i], src, T * sizeof *src);
if (na(x)) {
x = NADBL;
}
dset->Z[i][t] = x;
}
} }
if (cnames != NULL) { if (cnames != NULL) {
dset->varname[i][0] = '\0'; vname_from_colname(dset->varname[i], cnames[col], i);
strncat(dset->varname[i], cnames[col], VNAMELEN-1);
} else if (opt & OPT_N) { } else if (opt & OPT_N) {
sprintf(dset->varname[i], "%d", col + 1); sprintf(dset->varname[i], "%d", col + 1);
} else if (opt & OPT_R) {
sprintf(dset->varname[i], "v%d", i);
} else { } else {
sprintf(dset->varname[i], "col%d", col + 1); sprintf(dset->varname[i], "col%d", col + 1);
} }
} }
if (rnames != NULL) { if (rnames != NULL) {
for (t=0; t<T; t++) { for (t=0; t<T; t++) {
dset->S[t][0] = '\0'; dset->S[t][0] = '\0';
strncat(dset->S[t], rnames[t], OBSLEN-1); strncat(dset->S[t], rnames[t], OBSLEN-1);
} }
} }
if (cnames != NULL && (opt & OPT_S)) {
/* we must have valid varnames for "store" */
check_matrix_varnames(dset);
}
return dset; return dset;
} }
int write_matrix_as_dataset (const char *fname, int write_matrix_as_dataset (const char *fname,
gretlopt opt, gretlopt opt,
PRN *prn) PRN *prn)
{ {
const char *mname; const char *mname;
gretl_matrix *m; gretl_matrix *m;
DATASET *mdset; DATASET *mdset;
int err = 0; int err = 0;
mname = get_optval_string(STORE, OPT_A); mname = get_optval_string(STORE, OPT_A);
m = get_matrix_by_name(mname); m = get_matrix_by_name(mname);
if (m == NULL) { if (m == NULL) {
return E_DATA; return E_DATA;
} }
mdset = gretl_dataset_from_matrix(m, NULL, OPT_R, &err); mdset = gretl_dataset_from_matrix(m, NULL, OPT_S, &err);
if (!err) { if (!err) {
opt &= ~OPT_A; opt &= ~OPT_A;
err = write_data(fname, NULL, mdset, opt, prn); err = write_data(fname, NULL, mdset, opt, prn);
} }
destroy_dataset(mdset); destroy_dataset(mdset);
return err; return err;
} }
 End of changes. 15 change blocks. 
17 lines changed or deleted 86 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)