Logo Search packages:      
Sourcecode: foreign version File versions  Download package

minitab.c

/*
 *  Read Minitab portable data set format
 *
 *  Copyright 1999-1999 Douglas M. Bates <bates@stat.wisc.edu>,
 *                      Saikat DebRoy <saikat@stat.wisc.edu>
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be
 *  useful, but WITHOUT ANY WARRANTY; without even the implied
 *  warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
 *  PURPOSE.  See the GNU General Public License for more
 *  details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, a copy is available at
 *  http://www.r-project.org/Licenses/
 */

#include <stdlib.h>
#include <stdio.h>
#include <ctype.h>
#include <R.h>
#include <Rinternals.h>
#include "foreign.h"

#define MTP_BUF_SIZE 85
#define MTB_INITIAL_ENTRIES 10

typedef struct {
    int    type;        /* 3 = column, m = matrix, k = constant */
    int    cnum;        /* column number in the Minitab worksheet */
    int    len;               /* length of column */
    int    dtype;       /* data type: 0 = numeric */
    union {
      double *ndat;
      char   **cdat;
    } dat;
    char   name[9];
} MTBDATC, *MTB;

#define Column 3
#define Matrix 4
#define Constant 2

static                        /* trim white space from end of string */
char *strtrim(char *str)
{
    int i;
    for (i = strlen(str) - 1; i >= 0 && isspace((int)str[i]); i--) 
      str[i] = '\0';
    return str;
}

static
SEXP MTB2SEXP(MTB mtb[], int len) /* Create a list from a vector of
                             MTB's and Free the MTB storage */
{
    SEXP ans = PROTECT(allocVector(VECSXP,len)), 
      names = PROTECT(allocVector(STRSXP, len));
    int i,j;
    
    
    for (i = 0; i < len; i++) {
      MTB thisRec = mtb[i];

      SET_STRING_ELT(names, i, mkChar(thisRec->name));
      switch(mtb[i]->dtype) {
      case 0:                 /* numeric data */
          SET_VECTOR_ELT(ans, i, allocVector(REALSXP, mtb[i]->len));
          Memcpy(REAL(VECTOR_ELT(ans, i)), mtb[i]->dat.ndat, mtb[i]->len);
          Free(mtb[i]->dat.ndat);
          break;
        default:
            if (mtb[i]->type == 4) { 
                int nrow = mtb[i]->len / mtb[i]->dtype;
                int ncol = mtb[i]->dtype;
                SEXP aMatrix = PROTECT(allocMatrix(REALSXP,nrow,ncol));
            
                for (j = 0; j < nrow*ncol; j++) {
                    REAL(aMatrix)[j] = mtb[i]->dat.ndat[j];
                }
                SET_VECTOR_ELT(ans, i, aMatrix);
                Free(mtb[i]->dat.ndat);
                UNPROTECT(1);
            } else {
                error(_("non-numeric data types are not yet implemented"));
            }
      }
      Free(mtb[i]);
    }
    Free(mtb);
    setAttrib(ans, R_NamesSymbol, names);
    UNPROTECT(2);
    return(ans);
}
    
SEXP
read_mtp(SEXP fname)
{
    FILE *f;
    char buf[MTP_BUF_SIZE], blank[1];
    MTB  *mtb, thisRec;
    int i, j, nMTB = MTB_INITIAL_ENTRIES;
    
    PROTECT(fname = asChar(fname));
    if ((f = fopen(R_ExpandFileName(CHAR(fname)), "r")) == NULL)
      error(_("unable to open file '%s' for reading"), CHAR(fname));
    if ((fgets(buf, MTP_BUF_SIZE, f) == NULL) ||
      strncmp(buf, "Minitab Portable Worksheet ", 27) != 0)
      error(_("file '%s' is not in Minitab Portable Worksheet format"),
            CHAR(fname));
    fgets(buf, MTP_BUF_SIZE, f);
    UNPROTECT(1);
    
    mtb = Calloc(nMTB, MTB);
    for (i = 0; !feof(f); i++) {
      if (i >= nMTB) {
          nMTB *= 2;
          mtb = Realloc(mtb, nMTB, MTB);
      }
      thisRec = mtb[i] = Calloc(1, MTBDATC);
      if (sscanf(buf, "%%%7d%7d%7d%7d%c%8c", &(thisRec->type),
               &(thisRec->cnum), &(thisRec->len),
               &(thisRec->dtype), blank, thisRec->name) != 6)
          error(_("first record for entry %d is corrupt"), i+1);
      thisRec->name[8] = '\0';
      strtrim(thisRec->name); /* trim trailing white space on name */
      switch (thisRec->dtype) {
      case 0:           /* numeric data */
          thisRec->dat.ndat = Calloc(thisRec->len, double);
          for (j = 0; j < thisRec->len; j++) {
            fscanf(f, "%lg", thisRec->dat.ndat + j);
          }
          break;
        default:
            if (thisRec->type == 4) { /* we have a matrix so dtype is number of columns */
                thisRec->dat.ndat = Calloc(thisRec->len, double);
                for (j = 0; j < thisRec->len; j++) {
                    fscanf(f, "%lg", thisRec->dat.ndat + j);
                }
            } else {
                error(_("non-numeric data types are not yet implemented"));
            }
        } 
      fgets(buf, MTP_BUF_SIZE, f); /* clear rest of current line */
      fgets(buf, MTP_BUF_SIZE, f); /* load next line */
    }
    return MTB2SEXP(mtb, i);
}

Generated by  Doxygen 1.6.0   Back to index