Package org.renjin.base

Source Code of org.renjin.base.Base

/*
* R : A Computer Language for Statistical Data Analysis
* Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
* Copyright (C) 1997--2008  The R Development Core Team
* Copyright (C) 2003, 2004  The R Foundation
* Copyright (C) 2010 bedatadriven
*
* 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 3 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, see <http://www.gnu.org/licenses/>.
*/

package org.renjin.base;

import java.io.IOException;

import org.renjin.eval.Context;
import org.renjin.eval.EvalException;
import org.renjin.methods.Methods;
import org.renjin.primitives.Evaluation;
import org.renjin.invoke.annotations.Current;
import org.renjin.primitives.io.serialization.Serialization;
import org.renjin.primitives.matrix.Matrix;
import org.renjin.primitives.matrix.MatrixBuilder;
import org.renjin.primitives.vector.BinCodeVector;
import org.renjin.sexp.*;


/**
* Implementation of routines from the base dll.
*
* <p>The functions implemented here are distinct from the collection of
* primitives which make up most of the base package; these functions are
* called from R code using the .Call("methodname", arg1, arg2, ... argn, PACKAGE="base") syntax.
*
* <p>Also note that many methods use a convention whereby the values to be
* returned are allocated by the calling R code to save the C implementors the
* trouble of dealing with memory management (I think), so many of these methods
* take what are, in renjin's context, unused arguments.
*
*/
public class Base {

  private Base() { }
 
  public static boolean R_isMethodsDispatchOn(SEXP onOff) {
    return false;
  }

  public static ListVector R_getSymbolInfo(String sname, SEXP spackage, boolean withRegistrationInfo) {

    ListVector.Builder result = new ListVector.Builder();
    result.setAttribute(Symbols.CLASS, StringVector.valueOf("CRoutine"));

    return result.build();

  }

  public static ListVector R_getRegisteredRoutines(String dll) {
    ListVector.Builder builder = new ListVector.Builder();
    return builder.build();
  }

  /** @return  n if the data frame 'vec' has c(NA, n) rownames;
   *         nrow(.) otherwise;  note that data frames with nrow(.) == 0
   *          have no row.names.
   * ==> is also used in dim.data.frame()
   *
   * AB Note: I have no idea what this function really does but it is
   * so opaque that it is first against the wall when the revolution comes.
   */
  public static SEXP R_shortRowNames(SEXP vector, int type) {
    SEXP s =  vector.getAttribute(Symbols.ROW_NAMES);
    SEXP ans = s;

    if( type < 0 || type > 2) {
      throw new EvalException("invalid 'type' argument");
    }

    if(type >= 1) {
      int n;
      if (s instanceof IntVector && s.length() == 2 && ((IntVector) s).isElementNA(0)) {
        n = ((IntVector) s).getElementAsInt(1);
      } else {
        if (s == Null.INSTANCE) {
          n = 0;
        } else {
          n = s.length();
        }
      }
      if (type == 1) {
        ans = new IntArrayVector(n);
      } else {
        ans = new IntArrayVector(Math.abs(n));
      }
    }
    return ans;
  }
 
  /**
   *
   * "native" implementation called by tabulate(), which
   * takes the integer-valued vector bin and counts the number of times each integer occurs in it.
   *
   * <p>There is a bin for each of the values 1, ..., nbins; values outside that range
   * and NAs are (silently) ignored.
   *
   * @param bin the integer vector to bin
   * @param length the length of bin
   * @param nbins the number of bins
   * @param ans not used
   * @return
   */
  public static PairList R_tabulate(IntVector bin, int length, int nbins, SEXP ans) {
    int counts[] = new int[nbins];
    for(int i=0;i!=length;++i) {
      if(!bin.isElementNA(i)) {
        int value = bin.getElementAsInt(i);
        if(value >= 1 && value <= nbins) {
          counts[value-1]++;
        }
      }
    }
    return PairList.Node.singleton("ans", new IntArrayVector(counts));
  }
 
  public static SEXP Rrowsum_df(ListVector x, int ncol, Vector group, SEXP ugroup, boolean naRm) {
    throw new EvalException("nyi");
  }

  public static Vector Rrowsum_matrix(Vector x, int ncol, AtomicVector groups, AtomicVector ugroup, boolean naRm) {
   
    int numGroups = ugroup.length();
   
    Matrix source = new Matrix(x, ncol);
    MatrixBuilder result = source.newBuilder(numGroups, ncol);
   
    for(int col=0;col!=ncol;++col) {
     
      // sum the rows in this column by group
     
      double groupSums[] = new double[numGroups];
      for(int row=0;row!=source.getNumRows();++row) {
        int group = ugroup.indexOf(groups, row, 0);
        groupSums[group] += source.getElementAsDouble(row, col);
      }
     
      // copy sums to matrix
      for(int group=0;group!=ugroup.length();++group) {
        result.setValue(group, col, groupSums[group]);
      }
     
    }
    return result.build();
  }
  
 
  public static SEXP R_copyDFattr(SEXP in, SEXP out) {
   
    // NOTE: the equivalent C code actuallly modifies 'out' which
    // is not actually possible in Renjin-- we can only return a modified
    // copy. Not clear whether this will
    // have consequences -- this is called from [.data.frame
    ListVector attributesToCopy;
    if(in.hasAttributes()) {
      attributesToCopy = in.getAttributes().toVector();
    } else {
      attributesToCopy = new ListVector();
    }
    //IS_S4_OBJECT(in) ?  SET_S4_OBJECT(out) : UNSET_S4_OBJECT(out);
    //SET_OBJECT(out, OBJECT(in));

    return out.setAttributes(AttributeMap.fromListVector(attributesToCopy));
  }
 

  /* Gets the binding values of variables from a frame and returns them
   as a list.  If the force argument is true, promises are forced;
   otherwise they are not. */

  public static SEXP  R_getVarsFromFrame(@Current Context context, StringVector vars, Environment env, boolean force) {

    ListVector.NamedBuilder val = new ListVector.NamedBuilder();
    for(String var : vars) {
      SEXP boundValue = env.getVariable(var);
      if(boundValue == Symbol.UNBOUND_VALUE) {
        throw new EvalException("object %s not found", boundValue);
      }
      if(force) {
        boundValue = boundValue.force(context);
      }
      val.add(var, boundValue);
    }
    return val.build();
  }



 
  public static ListVector str_signif(Vector x, int n, String type, int width, int digits, String format, String flag, StringVector resultVector) {
    ListVector.NamedBuilder result = new ListVector.NamedBuilder();
    result.add("result", StrSignIf.str_signif(x, width, digits, format, flag));
    return result.build();
  }


  public static SEXP R_serialize(@Current Context context, SEXP object, SEXP connection, boolean ascii,
      SEXP version, SEXP refhook) throws IOException {
    return Serialization.serialize(context, object, connection, ascii, version, refhook);
  }
 
  public static SEXP R_unserialize(@Current Context context, SEXP connection, SEXP refhook) throws IOException {
      return Serialization.unserialize(context, connection, refhook);
  }

  public static String crc64ToString(String value) {
    return Crc64.getCrc64(value);
  }
  public static SEXP R_isS4Object(SEXP exp) {
    if(exp instanceof S4Object) {
      return LogicalVector.TRUE;
    } else if(exp.getAttribute(Symbols.S4_BIT) != Null.INSTANCE) {
      return LogicalVector.TRUE;
    } else {
      return LogicalVector.FALSE;
    }
  }
 
  public static SEXP R_do_new_object(S4Object classRepresentation) {
    return Methods.R_do_new_object(classRepresentation);
  }

  public static SEXP R_setS4Object(SEXP object, boolean bool, int index) {
    return R_setS4Object(object, bool, index != 0);
  }

  public static SEXP R_setS4Object(SEXP object, boolean bool, boolean index) {
    if(object instanceof S4Object) {
      return object;
    } else {
      return object.setAttribute(Symbols.S4_BIT, LogicalVector.TRUE);
    }
  }
 
  public static ListVector do_mapply(@Current Context context, Function fun, ListVector varyingArgs, Vector constantArgs, Environment rho) {
    return Evaluation.mapply(context, fun, varyingArgs, constantArgs, rho);
  }

  /* bincode  cuts up the data using half open intervals defined as [a,b)
     (if right = FALSE) or (a, b] (if right = TRUE)
  */
  public static ListVector bincode(DoubleVector x, int n, DoubleVector breaks, int nb, IntVector code_,
                             boolean right, boolean include_border, boolean naok) {

    // if we NAs are not ok, we have to check and throw an error now, not later
    if(!naok) {
      if(x.indexOfNA() != -1) {
        throw new EvalException("NA's in bincode(NAOK=FALSE)");
      }
    }
    IntVector codedVector = new BinCodeVector(x, breaks.toDoubleArray(), !right, include_border, AttributeMap.EMPTY);

    ListVector.NamedBuilder result = new ListVector.NamedBuilder();
    result.add("code", codedVector);
    return result.build();
  }

}
TOP

Related Classes of org.renjin.base.Base

TOP
Copyright © 2018 www.massapi.com. All rights reserved.
All source code are property of their respective owners. Java is a trademark of Sun Microsystems, Inc and owned by ORACLE Inc. Contact coftware#gmail.com.