diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/sample.R b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/sample.R new file mode 100644 index 0000000000000000000000000000000000000000..bda0c1c03090ea77951637ffddac747328e36785 --- /dev/null +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/sample.R @@ -0,0 +1,36 @@ +# File src/library/base/R/sample.R +# Part of the R package, http://www.R-project.org +# +# Copyright (C) 1995-2012 The R Core Team +# +# 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. +# +# A copy of the GNU General Public License is available at +# http://www.r-project.org/Licenses/ + +sample <- function(x, size, replace = FALSE, prob = NULL) +{ + if(length(x) == 1L && is.numeric(x) && x >= 1) { + if(missing(size)) size <- x + sample.int(x, size, replace, prob) + } else { + if(missing(size)) size <- length(x) + x[sample.int(length(x), size, replace, prob)] + } +} + +sample.int <- function(n, size = n, replace = FALSE, prob = NULL) +{ + if (!replace && is.null(prob) && n > 1e7 && size <= n/2) + .Internal(sample2(n, size)) + else .Internal(sample(n, size, replace, prob)) +} + diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Sample.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Sample.java new file mode 100644 index 0000000000000000000000000000000000000000..08222239e02b707fa60c76eb6fcb6dbbf9e71e64 --- /dev/null +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Sample.java @@ -0,0 +1,309 @@ +/* + * This material is distributed under the GNU General Public License + * Version 2. You may review the terms of this license at + * http://www.gnu.org/licenses/gpl-2.0.html + * + * Copyright (c) 1995, 1996, Robert Gentleman and Ross Ihaka + * Copyright (c) 1997--2012, The R Core Team + * Copyright (c) 2003--2008, The R Foundation + * Copyright (c) 2012-2013, Purdue University + * Copyright (c) 2013, 2014, Oracle and/or its affiliates + * + * All rights reserved. + */ + +package com.oracle.truffle.r.nodes.builtin.base; + +import com.oracle.truffle.api.*; +import com.oracle.truffle.api.dsl.*; +import com.oracle.truffle.r.nodes.*; +import com.oracle.truffle.r.nodes.builtin.*; +import com.oracle.truffle.r.nodes.unary.*; +import com.oracle.truffle.r.runtime.*; +import com.oracle.truffle.r.runtime.data.*; +import com.oracle.truffle.r.runtime.rng.*; + +@RBuiltin(name = "sample", kind = RBuiltinKind.INTERNAL) +public abstract class Sample extends RBuiltinNode { + + @CreateCast("arguments") + public RNode[] castArguments(RNode[] arguments) { + arguments[0] = CastIntegerNodeFactory.create(arguments[0], true, false, false); + arguments[1] = CastIntegerNodeFactory.create(arguments[1], true, false, false); + arguments[2] = CastLogicalNodeFactory.create(arguments[2], true, false, false); + arguments[3] = CastDoubleNodeFactory.create(arguments[3], true, false, false); + return arguments; + } + + @Specialization(order = 10, guards = "invalidFirstArgument") + @SuppressWarnings("unused") + public RIntVector doSampleInvalidFirstArg(final int x, final int size, final byte isRepeatable, final RDoubleVector prob) { + CompilerDirectives.transferToInterpreter(); + throw RError.getInvalidFirstArgument(getEncapsulatingSourceSection()); + } + + @Specialization(order = 20, guards = "invalidProb") + @SuppressWarnings("unused") + public RIntVector doSampleInvalidProb(final int x, final int size, final byte isRepeatable, final RDoubleVector prob) { + CompilerDirectives.transferToInterpreter(); + throw RError.getIncorrectNumProb(getEncapsulatingSourceSection()); + } + + @Specialization(order = 30, guards = "largerPopulation") + @SuppressWarnings("unused") + public RIntVector doSampleLargerPopulation(final int x, final int size, final byte isRepeatable, final RDoubleVector prob) { + CompilerDirectives.transferToInterpreter(); + throw RError.getLargerPopu(getEncapsulatingSourceSection()); + } + + @Specialization(order = 40, guards = "invalidSizeArgument") + @SuppressWarnings("unused") + public RIntVector doSampleInvalidSize(final int x, final int size, final byte isRepeatable, final RDoubleVector prob) { + CompilerDirectives.transferToInterpreter(); + throw RError.getInvalidArgument(getEncapsulatingSourceSection(), RRuntime.toString(size)); + + } + + @Specialization(order = 1, guards = {"!invalidFirstArgument", "!invalidProb", "!largerPopulation", "!invalidSizeArgument", "withReplacement"}) + public RIntVector doSampleWithReplacement(final int x, final int size, final byte isRepeatable, final RDoubleVector prob) { + // The following code is transcribed from GNU R src/main/random.c lines 493-501 in + // function do_sample. + double[] probArray = prob.getDataCopy(); + fixupProbability(probArray, x, size, isRepeatable); + int nc = 0; + for (double aProb : probArray) { + if (x * aProb > 0.1) { + nc++; + } + } + if (nc > 200) { + // TODO implement walker + throw new UnsupportedOperationException("walker_ProbSampleReplace is not yet implemented"); + } else { + return RDataFactory.createIntVector(probSampleReplace(x, probArray, size), RDataFactory.COMPLETE_VECTOR); + } + } + + @Specialization(order = 2, guards = {"!invalidFirstArgument", "!invalidProb", "!largerPopulation", "!invalidSizeArgument", "!withReplacement"}) + public RIntVector doSampleNoReplacement(final int x, final int size, final byte isRepeatable, final RDoubleVector prob) { + double[] probArray = prob.getDataCopy(); + fixupProbability(probArray, x, size, isRepeatable); + return RDataFactory.createIntVector(probSampleWithoutReplace(x, probArray, size), RDataFactory.COMPLETE_VECTOR); + } + + @SuppressWarnings("unused") + @Specialization(order = 50, guards = "invalidFirstArgumentNullProb") + public RIntVector doSampleInvalidFirstArgument(final int x, final int size, final byte isRepeatable, final RNull prob) { + CompilerDirectives.transferToInterpreter(); + throw RError.getInvalidFirstArgument(getEncapsulatingSourceSection()); + } + + @SuppressWarnings("unused") + @Specialization(order = 60, guards = "invalidSizeArgument") + public RIntVector doSampleInvalidSizeArgument(final int x, final int size, final byte isRepeatable, final RNull prob) { + CompilerDirectives.transferToInterpreter(); + throw RError.getInvalidArgument(getEncapsulatingSourceSection(), RRuntime.toString(size)); + } + + @SuppressWarnings("unused") + @Specialization(order = 70, guards = "largerPopulation") + public RIntVector doSampleInvalidLargerPopulation(final int x, final int size, final byte isRepeatable, final RNull prob) { + CompilerDirectives.transferToInterpreter(); + throw RError.getIncorrectNumProb(getEncapsulatingSourceSection()); + } + + @Specialization(order = 80, guards = {"!invalidFirstArgumentNullProb", "!invalidSizeArgument", "!largerPopulation"}) + public RIntVector doSample(final int x, final int size, final byte isRepeatable, @SuppressWarnings("unused") final RNull prob) { + // TODO:Add support of long integers. + // The following code is transcribed from GNU R src/main/random.c lines 533-545 in + // function do_sample. + int[] result = new int[size]; + /* avoid allocation for a single sample */ + if (isRepeatable == RRuntime.LOGICAL_TRUE || size < 2) { + for (int i = 0; i < size; i++) { + result[i] = (int) (x * RRNG.unifRand() + 1); + } + } else { + int n = x; + int[] ix = new int[x]; + for (int i = 0; i < x; i++) { + ix[i] = i; + } + for (int i = 0; i < size; i++) { + int j = (int) (n * RRNG.unifRand()); + result[i] = ix[j] + 1; + ix[j] = ix[--n]; + } + } + return RDataFactory.createIntVector(result, true); + } + + @SuppressWarnings("unused") + @Specialization(order = 100, guards = "invalidIsRepeatable") + public RIntVector doSampleInvalidIsRepeatable(final int x, final int size, final byte isRepeatable, final RDoubleVector prob) { + CompilerDirectives.transferToInterpreter(); + throw RError.getInvalidArgument(getEncapsulatingSourceSection(), RRuntime.toString(isRepeatable)); + } + + private void fixupProbability(double[] probArray, int x, int size, byte isRepeatable) { + // The following code is transcribed from GNU R src/main/random.c lines 429-449 + int nonZeroProbCount = 0; + double probSum = 0; + for (double aProb : probArray) { + if (!RRuntime.isFinite(aProb)) { + throw RError.getNAInProbVector(getEncapsulatingSourceSection()); + } + if (aProb < 0) { + throw RError.getNegativeProbability(getEncapsulatingSourceSection()); + } + if (aProb > 0) { + probSum += aProb; + nonZeroProbCount++; + } + } + if (nonZeroProbCount == 0 || (isRepeatable == RRuntime.LOGICAL_FALSE && size > nonZeroProbCount)) { + throw RError.getTooFewPositiveProbability(getEncapsulatingSourceSection()); + } + for (int i = 0; i < x; i++) { + probArray[i] /= probSum; + } + } + + @SuppressWarnings("unused") + protected static boolean invalidFirstArgumentNullProb(final int x, final int size, final byte isRepeatable, final RNull prob) { + return !RRuntime.isFinite(x) || x < 0 || x > 4.5e15 || (size > 0 && x == 0); + } + + @SuppressWarnings("unused") + protected static boolean invalidSizeArgument(final int x, final int size, final byte isRepeatable, final RNull prob) { + return RRuntime.isNA(size) || size < 0; + } + + @SuppressWarnings("unused") + protected static boolean largerPopulation(final int x, final int size, final byte isRepeatable, final RNull prob) { + return isRepeatable == RRuntime.LOGICAL_FALSE && size > x; + } + + @SuppressWarnings("unused") + protected static boolean invalidFirstArgument(final int x, final int size, final byte isRepeatable, final RDoubleVector prob) { + return RRuntime.isNA(x) || x < 0 || (size > 0 && x == 0); + } + + @SuppressWarnings("unused") + protected static boolean invalidSizeArgument(final int x, final int size, final byte isRepeatable, final RDoubleVector prob) { + return RRuntime.isNA(size) || size < 0; + } + + @SuppressWarnings("unused") + protected static boolean invalidProb(final int x, final int size, final byte isRepeatable, final RDoubleVector prob) { + return prob.getLength() != x; + } + + @SuppressWarnings("unused") + protected static boolean withReplacement(final int x, final int size, final byte isRepeatable, final RDoubleVector prob) { + return isRepeatable == RRuntime.LOGICAL_TRUE; + } + + @SuppressWarnings("unused") + protected static boolean largerPopulation(final int x, final int size, final byte isRepeatable, final RDoubleVector prob) { + return isRepeatable == RRuntime.LOGICAL_FALSE && size > x; + } + + @SuppressWarnings("unused") + protected static boolean invalidIsRepeatable(final int x, final int size, final byte isRepeatable, final RDoubleVector prob) { + return RRuntime.isNA(isRepeatable); + } + + private int[] probSampleReplace(int n, double[] probArray, int resultSize) { + // The following code is transcribed from GNU R src/main/random.c lines 309-335 + int[] result = new int[resultSize]; + int[] perm = new int[n]; + + for (int i = 0; i < n; i++) { + perm[i] = i + 1; + } + heapSort(perm, probArray); + for (int i = 1; i < n; i++) { + probArray[i] += probArray[i - 1]; + } + for (int i = 0; i < resultSize; i++) { + int j = 0; + double rU = RRNG.unifRand(); + for (j = 0; j < n - 1; j++) { + if (rU <= probArray[j]) { + break; + } + } + result[i] = perm[j]; + } + return result; + } + + private int[] probSampleWithoutReplace(int n, double[] probArray, int resultSize) { + // The following code is transcribed from GNU R src/main/random.c lines 396-428 + int[] ans = new int[resultSize]; + int[] perm = new int[n]; + for (int i = 0; i < n; i++) { + perm[i] = i + 1; + } + heapSort(perm, probArray); + double totalMass = 1; + for (int i = 0, n1 = n - 1; i < resultSize; i++, n1--) { + double rT = totalMass * RRNG.unifRand(); + double mass = 0; + int j = 0; + for (j = 0; j < n1; j++) { + mass += probArray[j]; + if (rT <= mass) { + break; + } + } + ans[i] = perm[j]; + totalMass -= probArray[j]; + for (int k = j; k < n1; k++) { + probArray[k] = probArray[k + 1]; + perm[k] = perm[k + 1]; + } + } + return ans; + } + + private void buildheap(double[] keys, int[] values) { + for (int i = (keys.length >> 1); i >= 0; i--) { + minHeapify(keys, i, keys.length, values); + } + } + + private void minHeapify(double[] keys, int currentIndex, int heapSize, int[] values) { + int leftChildIndex = currentIndex << 1; + int rightChildIndex = leftChildIndex + 1; + int lowestElementIndex = currentIndex; + if (leftChildIndex < heapSize && keys[leftChildIndex] < keys[currentIndex]) { + lowestElementIndex = leftChildIndex; + } + if (rightChildIndex < heapSize && keys[rightChildIndex] < keys[currentIndex]) { + lowestElementIndex = rightChildIndex; + } + if (lowestElementIndex != currentIndex) { + exchange(keys, currentIndex, lowestElementIndex, values); + minHeapify(keys, lowestElementIndex, heapSize, values); + } + } + + private static void exchange(double[] keys, int i, int j, int[] values) { + double c = keys[i]; + keys[i] = keys[j]; + keys[j] = c; + int temp = values[i]; + values[i] = values[j]; + values[j] = temp; + } + + private void heapSort(int[] values, double[] keys) { + buildheap(keys, values); + for (int i = keys.length - 1; i > 0; i--) { + exchange(keys, 0, i, values); + minHeapify(keys, 0, i, values); + } + } +} diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UpdateLevels.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UpdateLevels.java new file mode 100644 index 0000000000000000000000000000000000000000..ff551e79c2b09dec43ef31e0e2959921e2264566 --- /dev/null +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UpdateLevels.java @@ -0,0 +1,38 @@ +/* + * This material is distributed under the GNU General Public License + * Version 2. You may review the terms of this license at + * http://www.gnu.org/licenses/gpl-2.0.html + * + * Copyright (c) 2014, Purdue University + * Copyright (c) 2014, Oracle and/or its affiliates + * + * All rights reserved. + */ + +package com.oracle.truffle.r.nodes.builtin.base; + +import com.oracle.truffle.api.dsl.*; +import com.oracle.truffle.r.nodes.builtin.*; +import com.oracle.truffle.r.runtime.data.*; +import com.oracle.truffle.r.runtime.data.model.*; + +@RBuiltin(name = "levels<-", kind = RBuiltinKind.PRIMITIVE) +public abstract class UpdateLevels extends RInvisibleBuiltinNode { + + @Specialization + public RAbstractVector updateLevels(RAbstractVector vector, @SuppressWarnings("unused") RNull levels) { + controlVisibility(); + RVector v = vector.materialize(); + v.setLevels(null); + return v; + } + + @Specialization + public RAbstractVector updateLevels(RAbstractVector vector, Object levels) { + controlVisibility(); + RVector v = vector.materialize(); + v.setLevels(levels); + return v; + + } +} diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java index ef04684454005a1eb4135976b04ae9071e6e32ef..d0dce5e015ec475eeb3b075e84df3a16c2197c72 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java @@ -235,6 +235,13 @@ public abstract class RError extends RuntimeException { private static final String USE_DEFUNCT = "use of '%s' is defunct: use %s instead"; private static final String NCOL_ZERO = "nc = 0 for non-null data"; private static final String NROW_ZERO = "nr = 0 for non-null data"; + private static final String SAMPLE_LARGER_THAN_POPULATION = "cannot take a sample larger than the population when 'replace = FALSE'\n"; + private static final String SAMPLE_OBJECT_NOT_FOUND = "object '%s' not found"; + private static final String ERROR_IN_SAMPLE = "Error in sample.int(x, size, replace, prob) : "; + private static final String INCORRECT_NUM_PROB = "incorrect number of probabilities"; + private static final String NA_IN_PROB_VECTOR = "NA in probability vector"; + private static final String NEGATIVE_PROBABILITY = "non-positive probability"; + private static final String TOO_FEW_POSITIVE_PROBABILITY = "too few positive probabilities"; // not exactly // GNU-R message public static final String DOTS_BOUNDS = "The ... list does not contain %s elements"; @@ -2146,7 +2153,35 @@ public abstract class RError extends RuntimeException { return getGenericError(encapsulatingSourceSection, NCOL_ZERO); } + public static RError getLargerPopu(SourceSection encapsulatingSourceSection) { + return getGenericError(encapsulatingSourceSection, SAMPLE_LARGER_THAN_POPULATION); + } + + public static RError getErrorInSample(SourceSection encapsulatingSourceSection) { + return getGenericError(encapsulatingSourceSection, ERROR_IN_SAMPLE); + } + + public static RError get(SourceSection ast, String argName) { + return getGenericError(ast, stringFormat(RError.SAMPLE_OBJECT_NOT_FOUND, argName)); + } + + public static RError getIncorrectNumProb(SourceSection encapsulatingSourceSection) { + return getGenericError(encapsulatingSourceSection, INCORRECT_NUM_PROB); + } + public static RError getNrowZero(SourceSection encapsulatingSourceSection) { return getGenericError(encapsulatingSourceSection, NROW_ZERO); } + + public static RError getNAInProbVector(SourceSection encapsulatingSourceSection) { + return getGenericError(encapsulatingSourceSection, NA_IN_PROB_VECTOR); + } + + public static RError getNegativeProbability(SourceSection encapsulatingSourceSection) { + return getGenericError(encapsulatingSourceSection, NEGATIVE_PROBABILITY); + } + + public static RError getTooFewPositiveProbability(SourceSection encapsulatingSourceSection) { + return getGenericError(encapsulatingSourceSection, TOO_FEW_POSITIVE_PROBABILITY); + } } diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RRuntime.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RRuntime.java index 782061241cd018420a1d749909eae32c989d02e1..bcf04a2e335dbe40df80027e5c4f8b89a727a913 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RRuntime.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RRuntime.java @@ -105,6 +105,9 @@ public class RRuntime { public static final String NAMES_ATTR_KEY = new String("names"); public static final String NAMES_ATTR_EMPTY_VALUE = ""; + + public static final String LEVELS_ATTR_KEY = new String("levels"); + public static final String LEVELS_ATTR_EMPTY_VALUE = ""; public static final String NA_HEADER = "<NA>"; diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RVector.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RVector.java index 103bc2986b7f24e4989898fc5f259ace07b774db..515a2ac8ea0bf45a14ed9a9d87cfad8b77e29aeb 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RVector.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RVector.java @@ -206,6 +206,16 @@ public abstract class RVector extends RBounded implements RShareable, RAttributa } } + public void setLevels(Object newLevels) { + if (attributes != null && newLevels == null) { + // whether it's one dimensional array or not, assigning null always removes the "Levels" + // attribute + removeAttributeMapping(RRuntime.LEVELS_ATTR_KEY); + } else if (newLevels != null && newLevels != RNull.instance) { + putAttribute(RRuntime.LEVELS_ATTR_KEY, newLevels); + } + } + public final void setNames(Object newNames) { setNames(newNames, null); } diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test index 7abc6f47e250aafd15e814377f34546c345f607a..253ed91af891e46a5dd28acf4e3a5f8d60ce99bc 100644 --- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test @@ -6604,6 +6604,46 @@ a a b 7 42 NA NA +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testLevels +#{ x <- 1 ; levels(x)<-"a"; levels(x);} +[1] "a" + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testLevels +#{ x <- 1 ; levels(x)<-1; levels(x);} +[1] 1 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testLevels +#{ x <- 1 ; levels(x)<-4.5; levels(x);} +[1] 4.5 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testLevels +#{ x <- 1 ; levels(x)<-NULL; levels(x)} +NULL + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testLevels +#{ x <- 1 ; levels(x)<-c("cat", "dog"); levels(x)} +[1] "cat" "dog" + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testLevels +#{ x <- 1 ; levels(x)<-c(1); levels(x);} +[1] 1 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testLevels +#{ x <- 1 ; levels(x)<-c(1, "cat", 4.5, "3"); levels(x);} +[1] "1" "cat" "4.5" "3" + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testLevels +#{ x <- 1 ; levels(x)<-c(3, "cat"); levels(x);} +[1] "3" "cat" + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testLevels +#{ x <- 5 ; levels(x)<-"catdog"; levels(x);} +[1] "catdog" + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testLevels +#{ x <- 5 ; levels(x)<-c(1,2,3); levels(x);} +[1] 1 2 3 + ##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testList #{ list(1, b=2) } [[1]] @@ -8711,6 +8751,75 @@ numeric(0) #{ round(c(0,0.2,0.4,0.6,0.8,1)) } [1] 0 0 0 1 1 1 +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(4357, "default"); x <- 5 ; sample(x, 5, FALSE, NULL) ;} +[1] 3 4 5 2 1 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(4357, "default"); x <- 5 ; sample(x, 5, TRUE, NULL) ;} +[1] 3 5 5 4 2 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(4357, "default"); x <- c(5, "cat"); sample(x, 2, TRUE, NULL) ;} +[1] "5" "cat" + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(4357, "default"); x <- 5 ; prob <- c(.1, .2, .3, .2, .1); sample(x, 10, TRUE, prob) ; } + [1] 2 5 5 4 2 5 1 2 2 4 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(4357, "default"); x <- 5 ; prob <- c(.2, .2, .2, .2, .2 ); sample(x, 5, FALSE, prob) ; } +[1] 4 1 5 3 2 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(4357, "default"); x <- 5 ; prob <- c(.5, .5, .5, .5, .5); sample(x, 5, FALSE, prob) ; } +[1] 4 1 5 3 2 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(4357, "default"); x <- c("Heads", "Tails"); prob <- c(.3, .7) ; sample(x, 10, TRUE, prob) ; } + [1] "Tails" "Heads" "Heads" "Tails" "Tails" "Heads" "Heads" "Tails" "Tails" +[10] "Tails" + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(4357, "default"); x <- c(5, "cat"); sample(x, 2, FALSE, NULL) ;} +[1] "5" "cat" + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(4357, "default"); x <- c(5, "cat"); sample(x, 3, TRUE, NULL) ;} +[1] "5" "cat" "cat" + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(9567, "Marsaglia-Multicarry"); x <- 5 ; prob <- c(.1, .2, .3, .2, .1) ; sample(x, 10, TRUE, prob) ; } + [1] 4 3 4 1 3 2 1 5 1 5 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(9567, "Marsaglia-Multicarry"); x <- 5 ; prob <- c(.2, .2, .2, .2, .2 ) ; sample(x, 5, FALSE, prob) ; } +[1] 5 2 1 4 3 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(9567, "Marsaglia-Multicarry"); x <- 5 ; prob <- c(.5, .5, .5, .5, .5) ; sample(x, 5, FALSE, prob) ; } +[1] 5 2 1 4 3 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(9567, "Marsaglia-Multicarry"); x <- 5; sample(x, 5, FALSE, NULL) ;} +[1] 4 1 3 2 5 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(9567, "Marsaglia-Multicarry"); x <- 5; sample(x, 5, TRUE, NULL) ;} +[1] 4 1 4 5 1 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(9567, "Marsaglia-Multicarry"); x <- c(5, "cat") ; sample(x, 2, FALSE, NULL) ;} +[1] "cat" "5" + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(9567, "Marsaglia-Multicarry"); x <- c(5, "cat") ; sample(x, 2, TRUE, NULL) ;} +[1] "cat" "5" + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSample +#{ set.seed(9567, "Marsaglia-Multicarry"); x <- c(5, "cat") ; sample(x, 3, TRUE, NULL) ;} +[1] "cat" "5" "cat" + ##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSapply #{ f <- function() { sapply(1:3,function(x){x*2L}) }; f() + f() } [1] 4 8 12 diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/all/AllTests.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/all/AllTests.java index 5ecaf663fedae15cde22919c4655efbe12a93ba6..145764bdc402e070c40e2b183df08b56c09ae703 100644 --- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/all/AllTests.java +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/all/AllTests.java @@ -7828,6 +7828,56 @@ public class AllTests extends TestBase { assertEval("{ x<-c(a=7, b=42); length(x)<-1; x }"); } + @Test + public void TestSimpleBuiltins_testLevels_51c26a8220d13774c5325dc2085f1618() { + assertEval("{ x <- 1 ; levels(x)<-\"a\"; levels(x);}"); + } + + @Test + public void TestSimpleBuiltins_testLevels_51f6cf406202bae702b29b921fe361b1() { + assertEval("{ x <- 5 ; levels(x)<-\"catdog\"; levels(x);}"); + } + + @Test + public void TestSimpleBuiltins_testLevels_b564b429e63c911c91bc8db94aa89d0f() { + assertEval("{ x <- 1 ; levels(x)<-NULL; levels(x)}"); + } + + @Test + public void TestSimpleBuiltins_testLevels_12df55f19c55d781ba430c8453f932c6() { + assertEval("{ x <- 1 ; levels(x)<-1; levels(x);}"); + } + + @Test + public void TestSimpleBuiltins_testLevels_d0a86f43e4bb2b660b664bb3b6389dbe() { + assertEval("{ x <- 1 ; levels(x)<-4.5; levels(x);}"); + } + + @Test + public void TestSimpleBuiltins_testLevels_43af0170cc4eea0fd0d0738181c5dc3a() { + assertEval("{ x <- 1 ; levels(x)<-c(1); levels(x);}"); + } + + @Test + public void TestSimpleBuiltins_testLevels_feaabb001e0cb8df03f7be5848798557() { + assertEval("{ x <- 5 ; levels(x)<-c(1,2,3); levels(x);}"); + } + + @Test + public void TestSimpleBuiltins_testLevels_8900e17291cec47d742595d19d66d169() { + assertEval("{ x <- 1 ; levels(x)<-c(\"cat\", \"dog\"); levels(x)}"); + } + + @Test + public void TestSimpleBuiltins_testLevels_93213b1d33f245aacf5049287da65a3a() { + assertEval("{ x <- 1 ; levels(x)<-c(3, \"cat\"); levels(x);}"); + } + + @Test + public void TestSimpleBuiltins_testLevels_a57b41564aaaf1d0686f4d04c60eec94() { + assertEval("{ x <- 1 ; levels(x)<-c(1, \"cat\", 4.5, \"3\"); levels(x);}"); + } + @Test public void TestSimpleBuiltins_testList_c74b9ee71e8970c28a28d0daff0eeb0f() { assertEval("{ list(a=1, b=2) }"); @@ -10338,6 +10388,126 @@ public class AllTests extends TestBase { assertEval("{ a = rowSums(array(1:24,c(2,3,4))); c(a[1],a[2]) }"); } + @Test + public void TestSimpleBuiltins_testSample_4ff6bda9510551be806260a91f29d66a() { + assertEval("{ set.seed(4357, \"default\"); x <- 5 ; sample(x, 5, TRUE, NULL) ;}"); + } + + @Test + public void TestSimpleBuiltins_testSample_7d15c43b3d043034eab7b73140e1cf37() { + assertEval("{ set.seed(4357, \"default\"); x <- 5 ; sample(x, 5, FALSE, NULL) ;}"); + } + + @Test + public void TestSimpleBuiltins_testSample_dcc747e817ac6dfb48a4cfe58ab530a1() { + assertEval("{ set.seed(4357, \"default\"); x <- c(5, \"cat\"); sample(x, 2, TRUE, NULL) ;}"); + } + + @Test + public void TestSimpleBuiltins_testSample_5db44efede9eccb3844c2a664fdfb613() { + assertEval("{ set.seed(4357, \"default\"); x <- c(5, \"cat\"); sample(x, 2, FALSE, NULL) ;}"); + } + + @Test + public void TestSimpleBuiltins_testSample_ae46a6860ad161f9d1b365edd6733b48() { + assertEval("{ set.seed(4357, \"default\"); x <- c(5, \"cat\"); sample(x, 3, TRUE, NULL) ;}"); + } + + @Test + public void TestSimpleBuiltins_testSample_e9e71c268121741bbebdc93fe3aeeca2() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- 5; sample(x, 5, TRUE, NULL) ;}"); + } + + @Test + public void TestSimpleBuiltins_testSample_380de40128e214239e48bd8a9582f2b3() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- 5; sample(x, 5, FALSE, NULL) ;}"); + } + + @Test + public void TestSimpleBuiltins_testSample_4151d2a38fea7d8e89b9294821bf801d() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- c(5, \"cat\") ; sample(x, 2, TRUE, NULL) ;}"); + } + + @Test + public void TestSimpleBuiltins_testSample_f9a3a95a8ce4b1634718d2bdadf55059() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- c(5, \"cat\") ; sample(x, 2, FALSE, NULL) ;}"); + } + + @Test + public void TestSimpleBuiltins_testSample_95f2b8b4b242402b0e8a215e80f0901f() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- c(5, \"cat\") ; sample(x, 3, TRUE, NULL) ;}"); + } + + @Test + public void TestSimpleBuiltins_testSample_ec1b2a0d90f3dfaa4954b34e9f0eb188() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- 5 ; prob <- c(.1, .2, .3, .2, .1) ; sample(x, 10, TRUE, prob) ; }"); + } + + @Test + public void TestSimpleBuiltins_testSample_baf0f9fc33df9324c96b03a18647b595() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- 5 ; prob <- c(.5, .5, .5, .5, .5) ; sample(x, 5, FALSE, prob) ; }"); + } + + @Test + public void TestSimpleBuiltins_testSample_b37922d5b3d4e6177f75c6ccd3a7fd56() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- 5 ; prob <- c(.2, .2, .2, .2, .2 ) ; sample(x, 5, FALSE, prob) ; }"); + } + + @Test + public void TestSimpleBuiltins_testSample_756246d0e7c35e8aa71be5fb6307cb72() { + assertEval("{ set.seed(4357, \"default\"); x <- c(\"Heads\", \"Tails\"); prob <- c(.3, .7) ; sample(x, 10, TRUE, prob) ; }"); + } + + @Test + public void TestSimpleBuiltins_testSample_537b4f38f3640bbfa1b50ae75f90263c() { + assertEval("{ set.seed(4357, \"default\"); x <- 5 ; prob <- c(.1, .2, .3, .2, .1); sample(x, 10, TRUE, prob) ; }"); + } + + @Test + public void TestSimpleBuiltins_testSample_23c57d8cc4f196725a722d2b6727e522() { + assertEval("{ set.seed(4357, \"default\"); x <- 5 ; prob <- c(.5, .5, .5, .5, .5); sample(x, 5, FALSE, prob) ; }"); + } + + @Test + public void TestSimpleBuiltins_testSample_d02968add548f0fe4e773d609cb0ffea() { + assertEval("{ set.seed(4357, \"default\"); x <- 5 ; prob <- c(.2, .2, .2, .2, .2 ); sample(x, 5, FALSE, prob) ; }"); + } + + @Test + public void TestSimpleBuiltins_testSampleIgnore_ff42abcbf4f968c27e32a7dd28eda044() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\");x <- c(5) ; prob <- c(1, 2, 3, 4, 5) ; sample(x, 5, TRUE, prob) ; }"); + } + + @Test + public void TestSimpleBuiltins_testSampleIgnore_c0abb95d78ba54d518dba3716e78f683() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\");x <- c(5) ; prob <- c(1, 2, 3, 4, 5) ; sample(x, 5, FALSE, prob) ; }"); + } + + @Test + public void TestSimpleBuiltins_testSampleIgnore_b703c1a90d66f9baf7ccbe08919f69d1() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\");x <- c(\"Heads\", \"Tails\") ; prob <- c(.3, .7) ; sample(x, 10, TRUE, prob) ; }"); + } + + @Test + public void TestSimpleBuiltins_testSampleIgnore_c90feee3f3b3a20606e1b43eab8afb31() { + assertEval("{ set.seed(4357, \"default\"); x <- c(5) ; prob <- c(1, 2, 3, 4, 5) ; sample(x, 5, TRUE, prob) ; }"); + } + + @Test + public void TestSimpleBuiltins_testSampleIgnore_18482bc15a1e30cd46e5be81317a3374() { + assertEval("{ set.seed(4357, \"default\"); x <- c(5) ; prob <- c(1, 2, 3, 4, 5) ; sample(x, 5, FALSE, prob) ; }"); + } + + @Test + public void TestSimpleBuiltins_testSampleIgnore_38b963b6f50f4a4d9e1250d1df321b43() { + assertEval("{ set.seed(4357, \"default\"); x <- 5 ; sample(x, 6, FALSE, NULL) ;}"); + } + + @Test + public void TestSimpleBuiltins_testSampleIgnore_2935bb73d988381d4ae52f265101577a() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- 5 ; sample(x, 6, FALSE, NULL) ;}"); + } + @Test public void TestSimpleBuiltins_testSapply_d1488c6ad2fa1184247d106e5336622c() { assertEval("{ f <- function() { sapply(1:3,function(x){x*2L}) }; f() + f() }"); @@ -10738,6 +10908,16 @@ public class AllTests extends TestBase { assertEval("{ seq(along=c(10,11,12)) }"); } + @Test + public void TestSimpleBuiltins_testSetAttr_4c035922fa30fd65161fe53e1af97368() { + assertEval("{ x <- NULL; levels(x)<-\"dog\"; levels(x)}"); + } + + @Test + public void TestSimpleBuiltins_testSetAttr_d3a803a8bcf4ca34f3f28cc87c530aef() { + assertEval("{ x <- 1 ; levels(x)<-NULL; levels(notx)}"); + } + @Test public void TestSimpleBuiltins_testSimpleRm_ca7a9f28edcdd3c7bf66a0b3735a11dc() { assertEval("{ x <- 200 ; rm(\"x\") }"); diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/failing/FailingTests.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/failing/FailingTests.java index 54995a771b8af061f6b747ca1446f4ac2c38e275..1ebe1e202fc5bb43a8a5707c24bf96a94d0d1d44 100644 --- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/failing/FailingTests.java +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/failing/FailingTests.java @@ -1948,6 +1948,41 @@ public class FailingTests extends TestBase { assertEval("{ a = rowSums(array(1:24,c(2,3,4))); c(a[1],a[2]) }"); } + @Ignore + public void TestSimpleBuiltins_testSampleIgnore_ff42abcbf4f968c27e32a7dd28eda044() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\");x <- c(5) ; prob <- c(1, 2, 3, 4, 5) ; sample(x, 5, TRUE, prob) ; }"); + } + + @Ignore + public void TestSimpleBuiltins_testSampleIgnore_c0abb95d78ba54d518dba3716e78f683() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\");x <- c(5) ; prob <- c(1, 2, 3, 4, 5) ; sample(x, 5, FALSE, prob) ; }"); + } + + @Ignore + public void TestSimpleBuiltins_testSampleIgnore_b703c1a90d66f9baf7ccbe08919f69d1() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\");x <- c(\"Heads\", \"Tails\") ; prob <- c(.3, .7) ; sample(x, 10, TRUE, prob) ; }"); + } + + @Ignore + public void TestSimpleBuiltins_testSampleIgnore_c90feee3f3b3a20606e1b43eab8afb31() { + assertEval("{ set.seed(4357, \"default\"); x <- c(5) ; prob <- c(1, 2, 3, 4, 5) ; sample(x, 5, TRUE, prob) ; }"); + } + + @Ignore + public void TestSimpleBuiltins_testSampleIgnore_18482bc15a1e30cd46e5be81317a3374() { + assertEval("{ set.seed(4357, \"default\"); x <- c(5) ; prob <- c(1, 2, 3, 4, 5) ; sample(x, 5, FALSE, prob) ; }"); + } + + @Ignore + public void TestSimpleBuiltins_testSampleIgnore_38b963b6f50f4a4d9e1250d1df321b43() { + assertEval("{ set.seed(4357, \"default\"); x <- 5 ; sample(x, 6, FALSE, NULL) ;}"); + } + + @Ignore + public void TestSimpleBuiltins_testSampleIgnore_2935bb73d988381d4ae52f265101577a() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- 5 ; sample(x, 6, FALSE, NULL) ;}"); + } + @Ignore public void TestSimpleBuiltins_testSapplyIgnore_e30b8dbeaaac291438d9893765622dcc() { assertEval("{ f<-function(g) { sapply(1:3, g) } ; f(function(x) { x*2 }) ; f(function(x) { TRUE }) }"); @@ -2148,6 +2183,16 @@ public class FailingTests extends TestBase { assertEval("{ seq(along=c(10,11,12)) }"); } + @Ignore + public void TestSimpleBuiltins_testSetAttr_4c035922fa30fd65161fe53e1af97368() { + assertEval("{ x <- NULL; levels(x)<-\"dog\"; levels(x)}"); + } + + @Ignore + public void TestSimpleBuiltins_testSetAttr_d3a803a8bcf4ca34f3f28cc87c530aef() { + assertEval("{ x <- 1 ; levels(x)<-NULL; levels(notx)}"); + } + @Ignore public void TestSimpleBuiltins_testSortIgnore_6a592c6f57c71c5d15a2ca0155fee884() { assertEval("{ sort(c(1,2,0/0,NA)) }"); diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/simple/TestSimpleBuiltins.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/simple/TestSimpleBuiltins.java index 2730c86d2cd4d762a6889bdf13fd9c368655afc8..0eb49beacd19b7cbc8be1048322fa621328e783c 100644 --- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/simple/TestSimpleBuiltins.java +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/simple/TestSimpleBuiltins.java @@ -18,6 +18,14 @@ import com.oracle.truffle.r.test.*; public class TestSimpleBuiltins extends TestBase { + @Test + @Ignore + public void testSetAttr() { + assertEval("{ x <- NULL; levels(x)<-\"dog\"; levels(x)}"); + assertEval("{ x <- 1 ; levels(x)<-NULL; levels(notx)}"); + + } + @Test public void testSequence() { assertEval("{ 5L:10L }"); @@ -3014,4 +3022,59 @@ public class TestSimpleBuiltins extends TestBase { assertEval("{ which.max(c(5:1))}"); assertEval("{ which.max(c(1:10000))}"); } + + @Test + public void testSample() { + assertEval("{ set.seed(4357, \"default\"); x <- 5 ; sample(x, 5, TRUE, NULL) ;}"); + assertEval("{ set.seed(4357, \"default\"); x <- 5 ; sample(x, 5, FALSE, NULL) ;}"); + + assertEval("{ set.seed(4357, \"default\"); x <- c(5, \"cat\"); sample(x, 2, TRUE, NULL) ;}"); + assertEval("{ set.seed(4357, \"default\"); x <- c(5, \"cat\"); sample(x, 2, FALSE, NULL) ;}"); + assertEval("{ set.seed(4357, \"default\"); x <- c(5, \"cat\"); sample(x, 3, TRUE, NULL) ;}"); + + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- 5; sample(x, 5, TRUE, NULL) ;}"); + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- 5; sample(x, 5, FALSE, NULL) ;}"); + + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- c(5, \"cat\") ; sample(x, 2, TRUE, NULL) ;}"); + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- c(5, \"cat\") ; sample(x, 2, FALSE, NULL) ;}"); + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- c(5, \"cat\") ; sample(x, 3, TRUE, NULL) ;}"); + + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- 5 ; prob <- c(.1, .2, .3, .2, .1) ; sample(x, 10, TRUE, prob) ; }"); + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- 5 ; prob <- c(.5, .5, .5, .5, .5) ; sample(x, 5, FALSE, prob) ; }"); + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- 5 ; prob <- c(.2, .2, .2, .2, .2 ) ; sample(x, 5, FALSE, prob) ; }"); + + assertEval("{ set.seed(4357, \"default\"); x <- c(\"Heads\", \"Tails\"); prob <- c(.3, .7) ; sample(x, 10, TRUE, prob) ; }"); + assertEval("{ set.seed(4357, \"default\"); x <- 5 ; prob <- c(.1, .2, .3, .2, .1); sample(x, 10, TRUE, prob) ; }"); + assertEval("{ set.seed(4357, \"default\"); x <- 5 ; prob <- c(.5, .5, .5, .5, .5); sample(x, 5, FALSE, prob) ; }"); + assertEval("{ set.seed(4357, \"default\"); x <- 5 ; prob <- c(.2, .2, .2, .2, .2 ); sample(x, 5, FALSE, prob) ; }"); + } + + @Test + @Ignore + public void testSampleIgnore() { + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\");x <- c(5) ; prob <- c(1, 2, 3, 4, 5) ; sample(x, 5, TRUE, prob) ; }"); + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\");x <- c(5) ; prob <- c(1, 2, 3, 4, 5) ; sample(x, 5, FALSE, prob) ; }"); + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\");x <- c(\"Heads\", \"Tails\") ; prob <- c(.3, .7) ; sample(x, 10, TRUE, prob) ; }"); + assertEval("{ set.seed(4357, \"default\"); x <- c(5) ; prob <- c(1, 2, 3, 4, 5) ; sample(x, 5, TRUE, prob) ; }"); + assertEval("{ set.seed(4357, \"default\"); x <- c(5) ; prob <- c(1, 2, 3, 4, 5) ; sample(x, 5, FALSE, prob) ; }"); + + // Fails because of error message mismatch. + assertEval("{ set.seed(4357, \"default\"); x <- 5 ; sample(x, 6, FALSE, NULL) ;}"); + assertEval("{ set.seed(9567, \"Marsaglia-Multicarry\"); x <- 5 ; sample(x, 6, FALSE, NULL) ;}"); + } + + @Test + public void testLevels() { + assertEval("{ x <- 1 ; levels(x)<-\"a\"; levels(x);}"); + assertEval("{ x <- 5 ; levels(x)<-\"catdog\"; levels(x);}"); + assertEval("{ x <- 1 ; levels(x)<-NULL; levels(x)}"); + assertEval("{ x <- 1 ; levels(x)<-1; levels(x);}"); + assertEval("{ x <- 1 ; levels(x)<-4.5; levels(x);}"); + assertEval("{ x <- 1 ; levels(x)<-c(1); levels(x);}"); + assertEval("{ x <- 5 ; levels(x)<-c(1,2,3); levels(x);}"); + assertEval("{ x <- 1 ; levels(x)<-c(\"cat\", \"dog\"); levels(x)}"); + assertEval("{ x <- 1 ; levels(x)<-c(3, \"cat\"); levels(x);}"); + assertEval("{ x <- 1 ; levels(x)<-c(1, \"cat\", 4.5, \"3\"); levels(x);}"); + } + } diff --git a/mx.fastr/copyrights/overrides b/mx.fastr/copyrights/overrides index 8f4677341997a508ca4ba54971199503ecff03b7..4233cd65d4ca9d667aa60940d29caaa18363ced3 100644 --- a/mx.fastr/copyrights/overrides +++ b/mx.fastr/copyrights/overrides @@ -17,8 +17,10 @@ com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Prod.java com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/RepeatLength.java,purdue.copyright com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/S3DispatchNode.java,purdue.copyright com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/S3MethodDispatch.java,purdue.copyright +com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Sample.java,purdue.copyright com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UnClass.java,purdue.copyright com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UpdateClass.java,purdue.copyright +com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UpdateLevels.java,purdue.copyright com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UpdateStorageMode.java,purdue.copyright com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UseMethod.java,purdue.copyright com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UseMethodDispatchNode.java,purdue.copyright