tests/testthat/test.R
In stefan-m-lenz/JuliaConnectoR: A Functionally Oriented Interface for Integrating 'Julia' with R
Sys.unsetenv("R_TESTS")
test_that("Some smoke tests", {
expect_equal(juliaCall("prod", c(1,2,3)), 6)
juliaEval("")
juliaCall("string", list())
juliaCall("string", list(as.integer(1), "bla" = 23L))
juliaEval("String[]")
expect(!is.null(juliaEval("using Random; Random.seed!(5)")),
"Must be able to set random seed")
expect(is.null(juliaEval("Random.seed!(5);")),
"Eval with semicolon at end returns NULL")
})
test_that("Output is transferred", {
output <- capture_output({
juliaCall("println", as.integer(22))
})
expect_match(output, "^[\n]*22[\n]*$")
output <- capture_output({
juliaCall("println", "hello world")
})
expect_match(output, "^[\n]*hello world[\n]*$")
})
test_that("Warnings are transferred", {
output <- capture.output(type = "message", {
juliaEval('@warn "This might be serious"')
})
expect_match(output[1], "This might be serious")
})
test_that("Warnings and normal output are both transferred and stable", {
stdoutput <- capture_output({
stderroutput <- capture.output(type = "message", {
juliaLet('for i = 1:100
println(join(rand(["1", "ä", "ö"], rand(1:100))));
println(stderr,join(rand(["2", "u", "a"], rand(1:100))));
end')
ret <- juliaLet('println(22); 17')
})
})
expect_match(stdoutput, "[1äö\n]+")
expect_match(stderroutput, "[2ua\n]+") # TODO problems with non-ascii-characters
stdoutput <- capture_output({
stderroutput <- capture.output(type = "message", {
ret <- juliaLet('println(22); @warn "This might be serious"; 17')
})
})
expect_equal(ret, 17)
expect_match(stdoutput[1], "^[\n]*22[\n]*$")
expect_match(stderroutput[1], "This might be serious")
})
test_that("A return value of nothing is not printed", {
output <- capture_output({
juliaEval("nothing")
juliaCall("identity", NULL)
juliaLet("x = y", y = NULL)
})
expect_match(output, "^[\n]*$")
})
test_that("Test loading and importing a complex package", {
skip_on_cran()
juliaEval('begin
using Pkg;
try
@eval import StatsBase
catch ex
Pkg.add("StatsBase")
end
end
') # tests also trailing whitespace
StatsBase <- juliaImport("StatsBase")
expect_equivalent(juliaGet(StatsBase$mean_and_var(c(1,2,3))), list(2,1))
StatsBase$renyientropy(rnorm(100), 1)
})
test_that("Error when trying to import a non-existent package or module", {
expect_error(juliaImport("NonExistingPkg"))
expect_error(capture.output({juliaImport(".NonExistingModule")}, type = "message"))
})
test_that("Error when passing multiple strings to import or using", {
expect_error(juliaImport(c("Pkg", "UUID")), regexp = "exactly one")
})
test_that("Example for juliaEval runs", {
v1 <- juliaExpr('v"1.0.5"')
v2 <- juliaExpr('v"1.3.0"')
expect(juliaCall("<", v1, v2), "Comparison must work")
})
test_that("Echo: empty R vector", {testEcho(c())})
test_that("Echo: double", {
expect(is.integer(juliaEcho(1L)), "Must be integer")
testEcho(1L)
})
test_that("Echo: Single Int", {
testEcho(1L)
expect(is.integer(juliaEval("1")), "1 is not integer")
testEcho(juliaEval("1"))
expect(is.double(juliaEval("2^52")), "2^52 is not double") # TODO inexactness?
testEcho(juliaEval("2^52"))
})
test_that("Echo: 1-element vector of Int in Julia", {testEcho(juliaEval("[1]"))})
test_that("Echo: Matrix of Int", {testEcho(matrix(1:6, nrow = 2))})
test_that("Echo: Single Float64", {
testEcho(juliaEval("1.0"))
testEcho(1)
})
test_that("UInt32, Float16, and Float32 translated to doubles in R", {
toTest <- c("Float16(1.5)", "Float16[]", "Float16[1.5]",
"Float32(1.5)", "Float32[]", "Float32[1.5]",
"UInt32(32)", "UInt32[]", "UInt32[32]")
for (expr in toTest) {
expect(is.double(juliaEval(expr)), "Must be double")
}
})
test_that("Echo: 0-element vector of Float64 in Julia", {testEcho(juliaEval("Float64[]"))})
test_that("Echo: 1-element vector of Float64 in Julia", {testEcho(juliaEval("[1.0]"))})
test_that("Echo: 2-element vector of Float64/double", {
testEcho(c(1, 2))
testEcho("[1.0; 2.0]")
})
test_that("Echo: matrix of Float64 in Julia", {
testEcho(juliaEval("[1.0 2.0; 3.0 4.0]"))
testEcho(matrix(c(1,2,3,4,4,5), nrow = 2))
})
test_that("Echo: 1-element vector of Float32 in Julia", {testEcho(juliaEval("[1.0f0]"))})
test_that("Echo: matrix of Float32 in Julia", {testEcho(juliaEval("[1.0f0 2.0f0; 3.0f0 4.0f0]"))})
test_that("Echo: 1-element vector of String in Julia", {testEcho(juliaEval('String["bla"]'))})
test_that("Echo: 0-element vector of String in Julia", {testEcho("String[]")})
test_that("Echo: 1-element vector of String in R", {testEcho("bla")})
test_that("Echo: 2-element vector of String in R", {testEcho(c("bla", "blup"))})
test_that("Echo: 2-element vector of String in Julia", {testEcho(juliaEval('String["bla", "blup"]'))})
test_that("Echo: String with missing values", {
x <- c("Yes", "No", NA)
y <- juliaEcho(x)
expect_true(is.na(y[3]))
x <- matrix(c("bla", NA, NA, "NA"), nrow = 2)
y <- juliaEcho(x)
expect_false(is.na(y[1,1]))
expect_true(is.na(y[1,2]))
expect_true(is.na(y[2,1]))
expect_false(is.na(y[2,2]))
})
test_that("Echo: Int vector with missing values", {
expect_true(juliaLet("x[1] == 1 && ismissing(x[2]) && x[3] == 3", x = c(1L,NA, 3L)))
expect_true(juliaLet("ismissing(x)", x = NA_integer_))
x <- juliaEval("[1 missing 3; 3 missing 4 ]")
expect_type(x, "integer")
expect_true(all(is.na(x[,2])))
expect_null(attr(x, "JLTYPE"))
x <- juliaEval("[2^52 missing 3; 2^53 missing 4 ]")
expect_type(x, "double")
expect_true(all(is.na(x[,2])))
expect_equal(x[1,1], 2^52)
expect_equal(x[2,1], 2^53)
testEcho(x)
x <- juliaEval("Union{Int32,Missing}[1 missing 3; 3 missing 4 ]")
expect_type(x, "integer")
expect_true(all(is.na(x[,2])))
expect_equal(x[1,1], 1)
expect_equal(x[2,1], 3)
testEcho(x)
x <- juliaEval("Union{Int16,Missing}[-1 missing 3; 3 missing 4 ]")
expect_type(x, "integer")
expect_true(all(is.na(x[,2])))
expect_equal(x[1,1], -1)
expect_equal(x[2,1], 3)
testEcho(x)
testEcho(c(1L, 2L, NA, NA))
testEcho(matrix(c(1L, 2L, NA, NA), nrow = 2))
})
test_that("Echo: Double vector with missing values", {
expect_true(juliaLet("x[1] == 1.0 && ismissing(x[2]) && x[3] == 3.0", x = c(1,NA, 3)))
expect_true(juliaLet("ismissing(x)", x = NA_integer_))
x <- juliaEval("[1.0 missing 3.0; 3.0 missing 4.0 ]")
expect_type(x, "double")
expect_true(all(is.na(x[,2])))
expect_null(attr(x, "JLTYPE"))
x <- juliaEval("Union{Float32,Missing}[1.0f0 missing 3.0f0; 3.0f0 missing 4.0f0 ]")
expect_true(all(is.na(x[,2])))
expect_equal(x[1,1], 1)
expect_equal(x[2,1], 3)
testEcho(x)
testEcho(c(1, 2, NA, NA))
testEcho(matrix(c(1, 2, NA, NA), nrow = 2))
})
test_that("Dirty missing values are recognized", {
dirtyNa <- c(as.raw(0xa2), as.raw(0x07), as.raw(0x00), as.raw(0x00),
as.raw(0x00), as.raw(0x00), as.raw(0xf8), as.raw(0x7f))
dirtyNA <- readBin(dirtyNa, what = "double", endian = "little")
expect_true(is.na(dirtyNA) && !is.nan(dirtyNA))
expect_true(juliaCall("ismissing", dirtyNA))
expect_true(juliaLet("ismissing(x[2])", x = c(1, dirtyNA)))
echoDirtyNA <- juliaEcho(dirtyNA)
expect_true(is.na(echoDirtyNA) && ! is.nan(echoDirtyNA))
dirtyComplexNA <- complex(real = dirtyNA, imaginary = dirtyNA)
expect_true(is.na(dirtyComplexNA) && !is.nan(dirtyComplexNA))
expect_true(juliaCall("ismissing", dirtyComplexNA))
x <- c(1+1i, dirtyComplexNA, NA)
expect_true(juliaLet("ismissing(x[2]) && ismissing(x[3])", x = x))
testEcho(x)
# The following doesn't work: dirtNA coerced to NA+0i, not NA+NA*i:
# expect_true(juliaLet("ismissing(x[2])", x = c(1+1i, dirtyNA)))
echoDirtyComplexNA <- juliaEcho(dirtyComplexNA)
expect_true(is.na(echoDirtyComplexNA) && !is.nan(echoDirtyComplexNA))
})
test_that("NaN and NA are handled differently", {
# NaN in R is translated to a NaN Float64 value in Julia
# NA in R is translated to a missing value in Julia
x <- juliaEval("[1; missing; NaN]")
expect_equal(x[1], 1)
expect_true(is.na(x[2]) && !is.nan(x[2]))
expect_true(is.nan(x[3]))
y <- juliaEcho(x)
expect_equal(y[1], 1)
expect_true(is.na(y[2]) && !is.nan(y[2]))
expect_true(is.nan(y[3]))
expect_equal(juliaCall("typeof", c(1, NA)),
juliaEval("Array{Union{Float64,Missing},1}"))
expect_equal(juliaCall("typeof", c(1, NaN)),
juliaEval("Array{Float64,1}"))
expect_equal(juliaCall("typeof", c(1+1i, NA)),
juliaEval("Array{Union{Complex{Float64},Missing},1}"))
expect_equal(juliaCall("typeof", c(1+1i, NaN)),
juliaEval("Array{Complex{Float64},1}"))
expect_true(juliaLet("ismissing(x[2])", x = c(1+1i, NA)))
})
test_that("Missing values transferred as NA", {
expect_true(is.na(juliaEval("missing")))
expect_true(all(is.na(juliaEval("[missing; missing]"))))
expect_true(all(is.na(juliaEval("[missing missing; missing missing]"))))
})
test_that("Logical with missing values", {
juliaLet("x[1] && !x[2] && ismissing(x[3])", x = c(TRUE, FALSE, NA))
x <- c(TRUE, FALSE, NA)
testEcho(x)
})
test_that("Complex with missing values", {
juliaLet("x[1] == 1+1im && x[2] == 2+2im && ismissing(x[3])", x = c(1 +1i, 2+2i, NA))
x <- c(1 +1i, 2+2i, NA)
testEcho(x)
x <- juliaEval("[1+1im 1+2im; 0 missing]")
expect_equivalent(x, matrix(c(1+1i, 0, 1+2i, NA), nrow = 2))
testEcho(x)
x <- juliaEval("[1.0+im 2.0+im; 0.0 missing]")
expect_equal(x, matrix(c(1+1i, 0, 2+1i, NA), nrow = 2))
expect_true(is.null(attr(x, "JLTYPE")))
testEcho(x)
})
test_that("Echo: logical vectors", {
testEcho(juliaEval('Bool[]'))
testEcho(logical())
testEcho(TRUE)
testEcho(FALSE)
testEcho(c(TRUE, FALSE))
testEcho("Bool[true]")
})
test_that("Echo: Pointers", {
arrPtr <- juliaFun("Base.pointer", list(1,2,3))
ptr <- arrPtr(2L)
expect_type(ptr, "raw")
testEcho(ptr)
ptrs <- juliaCall("map", arrPtr, as.integer(1:3))
testEcho(ptrs)
})
test_that("Echo: Ref", {
testEcho(juliaCall("Ref", list(1,2,3), 2L))
r <- juliaEval("global reftestvar = 1; Ref(reftestvar)")
testEcho(r)
})
test_that("Complex values are handled first class", {
testEcho(1i)
testEcho(juliaEval("1+im"))
testEcho(juliaEval("[1+im]"))
testEcho(juliaEval("[1+im; 2+im]"))
testEcho(c(1+1i,2 + 2i))
suppressWarnings({jla <- juliaImport("LinearAlgebra")})
testEcho(matrix(c(1, 0, 0, -1), ncol = 2))
expect(all(jla$eigvals(matrix(c(1, 0, 0, -1), ncol = 2),
matrix(c(0, 1, 1, 0), ncol = 2)) %in% c(1i, -1i)),
"")
expect(all(jla$eigmax(matrix(c(0, 1i, -1i, 0), ncol = 2)) == 1.0), "")
complexTypeParameters = c("Int8", "Int16", "Int32", "Int64",
"Float16", "Float32", "Float64")
for (complexPar in complexTypeParameters) {
juliaComplexType <- paste0("Complex{", complexPar, "}")
c <- juliaEval(paste0(juliaComplexType, "(5-3im)"))
expect_equivalent(c, 5 - 3i)
carr <- juliaEval(paste0(juliaComplexType, "[4+4im, 2-2im]"))
expect_equivalent(carr, c(4+4i, 2-2i))
if (complexPar == "Float64") {
expect_null(attr(c, "JLTYPE"))
} else {
expect_true(juliaCall("==", juliaEval(attr(c, "JLTYPE")),
juliaEval(juliaComplexType)))
}
}
})
test_that("Echo: raw vector", {
testEcho(as.raw(c(1,2,3)))
testEcho(juliaEval("[0x01]"))
testEcho(juliaEval("UInt8[]"))
expect_equivalent(juliaEval("[0x01 0x02; 0x03 0x04]"),
matrix(c(1,3,2,4), nrow = 2))
expect_equal(juliaCall("string", c(as.raw(0xca), as.raw(0xfe))),
"UInt8[0xca, 0xfe]")
})
test_that("Echo: raw vector", {
testEcho(juliaEval("Int32[1, 2]"))
testEcho(juliaEval("Int32[]"))
testEcho(juliaEval("Int32[1]"))
})
test_that("Echo: Single Int16", {testEcho(juliaEval('Int16(300)'))})
test_that("Echo: Int16 Vector", {testEcho(juliaEval('Int16[1,2,3]'))})
test_that("Echo: 1-element Int16 Vector", {
expect_equal(juliaCall("string", juliaEval('Int16[300]')),
"Int16[300]")
})
test_that("Echo: Single UInt128", {testEcho(juliaEval('UInt128(2)^100 +1'))})
test_that("Echo: UInt128 Vector", {testEcho(juliaEval('UInt128[1,2,3]'))})
test_that("Echo: 1-element UInt128 Vector", {
expect_equal(juliaCall("string", juliaEval('UInt128[1]')),
"UInt128[0x00000000000000000000000000000001]")
})
test_that("Echo: List with NULL elements", {
x <- juliaGet(juliaEcho(list(1, NULL, 3)))
expect_equal(x[[1]], 1)
expect_null(x[[2]])
expect_equal(x[[3]], 3)
expect_equal(length(x), 3)
testEcho(juliaEval('[1, nothing, 3]'))
x <- list("bla", NULL)
expect_equal(x[[1]], "bla")
expect_null(x[[2]])
x <- list(NULL, NULL)
expect_null(x[[1]])
expect_null(x[[2]])
})
test_that("Mutable struct usable by reference", {
juliaEval('mutable struct TestMutableStruct
x::Int
end')
jlRef <- juliaEval("TestMutableStruct(1)")
refEcho <- juliaEcho(jlRef)
expect_true(juliaCall("==", jlRef, refEcho))
expect_true(all(get("ref", jlRef) == get("ref", refEcho)))
expect_equal(refEcho$x, 1)
refEcho$x <- 2L
expect_equal(jlRef$x, 2)
ref <- get("ref", jlRef)
jlRef <- NULL
refEcho <- NULL
invisible(gc())
juliaEval("1")
expect_false(juliaLet("haskey(communicator.sharedheap, ref)", ref = ref,
communicator = JuliaConnectoR:::pkgLocal$communicator))
# Test behaviuor with juliaGet:
# The reference must be attached
jlRefEnv <- attr(juliaGet(juliaEval("TestMutableStruct(1)")), "JLREF")
expect_true(is.environment(jlRefEnv))
expect_true(is.raw(jlRefEnv$ref))
})
test_that("Immutable struct usable by reference and translated", {
juliaEval('struct TestImmutableStruct
x::Int
end')
jlRef <- juliaEval("TestImmutableStruct(1)")
expect_s3_class(jlRef, "JuliaStructProxy")
refEcho <- juliaEcho(jlRef)
expect_true(juliaCall("==", jlRef, refEcho))
expect_equal(refEcho$x, 1)
ref <- get("ref", jlRef)
expect_equal(juliaGet(jlRef)$x, 1)
expect_false(juliaLet("haskey(communicator.sharedheap, ref)", ref = ref,
communicator = JuliaConnectoR:::pkgLocal$communicator))
gc()
juliaEval("1")
})
test_that("Currying in juliaFun works", {
plus1 <- juliaFun("+", 1)
plus1(2)
expect_equal(juliaCall("map", plus1, c(1,2,3)), c(2,3,4))
})
test_that("Multidimensional object arrays work", {
juliaEval("struct MultiTestStruct
f::Float64
end")
content <- juliaEval("rand(4,5,6)")
testEcho(content)
x <- juliaLet("map(MultiTestStruct, c)", c = content)
testEcho(x)
expect_equivalent(dim(x), c(4,5,6))
expect_equivalent(juliaGet(x[1,1,1]), list(juliaGet(x[[1,1,1]])))
x[[1,2,3]] <- juliaEval("MultiTestStruct(17.0)")
expect_equal(x[[1,2,3]]$f, 17)
x[1,2,2] <- juliaEval("MultiTestStruct(19.0)")
expect_equal(x[[1,2,2]]$f, 19)
x[1,2,2] <- list(juliaEval("MultiTestStruct(19.0)"))
expect_equal(x[[1,2,2]]$f, 19)
expect_equal(dim(x[3:4, 4:5, 1]), c(2,2,1))
expect_equal(dim(x[3:4, as.integer(4:5), 1L]), c(2,2,1))
x[3:4, as.integer(4:5), 1L] <- juliaEval("MultiTestStruct(20.0)")
expect_equal(juliaGet(x[[3, 4, 1]])$f, 20)
expect_equal(juliaGet(x[[4, 5, 1]])$f, 20)
y <- juliaGet(x)
attr(y, "JLDIM") <- c(1L, 2L, 3L)
expect_error(juliaEcho(y), regexp = "Incorrect dimensions")
# Must also work with dimensions of zero
testEcho(juliaEval("Matrix{MultiTestStruct}(undef, 0, 0)"))
x <- juliaEval("Array{MultiTestStruct}(undef, 0, 0, 0)")
testEcho(x)
expect_equivalent(dim(x), c(0,0,0))
# Two dimensions
content <- juliaEval("rand(2,3)")
x <- juliaLet("map(MultiTestStruct, c)", c = content)
x[[1,2]] <- juliaEval("MultiTestStruct(3.0)")
expect_equal(x[[1,2]]$f, 3)
})
test_that("Arrays with undef entries are translated", {
juliaEval("mutable struct MutableTestStruct
f::Float64
end")
# all undefs
testEcho(juliaEval("Vector{MutableTestStruct}(undef, 3)"),
comparableInJulia = FALSE)
# undefs and values
juliaLet("x = Vector{MutableTestStruct}(undef, 3);
x[1] = MutableTestStruct(x1);
x[2] = MutableTestStruct(x2);
x", x1 = 1.0, x2 = 2.0)
testEcho(juliaEval("Vector{MutableTestStruct}(undef, 3)"),
comparableInJulia = FALSE)
# multidimensional arrays with undefs and values
x <- juliaLet("x = Array{MutableTestStruct}(undef, 2, 3, 4);
x[1,1,1] = MutableTestStruct(x1);
x[2,2,2] = MutableTestStruct(x2);
x", x1 = 1.0, x2 = 2.0)
testEcho(x, comparableInJulia = FALSE)
expect_equal(x[[1]]$f, 1)
})
test_that("Undefined strings are transferred as empty strings", {
expect_equal(juliaEval("Vector{String}(undef, 3)"), c("", "", ""))
})
test_that("String with null can be translated back to Julia", {
# einfacher string
jlStrWithNul <- "String([0x48, 0x65, 0x6c, 0x6c, 0x6f, 0x00, 0x5a, 0x65, 0x72, 0x6f, 0x57])"
str <- juliaEval(jlStrWithNul)
expect_true(is.raw(str))
expect_equal(as.character(juliaCall("typeof", str)), "String")
expect_equal(as.character(juliaLet("String(x[1:5])", x = str)), "Hello")
# string array
strArr <- juliaLet("String[a,b]", a = str, b = str)
expect_true(is.list(strArr))
strArr <- juliaLet("String[a,b,c]", a = str, b = str, c = str)
expect_true(is.list(strArr))
expect_equal(juliaCall("typeof", strArr), juliaEval("Array{String,1}"))
})
# Test Let
test_that("Let: used like eval", {
output <- capture_output({expect(is.null(juliaLet("print(1)")), "Failed")})
expect_equal(output, "1")
})
test_that("Let: must error with no named argument", {expect_error(juliaLet("print(x)", 1), "")})
test_that("Let: basic echo", {expect(all(juliaLet("identity(x)", x=c(2, 3)) == c(2,3)), "Failed")})
test_that("Let: Simple example from documentation works", {
expect_equal(capture_output({juliaLet('println(x)', x = 1)}),
capture_output({juliaEval('let x = 1.0; println(x) end')}))
})
test_that("Let: arguments without names not accepted", {
expect_error(juliaLet("println(1)", 1), regexp = "names")
expect_error(juliaLet("println(1)", x=1, 1, y=2), regexp = "names")
})
#Test Pairs
test_that("Echo: Pairs", {
testEcho(juliaEval("(1 => 2.0)"))
testEcho(juliaEval("1 => 2.0 => 3.0"))
testEcho(juliaEval("[1 => 2.0, 2 => 3.0]"))
})
# Test Tuples
test_that("Echo: Tuples", {
x <- juliaEval("(1, 17, 18)")
expect_equal(x[[2]], 17)
expect_equal(juliaGet(x[1]), juliaGet(juliaEval("(1,)")))
expect_length(x, 3)
expect_length(x[1:2], 2)
testEcho(juliaEval("(1, 2.0)"))
testEcho(juliaEval("((1, 2.0), 3.0)"))
testEcho(juliaLet("collect(zip(x,y))", x = c(1L,2L, 3L), y = c(1,0,1)))
testEcho(juliaEval("(Ref(false), Ref(true))"))
testEcho(juliaEval("Tuple{}()"))
})
# Test Named Tuples
test_that("Echo: Named Tuples", {
namedTuple <- juliaLet("y=2*x; z = 3*u + 1; (x=y, y=z)", x=2, u=4)
expect_s3_class(namedTuple, "JuliaStructProxy")
expect_equal(namedTuple$y, 13)
expect_type(juliaGet(namedTuple), "list")
expect_equal(juliaGet(namedTuple)$y, 13)
testEcho(namedTuple)
})
# Test Module
test_that("Echo: Module", {
juliaEval("module TestModule end")
testEcho(juliaEval("TestModule"))
})
test_that("Echo: Symbol", {
x <- juliaEval(":asymbol")
expect_true(is.symbol(x))
expect_true(juliaCall("isa", as.symbol("s"), juliaExpr("Symbol")))
testEcho(x)
})
# Test Dictionary
test_that("Echo: Dictionary", {
d <- juliaEval("Dict(:bla => 1.0, :blup => 3.0)")
expect_equivalent(d[juliaExpr(":bla")][[1]], 1)
expect_equal(d[juliaExpr(":bla"), juliaExpr(":bla")], as.list(c(1, 1)))
expect_equal(d[[as.symbol("bla")]], 1)
expect_equal(d[as.symbol("blup")],list(3))
d[juliaExpr(":blup")] <- 4
expect_equal(d[[juliaExpr(":blup")]], 4)
d[[juliaExpr(":blup")]] <- 5
expect_equal(d[[juliaExpr(":blup")]], 5)
d2 <- juliaGet(d)
expect_setequal(d2[["keys"]], juliaGet(juliaEval("[:bla, :blup]")))
expect_setequal(d2[["values"]], list(1, 5))
d[juliaExpr(":hi"), juliaExpr(":hello")] <- c(15, 14)
expect_equal(d[juliaExpr(":bla"), juliaExpr(":hi")], as.list(c(1, 15)))
d[juliaExpr(":hi"), juliaExpr(":hello")] <- as.list(c(16, 17))
expect_equal(d[juliaExpr(":bla"), juliaExpr(":hello"), juliaExpr(":hi")], as.list(c(1, 17, 16)))
expect_length(d[juliaExpr(":bla"), juliaExpr(":hi"), juliaExpr(":hello"), juliaExpr(":hello")], 4)
d <- juliaLet("Dict(zip(x, y))", x = c("bla", "blup"), y = c(1,2))
expect_equal(d[["bla"]], 1)
expect_equivalent(d["blup"], list(2))
d2 <- juliaGet(d)
expect_setequal(d2[["keys"]], list("bla", "blup"))
expect_setequal(d2[["values"]], list(1, 2))
d2 <- juliaGet(d)
expect_setequal(d2[["keys"]], list("bla", "blup"))
expect_setequal(d2[["values"]], list(1,2))
d$bla <- 17
expect_equal(d$bla, 17)
d <- juliaLet("Dict(zip(x, y))", x = list("bla"), y = list(1))
expect_equal(length(juliaCall("keys", d)), 1)
testEcho(d)
d <- juliaLet("Dict(zip(x, y))", x = list(), y = list())
d2 <- juliaGet(d)
expect_length(d2[["keys"]], 0)
expect_length(d2[["values"]], 0)
testEcho(d)
})
# Test Set
test_that("Echo: Set", {
s1 <- juliaEval("Set([1; 2; 3; 4])")
s2 <- juliaEval("Set([1; 2])")
expect_length(setdiff(juliaGet(juliaEval("Set([1; 2; 3; 4])")),
c(1,2,3,4)), 0)
expect_length(setdiff(juliaGet(juliaLet("setdiff(s1, s2)", s1 = s1, s2 = s2)),
c(3,4)), 0)
testEcho(s1)
})
# Test types with bitstypes
test_that("Object with bitstype", {
uuidregex <- '^[a-f0-9]{8}-?[a-f0-9]{4}-?4[a-f0-9]{3}-?[89ab][a-f0-9]{3}-?[a-f0-9]{12}$'
UUIDs <- juliaImport("UUIDs")
expect_match(juliaCall("string", UUIDs$uuid4()), uuidregex)
})
test_that("Exotic objects handled gracefully", {
x <- quote(1 + 1)
expect_type(x, "language")
expect_warning({ y <- juliaEcho(list(x = x))},
regexp = "not translatable", all = FALSE)
expect_null(y$x)
})
# Test complex constructor with all kinds of types
test_that("Complex Julia object with different member type", {
juliaEval('struct TestTypeWithAllKindsOfStuff
n::Nothing
f16::Float16
f32::Float32
f64::Float64
b::Bool
i8::Int8
ui8::UInt8
i16::Int16
ui16::UInt16
i32::Int32
ui32::UInt32
ch::Char
i64::Int64
ui64::UInt64
i128::Int128
ui128::UInt128
f16vec::Vector{Float16}
f32vec::Vector{Float32}
f64vec::Vector{Float64}
bvec::Vector{Bool}
i8vec::Vector{Int8}
ui8vec::Vector{UInt8}
i16vec::Vector{Int16}
ui16vec::Vector{UInt16}
i32vec::Vector{Int32}
ui32vec::Vector{UInt32}
chvec::Vector{Char}
i64vec::Vector{Int64}
ui64vec::Vector{UInt64}
i128vec::Vector{Int128}
ui128vec::Vector{UInt128}
end')
juliaEval('function TestTypeWithAllKindsOfStuff()
TestTypeWithAllKindsOfStuff(
nothing,
rand(Float16), rand(Float32), rand(Float64),
rand(Bool),
rand(Int8), rand(UInt8),
rand(Int16), rand(UInt16),
rand(Int32), rand(UInt32),
rand(Char),
rand(Int64), rand(UInt64),
rand(Int128), rand(UInt128),
rand(Float16, 2), rand(Float32, 2), rand(Float64, 2),
rand(Bool, 2),
rand(Int8, 2), rand(UInt8, 2),
rand(Int16, 2), rand(UInt16, 2),
rand(Int32, 2), rand(UInt32, 2),
rand(Char, 2),
rand(Int64, 2), rand(UInt64, 2),
rand(Int128, 2), rand(UInt128, 2))
end')
testEcho(juliaEval("TestTypeWithAllKindsOfStuff()"))
})
test_that("Private inner constructor is forged", {
juliaEval('struct MyPrivateX
x::Int
function MyPrivateX()
new(5)
end
end')
p <- juliaEval("MyPrivateX()")
testEcho(p)
})
test_that("Imported modules are printed", {
# a stdlib module
Pkg <- juliaImport("Pkg")
expect_match(regexp = 'Julia module "Pkg": [0-9]+ function.*',
capture.output(print(Pkg))[1])
# a user defined module
module <- juliaEval('module ImportTestModule1
export f
f(x)=1
end')
itm1 <- juliaImport(module, all = FALSE)
expectedOutput <-
'Julia module "Main.ImportTestModule1": 1 function.*'
expect_match(capture.output(print(itm1))[1], regexp = expectedOutput)
itm1_2 <- juliaImport(".ImportTestModule1", all = FALSE)
expect_match(capture.output(print(itm1_2))[1], regexp = expectedOutput)
})
test_that("Empty module does not cause problems", {
juliaEval("module EmptyTestModule end")
expect_length(ls(juliaImport(".EmptyTestModule")), 2) # (eval and include)
juliaEval("module EmptyTestModule2 end")
expect_length(ls(juliaImport(".EmptyTestModule2", all = FALSE)), 0)
})
test_that("Errors are handled gracefully", {
expect_error(juliaCall("sum", c(1,2,3, "bla")))
expect_error(juliaCall("thisisnotarealfunction", 100, 4))
expect_error(juliaCall("RConnector.thisisnotarealfunction", "haha"))
expect_error(juliaCall("NotARealModule.thisisnotarealfunction", list(1,2,3)))
})
test_that("Vectors of objects can be accessed by index via proxy", {
x <- juliaEval("[ [1;2;3], [4;5;6], [7;8;9] ]")
expect_s3_class(x, "JuliaArrayProxy")
expect_equal(x[[1]][2], 2)
expect_equal(x[[2]][2], 5)
x[[1]][1] <- 17L
expect_equal(x[[1]][1], 17)
expect_equal(x[2:3][[1]][[1]], 4)
x[2:3][[1]][[1]] <- 18L
expect_equal(x[2:3][[1]][[1]], 18)
expect_equal(x[[1]][x[[2]] == 5], 2) # logical indexing
# juliaGet version must behave in the same way as the proxy version
y <- juliaGet(x)
expect_equal(x[[2]], y[[2]])
expect_equal(x[[1]][2], y[[1]][2])
expect_equal(x[[2]][2], y[[2]][2])
x[[1]][1] <- 17L
y[[1]][1] <- 17L
expect_equal(x[[1]][1], 17)
expect_equal(y[[1]][1], 17)
x[2:3][[1]][[1]] <- 18L
y <- juliaGet(x)
expect_equal(y[2:3][[1]][[1]], 18)
expect_equal(x[2:3][[1]][1], y[2:3][[1]][1])
expect_equal(x[[2]], y[[2]])
# Multiple dimensions
y <- juliaEval("map( x-> [1;x;3], rand(2,2,2))")
expect_equivalent(y[c(1,2)][[1]], y[[1]])
expect_equivalent(y[c(1,3)][[2]], y[[3]])
y[c(1,3)] <- juliaEval("[[17.0], [18.0]]")
expect_equivalent(juliaGet(y[1]), list(17))
expect_equivalent(juliaGet(y[3]), list(18))
expect_equivalent(juliaGet(y)[c(4,5)], juliaGet(y[c(4,5)]))
})
test_that("Callback functions", {
x <- juliaEcho(function() {})
expect_equal(typeof(x), "closure")
expect_equal(x, function() {})
outputenv <- new.env(parent = emptyenv())
outputenv$output <- c()
doOutput <- function(x) {
outputenv$output <- c(outputenv$output, x)
}
# Nested callback functions
juliaEval('struct TestStruct f::Function end')
juliaEval('function testNestedFun(ts::Vector{TestStruct}) map(t -> t.f(), ts) end')
t <- juliaCall("testNestedFun",
list(juliaCall("TestStruct", function() {doOutput("a")}),
juliaCall("TestStruct", function() {doOutput("b")}),
juliaCall("TestStruct", function() {doOutput("c")})))
expect_equal(outputenv$output, c("a", "b", "c"))
# as named arguments
outputenv$output <- c()
juliaEval('function testNestedFunNamed(;ts::Vector{TestStruct}) map(t -> t.f(), ts) end')
t <- juliaCall("testNestedFunNamed", ts =
list(juliaCall("TestStruct", function() {doOutput("x")}),
juliaCall("TestStruct", function() {doOutput("y")})))
expect_equal(outputenv$output, c("x", "y"))
# test repeated call of nested functions
outputenv$output <- c()
juliaEval('function testNestedFun2(ts::Vector{TestStruct}) for i = 1:2 map(t -> t.f(), ts) end end')
t <- juliaCall("testNestedFun2",
list(juliaCall("TestStruct", function() {doOutput(1)}),
juliaCall("TestStruct", function() {doOutput(2)})))
expect_equal(outputenv$output, c(1,2,1,2))
# Test multiple arguments
outputenv$output <- c()
juliaEval('function testNestedFunArgs(ts::Vector{TestStruct}, args...) map(t -> t.f(args...), ts) end')
t <- juliaCall("testNestedFunArgs",
list(juliaCall("TestStruct", function(x, y, z) {doOutput(x)}),
juliaCall("TestStruct", function(x, y, z) {doOutput(z); return(c(5,6,7))})),
1, 2, 3)
expect_equal(outputenv$output, c(1,3))
outputenv$output <- c()
juliaEval('function testNestedAndUnnested(f::Function, ts::Vector{TestStruct}, args...)
testNestedFunArgs(ts, args...)
f(args...)
end')
t <- juliaCall("testNestedAndUnnested",
function(x, y) {doOutput(x)},
list(juliaCall("TestStruct", function(x,y) {doOutput(x)}),
juliaCall("TestStruct", function(x, y) {doOutput(y); return(list(5,6,7))})),
17,18)
expect_equal(outputenv$output, c(17, 18, 17))
})
test_that("Callback function calling Julia erroring in Julia", {
f <- juliaEval('(x) -> error("Error")')
g <- function(x) {cat("OK"); f(x); print("NotOK"); x}
output <- capture.output(expect_error(juliaCall("map", g, c(1,2,3))))
expect_equal(output, "OK")
})
test_that("Builtin functions can be used as callback functions", {
expect_equal(juliaCall("map", sqrt, c(1,4,9)), c(1,2,3))
})
test_that("Callback function might have error in R", {
fOK <- function(x) { return(x+1) }
fnotOK <- function(x) {
if (x == 2) {
stop("No even numbers please")
} else {
return(1)
}
}
expect_equal(juliaCall("map", fOK, c(1,2,3)), c(2,3,4))
expect_error(juliaCall("map", fnotOK, c(1,2,3)), class = "error")
})
test_that("Julia functions as members are transferred and usable in R", {
op1 <- juliaFun("+")
juliaEval('struct FunTestStruct f::Function end')
funTestStruct <- juliaCall("FunTestStruct", op1)
expect_equal(funTestStruct$f(1,2), 3)
})
test_that("juliaCall checks given name before running", {
expect_error(juliaCall())
expect_error(juliaCall(1))
expect_error(juliaCall(c("bla", "bla")))
})
test_that("juliaCall can handle keyword arguments with key \"name\"", {
Pkg <- juliaImport("Pkg")
# indirect via created function object
expect_equal(Pkg$PackageSpec(name = "RData", version = "v0.10")$name,
"RData")
# direct call of juliaCall
pkgspec <- juliaCall("Pkg.PackageSpec", name = "RData", version = "0.10")
expect_equal(pkgspec$name, "RData")
})
test_that("Documentation example of juliaFun", {
juliaSqrt <- juliaFun("sqrt")
expect_equal(juliaSqrt(2), sqrt(2))
expect_equal(juliaCall("map", juliaSqrt, c(1,4,9)), c(1,2,3))
})
test_that("Constructors stand for their types", {
juliaEval('module TestTypeModule
export TestType
struct TestType end
end')
TestTypeModule <- juliaImport(".TestTypeModule")
expect_equal(as.character(juliaCall("typeof", TestTypeModule$TestType)),
"DataType")
})
test_that("Parametric types are imported", {
juliaEval("module ParametricTypeTestModule
export MyParametricType
struct MyParametricType{T}
i::T
end
end")
ParametricTypeTestModule <- juliaImport(".ParametricTypeTestModule")
expect_equal(ParametricTypeTestModule$MyParametricType(2)$i, 2)
expect_equal(ParametricTypeTestModule$MyParametricType("bla")$i, "bla")
})
test_that("Starting and stopping Julia server" , {
stopJulia()
port <- startJuliaServer()
expect_match(Sys.getenv("JULIACONNECTOR_SERVER"), paste0("localhost:", port))
# starting the server twice should give a warning and not do anything
expect_warning(startJuliaServer())
expect_match(Sys.getenv("JULIACONNECTOR_SERVER"), paste0("localhost:", port))
# now the server should start successfully
expect_equal(juliaEval("1"), 1)
# set a variable in a separate process:
rPath <- file.path(R.home("bin"), "R")
if (Sys.info()["sysname"] == "Windows") {
rPath <- paste0(rPath, ".exe")
}
system2(rPath, c("-e", shQuote(
paste0("library(JuliaConnectoR); juliaEval('global x = 1')"))),
stdout = FALSE)
# check that variable is set in this Julia session,
# i.e. that the two R processes share the same Julia process
expect_equal(juliaEval("x"), 1)
stopJulia()
expect_equal(Sys.getenv("JULIACONNECTOR_SERVER"), "")
expect_null(JuliaConnectoR:::pkgLocal$con)
})
test_that("Julia startup options can be modified", {
stopJulia()
oldJuliaOpts <- Sys.getenv("JULIACONNECTOR_JULIAOPTS")
# set project directory via startup opts
projectPathWithSpaces <- file.path(tempdir(), "Dirname with Spaces")
dir.create(file.path(tempdir(), "Dirname with Spaces"))
specifyProjectOpts <- paste0('--project="', projectPathWithSpaces, '"')
Sys.setenv("JULIACONNECTOR_JULIAOPTS" = paste0('--project="',
projectPathWithSpaces, '"'))
expect_match(capture.output({juliaEval("import Pkg; Pkg.status()")}),
regexp = "Dirname with Spaces", fixed = TRUE, all = FALSE)
stopJulia()
# set two startup opts: project directory and deprecation warnings
Sys.setenv("JULIACONNECTOR_JULIAOPTS" = paste(specifyProjectOpts,
"--depwarn=no"))
juliaDepWarn <- 'Base.depwarn("there is a deprecation warning", :foo)'
expect_length(capture.output({juliaEval(juliaDepWarn)}), 0)
stopJulia()
# clean up
unlink(projectPathWithSpaces, recursive = TRUE)
if (oldJuliaOpts == '') {
Sys.unsetenv("JULIACONNECTOR_JULIAOPTS")
} else {
Sys.setenv("JULIACONNECTOR_JULIAOPTS" = oldJuliaOpts)
}
})
test_that("JULIACONNECTOR_SERVER environment variable and Killing Julia works", {
# if JULIACONNECTOR_SERVER is used, the server must be started with
# "keeprunning = true" to work.
skip_on_cran()
JuliaConnectoR:::stopJulia()
oldJuliaConnectorServer <- Sys.getenv("JULIACONNECTOR_SERVER")
# start new JuliaConnectoR server
port <- JuliaConnectoR:::startJuliaServer(12980)
expect_match(Sys.getenv("JULIACONNECTOR_SERVER"), paste0("localhost:", port))
# test with wrong variable
Sys.setenv("JULIACONNECTOR_SERVER" = "wrong form")
expect_error(JuliaConnectoR:::startJulia(), regexp = "<host>:<port>")
# now for real
Sys.setenv("JULIACONNECTOR_SERVER" = paste("localhost", port, sep = ":"))
# test some command, if it works
expect_equal(juliaCall("prod", c(1,2)), 2)
# test killing
JuliaConnectoR:::killJulia()
if (oldJuliaConnectorServer == "") {
Sys.unsetenv("JULIACONNECTOR_SERVER")
} else {
Sys.setenv("JULIACONNECTOR_SERVER" = oldJuliaConnectorServer)
}
})
test_that("Error if Julia is not setup properly", {
oldJuliaBindir <- Sys.getenv("JULIA_BINDIR")
Sys.setenv("JULIA_BINDIR" = "/this/isnot/a/directory/")
expect_error(JuliaConnectoR:::runJuliaServer(16752), "No Julia executable file found")
if (oldJuliaBindir == "") {
Sys.unsetenv("JULIA_BINDIR")
} else {
Sys.setenv("JULIA_BINDIR" = oldJuliaBindir)
}
expect_equal(1, juliaEval("1"))
})
test_that("Fallback on juliaup fails correctly", {
skip_on_cran()
juliaCmdJuliaup <- file.path(Sys.getenv("HOME"), ".juliaup", "bin", "julia")
if (!file.exists(juliaCmdJuliaup)) {
expect_error(JuliaConnectoR:::fallbackOnDefaultJuliaupPath(), regexp = "\\?`Julia-Setup`")
} else {
expect_equal(juliaCmdJuliaup, JuliaConnectoR:::fallbackOnDefaultJuliaupPath())
}
})
test_that("Circular references do not lead to a crash", {
definition <- 'mutable struct TestRecur
r::Union{TestRecur, Int}
end'
try({juliaEval(definition)}, silent = TRUE) # (ignore redefinition error)
r <- juliaEval("r1 = TestRecur(2); r2 = TestRecur(r1); r1.r = r2; r1")
expect_match(capture.output({print(juliaEcho(r))}), regex = "circular reference", all = FALSE)
expect_error(juliaEcho(juliaGet(r)), regex = "Circular reference")
# reference only
r <- juliaEval("r1 = TestRecur(2); r2 = TestRecur(r1); r1.r = r2; r1")
expect_match(capture.output({print(juliaEcho(r))}), regex = "circular reference", all = FALSE)
expect_equal(juliaCall("typeof", r$r$r), juliaCall("typeof", r))
})
test_that("Anonymous functions can be transferred", {
af1 <- juliaEval("() -> 17")
expect_equal(af1(), 17)
expect_equal(juliaEcho(af1)(), 17)
rm(af1)
af2 <- juliaEval("(args...; kwargs...) -> 19")
expect_equal(af2(list(), 3, bla = 2), 19)
rm(af2)
# Test cleaning of references
invisible(gc(verbose = FALSE))
expect_gt(length(JuliaConnectoR:::pkgLocal$finalizedRefs), 0)
juliaEval("1")
expect_null(JuliaConnectoR:::pkgLocal$finalizedRefs)
juliaEval("struct TestAnonFunStruct
f::Function
end")
afs <- juliaEval("TestAnonFunStruct(() -> 20)")
expect_equal(afs$f(), 20)
})
test_that("Test BigInt: a Julia object with external pointers", {
# Note: It is not really recommended to translate objects with
# external pointers. Nevertheless, it should work and not cause a crash.
i1 <- juliaGet(juliaCall("BigInt", 2147483647L))
i2 <- juliaGet(juliaCall("BigInt", 2147483647L))
p <- juliaGet(juliaCall("prod", list(i1, i2, i1)))
p2 <- juliaGet(juliaCall("prod", list(i1, i2, i1)))
juliaCall("GC.gc") # references in sharedheap must survive this
jldiv <- juliaFun("div")
expect_equal(juliaCall("Int", jldiv(jldiv(p,i1), i2)), 2147483647L)
expect_equal(juliaLet("Int(div(div(p,i1),i2))", p = p, i1 = i1, i2 = i2),
2147483647)
f <- juliaLet("p/i1/i2", p = p, i1 = i1, i2 = i2)
expect_equal(juliaCall("Float64", f), 2147483647)
i1Ref <- attr(i1, "JLREF")$ref
expect_true(juliaLet("communicator.sharedheap[ref].refcount > 0",
ref = i1Ref, communicator = pkgLocal$communicator))
i1 <- NULL
invisible(gc())
juliaEval("1") # after one command, the references from R should be cleaned up
# Multiple calls to the Julia garbage are necessary for a complete clean-up as
# one finalization may make another object unreachable, which will then
# be cleaned up in the next run.
juliaCall("GC.gc")
juliaCall("GC.gc")
juliaCall("GC.gc")
expect_false(juliaLet("haskey(communicator.sharedheap, ref)", ref = i1Ref,
communicator = pkgLocal$communicator))
})
test_that("Serialized mutable struct can be restored", {
juliaEval("mutable struct TestSerializationStruct
i::Int
end")
x <- juliaGet(juliaEval("TestSerializationStruct(1)"))
tmpfile <- tempfile()
save("x", file = tmpfile)
x <- NULL
#juliaEval("println(RConnector.sharedheap)")
invisible(gc())
juliaEval("1")
juliaCall("GC.gc")
load(tmpfile)
msg <- capture.output(type = "message", {
expect_equal(juliaEcho(x)$i, 1)
})
expect_match(msg, "external references", all = FALSE)
x <- NULL
juliaEval("1")
juliaCall("GC.gc") # copy of the serialized copy is cleaned up
file.remove(tmpfile)
})
test_that("Object with unexported function defined in different modules", {
juliaEval('
module FirstModule
struct FirstType
f::Function
end
f(x::FirstType) = 1
end
module SecondModule
import ..FirstModule.f
struct SecondType
f::Function
end
f(x::SecondType) = 2
end #module')
# It doesn't matter whether SecondModule.f or FirstModule.f is used
ft1 <- juliaEval("FirstModule.FirstType(SecondModule.f)")
ft2 <- juliaEval("SecondModule.SecondType(FirstModule.f)")
expect_equal(juliaLet("x.f(x)", x = ft1), 1)
expect_equal(juliaLet("x.f(x)", x = ft2), 2)
expect_equal(juliaLet("x.f(y)", x = ft1, y = ft2), 2)
expect_equal(juliaLet("x.f(y)", x = ft2, y = ft1), 1)
})
test_that("AbstractArrays are transferred by reference and can be translated to struct", {
a <- juliaEval('using SparseArrays
A = sparse([1, 2, 3], [1, 2, 3], [0, 2, 0])')
expect_s3_class(a, "JuliaArrayProxy")
# indexing
expect_equal(a[[2,2]], 2)
# backtranslation
expect_true(juliaCall("issparse", juliaGet(a)))
testEcho(a)
})
test_that("Operators can be imported and used", {
suppressWarnings({jla <- juliaImport("LinearAlgebra", all = FALSE)})
expect_equal(jla$`<cdot>`(1,2), 2)
suppressWarnings({base <- juliaImport("Base", all = FALSE)})
expect_true(base$`<subseteq>`(c(1,2), c(1,2,3)))
})
test_that("Boltzmann machine can be trained and used", {
#skip_on_cran()
juliaEval('using Pkg;
try
@eval import BoltzmannMachines
catch ex
Pkg.add(PackageSpec(name = "BoltzmannMachines", version = v"1.2"))
end')
# Set a random seed in Julia
juliaEval("using Random; Random.seed!(5);")
BM <- juliaImport("BoltzmannMachines")
# a test data set from the BoltzmannMachines-package, just to have some data
x <- BM$barsandstripes(50L, 4L)
x
# Train DBMs with
dbm <- BM$fitdbm(x, epochs = 2L, nhiddens = c(4L,3L))
dbm
dbm2 <- BM$fitdbm(x, epochs = 1L,
pretraining = list(BM$TrainLayer(nhidden = 4L),
BM$TrainLayer(nhidden = 3L)))
dbm2 <- juliaGet(dbm2)
# Use a trained model to generate samples
gensamples <- BM$samples(dbm, 10L)
expect_equal(nrow(gensamples), 10)
# Evaluate the model: Likelihood estimation ...
BM$loglikelihood(dbm2, x)
# ... or exact calculation (possible for such a small model)
BM$exactloglikelihood(dbm2, x)
})
test_that("juliaPut", {
x <- juliaPut(c(1,2,3))
expect_s3_class(x, "JuliaSimpleArrayProxy")
expect_equal(x[[1]], 1)
expect_equal(x[1:2], c(1,2))
expect_type(x[3], "double")
x[2:3] <- 0
expect_equal(juliaCall("sum", x), 1)
expect_error(juliaPut(juliaEval("(a=1,b=2,c=3)")))
x <- juliaPut("bla")
expect_equal(as.character(juliaCall("typeof", x)), "String")
# use on translated object
x <- juliaGet(juliaEval("[(1,2), (2,3)]"))
expect_s3_class(juliaPut(x), "JuliaArrayProxy")
})
test_that("Display of default printing is limited to width", {
x <- juliaEval("rand(100, 100)")
y <- juliaPut(x)
printOutput <- capture.output({print(y)})
expect_lte(nchar(printOutput[length(printOutput)]),
getOption("width"))
})
test_that("Error message for tables", {
capture.output({JuliaConnectoR:::showUpdateTablesMsg()})
x <- juliaEcho(list(c(1,2), c(1,2,3)))
expect_s3_class(x, "JuliaProxy")
expect_error({as.data.frame(x)})
})
test_that("Data frame can be translated", {
x <- data.frame(x = c(0, 2, 4), y = c("bla", "blup", "ha"),
stringsAsFactors = FALSE)
testEcho(x)
y <- juliaEcho(x)
x2 <- as.data.frame(juliaEcho(x))
expect_s3_class(x2, "data.frame")
expect_equal(x2$x, c(0,2,4))
expect_equal(x2$y, c("bla", "blup", "ha"))
testEcho(data.frame())
Pkg <- juliaImport("Pkg")
if (juliaEval('VERSION < v"1.6"')) {
subproject <- "1_0"
} else if (juliaEval('VERSION < v"1.10"')) {
subproject <- "1_6"
} else {
subproject <- "1_10"
}
Pkg$activate(system.file("examples", "IndexedTables-Project", subproject,
package = "JuliaConnectoR"))
Pkg$instantiate()
juliaEval("import IndexedTables")
x <- data.frame(x = c(0, 2, 4), y = c("bla", "blup", "ha"),
stringsAsFactors = FALSE)
y <- juliaCall("IndexedTables.table", x)
expect_equal(as.data.frame(x), x)
# Works also without column names (Issue #16)
df <- juliaCall("IndexedTables.table", 1:3, 11:13)
df <- as.data.frame(df)
expect_equal(df[, 1], 1:3)
expect_equal(df[, 2], 11:13)
})
test_that("Attempt to translate Julia Table with incompatible types results in proper error", {
juliaEval("import IndexedTables")
x <- juliaEval('IndexedTables.table(["a", 1, 2], [1,2,3])')
expect_error(as.data.frame(x), regexp = 'Column type "Any" cannot be translated')
})
test_that("Julia types are converted to r compatible types in data frames", {
x1 <- juliaEval("[1.0f0*im + 1.0f0, 0.0f0]")
x2 <- juliaEval('map(i -> SubString(i, 2,3), ["asdf", "wert"])')
x3 <- juliaEval('[true, false]')
x4 <- juliaEval("['a', 'b']")
x <- juliaLet('Dict(:x1 => x1, :x2 => x2, :x3 => x3, :x4 => x4)',
x1 = x1, x2 = x2, x3 = x3, x4 = x4)
x <- as.data.frame(x)
expect_equivalent(x$x1, x1)
expect_equal(x$x2, c("sd", "er"))
expect_equal(x$x3, x3)
expect_equivalent(x$x4, x4)
})
test_that("Broadcasting via dot syntax works", {
expect_equal(juliaCall("sin.", c(0, 1/3*pi, pi/2)),
c(0, sqrt(3)/2, 1))
juliaEval("import Statistics")
arrofarrs <- juliaEval("[[2;3], [4;5]]")
expect_equal(juliaCall("Statistics.mean.", arrofarrs), c(2.5, 4.5))
expect_equal(juliaGet(juliaCall("Statistics.mean.", arrofarrs, dims = 1L)),
juliaGet(juliaEval("[[2.5], [4.5]]")))
# Test functions with multiple arguments
juliaEval("module TestBroadcasting
function my_add(x,y) x+y end
function my_mul(x,y) x*y end
end")
expect_equal(juliaCall("TestBroadcasting.my_add.", 10, c(1,2,3)),
juliaEval("TestBroadcasting.my_add.(10, [1, 2, 3])"))
expect_equal(juliaCall("TestBroadcasting.my_mul.", c(1,2,3), c(4,5,6)),
juliaEval("TestBroadcasting.my_mul.([1, 2, 3], [4, 5, 6])"))
# Check that dimension mismatch leads to an error
expect_error(juliaCall("TestBroadcasting.my_mul.", c(1,2,3,4), c(5,6)))
})
test_that("Environemnt variables for Julia can be set", {
# prepare
os <- Sys.info()['sysname']
oldJuliaEnv <- Sys.getenv("JULIACONNECTOR_JULIAENV")
JuliaConnectoR:::stopJulia()
# Test with one variable
Sys.setenv(JULIACONNECTOR_JULIAENV = "TESTVARIABLE1=1")
if (os == "Windows") {
expect_warning(juliaEval("1+1"))
} else {
expect_equal(juliaEval('ENV["TESTVARIABLE1"]'), "1")
}
JuliaConnectoR:::stopJulia()
# Test with two variables
Sys.setenv(JULIACONNECTOR_JULIAENV = "TESTVARIABLE1=1; TESTVARIABLE2='abc'")
if (os == "Windows") {
expect_warning(juliaEval("1+1"))
} else {
expect_equal(juliaEval('ENV["TESTVARIABLE1"]'), "1")
expect_equal(juliaEval('ENV["TESTVARIABLE2"]'), "abc")
}
JuliaConnectoR:::stopJulia()
# LD_LIBRARY_PATH can be set via JULIACONNECTOR_JULIAENV
Sys.setenv(JULIACONNECTOR_JULIAENV = "LD_LIBRARY_PATH='abc'")
if (os == "Linux") {
expect_match(JuliaConnectoR:::getJuliaEnv(), "LD_LIBRARY_PATH='abc'")
}
# clean up
if (oldJuliaEnv == "") {
Sys.unsetenv("JULIACONNECTOR_JULIAENV")
} else {
Sys.setenv(JULIACONNECTOR_JULIAENV = oldJuliaEnv)
}
})
test_that("Iris/Flux example from README works", {
skip_on_cran()
skip_on_covr()
#skip_if(Sys.info()["login"] %in% c("lenz", "Stefan Lenz", "selectstern", "lenzstef"))
cat("\nExecuting README examples...\n")
if (juliaEval('VERSION < v"1.9"')) {
skip("Skip Flux example because Julia version is too old")
} else {
projectFolder <- "project_1_9"
}
Pkg <- juliaImport("Pkg")
Pkg$activate(system.file("examples", "iris-example", projectFolder,
package = "JuliaConnectoR", mustWork = TRUE))
Pkg$instantiate()
irisExampleJl <- system.file("examples", "iris-example", "iris-example.jl",
package = "JuliaConnectoR", mustWork = TRUE)
irisExampleJuliaCode <- readLines(irisExampleJl)
juliaEval(paste(irisExampleJuliaCode, collapse = "\n"))
expect_true(juliaEval("accuracy(model, testdata) > 0.9"))
irisExampleR <- system.file("examples", "iris-example", "iris-example.R",
package = "JuliaConnectoR", mustWork = TRUE)
irisExampleRCode <- readLines(irisExampleR)
scriptEnv <- new.env(emptyenv())
suppressWarnings(eval(parse(text = paste(irisExampleRCode, collapse = "\n")),
envir = scriptEnv))
# Test that training the model worked
print(juliaCall("accuracy", scriptEnv$model, scriptEnv$testdata))
expect_true(juliaCall("accuracy", scriptEnv$model, scriptEnv$testdata) > 0.9)
Pkg$activate() # use default environment again
})
test_that("Boltzmann example from README works", {
skip_on_cran()
returningError <- function(x) {
paste0("tryCatch({", x , '},',
'error = function(e) { paste("e: ",e$message) },',
'warning = function(w) { paste("w: ", w$message) })')
}
juliaEval('import Pkg;
try
@eval import BoltzmannMachines
catch ex
Pkg.add(PackageSpec(name = "BoltzmannMachines", version = v"1.3"))
end')
boltzmannExampleR <- system.file("examples", "boltzmann-example.R",
package = "JuliaConnectoR", mustWork = TRUE)
bmExample <- readLines(boltzmannExampleR)
bmExample <- sub("plot\\(.*", "", bmExample)
bmScriptEnv <- new.env(emptyenv())
code <- paste(bmExample, collapse = "\n")
code <- returningError(code)
eval(parse(text = code), envir = bmScriptEnv)
expect_s3_class(bmScriptEnv$dbm, "JuliaProxy")
})
stefan-m-lenz/JuliaConnectoR documentation built on Oct. 13, 2024, 10:50 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Sys.unsetenv("R_TESTS")
test_that("Some smoke tests", {
expect_equal(juliaCall("prod", c(1,2,3)), 6)
juliaEval("")
juliaCall("string", list())
juliaCall("string", list(as.integer(1), "bla" = 23L))
juliaEval("String[]")
expect(!is.null(juliaEval("using Random; Random.seed!(5)")),
"Must be able to set random seed")
expect(is.null(juliaEval("Random.seed!(5);")),
"Eval with semicolon at end returns NULL")
})
test_that("Output is transferred", {
output <- capture_output({
juliaCall("println", as.integer(22))
})
expect_match(output, "^[\n]*22[\n]*$")
output <- capture_output({
juliaCall("println", "hello world")
})
expect_match(output, "^[\n]*hello world[\n]*$")
})
test_that("Warnings are transferred", {
output <- capture.output(type = "message", {
juliaEval('@warn "This might be serious"')
})
expect_match(output[1], "This might be serious")
})
test_that("Warnings and normal output are both transferred and stable", {
stdoutput <- capture_output({
stderroutput <- capture.output(type = "message", {
juliaLet('for i = 1:100
println(join(rand(["1", "ä", "ö"], rand(1:100))));
println(stderr,join(rand(["2", "u", "a"], rand(1:100))));
end')
ret <- juliaLet('println(22); 17')
})
})
expect_match(stdoutput, "[1äö\n]+")
expect_match(stderroutput, "[2ua\n]+") # TODO problems with non-ascii-characters
stdoutput <- capture_output({
stderroutput <- capture.output(type = "message", {
ret <- juliaLet('println(22); @warn "This might be serious"; 17')
})
})
expect_equal(ret, 17)
expect_match(stdoutput[1], "^[\n]*22[\n]*$")
expect_match(stderroutput[1], "This might be serious")
})
test_that("A return value of nothing is not printed", {
output <- capture_output({
juliaEval("nothing")
juliaCall("identity", NULL)
juliaLet("x = y", y = NULL)
})
expect_match(output, "^[\n]*$")
})
test_that("Test loading and importing a complex package", {
skip_on_cran()
juliaEval('begin
using Pkg;
try
@eval import StatsBase
catch ex
Pkg.add("StatsBase")
end
end
') # tests also trailing whitespace
StatsBase <- juliaImport("StatsBase")
expect_equivalent(juliaGet(StatsBase$mean_and_var(c(1,2,3))), list(2,1))
StatsBase$renyientropy(rnorm(100), 1)
})
test_that("Error when trying to import a non-existent package or module", {
expect_error(juliaImport("NonExistingPkg"))
expect_error(capture.output({juliaImport(".NonExistingModule")}, type = "message"))
})
test_that("Error when passing multiple strings to import or using", {
expect_error(juliaImport(c("Pkg", "UUID")), regexp = "exactly one")
})
test_that("Example for juliaEval runs", {
v1 <- juliaExpr('v"1.0.5"')
v2 <- juliaExpr('v"1.3.0"')
expect(juliaCall("<", v1, v2), "Comparison must work")
})
test_that("Echo: empty R vector", {testEcho(c())})
test_that("Echo: double", {
expect(is.integer(juliaEcho(1L)), "Must be integer")
testEcho(1L)
})
test_that("Echo: Single Int", {
testEcho(1L)
expect(is.integer(juliaEval("1")), "1 is not integer")
testEcho(juliaEval("1"))
expect(is.double(juliaEval("2^52")), "2^52 is not double") # TODO inexactness?
testEcho(juliaEval("2^52"))
})
test_that("Echo: 1-element vector of Int in Julia", {testEcho(juliaEval("[1]"))})
test_that("Echo: Matrix of Int", {testEcho(matrix(1:6, nrow = 2))})
test_that("Echo: Single Float64", {
testEcho(juliaEval("1.0"))
testEcho(1)
})
test_that("UInt32, Float16, and Float32 translated to doubles in R", {
toTest <- c("Float16(1.5)", "Float16[]", "Float16[1.5]",
"Float32(1.5)", "Float32[]", "Float32[1.5]",
"UInt32(32)", "UInt32[]", "UInt32[32]")
for (expr in toTest) {
expect(is.double(juliaEval(expr)), "Must be double")
}
})
test_that("Echo: 0-element vector of Float64 in Julia", {testEcho(juliaEval("Float64[]"))})
test_that("Echo: 1-element vector of Float64 in Julia", {testEcho(juliaEval("[1.0]"))})
test_that("Echo: 2-element vector of Float64/double", {
testEcho(c(1, 2))
testEcho("[1.0; 2.0]")
})
test_that("Echo: matrix of Float64 in Julia", {
testEcho(juliaEval("[1.0 2.0; 3.0 4.0]"))
testEcho(matrix(c(1,2,3,4,4,5), nrow = 2))
})
test_that("Echo: 1-element vector of Float32 in Julia", {testEcho(juliaEval("[1.0f0]"))})
test_that("Echo: matrix of Float32 in Julia", {testEcho(juliaEval("[1.0f0 2.0f0; 3.0f0 4.0f0]"))})
test_that("Echo: 1-element vector of String in Julia", {testEcho(juliaEval('String["bla"]'))})
test_that("Echo: 0-element vector of String in Julia", {testEcho("String[]")})
test_that("Echo: 1-element vector of String in R", {testEcho("bla")})
test_that("Echo: 2-element vector of String in R", {testEcho(c("bla", "blup"))})
test_that("Echo: 2-element vector of String in Julia", {testEcho(juliaEval('String["bla", "blup"]'))})
test_that("Echo: String with missing values", {
x <- c("Yes", "No", NA)
y <- juliaEcho(x)
expect_true(is.na(y[3]))
x <- matrix(c("bla", NA, NA, "NA"), nrow = 2)
y <- juliaEcho(x)
expect_false(is.na(y[1,1]))
expect_true(is.na(y[1,2]))
expect_true(is.na(y[2,1]))
expect_false(is.na(y[2,2]))
})
test_that("Echo: Int vector with missing values", {
expect_true(juliaLet("x[1] == 1 && ismissing(x[2]) && x[3] == 3", x = c(1L,NA, 3L)))
expect_true(juliaLet("ismissing(x)", x = NA_integer_))
x <- juliaEval("[1 missing 3; 3 missing 4 ]")
expect_type(x, "integer")
expect_true(all(is.na(x[,2])))
expect_null(attr(x, "JLTYPE"))
x <- juliaEval("[2^52 missing 3; 2^53 missing 4 ]")
expect_type(x, "double")
expect_true(all(is.na(x[,2])))
expect_equal(x[1,1], 2^52)
expect_equal(x[2,1], 2^53)
testEcho(x)
x <- juliaEval("Union{Int32,Missing}[1 missing 3; 3 missing 4 ]")
expect_type(x, "integer")
expect_true(all(is.na(x[,2])))
expect_equal(x[1,1], 1)
expect_equal(x[2,1], 3)
testEcho(x)
x <- juliaEval("Union{Int16,Missing}[-1 missing 3; 3 missing 4 ]")
expect_type(x, "integer")
expect_true(all(is.na(x[,2])))
expect_equal(x[1,1], -1)
expect_equal(x[2,1], 3)
testEcho(x)
testEcho(c(1L, 2L, NA, NA))
testEcho(matrix(c(1L, 2L, NA, NA), nrow = 2))
})
test_that("Echo: Double vector with missing values", {
expect_true(juliaLet("x[1] == 1.0 && ismissing(x[2]) && x[3] == 3.0", x = c(1,NA, 3)))
expect_true(juliaLet("ismissing(x)", x = NA_integer_))
x <- juliaEval("[1.0 missing 3.0; 3.0 missing 4.0 ]")
expect_type(x, "double")
expect_true(all(is.na(x[,2])))
expect_null(attr(x, "JLTYPE"))
x <- juliaEval("Union{Float32,Missing}[1.0f0 missing 3.0f0; 3.0f0 missing 4.0f0 ]")
expect_true(all(is.na(x[,2])))
expect_equal(x[1,1], 1)
expect_equal(x[2,1], 3)
testEcho(x)
testEcho(c(1, 2, NA, NA))
testEcho(matrix(c(1, 2, NA, NA), nrow = 2))
})
test_that("Dirty missing values are recognized", {
dirtyNa <- c(as.raw(0xa2), as.raw(0x07), as.raw(0x00), as.raw(0x00),
as.raw(0x00), as.raw(0x00), as.raw(0xf8), as.raw(0x7f))
dirtyNA <- readBin(dirtyNa, what = "double", endian = "little")
expect_true(is.na(dirtyNA) && !is.nan(dirtyNA))
expect_true(juliaCall("ismissing", dirtyNA))
expect_true(juliaLet("ismissing(x[2])", x = c(1, dirtyNA)))
echoDirtyNA <- juliaEcho(dirtyNA)
expect_true(is.na(echoDirtyNA) && ! is.nan(echoDirtyNA))
dirtyComplexNA <- complex(real = dirtyNA, imaginary = dirtyNA)
expect_true(is.na(dirtyComplexNA) && !is.nan(dirtyComplexNA))
expect_true(juliaCall("ismissing", dirtyComplexNA))
x <- c(1+1i, dirtyComplexNA, NA)
expect_true(juliaLet("ismissing(x[2]) && ismissing(x[3])", x = x))
testEcho(x)
# The following doesn't work: dirtNA coerced to NA+0i, not NA+NA*i:
# expect_true(juliaLet("ismissing(x[2])", x = c(1+1i, dirtyNA)))
echoDirtyComplexNA <- juliaEcho(dirtyComplexNA)
expect_true(is.na(echoDirtyComplexNA) && !is.nan(echoDirtyComplexNA))
})
test_that("NaN and NA are handled differently", {
# NaN in R is translated to a NaN Float64 value in Julia
# NA in R is translated to a missing value in Julia
x <- juliaEval("[1; missing; NaN]")
expect_equal(x[1], 1)
expect_true(is.na(x[2]) && !is.nan(x[2]))
expect_true(is.nan(x[3]))
y <- juliaEcho(x)
expect_equal(y[1], 1)
expect_true(is.na(y[2]) && !is.nan(y[2]))
expect_true(is.nan(y[3]))
expect_equal(juliaCall("typeof", c(1, NA)),
juliaEval("Array{Union{Float64,Missing},1}"))
expect_equal(juliaCall("typeof", c(1, NaN)),
juliaEval("Array{Float64,1}"))
expect_equal(juliaCall("typeof", c(1+1i, NA)),
juliaEval("Array{Union{Complex{Float64},Missing},1}"))
expect_equal(juliaCall("typeof", c(1+1i, NaN)),
juliaEval("Array{Complex{Float64},1}"))
expect_true(juliaLet("ismissing(x[2])", x = c(1+1i, NA)))
})
test_that("Missing values transferred as NA", {
expect_true(is.na(juliaEval("missing")))
expect_true(all(is.na(juliaEval("[missing; missing]"))))
expect_true(all(is.na(juliaEval("[missing missing; missing missing]"))))
})
test_that("Logical with missing values", {
juliaLet("x[1] && !x[2] && ismissing(x[3])", x = c(TRUE, FALSE, NA))
x <- c(TRUE, FALSE, NA)
testEcho(x)
})
test_that("Complex with missing values", {
juliaLet("x[1] == 1+1im && x[2] == 2+2im && ismissing(x[3])", x = c(1 +1i, 2+2i, NA))
x <- c(1 +1i, 2+2i, NA)
testEcho(x)
x <- juliaEval("[1+1im 1+2im; 0 missing]")
expect_equivalent(x, matrix(c(1+1i, 0, 1+2i, NA), nrow = 2))
testEcho(x)
x <- juliaEval("[1.0+im 2.0+im; 0.0 missing]")
expect_equal(x, matrix(c(1+1i, 0, 2+1i, NA), nrow = 2))
expect_true(is.null(attr(x, "JLTYPE")))
testEcho(x)
})
test_that("Echo: logical vectors", {
testEcho(juliaEval('Bool[]'))
testEcho(logical())
testEcho(TRUE)
testEcho(FALSE)
testEcho(c(TRUE, FALSE))
testEcho("Bool[true]")
})
test_that("Echo: Pointers", {
arrPtr <- juliaFun("Base.pointer", list(1,2,3))
ptr <- arrPtr(2L)
expect_type(ptr, "raw")
testEcho(ptr)
ptrs <- juliaCall("map", arrPtr, as.integer(1:3))
testEcho(ptrs)
})
test_that("Echo: Ref", {
testEcho(juliaCall("Ref", list(1,2,3), 2L))
r <- juliaEval("global reftestvar = 1; Ref(reftestvar)")
testEcho(r)
})
test_that("Complex values are handled first class", {
testEcho(1i)
testEcho(juliaEval("1+im"))
testEcho(juliaEval("[1+im]"))
testEcho(juliaEval("[1+im; 2+im]"))
testEcho(c(1+1i,2 + 2i))
suppressWarnings({jla <- juliaImport("LinearAlgebra")})
testEcho(matrix(c(1, 0, 0, -1), ncol = 2))
expect(all(jla$eigvals(matrix(c(1, 0, 0, -1), ncol = 2),
matrix(c(0, 1, 1, 0), ncol = 2)) %in% c(1i, -1i)),
"")
expect(all(jla$eigmax(matrix(c(0, 1i, -1i, 0), ncol = 2)) == 1.0), "")
complexTypeParameters = c("Int8", "Int16", "Int32", "Int64",
"Float16", "Float32", "Float64")
for (complexPar in complexTypeParameters) {
juliaComplexType <- paste0("Complex{", complexPar, "}")
c <- juliaEval(paste0(juliaComplexType, "(5-3im)"))
expect_equivalent(c, 5 - 3i)
carr <- juliaEval(paste0(juliaComplexType, "[4+4im, 2-2im]"))
expect_equivalent(carr, c(4+4i, 2-2i))
if (complexPar == "Float64") {
expect_null(attr(c, "JLTYPE"))
} else {
expect_true(juliaCall("==", juliaEval(attr(c, "JLTYPE")),
juliaEval(juliaComplexType)))
}
}
})
test_that("Echo: raw vector", {
testEcho(as.raw(c(1,2,3)))
testEcho(juliaEval("[0x01]"))
testEcho(juliaEval("UInt8[]"))
expect_equivalent(juliaEval("[0x01 0x02; 0x03 0x04]"),
matrix(c(1,3,2,4), nrow = 2))
expect_equal(juliaCall("string", c(as.raw(0xca), as.raw(0xfe))),
"UInt8[0xca, 0xfe]")
})
test_that("Echo: raw vector", {
testEcho(juliaEval("Int32[1, 2]"))
testEcho(juliaEval("Int32[]"))
testEcho(juliaEval("Int32[1]"))
})
test_that("Echo: Single Int16", {testEcho(juliaEval('Int16(300)'))})
test_that("Echo: Int16 Vector", {testEcho(juliaEval('Int16[1,2,3]'))})
test_that("Echo: 1-element Int16 Vector", {
expect_equal(juliaCall("string", juliaEval('Int16[300]')),
"Int16[300]")
})
test_that("Echo: Single UInt128", {testEcho(juliaEval('UInt128(2)^100 +1'))})
test_that("Echo: UInt128 Vector", {testEcho(juliaEval('UInt128[1,2,3]'))})
test_that("Echo: 1-element UInt128 Vector", {
expect_equal(juliaCall("string", juliaEval('UInt128[1]')),
"UInt128[0x00000000000000000000000000000001]")
})
test_that("Echo: List with NULL elements", {
x <- juliaGet(juliaEcho(list(1, NULL, 3)))
expect_equal(x[[1]], 1)
expect_null(x[[2]])
expect_equal(x[[3]], 3)
expect_equal(length(x), 3)
testEcho(juliaEval('[1, nothing, 3]'))
x <- list("bla", NULL)
expect_equal(x[[1]], "bla")
expect_null(x[[2]])
x <- list(NULL, NULL)
expect_null(x[[1]])
expect_null(x[[2]])
})
test_that("Mutable struct usable by reference", {
juliaEval('mutable struct TestMutableStruct
x::Int
end')
jlRef <- juliaEval("TestMutableStruct(1)")
refEcho <- juliaEcho(jlRef)
expect_true(juliaCall("==", jlRef, refEcho))
expect_true(all(get("ref", jlRef) == get("ref", refEcho)))
expect_equal(refEcho$x, 1)
refEcho$x <- 2L
expect_equal(jlRef$x, 2)
ref <- get("ref", jlRef)
jlRef <- NULL
refEcho <- NULL
invisible(gc())
juliaEval("1")
expect_false(juliaLet("haskey(communicator.sharedheap, ref)", ref = ref,
communicator = JuliaConnectoR:::pkgLocal$communicator))
# Test behaviuor with juliaGet:
# The reference must be attached
jlRefEnv <- attr(juliaGet(juliaEval("TestMutableStruct(1)")), "JLREF")
expect_true(is.environment(jlRefEnv))
expect_true(is.raw(jlRefEnv$ref))
})
test_that("Immutable struct usable by reference and translated", {
juliaEval('struct TestImmutableStruct
x::Int
end')
jlRef <- juliaEval("TestImmutableStruct(1)")
expect_s3_class(jlRef, "JuliaStructProxy")
refEcho <- juliaEcho(jlRef)
expect_true(juliaCall("==", jlRef, refEcho))
expect_equal(refEcho$x, 1)
ref <- get("ref", jlRef)
expect_equal(juliaGet(jlRef)$x, 1)
expect_false(juliaLet("haskey(communicator.sharedheap, ref)", ref = ref,
communicator = JuliaConnectoR:::pkgLocal$communicator))
gc()
juliaEval("1")
})
test_that("Currying in juliaFun works", {
plus1 <- juliaFun("+", 1)
plus1(2)
expect_equal(juliaCall("map", plus1, c(1,2,3)), c(2,3,4))
})
test_that("Multidimensional object arrays work", {
juliaEval("struct MultiTestStruct
f::Float64
end")
content <- juliaEval("rand(4,5,6)")
testEcho(content)
x <- juliaLet("map(MultiTestStruct, c)", c = content)
testEcho(x)
expect_equivalent(dim(x), c(4,5,6))
expect_equivalent(juliaGet(x[1,1,1]), list(juliaGet(x[[1,1,1]])))
x[[1,2,3]] <- juliaEval("MultiTestStruct(17.0)")
expect_equal(x[[1,2,3]]$f, 17)
x[1,2,2] <- juliaEval("MultiTestStruct(19.0)")
expect_equal(x[[1,2,2]]$f, 19)
x[1,2,2] <- list(juliaEval("MultiTestStruct(19.0)"))
expect_equal(x[[1,2,2]]$f, 19)
expect_equal(dim(x[3:4, 4:5, 1]), c(2,2,1))
expect_equal(dim(x[3:4, as.integer(4:5), 1L]), c(2,2,1))
x[3:4, as.integer(4:5), 1L] <- juliaEval("MultiTestStruct(20.0)")
expect_equal(juliaGet(x[[3, 4, 1]])$f, 20)
expect_equal(juliaGet(x[[4, 5, 1]])$f, 20)
y <- juliaGet(x)
attr(y, "JLDIM") <- c(1L, 2L, 3L)
expect_error(juliaEcho(y), regexp = "Incorrect dimensions")
# Must also work with dimensions of zero
testEcho(juliaEval("Matrix{MultiTestStruct}(undef, 0, 0)"))
x <- juliaEval("Array{MultiTestStruct}(undef, 0, 0, 0)")
testEcho(x)
expect_equivalent(dim(x), c(0,0,0))
# Two dimensions
content <- juliaEval("rand(2,3)")
x <- juliaLet("map(MultiTestStruct, c)", c = content)
x[[1,2]] <- juliaEval("MultiTestStruct(3.0)")
expect_equal(x[[1,2]]$f, 3)
})
test_that("Arrays with undef entries are translated", {
juliaEval("mutable struct MutableTestStruct
f::Float64
end")
# all undefs
testEcho(juliaEval("Vector{MutableTestStruct}(undef, 3)"),
comparableInJulia = FALSE)
# undefs and values
juliaLet("x = Vector{MutableTestStruct}(undef, 3);
x[1] = MutableTestStruct(x1);
x[2] = MutableTestStruct(x2);
x", x1 = 1.0, x2 = 2.0)
testEcho(juliaEval("Vector{MutableTestStruct}(undef, 3)"),
comparableInJulia = FALSE)
# multidimensional arrays with undefs and values
x <- juliaLet("x = Array{MutableTestStruct}(undef, 2, 3, 4);
x[1,1,1] = MutableTestStruct(x1);
x[2,2,2] = MutableTestStruct(x2);
x", x1 = 1.0, x2 = 2.0)
testEcho(x, comparableInJulia = FALSE)
expect_equal(x[[1]]$f, 1)
})
test_that("Undefined strings are transferred as empty strings", {
expect_equal(juliaEval("Vector{String}(undef, 3)"), c("", "", ""))
})
test_that("String with null can be translated back to Julia", {
# einfacher string
jlStrWithNul <- "String([0x48, 0x65, 0x6c, 0x6c, 0x6f, 0x00, 0x5a, 0x65, 0x72, 0x6f, 0x57])"
str <- juliaEval(jlStrWithNul)
expect_true(is.raw(str))
expect_equal(as.character(juliaCall("typeof", str)), "String")
expect_equal(as.character(juliaLet("String(x[1:5])", x = str)), "Hello")
# string array
strArr <- juliaLet("String[a,b]", a = str, b = str)
expect_true(is.list(strArr))
strArr <- juliaLet("String[a,b,c]", a = str, b = str, c = str)
expect_true(is.list(strArr))
expect_equal(juliaCall("typeof", strArr), juliaEval("Array{String,1}"))
})
# Test Let
test_that("Let: used like eval", {
output <- capture_output({expect(is.null(juliaLet("print(1)")), "Failed")})
expect_equal(output, "1")
})
test_that("Let: must error with no named argument", {expect_error(juliaLet("print(x)", 1), "")})
test_that("Let: basic echo", {expect(all(juliaLet("identity(x)", x=c(2, 3)) == c(2,3)), "Failed")})
test_that("Let: Simple example from documentation works", {
expect_equal(capture_output({juliaLet('println(x)', x = 1)}),
capture_output({juliaEval('let x = 1.0; println(x) end')}))
})
test_that("Let: arguments without names not accepted", {
expect_error(juliaLet("println(1)", 1), regexp = "names")
expect_error(juliaLet("println(1)", x=1, 1, y=2), regexp = "names")
})
#Test Pairs
test_that("Echo: Pairs", {
testEcho(juliaEval("(1 => 2.0)"))
testEcho(juliaEval("1 => 2.0 => 3.0"))
testEcho(juliaEval("[1 => 2.0, 2 => 3.0]"))
})
# Test Tuples
test_that("Echo: Tuples", {
x <- juliaEval("(1, 17, 18)")
expect_equal(x[[2]], 17)
expect_equal(juliaGet(x[1]), juliaGet(juliaEval("(1,)")))
expect_length(x, 3)
expect_length(x[1:2], 2)
testEcho(juliaEval("(1, 2.0)"))
testEcho(juliaEval("((1, 2.0), 3.0)"))
testEcho(juliaLet("collect(zip(x,y))", x = c(1L,2L, 3L), y = c(1,0,1)))
testEcho(juliaEval("(Ref(false), Ref(true))"))
testEcho(juliaEval("Tuple{}()"))
})
# Test Named Tuples
test_that("Echo: Named Tuples", {
namedTuple <- juliaLet("y=2*x; z = 3*u + 1; (x=y, y=z)", x=2, u=4)
expect_s3_class(namedTuple, "JuliaStructProxy")
expect_equal(namedTuple$y, 13)
expect_type(juliaGet(namedTuple), "list")
expect_equal(juliaGet(namedTuple)$y, 13)
testEcho(namedTuple)
})
# Test Module
test_that("Echo: Module", {
juliaEval("module TestModule end")
testEcho(juliaEval("TestModule"))
})
test_that("Echo: Symbol", {
x <- juliaEval(":asymbol")
expect_true(is.symbol(x))
expect_true(juliaCall("isa", as.symbol("s"), juliaExpr("Symbol")))
testEcho(x)
})
# Test Dictionary
test_that("Echo: Dictionary", {
d <- juliaEval("Dict(:bla => 1.0, :blup => 3.0)")
expect_equivalent(d[juliaExpr(":bla")][[1]], 1)
expect_equal(d[juliaExpr(":bla"), juliaExpr(":bla")], as.list(c(1, 1)))
expect_equal(d[[as.symbol("bla")]], 1)
expect_equal(d[as.symbol("blup")],list(3))
d[juliaExpr(":blup")] <- 4
expect_equal(d[[juliaExpr(":blup")]], 4)
d[[juliaExpr(":blup")]] <- 5
expect_equal(d[[juliaExpr(":blup")]], 5)
d2 <- juliaGet(d)
expect_setequal(d2[["keys"]], juliaGet(juliaEval("[:bla, :blup]")))
expect_setequal(d2[["values"]], list(1, 5))
d[juliaExpr(":hi"), juliaExpr(":hello")] <- c(15, 14)
expect_equal(d[juliaExpr(":bla"), juliaExpr(":hi")], as.list(c(1, 15)))
d[juliaExpr(":hi"), juliaExpr(":hello")] <- as.list(c(16, 17))
expect_equal(d[juliaExpr(":bla"), juliaExpr(":hello"), juliaExpr(":hi")], as.list(c(1, 17, 16)))
expect_length(d[juliaExpr(":bla"), juliaExpr(":hi"), juliaExpr(":hello"), juliaExpr(":hello")], 4)
d <- juliaLet("Dict(zip(x, y))", x = c("bla", "blup"), y = c(1,2))
expect_equal(d[["bla"]], 1)
expect_equivalent(d["blup"], list(2))
d2 <- juliaGet(d)
expect_setequal(d2[["keys"]], list("bla", "blup"))
expect_setequal(d2[["values"]], list(1, 2))
d2 <- juliaGet(d)
expect_setequal(d2[["keys"]], list("bla", "blup"))
expect_setequal(d2[["values"]], list(1,2))
d$bla <- 17
expect_equal(d$bla, 17)
d <- juliaLet("Dict(zip(x, y))", x = list("bla"), y = list(1))
expect_equal(length(juliaCall("keys", d)), 1)
testEcho(d)
d <- juliaLet("Dict(zip(x, y))", x = list(), y = list())
d2 <- juliaGet(d)
expect_length(d2[["keys"]], 0)
expect_length(d2[["values"]], 0)
testEcho(d)
})
# Test Set
test_that("Echo: Set", {
s1 <- juliaEval("Set([1; 2; 3; 4])")
s2 <- juliaEval("Set([1; 2])")
expect_length(setdiff(juliaGet(juliaEval("Set([1; 2; 3; 4])")),
c(1,2,3,4)), 0)
expect_length(setdiff(juliaGet(juliaLet("setdiff(s1, s2)", s1 = s1, s2 = s2)),
c(3,4)), 0)
testEcho(s1)
})
# Test types with bitstypes
test_that("Object with bitstype", {
uuidregex <- '^[a-f0-9]{8}-?[a-f0-9]{4}-?4[a-f0-9]{3}-?[89ab][a-f0-9]{3}-?[a-f0-9]{12}$'
UUIDs <- juliaImport("UUIDs")
expect_match(juliaCall("string", UUIDs$uuid4()), uuidregex)
})
test_that("Exotic objects handled gracefully", {
x <- quote(1 + 1)
expect_type(x, "language")
expect_warning({ y <- juliaEcho(list(x = x))},
regexp = "not translatable", all = FALSE)
expect_null(y$x)
})
# Test complex constructor with all kinds of types
test_that("Complex Julia object with different member type", {
juliaEval('struct TestTypeWithAllKindsOfStuff
n::Nothing
f16::Float16
f32::Float32
f64::Float64
b::Bool
i8::Int8
ui8::UInt8
i16::Int16
ui16::UInt16
i32::Int32
ui32::UInt32
ch::Char
i64::Int64
ui64::UInt64
i128::Int128
ui128::UInt128
f16vec::Vector{Float16}
f32vec::Vector{Float32}
f64vec::Vector{Float64}
bvec::Vector{Bool}
i8vec::Vector{Int8}
ui8vec::Vector{UInt8}
i16vec::Vector{Int16}
ui16vec::Vector{UInt16}
i32vec::Vector{Int32}
ui32vec::Vector{UInt32}
chvec::Vector{Char}
i64vec::Vector{Int64}
ui64vec::Vector{UInt64}
i128vec::Vector{Int128}
ui128vec::Vector{UInt128}
end')
juliaEval('function TestTypeWithAllKindsOfStuff()
TestTypeWithAllKindsOfStuff(
nothing,
rand(Float16), rand(Float32), rand(Float64),
rand(Bool),
rand(Int8), rand(UInt8),
rand(Int16), rand(UInt16),
rand(Int32), rand(UInt32),
rand(Char),
rand(Int64), rand(UInt64),
rand(Int128), rand(UInt128),
rand(Float16, 2), rand(Float32, 2), rand(Float64, 2),
rand(Bool, 2),
rand(Int8, 2), rand(UInt8, 2),
rand(Int16, 2), rand(UInt16, 2),
rand(Int32, 2), rand(UInt32, 2),
rand(Char, 2),
rand(Int64, 2), rand(UInt64, 2),
rand(Int128, 2), rand(UInt128, 2))
end')
testEcho(juliaEval("TestTypeWithAllKindsOfStuff()"))
})
test_that("Private inner constructor is forged", {
juliaEval('struct MyPrivateX
x::Int
function MyPrivateX()
new(5)
end
end')
p <- juliaEval("MyPrivateX()")
testEcho(p)
})
test_that("Imported modules are printed", {
# a stdlib module
Pkg <- juliaImport("Pkg")
expect_match(regexp = 'Julia module "Pkg": [0-9]+ function.*',
capture.output(print(Pkg))[1])
# a user defined module
module <- juliaEval('module ImportTestModule1
export f
f(x)=1
end')
itm1 <- juliaImport(module, all = FALSE)
expectedOutput <-
'Julia module "Main.ImportTestModule1": 1 function.*'
expect_match(capture.output(print(itm1))[1], regexp = expectedOutput)
itm1_2 <- juliaImport(".ImportTestModule1", all = FALSE)
expect_match(capture.output(print(itm1_2))[1], regexp = expectedOutput)
})
test_that("Empty module does not cause problems", {
juliaEval("module EmptyTestModule end")
expect_length(ls(juliaImport(".EmptyTestModule")), 2) # (eval and include)
juliaEval("module EmptyTestModule2 end")
expect_length(ls(juliaImport(".EmptyTestModule2", all = FALSE)), 0)
})
test_that("Errors are handled gracefully", {
expect_error(juliaCall("sum", c(1,2,3, "bla")))
expect_error(juliaCall("thisisnotarealfunction", 100, 4))
expect_error(juliaCall("RConnector.thisisnotarealfunction", "haha"))
expect_error(juliaCall("NotARealModule.thisisnotarealfunction", list(1,2,3)))
})
test_that("Vectors of objects can be accessed by index via proxy", {
x <- juliaEval("[ [1;2;3], [4;5;6], [7;8;9] ]")
expect_s3_class(x, "JuliaArrayProxy")
expect_equal(x[[1]][2], 2)
expect_equal(x[[2]][2], 5)
x[[1]][1] <- 17L
expect_equal(x[[1]][1], 17)
expect_equal(x[2:3][[1]][[1]], 4)
x[2:3][[1]][[1]] <- 18L
expect_equal(x[2:3][[1]][[1]], 18)
expect_equal(x[[1]][x[[2]] == 5], 2) # logical indexing
# juliaGet version must behave in the same way as the proxy version
y <- juliaGet(x)
expect_equal(x[[2]], y[[2]])
expect_equal(x[[1]][2], y[[1]][2])
expect_equal(x[[2]][2], y[[2]][2])
x[[1]][1] <- 17L
y[[1]][1] <- 17L
expect_equal(x[[1]][1], 17)
expect_equal(y[[1]][1], 17)
x[2:3][[1]][[1]] <- 18L
y <- juliaGet(x)
expect_equal(y[2:3][[1]][[1]], 18)
expect_equal(x[2:3][[1]][1], y[2:3][[1]][1])
expect_equal(x[[2]], y[[2]])
# Multiple dimensions
y <- juliaEval("map( x-> [1;x;3], rand(2,2,2))")
expect_equivalent(y[c(1,2)][[1]], y[[1]])
expect_equivalent(y[c(1,3)][[2]], y[[3]])
y[c(1,3)] <- juliaEval("[[17.0], [18.0]]")
expect_equivalent(juliaGet(y[1]), list(17))
expect_equivalent(juliaGet(y[3]), list(18))
expect_equivalent(juliaGet(y)[c(4,5)], juliaGet(y[c(4,5)]))
})
test_that("Callback functions", {
x <- juliaEcho(function() {})
expect_equal(typeof(x), "closure")
expect_equal(x, function() {})
outputenv <- new.env(parent = emptyenv())
outputenv$output <- c()
doOutput <- function(x) {
outputenv$output <- c(outputenv$output, x)
}
# Nested callback functions
juliaEval('struct TestStruct f::Function end')
juliaEval('function testNestedFun(ts::Vector{TestStruct}) map(t -> t.f(), ts) end')
t <- juliaCall("testNestedFun",
list(juliaCall("TestStruct", function() {doOutput("a")}),
juliaCall("TestStruct", function() {doOutput("b")}),
juliaCall("TestStruct", function() {doOutput("c")})))
expect_equal(outputenv$output, c("a", "b", "c"))
# as named arguments
outputenv$output <- c()
juliaEval('function testNestedFunNamed(;ts::Vector{TestStruct}) map(t -> t.f(), ts) end')
t <- juliaCall("testNestedFunNamed", ts =
list(juliaCall("TestStruct", function() {doOutput("x")}),
juliaCall("TestStruct", function() {doOutput("y")})))
expect_equal(outputenv$output, c("x", "y"))
# test repeated call of nested functions
outputenv$output <- c()
juliaEval('function testNestedFun2(ts::Vector{TestStruct}) for i = 1:2 map(t -> t.f(), ts) end end')
t <- juliaCall("testNestedFun2",
list(juliaCall("TestStruct", function() {doOutput(1)}),
juliaCall("TestStruct", function() {doOutput(2)})))
expect_equal(outputenv$output, c(1,2,1,2))
# Test multiple arguments
outputenv$output <- c()
juliaEval('function testNestedFunArgs(ts::Vector{TestStruct}, args...) map(t -> t.f(args...), ts) end')
t <- juliaCall("testNestedFunArgs",
list(juliaCall("TestStruct", function(x, y, z) {doOutput(x)}),
juliaCall("TestStruct", function(x, y, z) {doOutput(z); return(c(5,6,7))})),
1, 2, 3)
expect_equal(outputenv$output, c(1,3))
outputenv$output <- c()
juliaEval('function testNestedAndUnnested(f::Function, ts::Vector{TestStruct}, args...)
testNestedFunArgs(ts, args...)
f(args...)
end')
t <- juliaCall("testNestedAndUnnested",
function(x, y) {doOutput(x)},
list(juliaCall("TestStruct", function(x,y) {doOutput(x)}),
juliaCall("TestStruct", function(x, y) {doOutput(y); return(list(5,6,7))})),
17,18)
expect_equal(outputenv$output, c(17, 18, 17))
})
test_that("Callback function calling Julia erroring in Julia", {
f <- juliaEval('(x) -> error("Error")')
g <- function(x) {cat("OK"); f(x); print("NotOK"); x}
output <- capture.output(expect_error(juliaCall("map", g, c(1,2,3))))
expect_equal(output, "OK")
})
test_that("Builtin functions can be used as callback functions", {
expect_equal(juliaCall("map", sqrt, c(1,4,9)), c(1,2,3))
})
test_that("Callback function might have error in R", {
fOK <- function(x) { return(x+1) }
fnotOK <- function(x) {
if (x == 2) {
stop("No even numbers please")
} else {
return(1)
}
}
expect_equal(juliaCall("map", fOK, c(1,2,3)), c(2,3,4))
expect_error(juliaCall("map", fnotOK, c(1,2,3)), class = "error")
})
test_that("Julia functions as members are transferred and usable in R", {
op1 <- juliaFun("+")
juliaEval('struct FunTestStruct f::Function end')
funTestStruct <- juliaCall("FunTestStruct", op1)
expect_equal(funTestStruct$f(1,2), 3)
})
test_that("juliaCall checks given name before running", {
expect_error(juliaCall())
expect_error(juliaCall(1))
expect_error(juliaCall(c("bla", "bla")))
})
test_that("juliaCall can handle keyword arguments with key \"name\"", {
Pkg <- juliaImport("Pkg")
# indirect via created function object
expect_equal(Pkg$PackageSpec(name = "RData", version = "v0.10")$name,
"RData")
# direct call of juliaCall
pkgspec <- juliaCall("Pkg.PackageSpec", name = "RData", version = "0.10")
expect_equal(pkgspec$name, "RData")
})
test_that("Documentation example of juliaFun", {
juliaSqrt <- juliaFun("sqrt")
expect_equal(juliaSqrt(2), sqrt(2))
expect_equal(juliaCall("map", juliaSqrt, c(1,4,9)), c(1,2,3))
})
test_that("Constructors stand for their types", {
juliaEval('module TestTypeModule
export TestType
struct TestType end
end')
TestTypeModule <- juliaImport(".TestTypeModule")
expect_equal(as.character(juliaCall("typeof", TestTypeModule$TestType)),
"DataType")
})
test_that("Parametric types are imported", {
juliaEval("module ParametricTypeTestModule
export MyParametricType
struct MyParametricType{T}
i::T
end
end")
ParametricTypeTestModule <- juliaImport(".ParametricTypeTestModule")
expect_equal(ParametricTypeTestModule$MyParametricType(2)$i, 2)
expect_equal(ParametricTypeTestModule$MyParametricType("bla")$i, "bla")
})
test_that("Starting and stopping Julia server" , {
stopJulia()
port <- startJuliaServer()
expect_match(Sys.getenv("JULIACONNECTOR_SERVER"), paste0("localhost:", port))
# starting the server twice should give a warning and not do anything
expect_warning(startJuliaServer())
expect_match(Sys.getenv("JULIACONNECTOR_SERVER"), paste0("localhost:", port))
# now the server should start successfully
expect_equal(juliaEval("1"), 1)
# set a variable in a separate process:
rPath <- file.path(R.home("bin"), "R")
if (Sys.info()["sysname"] == "Windows") {
rPath <- paste0(rPath, ".exe")
}
system2(rPath, c("-e", shQuote(
paste0("library(JuliaConnectoR); juliaEval('global x = 1')"))),
stdout = FALSE)
# check that variable is set in this Julia session,
# i.e. that the two R processes share the same Julia process
expect_equal(juliaEval("x"), 1)
stopJulia()
expect_equal(Sys.getenv("JULIACONNECTOR_SERVER"), "")
expect_null(JuliaConnectoR:::pkgLocal$con)
})
test_that("Julia startup options can be modified", {
stopJulia()
oldJuliaOpts <- Sys.getenv("JULIACONNECTOR_JULIAOPTS")
# set project directory via startup opts
projectPathWithSpaces <- file.path(tempdir(), "Dirname with Spaces")
dir.create(file.path(tempdir(), "Dirname with Spaces"))
specifyProjectOpts <- paste0('--project="', projectPathWithSpaces, '"')
Sys.setenv("JULIACONNECTOR_JULIAOPTS" = paste0('--project="',
projectPathWithSpaces, '"'))
expect_match(capture.output({juliaEval("import Pkg; Pkg.status()")}),
regexp = "Dirname with Spaces", fixed = TRUE, all = FALSE)
stopJulia()
# set two startup opts: project directory and deprecation warnings
Sys.setenv("JULIACONNECTOR_JULIAOPTS" = paste(specifyProjectOpts,
"--depwarn=no"))
juliaDepWarn <- 'Base.depwarn("there is a deprecation warning", :foo)'
expect_length(capture.output({juliaEval(juliaDepWarn)}), 0)
stopJulia()
# clean up
unlink(projectPathWithSpaces, recursive = TRUE)
if (oldJuliaOpts == '') {
Sys.unsetenv("JULIACONNECTOR_JULIAOPTS")
} else {
Sys.setenv("JULIACONNECTOR_JULIAOPTS" = oldJuliaOpts)
}
})
test_that("JULIACONNECTOR_SERVER environment variable and Killing Julia works", {
# if JULIACONNECTOR_SERVER is used, the server must be started with
# "keeprunning = true" to work.
skip_on_cran()
JuliaConnectoR:::stopJulia()
oldJuliaConnectorServer <- Sys.getenv("JULIACONNECTOR_SERVER")
# start new JuliaConnectoR server
port <- JuliaConnectoR:::startJuliaServer(12980)
expect_match(Sys.getenv("JULIACONNECTOR_SERVER"), paste0("localhost:", port))
# test with wrong variable
Sys.setenv("JULIACONNECTOR_SERVER" = "wrong form")
expect_error(JuliaConnectoR:::startJulia(), regexp = "<host>:<port>")
# now for real
Sys.setenv("JULIACONNECTOR_SERVER" = paste("localhost", port, sep = ":"))
# test some command, if it works
expect_equal(juliaCall("prod", c(1,2)), 2)
# test killing
JuliaConnectoR:::killJulia()
if (oldJuliaConnectorServer == "") {
Sys.unsetenv("JULIACONNECTOR_SERVER")
} else {
Sys.setenv("JULIACONNECTOR_SERVER" = oldJuliaConnectorServer)
}
})
test_that("Error if Julia is not setup properly", {
oldJuliaBindir <- Sys.getenv("JULIA_BINDIR")
Sys.setenv("JULIA_BINDIR" = "/this/isnot/a/directory/")
expect_error(JuliaConnectoR:::runJuliaServer(16752), "No Julia executable file found")
if (oldJuliaBindir == "") {
Sys.unsetenv("JULIA_BINDIR")
} else {
Sys.setenv("JULIA_BINDIR" = oldJuliaBindir)
}
expect_equal(1, juliaEval("1"))
})
test_that("Fallback on juliaup fails correctly", {
skip_on_cran()
juliaCmdJuliaup <- file.path(Sys.getenv("HOME"), ".juliaup", "bin", "julia")
if (!file.exists(juliaCmdJuliaup)) {
expect_error(JuliaConnectoR:::fallbackOnDefaultJuliaupPath(), regexp = "\\?`Julia-Setup`")
} else {
expect_equal(juliaCmdJuliaup, JuliaConnectoR:::fallbackOnDefaultJuliaupPath())
}
})
test_that("Circular references do not lead to a crash", {
definition <- 'mutable struct TestRecur
r::Union{TestRecur, Int}
end'
try({juliaEval(definition)}, silent = TRUE) # (ignore redefinition error)
r <- juliaEval("r1 = TestRecur(2); r2 = TestRecur(r1); r1.r = r2; r1")
expect_match(capture.output({print(juliaEcho(r))}), regex = "circular reference", all = FALSE)
expect_error(juliaEcho(juliaGet(r)), regex = "Circular reference")
# reference only
r <- juliaEval("r1 = TestRecur(2); r2 = TestRecur(r1); r1.r = r2; r1")
expect_match(capture.output({print(juliaEcho(r))}), regex = "circular reference", all = FALSE)
expect_equal(juliaCall("typeof", r$r$r), juliaCall("typeof", r))
})
test_that("Anonymous functions can be transferred", {
af1 <- juliaEval("() -> 17")
expect_equal(af1(), 17)
expect_equal(juliaEcho(af1)(), 17)
rm(af1)
af2 <- juliaEval("(args...; kwargs...) -> 19")
expect_equal(af2(list(), 3, bla = 2), 19)
rm(af2)
# Test cleaning of references
invisible(gc(verbose = FALSE))
expect_gt(length(JuliaConnectoR:::pkgLocal$finalizedRefs), 0)
juliaEval("1")
expect_null(JuliaConnectoR:::pkgLocal$finalizedRefs)
juliaEval("struct TestAnonFunStruct
f::Function
end")
afs <- juliaEval("TestAnonFunStruct(() -> 20)")
expect_equal(afs$f(), 20)
})
test_that("Test BigInt: a Julia object with external pointers", {
# Note: It is not really recommended to translate objects with
# external pointers. Nevertheless, it should work and not cause a crash.
i1 <- juliaGet(juliaCall("BigInt", 2147483647L))
i2 <- juliaGet(juliaCall("BigInt", 2147483647L))
p <- juliaGet(juliaCall("prod", list(i1, i2, i1)))
p2 <- juliaGet(juliaCall("prod", list(i1, i2, i1)))
juliaCall("GC.gc") # references in sharedheap must survive this
jldiv <- juliaFun("div")
expect_equal(juliaCall("Int", jldiv(jldiv(p,i1), i2)), 2147483647L)
expect_equal(juliaLet("Int(div(div(p,i1),i2))", p = p, i1 = i1, i2 = i2),
2147483647)
f <- juliaLet("p/i1/i2", p = p, i1 = i1, i2 = i2)
expect_equal(juliaCall("Float64", f), 2147483647)
i1Ref <- attr(i1, "JLREF")$ref
expect_true(juliaLet("communicator.sharedheap[ref].refcount > 0",
ref = i1Ref, communicator = pkgLocal$communicator))
i1 <- NULL
invisible(gc())
juliaEval("1") # after one command, the references from R should be cleaned up
# Multiple calls to the Julia garbage are necessary for a complete clean-up as
# one finalization may make another object unreachable, which will then
# be cleaned up in the next run.
juliaCall("GC.gc")
juliaCall("GC.gc")
juliaCall("GC.gc")
expect_false(juliaLet("haskey(communicator.sharedheap, ref)", ref = i1Ref,
communicator = pkgLocal$communicator))
})
test_that("Serialized mutable struct can be restored", {
juliaEval("mutable struct TestSerializationStruct
i::Int
end")
x <- juliaGet(juliaEval("TestSerializationStruct(1)"))
tmpfile <- tempfile()
save("x", file = tmpfile)
x <- NULL
#juliaEval("println(RConnector.sharedheap)")
invisible(gc())
juliaEval("1")
juliaCall("GC.gc")
load(tmpfile)
msg <- capture.output(type = "message", {
expect_equal(juliaEcho(x)$i, 1)
})
expect_match(msg, "external references", all = FALSE)
x <- NULL
juliaEval("1")
juliaCall("GC.gc") # copy of the serialized copy is cleaned up
file.remove(tmpfile)
})
test_that("Object with unexported function defined in different modules", {
juliaEval('
module FirstModule
struct FirstType
f::Function
end
f(x::FirstType) = 1
end
module SecondModule
import ..FirstModule.f
struct SecondType
f::Function
end
f(x::SecondType) = 2
end #module')
# It doesn't matter whether SecondModule.f or FirstModule.f is used
ft1 <- juliaEval("FirstModule.FirstType(SecondModule.f)")
ft2 <- juliaEval("SecondModule.SecondType(FirstModule.f)")
expect_equal(juliaLet("x.f(x)", x = ft1), 1)
expect_equal(juliaLet("x.f(x)", x = ft2), 2)
expect_equal(juliaLet("x.f(y)", x = ft1, y = ft2), 2)
expect_equal(juliaLet("x.f(y)", x = ft2, y = ft1), 1)
})
test_that("AbstractArrays are transferred by reference and can be translated to struct", {
a <- juliaEval('using SparseArrays
A = sparse([1, 2, 3], [1, 2, 3], [0, 2, 0])')
expect_s3_class(a, "JuliaArrayProxy")
# indexing
expect_equal(a[[2,2]], 2)
# backtranslation
expect_true(juliaCall("issparse", juliaGet(a)))
testEcho(a)
})
test_that("Operators can be imported and used", {
suppressWarnings({jla <- juliaImport("LinearAlgebra", all = FALSE)})
expect_equal(jla$`<cdot>`(1,2), 2)
suppressWarnings({base <- juliaImport("Base", all = FALSE)})
expect_true(base$`<subseteq>`(c(1,2), c(1,2,3)))
})
test_that("Boltzmann machine can be trained and used", {
#skip_on_cran()
juliaEval('using Pkg;
try
@eval import BoltzmannMachines
catch ex
Pkg.add(PackageSpec(name = "BoltzmannMachines", version = v"1.2"))
end')
# Set a random seed in Julia
juliaEval("using Random; Random.seed!(5);")
BM <- juliaImport("BoltzmannMachines")
# a test data set from the BoltzmannMachines-package, just to have some data
x <- BM$barsandstripes(50L, 4L)
x
# Train DBMs with
dbm <- BM$fitdbm(x, epochs = 2L, nhiddens = c(4L,3L))
dbm
dbm2 <- BM$fitdbm(x, epochs = 1L,
pretraining = list(BM$TrainLayer(nhidden = 4L),
BM$TrainLayer(nhidden = 3L)))
dbm2 <- juliaGet(dbm2)
# Use a trained model to generate samples
gensamples <- BM$samples(dbm, 10L)
expect_equal(nrow(gensamples), 10)
# Evaluate the model: Likelihood estimation ...
BM$loglikelihood(dbm2, x)
# ... or exact calculation (possible for such a small model)
BM$exactloglikelihood(dbm2, x)
})
test_that("juliaPut", {
x <- juliaPut(c(1,2,3))
expect_s3_class(x, "JuliaSimpleArrayProxy")
expect_equal(x[[1]], 1)
expect_equal(x[1:2], c(1,2))
expect_type(x[3], "double")
x[2:3] <- 0
expect_equal(juliaCall("sum", x), 1)
expect_error(juliaPut(juliaEval("(a=1,b=2,c=3)")))
x <- juliaPut("bla")
expect_equal(as.character(juliaCall("typeof", x)), "String")
# use on translated object
x <- juliaGet(juliaEval("[(1,2), (2,3)]"))
expect_s3_class(juliaPut(x), "JuliaArrayProxy")
})
test_that("Display of default printing is limited to width", {
x <- juliaEval("rand(100, 100)")
y <- juliaPut(x)
printOutput <- capture.output({print(y)})
expect_lte(nchar(printOutput[length(printOutput)]),
getOption("width"))
})
test_that("Error message for tables", {
capture.output({JuliaConnectoR:::showUpdateTablesMsg()})
x <- juliaEcho(list(c(1,2), c(1,2,3)))
expect_s3_class(x, "JuliaProxy")
expect_error({as.data.frame(x)})
})
test_that("Data frame can be translated", {
x <- data.frame(x = c(0, 2, 4), y = c("bla", "blup", "ha"),
stringsAsFactors = FALSE)
testEcho(x)
y <- juliaEcho(x)
x2 <- as.data.frame(juliaEcho(x))
expect_s3_class(x2, "data.frame")
expect_equal(x2$x, c(0,2,4))
expect_equal(x2$y, c("bla", "blup", "ha"))
testEcho(data.frame())
Pkg <- juliaImport("Pkg")
if (juliaEval('VERSION < v"1.6"')) {
subproject <- "1_0"
} else if (juliaEval('VERSION < v"1.10"')) {
subproject <- "1_6"
} else {
subproject <- "1_10"
}
Pkg$activate(system.file("examples", "IndexedTables-Project", subproject,
package = "JuliaConnectoR"))
Pkg$instantiate()
juliaEval("import IndexedTables")
x <- data.frame(x = c(0, 2, 4), y = c("bla", "blup", "ha"),
stringsAsFactors = FALSE)
y <- juliaCall("IndexedTables.table", x)
expect_equal(as.data.frame(x), x)
# Works also without column names (Issue #16)
df <- juliaCall("IndexedTables.table", 1:3, 11:13)
df <- as.data.frame(df)
expect_equal(df[, 1], 1:3)
expect_equal(df[, 2], 11:13)
})
test_that("Attempt to translate Julia Table with incompatible types results in proper error", {
juliaEval("import IndexedTables")
x <- juliaEval('IndexedTables.table(["a", 1, 2], [1,2,3])')
expect_error(as.data.frame(x), regexp = 'Column type "Any" cannot be translated')
})
test_that("Julia types are converted to r compatible types in data frames", {
x1 <- juliaEval("[1.0f0*im + 1.0f0, 0.0f0]")
x2 <- juliaEval('map(i -> SubString(i, 2,3), ["asdf", "wert"])')
x3 <- juliaEval('[true, false]')
x4 <- juliaEval("['a', 'b']")
x <- juliaLet('Dict(:x1 => x1, :x2 => x2, :x3 => x3, :x4 => x4)',
x1 = x1, x2 = x2, x3 = x3, x4 = x4)
x <- as.data.frame(x)
expect_equivalent(x$x1, x1)
expect_equal(x$x2, c("sd", "er"))
expect_equal(x$x3, x3)
expect_equivalent(x$x4, x4)
})
test_that("Broadcasting via dot syntax works", {
expect_equal(juliaCall("sin.", c(0, 1/3*pi, pi/2)),
c(0, sqrt(3)/2, 1))
juliaEval("import Statistics")
arrofarrs <- juliaEval("[[2;3], [4;5]]")
expect_equal(juliaCall("Statistics.mean.", arrofarrs), c(2.5, 4.5))
expect_equal(juliaGet(juliaCall("Statistics.mean.", arrofarrs, dims = 1L)),
juliaGet(juliaEval("[[2.5], [4.5]]")))
# Test functions with multiple arguments
juliaEval("module TestBroadcasting
function my_add(x,y) x+y end
function my_mul(x,y) x*y end
end")
expect_equal(juliaCall("TestBroadcasting.my_add.", 10, c(1,2,3)),
juliaEval("TestBroadcasting.my_add.(10, [1, 2, 3])"))
expect_equal(juliaCall("TestBroadcasting.my_mul.", c(1,2,3), c(4,5,6)),
juliaEval("TestBroadcasting.my_mul.([1, 2, 3], [4, 5, 6])"))
# Check that dimension mismatch leads to an error
expect_error(juliaCall("TestBroadcasting.my_mul.", c(1,2,3,4), c(5,6)))
})
test_that("Environemnt variables for Julia can be set", {
# prepare
os <- Sys.info()['sysname']
oldJuliaEnv <- Sys.getenv("JULIACONNECTOR_JULIAENV")
JuliaConnectoR:::stopJulia()
# Test with one variable
Sys.setenv(JULIACONNECTOR_JULIAENV = "TESTVARIABLE1=1")
if (os == "Windows") {
expect_warning(juliaEval("1+1"))
} else {
expect_equal(juliaEval('ENV["TESTVARIABLE1"]'), "1")
}
JuliaConnectoR:::stopJulia()
# Test with two variables
Sys.setenv(JULIACONNECTOR_JULIAENV = "TESTVARIABLE1=1; TESTVARIABLE2='abc'")
if (os == "Windows") {
expect_warning(juliaEval("1+1"))
} else {
expect_equal(juliaEval('ENV["TESTVARIABLE1"]'), "1")
expect_equal(juliaEval('ENV["TESTVARIABLE2"]'), "abc")
}
JuliaConnectoR:::stopJulia()
# LD_LIBRARY_PATH can be set via JULIACONNECTOR_JULIAENV
Sys.setenv(JULIACONNECTOR_JULIAENV = "LD_LIBRARY_PATH='abc'")
if (os == "Linux") {
expect_match(JuliaConnectoR:::getJuliaEnv(), "LD_LIBRARY_PATH='abc'")
}
# clean up
if (oldJuliaEnv == "") {
Sys.unsetenv("JULIACONNECTOR_JULIAENV")
} else {
Sys.setenv(JULIACONNECTOR_JULIAENV = oldJuliaEnv)
}
})
test_that("Iris/Flux example from README works", {
skip_on_cran()
skip_on_covr()
#skip_if(Sys.info()["login"] %in% c("lenz", "Stefan Lenz", "selectstern", "lenzstef"))
cat("\nExecuting README examples...\n")
if (juliaEval('VERSION < v"1.9"')) {
skip("Skip Flux example because Julia version is too old")
} else {
projectFolder <- "project_1_9"
}
Pkg <- juliaImport("Pkg")
Pkg$activate(system.file("examples", "iris-example", projectFolder,
package = "JuliaConnectoR", mustWork = TRUE))
Pkg$instantiate()
irisExampleJl <- system.file("examples", "iris-example", "iris-example.jl",
package = "JuliaConnectoR", mustWork = TRUE)
irisExampleJuliaCode <- readLines(irisExampleJl)
juliaEval(paste(irisExampleJuliaCode, collapse = "\n"))
expect_true(juliaEval("accuracy(model, testdata) > 0.9"))
irisExampleR <- system.file("examples", "iris-example", "iris-example.R",
package = "JuliaConnectoR", mustWork = TRUE)
irisExampleRCode <- readLines(irisExampleR)
scriptEnv <- new.env(emptyenv())
suppressWarnings(eval(parse(text = paste(irisExampleRCode, collapse = "\n")),
envir = scriptEnv))
# Test that training the model worked
print(juliaCall("accuracy", scriptEnv$model, scriptEnv$testdata))
expect_true(juliaCall("accuracy", scriptEnv$model, scriptEnv$testdata) > 0.9)
Pkg$activate() # use default environment again
})
test_that("Boltzmann example from README works", {
skip_on_cran()
returningError <- function(x) {
paste0("tryCatch({", x , '},',
'error = function(e) { paste("e: ",e$message) },',
'warning = function(w) { paste("w: ", w$message) })')
}
juliaEval('import Pkg;
try
@eval import BoltzmannMachines
catch ex
Pkg.add(PackageSpec(name = "BoltzmannMachines", version = v"1.3"))
end')
boltzmannExampleR <- system.file("examples", "boltzmann-example.R",
package = "JuliaConnectoR", mustWork = TRUE)
bmExample <- readLines(boltzmannExampleR)
bmExample <- sub("plot\\(.*", "", bmExample)
bmScriptEnv <- new.env(emptyenv())
code <- paste(bmExample, collapse = "\n")
code <- returningError(code)
eval(parse(text = code), envir = bmScriptEnv)
expect_s3_class(bmScriptEnv$dbm, "JuliaProxy")
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.