From c15e39e8a3665a06362ef39d50fef582ff7e6f4d Mon Sep 17 00:00:00 2001 From: Lukas Elmiger Date: Wed, 11 Jan 2017 22:59:50 +0100 Subject: [PATCH 01/26] Convert Date and DateTime to/from R --- src/convert-base.jl | 29 ++++++++++++++++++ src/convert-default.jl | 16 ++++++++-- test/conversion.jl | 67 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 109 insertions(+), 3 deletions(-) diff --git a/src/convert-base.jl b/src/convert-base.jl index 9c8b4aef..ba9dc9f9 100644 --- a/src/convert-base.jl +++ b/src/convert-base.jl @@ -140,6 +140,35 @@ for (J,S) in ((:Integer,:IntSxp), end end +# Date and DateTime +function sexp(d::Date) + res = sexp(RealSxp, convert(Float64, d - Dates.Day(719163))) + setclass!(res, sexp("Date")) + res +end +function sexp(a::AbstractArray{Date}) + res = sexp(RealSxp, convert(AbstractArray{Float64}, a - Dates.Day(719163))) + setclass!(res, sexp("Date")) + res +end +function sexp(d::DateTime) + res = sexp(RealSxp, convert(Float64, d - Dates.Day(719163)) / 1000) + setclass!(res, sexp(["POSIXct", "POSIXt"])) + setattrib!(res, "tzone", sexp("UTC")) + res +end +function sexp(a::AbstractArray{DateTime}) + res = sexp(RealSxp, convert(AbstractArray{Float64}, a - Dates.Day(719163)) / 1000) + setclass!(res, sexp(["POSIXct", "POSIXt"])) + setattrib!(res, "tzone", sexp("UTC")) + res +end +rcopy(::Type{Date}, s::RealSxpPtr) = rcopy(Date, s[1]) +rcopy(::Type{DateTime}, s::RealSxpPtr) = rcopy(DateTime, s[1]) + +rcopy(::Type{Date}, x::Float64) = convert(Date, x) + Dates.Day(719163) +rcopy(::Type{DateTime}, x::Float64) = convert(DateTime, x*1000) + Dates.Day(719163) + # Handle LglSxp seperately sexp(::Type{LglSxp},v::Union{Bool,Cint}) = diff --git a/src/convert-default.jl b/src/convert-default.jl index c224a4e6..f5a2aba5 100644 --- a/src/convert-default.jl +++ b/src/convert-default.jl @@ -16,12 +16,22 @@ function rcopy(s::StrSxpPtr) end end function rcopy(s::RealSxpPtr) + T = Float64 + classPtr = sexp(getclass(s)) + if typeof(classPtr) == StrSxpPtr + class = rcopy(Vector{String}, classPtr) + if "Date" in class + T = Date + elseif "POSIXct" in class + T = DateTime + end + end if anyna(s) - rcopy(NullableArray{Float64},s) + rcopy(NullableArray{T},s) elseif length(s) == 1 - rcopy(Float64,s) + rcopy(T,s) else - rcopy(Array{Float64},s) + rcopy(Array{T},s) end end function rcopy(s::CplxSxpPtr) diff --git a/test/conversion.jl b/test/conversion.jl index 7cccd207..cd8868b4 100644 --- a/test/conversion.jl +++ b/test/conversion.jl @@ -168,6 +168,73 @@ r = RObject(a) @test r[3] === convert(Float64,a[3]) @test r[2,3,1,2] === convert(Float64,a[2,3,1,2]) +# date +s = "2012-12-12" +d = Date(s) +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == "Date" +@test length(r) == 1 +@test size(r) == (1,) +@test rcopy(r) === d +@test rcopy(R"as.Date($s)") == d +@test rcopy(R"identical(as.Date($s), $d)") + +s = ["2001-01-01", "1111-11-11", "2012-12-12"] +d = Date.(s) +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == "Date" +@test length(r) == length(d) +@test size(r) == size(d) +@test rcopy(r) == d +@test rcopy(R"as.Date($s)") == d +@test rcopy(R"identical(as.Date($s), $d)") + +d = Date[] +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == "Date" +@test length(r) == length(d) +@test size(r) == size(d) +@test rcopy(r) == d +@test rcopy("as.Date(character(0))") == Date[] + +# dateTime +s = "2012-12-12T12:12:12" +d = DateTime(s) +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == ["POSIXct", "POSIXt"] +@test rcopy(getattrib(r, "tzone")) == "UTC" +@test length(r) == 1 +@test size(r) == (1,) +@test rcopy(r) === d +@test rcopy(R"as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S')") == d +@test rcopy(R"identical(as.character($d, '%Y-%m-%dT%H:%M:%S'), $s)") + +s = ["2001-01-01T01:01:01", "1111-11-11T11:11:00", "2012-12-12T12:12:12"] +d = DateTime.(s) +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == ["POSIXct", "POSIXt"] +@test rcopy(getattrib(r, "tzone")) == "UTC" +@test length(r) == length(d) +@test size(r) == size(d) +@test rcopy(r) == d +@test rcopy(R"as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S')") == d +@test rcopy(R"identical(as.character($d, '%Y-%m-%dT%H:%M:%S'), $s)") + +d = DateTime[] +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == ["POSIXct", "POSIXt"] +@test rcopy(getattrib(r, "tzone")) == "UTC" +@test length(r) == length(d) +@test size(r) == size(d) +@test rcopy(r) == d +@test rcopy("as.POSIXct(character(0))") == Date[] + # complex x = 7.0-2.0*im r = RObject(x) From c67b8e15e68884f2d247559f141452931753a927 Mon Sep 17 00:00:00 2001 From: Lukas Elmiger Date: Thu, 12 Jan 2017 17:24:48 +0100 Subject: [PATCH 02/26] Support Nullable Date/DateTime --- src/convert-data.jl | 8 ++++++- test/conversion.jl | 55 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 62 insertions(+), 1 deletion(-) diff --git a/src/convert-data.jl b/src/convert-data.jl index da538e8e..93fd52a6 100644 --- a/src/convert-data.jl +++ b/src/convert-data.jl @@ -14,7 +14,13 @@ function rcopy{S<:StrSxp}(::Type{Nullable}, s::Ptr{S}) end function rcopy{T,S<:VectorSxp}(::Type{NullableArray{T}}, s::Ptr{S}) - NullableArray(rcopy(Array{T},s), isna(s)) + if T == Date || T == DateTime + # Can not convert NaN to Date or DateTime which are internally stored as Int + value = T[isna(x) ? convert(T, 0.0) : rcopy(T, x) for x in s] + NullableArray(value, isna(s)) + else + NullableArray(rcopy(Array{T},s), isna(s)) + end end function rcopy{S<:VectorSxp}(::Type{NullableArray}, s::Ptr{S}) NullableArray(rcopy(Array,s), isna(s)) diff --git a/test/conversion.jl b/test/conversion.jl index cd8868b4..fc4212ca 100644 --- a/test/conversion.jl +++ b/test/conversion.jl @@ -1,3 +1,6 @@ +using NullableArrays + + # strings x = "ppzz!#" r = RObject(x) @@ -200,6 +203,31 @@ r = RObject(d) @test rcopy(r) == d @test rcopy("as.Date(character(0))") == Date[] +# nullable date +s = NullableArray(["0001-01-01", "2012-12-12"], [true, false]) +d = NullableArray(Date.(s.values), s.isnull) +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == "Date" +@test length(r) == length(d) +@test size(r) == size(d) +@test rcopy(r).isnull == d.isnull +@test rcopy(r).values[!d.isnull] == d.values[!d.isnull] +@test rcopy(R"identical(as.Date($s), $d)") +@test rcopy(R"identical(as.character($d), $s)") + +s = NullableArray(["0001-01-01"], [true]) +d = NullableArray(Date.(s.values), s.isnull) +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == "Date" +@test length(r) == length(d) +@test size(r) == size(d) +@test all(rcopy(r).isnull) +@test rcopy(R"identical(as.Date(NA), $d)") +@test rcopy(R"identical(as.character(NA), $s)") + + # dateTime s = "2012-12-12T12:12:12" d = DateTime(s) @@ -235,6 +263,33 @@ r = RObject(d) @test rcopy(r) == d @test rcopy("as.POSIXct(character(0))") == Date[] +# nullable dateTime +s = NullableArray(["0001-01-01", "2012-12-12T12:12:12"], [true, false]) +d = NullableArray(DateTime.(s.values), s.isnull) +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == ["POSIXct", "POSIXt"] +@test rcopy(getattrib(r, "tzone")) == "UTC" +@test length(r) == length(d) +@test size(r) == size(d) +@test rcopy(r).isnull == d.isnull +@test rcopy(r).values[!d.isnull] == d.values[!d.isnull] +@test rcopy(R"identical(as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S'), $d)") +@test rcopy(R"identical(as.character($d, '%Y-%m-%dT%H:%M:%S'), $s)") + +s = NullableArray(["0001-01-01"], [true]) +d = NullableArray(DateTime.(s.values), s.isnull) +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == ["POSIXct", "POSIXt"] +@test rcopy(getattrib(r, "tzone")) == "UTC" +@test length(r) == length(d) +@test size(r) == size(d) +@test all(rcopy(r).isnull) +@test rcopy(R"identical(as.POSIXct(NA_character_, 'UTC'), $d)") +@test rcopy(R"identical(as.character(NA), $s)") + + # complex x = 7.0-2.0*im r = RObject(x) From 2c6104033dae43fccf3e214e0099df97111269dd Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Thu, 16 Mar 2017 01:07:19 -0400 Subject: [PATCH 03/26] deprecate rcopy(::String) and rcopy(:Symbol) fixup fixup2 --- src/deprecated.jl | 17 +++++++++++++++++ src/eval.jl | 10 +--------- src/library.jl | 4 ++-- test/basic.jl | 10 +++++----- test/conversion.jl | 2 +- test/dataframe.jl | 36 ++++++++++++++++++------------------ test/rstr.jl | 2 +- 7 files changed, 45 insertions(+), 36 deletions(-) diff --git a/src/deprecated.jl b/src/deprecated.jl index 0ff573b3..23ceefcd 100644 --- a/src/deprecated.jl +++ b/src/deprecated.jl @@ -6,3 +6,20 @@ @deprecate setNames! setnames! @deprecate getClass getclass @deprecate setClass! setclass! + +function rcopy(str::AbstractString) + Base.depwarn(""" + `rcopy(str::AbstractString)` is deprecated, use `rcopy(reval(str))` + or rcopy(R"") instead. + """, :rcopy) + rcopy(reval(str)) +end +function rcopy{T}(::Type{T}, str::AbstractString) + Base.depwarn(""" + `rcopy{T}(::Type{T}, str::AbstractString)` is deprecated, use + `rcopy(T, reval(str))` or rcopy(T, R"") instead. + """, :rcopy) + rcopy(T, reval(str)) +end +@deprecate rcopy(sym::Symbol) rcopy(reval(sym)) +@deprecate rcopy{T}(::Type{T}, sym::Symbol) rcopy(T, reval(sym)) diff --git a/src/eval.jl b/src/eval.jl index 8cfd18f3..7141aa8e 100644 --- a/src/eval.jl +++ b/src/eval.jl @@ -83,15 +83,7 @@ function rparse_p(st::Ptr{StrSxp}) sexp(val) end rparse_p(st::AbstractString) = rparse_p(sexp(st)) +rparse_p(s::Symbol) = rparse_p(string(s)) "Parse a string as an R expression, returning an RObject." rparse(st::AbstractString) = RObject(rparse_p(st)) - - -""" -Evaluate and convert the result of a string as an R expression. -""" -rcopy(str::AbstractString) = rcopy(reval_p(rparse_p(str))) -rcopy(sym::Symbol) = rcopy(reval_p(sexp(sym))) -rcopy{T}(::Type{T}, str::AbstractString) = rcopy(T, reval_p(rparse_p(str))) -rcopy{T}(::Type{T}, sym::Symbol) = rcopy(T, reval_p(sexp(sym))) diff --git a/src/library.jl b/src/library.jl index d59a3482..0b4c87dc 100644 --- a/src/library.jl +++ b/src/library.jl @@ -8,7 +8,7 @@ const reserved = Set(["while", "if", "for", "try", "return", "break", function rwrap(pkg::String, s::Symbol) reval("library($pkg)") - members = rcopy("ls('package:$pkg')") + members = rcopy(reval("ls('package:$pkg')")) filter!(x -> !(x in reserved), members) m = Module(s) consts = [:(const $(Symbol(x)) = rcall(Symbol("::"),$(QuoteNode(Symbol(pkg))),$(QuoteNode(Symbol(x))))) for x in members] @@ -52,7 +52,7 @@ macro rlibrary(x) pkg = Expr(:quote, x) quote reval("library($($pkg))") - members = rcopy("ls('package:$($pkg)')") + members = rcopy(reval("ls('package:$($pkg)')")) filter!(x -> !(x in reserved), members) for m in members sym = Symbol(m) diff --git a/test/basic.jl b/test/basic.jl index f872e37f..d096e65f 100644 --- a/test/basic.jl +++ b/test/basic.jl @@ -89,8 +89,8 @@ rprint(io, reval(""" # operators a = reval("a=c(1,2,3)") b = reval("b=c(4,5,6)") -@test rcopy(a+b)==rcopy("a+b") -@test rcopy(a-b)==rcopy("a-b") -@test rcopy(a*b)==rcopy("a*b") -@test rcopy(a/b)==rcopy("a/b") -@test rcopy(a^b)==rcopy("a^b") +@test rcopy(a+b)==rcopy(R"a+b") +@test rcopy(a-b)==rcopy(R"a-b") +@test rcopy(a*b)==rcopy(R"a*b") +@test rcopy(a/b)==rcopy(R"a/b") +@test rcopy(a^b)==rcopy(R"a^b") diff --git a/test/conversion.jl b/test/conversion.jl index 7cccd207..7f2c68e6 100644 --- a/test/conversion.jl +++ b/test/conversion.jl @@ -227,7 +227,7 @@ d = Dict(:a=>[1, 2, 4], :b=> ["e", "d", "f"]) r = RObject(d) @test r[:a][3] == 4 @test rcopy(r[:b][2]) == "d" -l = rcopy("list(a=1,b=c(1,3,4))") +l = rcopy(R"list(a=1,b=c(1,3,4))") @test l[:a] == 1 @test l[:b][3] == 4 d = RObject(Dict(1=>2)) diff --git a/test/dataframe.jl b/test/dataframe.jl index cb549cf8..82ee982b 100644 --- a/test/dataframe.jl +++ b/test/dataframe.jl @@ -10,7 +10,7 @@ v110 = rcopy(NullableArray,reval("c(1L, NA)")) @test eltype(v110) == Nullable{Int32} @test isnull(rcopy(NullableArray, RObject(v110[2]))[1]) -attenu = rcopy(DataFrame,:attenu) +attenu = rcopy(DataFrame,reval(:attenu)) @test isa(attenu,DataFrame) @test size(attenu) == (182,5) @test rcopy(rcall(:dim,RObject(attenu))) == [182,5] @@ -27,43 +27,43 @@ v = NullableArray([true,true], [true,false]) @test isequal(rcopy(NullableArray,RObject(v)), v) v = NullableArray([true,true], [false,true]) @test isequal(rcopy(NullableArray,RObject(v)), v) -@test isequal(rcopy(NullableArray,"c(NA,TRUE)"), NullableArray([true,true], [true,false])) -@test isequal(rcopy(NullableArray,"c(TRUE, NA)"), NullableArray([true,true], [false,true])) +@test isequal(rcopy(NullableArray,R"c(NA,TRUE)"), NullableArray([true,true], [true,false])) +@test isequal(rcopy(NullableArray,R"c(TRUE, NA)"), NullableArray([true,true], [false,true])) # int64 v = NullableArray([1,2], [true,false]) @test isequal(rcopy(NullableArray,RObject(v)), v) v = NullableArray([1,2], [false,true]) @test isequal(rcopy(NullableArray,RObject(v)), v) -@test isequal(rcopy(NullableArray,"c(NA,1L)"), NullableArray([0,1], [true,false])) -@test isequal(rcopy(NullableArray,"c(1L,NA)"), NullableArray([1,0], [false,true])) +@test isequal(rcopy(NullableArray,R"c(NA,1L)"), NullableArray([0,1], [true,false])) +@test isequal(rcopy(NullableArray,R"c(1L,NA)"), NullableArray([1,0], [false,true])) # int32 v = NullableArray(Int32[1,2], [true,false]) @test isequal(rcopy(NullableArray,RObject(v)), v) v = NullableArray(Int32[1,2], [false,true]) @test isequal(rcopy(NullableArray,RObject(v)), v) -@test isequal(rcopy(NullableArray,"c(NA,1L)"), NullableArray(Int32[0,1], [true,false])) -@test isequal(rcopy(NullableArray,"c(1L,NA)"), NullableArray(Int32[1,0], [false,true])) +@test isequal(rcopy(NullableArray,R"c(NA,1L)"), NullableArray(Int32[0,1], [true,false])) +@test isequal(rcopy(NullableArray,R"c(1L,NA)"), NullableArray(Int32[1,0], [false,true])) # real v = NullableArray([1.,2.], [true,false]) @test isequal(rcopy(NullableArray,RObject(v)), v) v = NullableArray([1.,2.], [false,true]) @test isequal(rcopy(NullableArray,RObject(v)), v) -@test isequal(rcopy(NullableArray,"c(NA,1)"), NullableArray([0,1.], [true,false])) -@test isequal(rcopy(NullableArray,"c(1,NA)"), NullableArray([1.,0], [false,true])) +@test isequal(rcopy(NullableArray,R"c(NA,1)"), NullableArray([0,1.], [true,false])) +@test isequal(rcopy(NullableArray,R"c(1,NA)"), NullableArray([1.,0], [false,true])) # complex v = NullableArray([0,1.+0*im], [true,false]) @test isequal(rcopy(NullableArray,RObject(v)), v) v = NullableArray([0,1.+0*im], [false,true]) @test isequal(rcopy(NullableArray,RObject(v)), v) -@test isequal(rcopy(NullableArray,"c(NA,1+0i)"), NullableArray([0,1.+0*im], [true,false])) -@test isequal(rcopy(NullableArray,"c(1+0i,NA)"), NullableArray([1.+0*im,0], [false,true])) +@test isequal(rcopy(NullableArray,R"c(NA,1+0i)"), NullableArray([0,1.+0*im], [true,false])) +@test isequal(rcopy(NullableArray,R"c(1+0i,NA)"), NullableArray([1.+0*im,0], [false,true])) # string v = NullableArray(["","abc"], [true,false]) @test isequal(rcopy(NullableArray,RObject(v)), v) v = NullableArray(["","abc"], [false,true]) @test isequal(rcopy(NullableArray,RObject(v)), v) -@test isequal(rcopy(NullableArray,"c(NA,'NA')"), NullableArray(["","NA"], [true,false])) -@test isequal(rcopy(NullableArray,"c('NA',NA)"), NullableArray(["NA",""], [false,true])) +@test isequal(rcopy(NullableArray,R"c(NA,'NA')"), NullableArray(["","NA"], [true,false])) +@test isequal(rcopy(NullableArray,R"c('NA',NA)"), NullableArray(["NA",""], [false,true])) # CategoricalArrays v = CategoricalArray(repeat(["a", "b"], inner = 5)) @@ -74,8 +74,8 @@ v = CategoricalArray(repeat(["a", "b"], inner = 5), ordered=true) @test isequal(rcopy(CategoricalArray,RObject(v)), v) v = NullableCategoricalArray(repeat(["a", "b"], inner = 5), repeat([true, false], outer = 5), ordered=true) @test isequal(rcopy(NullableCategoricalArray,RObject(v)), v) -@test_throws ErrorException rcopy(NullableArray,"as.factor(c('a','a','c'))") -@test CategoricalArrays.levels(rcopy(CategoricalArray,"factor(c('a','a','c'))")) == ["a","c"] -@test CategoricalArrays.levels(rcopy(NullableCategoricalArray,"factor(c('a',NA,'c'))")) == ["a","c"] -@test CategoricalArrays.isordered(rcopy(CategoricalArray,"ordered(c('a','a','c'))")) -@test CategoricalArrays.isordered(rcopy(NullableCategoricalArray,"ordered(c('a',NA,'c'))")) +@test_throws ErrorException rcopy(NullableArray,R"as.factor(c('a','a','c'))") +@test CategoricalArrays.levels(rcopy(CategoricalArray,R"factor(c('a','a','c'))")) == ["a","c"] +@test CategoricalArrays.levels(rcopy(NullableCategoricalArray,R"factor(c('a',NA,'c'))")) == ["a","c"] +@test CategoricalArrays.isordered(rcopy(CategoricalArray,R"ordered(c('a','a','c'))")) +@test CategoricalArrays.isordered(rcopy(NullableCategoricalArray,R"ordered(c('a',NA,'c'))")) diff --git a/test/rstr.jl b/test/rstr.jl index 1588b932..b8cde230 100644 --- a/test/rstr.jl +++ b/test/rstr.jl @@ -44,7 +44,7 @@ proident, sunt in culpa qui officia deserunt mollit anim id est laborum." y = \$β """)[3] == 3 -iris = rcopy(:iris) +iris = rcopy(reval(:iris)) model = R"lm(Sepal.Length ~ Sepal.Width,data=$iris)" @test rcopy(RCall.getclass(model)) == "lm" @test isapprox(rcopy(R"sum($iris$Sepal.Length)"), sum(iris[Symbol("Sepal.Length")]), rtol=4*eps()) From 8205991494fcef6f5c27f63034b00beef854efde Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Wed, 15 Mar 2017 23:58:59 -0400 Subject: [PATCH 04/26] move conversion related code to a subdirectory --- src/RCall.jl | 6 +++--- src/{convert-base.jl => convert/base.jl} | 0 src/{convert-data.jl => convert/data.jl} | 0 src/{convert-default.jl => convert/default.jl} | 0 4 files changed, 3 insertions(+), 3 deletions(-) rename src/{convert-base.jl => convert/base.jl} (100%) rename src/{convert-data.jl => convert/data.jl} (100%) rename src/{convert-default.jl => convert/default.jl} (100%) diff --git a/src/RCall.jl b/src/RCall.jl index 78975cf3..26cd0abf 100644 --- a/src/RCall.jl +++ b/src/RCall.jl @@ -21,9 +21,9 @@ include("setup.jl") include("types.jl") include("constants.jl") include("methods.jl") -include("convert-base.jl") -include("convert-data.jl") -include("convert-default.jl") +include("convert/base.jl") +include("convert/data.jl") +include("convert/default.jl") include("eventloop.jl") include("eval.jl") include("io.jl") diff --git a/src/convert-base.jl b/src/convert/base.jl similarity index 100% rename from src/convert-base.jl rename to src/convert/base.jl diff --git a/src/convert-data.jl b/src/convert/data.jl similarity index 100% rename from src/convert-data.jl rename to src/convert/data.jl diff --git a/src/convert-default.jl b/src/convert/default.jl similarity index 100% rename from src/convert-default.jl rename to src/convert/default.jl From 2c35efcfa23036a8cc9ae8d0400074f77fb7a024 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Thu, 16 Mar 2017 01:57:50 -0400 Subject: [PATCH 05/26] code refactoring --- src/RCall.jl | 5 +- src/convert/base.jl | 71 +++++++++------------------ src/convert/dataframe.jl | 49 ++++++++++++++++++ src/convert/{data.jl => datatable.jl} | 50 +------------------ src/convert/default.jl | 66 +++++++++++++++++++------ src/types.jl | 5 +- test/conversion.jl | 10 ++-- 7 files changed, 132 insertions(+), 124 deletions(-) create mode 100644 src/convert/dataframe.jl rename src/convert/{data.jl => datatable.jl} (70%) diff --git a/src/RCall.jl b/src/RCall.jl index 26cd0abf..d9f143d2 100644 --- a/src/RCall.jl +++ b/src/RCall.jl @@ -1,6 +1,6 @@ __precompile__() module RCall -using Compat, DataFrames, NullableArrays, CategoricalArrays +using Compat, DataFrames, DataArrays, NullableArrays, CategoricalArrays import DataStructures: OrderedDict @@ -22,7 +22,8 @@ include("types.jl") include("constants.jl") include("methods.jl") include("convert/base.jl") -include("convert/data.jl") +include("convert/dataframe.jl") +include("convert/datatable.jl") include("convert/default.jl") include("eventloop.jl") include("eval.jl") diff --git a/src/convert/base.jl b/src/convert/base.jl index b302fd0b..e39ed70c 100644 --- a/src/convert/base.jl +++ b/src/convert/base.jl @@ -1,49 +1,36 @@ # conversion methods for Base Julia types -# Fallbacks -""" -`rcopy(T,p)` converts a pointer `p` to a Sxp object to a native Julia object of type T. - -`rcopy(p)` performs a default conversion. -""" -rcopy{S<:Sxp}(::Type{Any},x::Ptr{S}) = rcopy(x) - -# used in vector indexing -for T in [:Cint, :Float64, :Complex128] - @eval begin - rcopy(x::$T) = x - rcopy(::Type{$T}, x::$T) = x - end -end - -rcopy(r::RObject) = rcopy(r.p) +# allow `Int(R"1+1")` +convert{T, S<:Sxp}(::Type{T}, r::RObject{S}) = rcopy(T,r.p) +convert{S<:Sxp}(::Type{RObject{S}}, r::RObject{S}) = r rcopy{T}(::Type{T},r::RObject) = rcopy(T,r.p) - -""" -`sexp(S,x)` converts a Julia object `x` to a pointer to a Sxp object of type `S`. - -`sexp(x)` performs a default conversion. -""" -# used in vector indexing -sexp(::Type{Cint},x) = convert(Cint,x) -sexp(::Type{Float64},x) = convert(Float64,x) -sexp(::Type{Complex128},x) = convert(Complex128,x) +# # used in vector indexing +# for T in [:Cint, :Float64, :Complex128] +# @eval begin +# rcopy(x::$T) = x +# rcopy(::Type{$T}, x::$T) = x +# end +# end + +# """ +# `sexp(S,x)` converts a Julia object `x` to a pointer to a Sxp object of type `S`. +# """ +# # used in vector indexing +# sexp(::Type{Cint},x) = convert(Cint,x) +# sexp(::Type{Float64},x) = convert(Float64,x) +# sexp(::Type{Complex128},x) = convert(Complex128,x) # NilSxp -sexp(::Void) = sexp(Const.NilValue) -rcopy(::Ptr{NilSxp}) = nothing +sexp{S<:Sxp}(::Type{S}, ::Void) = sexp(Const.NilValue) +rcopy{T}(::Type{T}, ::Ptr{NilSxp}) = T(nothing) # SymSxp "Create a `SymSxp` from a `Symbol`" sexp(::Type{SymSxp}, s::AbstractString) = ccall((:Rf_install, libR), Ptr{SymSxp}, (Ptr{UInt8},), s) sexp(::Type{SymSxp}, s::Symbol) = sexp(SymSxp,string(s)) -sexp(s::Symbol) = sexp(SymSxp,s) -rcopy(::Type{Symbol},ss::SymSxp) = Symbol(rcopy(AbstractString,ss)) -rcopy(::Type{AbstractString},ss::SymSxp) = rcopy(AbstractString,ss.name) -rcopy{T<:Union{Symbol,AbstractString}}(::Type{T},s::Ptr{SymSxp}) = - rcopy(T,unsafe_load(s)) +rcopy{T<:Union{Symbol,AbstractString}}(::Type{T},s::Ptr{SymSxp}) = rcopy(T, sexp(unsafe_load(s).name)) # CharSxp @@ -61,7 +48,7 @@ rcopy(::Type{Symbol},s::CharSxpPtr) = Symbol(rcopy(AbstractString,s)) rcopy(::Type{Int}, s::CharSxpPtr) = parse(Int, rcopy(s)) -# general vectors +# Arrays function sexp{S<:VectorSxp}(::Type{S}, a::AbstractArray) ra = protect(allocArray(S, size(a)...)) try @@ -73,7 +60,6 @@ function sexp{S<:VectorSxp}(::Type{S}, a::AbstractArray) end ra end -sexp(a::AbstractArray) = sexp(VecSxp,a) function rcopy{T,S<:VectorSxp}(::Type{Array{T}}, s::Ptr{S}) protect(s) @@ -95,9 +81,6 @@ sexp(::Type{StrSxp}, s::CharSxpPtr) = ccall((:Rf_ScalarString,libR),Ptr{StrSxp}, sexp(::Type{StrSxp},s::Symbol) = sexp(StrSxp,sexp(CharSxp,s)) "Create a `StrSxp` from an `AbstractString`" sexp(::Type{StrSxp},st::AbstractString) = sexp(StrSxp,sexp(CharSxp,st)) -sexp(st::AbstractString) = sexp(StrSxp,st) -"Create a `StrSxp` from an Abstract String Array" -sexp{S<:AbstractString}(a::AbstractArray{S}) = sexp(StrSxp,a) rcopy(::Type{Vector}, s::StrSxpPtr) = rcopy(Vector{String}, s) rcopy(::Type{Array}, s::StrSxpPtr) = rcopy(Array{String}, s) @@ -121,8 +104,6 @@ for (J,S) in ((:Integer,:IntSxp), copy!(unsafe_vec(ra),a) ra end - sexp(v::$J) = sexp($S,v) - sexp{T<:$J}(a::AbstractArray{T}) = sexp($S,a) rcopy{T<:$J}(::Type{T},s::Ptr{$S}) = convert(T,s[1]) function rcopy{T<:$J}(::Type{Vector{T}},s::Ptr{$S}) @@ -149,9 +130,6 @@ function sexp{T<:Union{Bool,Cint}}(::Type{LglSxp}, a::AbstractArray{T}) copy!(unsafe_vec(ra),a) ra end -sexp(v::Bool) = sexp(LglSxp,v) -sexp(a::AbstractArray{Bool}) = sexp(LglSxp,a) - rcopy(::Type{Cint},s::Ptr{LglSxp}) = convert(Cint,s[1]) rcopy(::Type{Bool},s::Ptr{LglSxp}) = s[1]!=0 @@ -202,7 +180,7 @@ function rcopy(::Type{BitArray},s::Ptr{LglSxp}) end -# Associative types +# VecSxp # R does not have a native dictionary type, but named vectors/lists are often # used to this effect. @@ -222,9 +200,6 @@ function sexp{S<:VectorSxp}(::Type{S},d::Associative) end vs end -sexp{K,V<:AbstractString}(d::Associative{K,V}) = sexp(StrSxp,d) -sexp(d::Associative) = sexp(VecSxp,d) - function rcopy{A<:Associative,S<:VectorSxp}(::Type{A}, s::Ptr{S}) protect(s) diff --git a/src/convert/dataframe.jl b/src/convert/dataframe.jl new file mode 100644 index 00000000..93e89518 --- /dev/null +++ b/src/convert/dataframe.jl @@ -0,0 +1,49 @@ +# conversion methods for DataArrays, PooledDataArrays and DataFrames + +## DataFrame to sexp conversion. +function sexp(d::AbstractDataFrame) + nr,nc = size(d) + nv = names(d) + rd = protect(allocArray(VecSxp, nc)) + try + for i in 1:nc + rd[i] = sexp(d[nv[i]]) + end + setattrib!(rd,Const.NamesSymbol, sexp([string(n) for n in nv])) + setattrib!(rd,Const.ClassSymbol, sexp("data.frame")) + setattrib!(rd,Const.RowNamesSymbol, sexp(1:nr)) + finally + unprotect(1) + end + rd +end + + +# R formula objects +function sexp(f::Formula) + s = protect(rlang_p(:~,rlang_formula(f.lhs),rlang_formula(f.rhs))) + try + setattrib!(s,Const.ClassSymbol,sexp("formula")) + setattrib!(s,".Environment",Const.GlobalEnv) + finally + unprotect(1) + end + s +end + +function rlang_formula(e::Expr) + e.head == :call || error("invalid formula object") + op = e.args[1] + if op == :& + op = :(:) + end + if length(e.args) > 3 && op in (:+,:*,:(:)) + rlang_p(op, + rlang_formula(Expr(e.head,e.args[1:end-1]...)), + rlang_formula(e.args[end])) + else + rlang_p(op,map(rlang_formula,e.args[2:end])...) + end +end +rlang_formula(e::Symbol) = e +rlang_formula(n::Number) = n diff --git a/src/convert/data.jl b/src/convert/datatable.jl similarity index 70% rename from src/convert/data.jl rename to src/convert/datatable.jl index bf01cb75..bd19009f 100644 --- a/src/convert/data.jl +++ b/src/convert/datatable.jl @@ -1,4 +1,4 @@ -# conversion methods for NullableArrays, CategoricalArrays and DataFrames +# conversion methods for NullableArrays, CategoricalArrays and DataTables function rcopy{T,S<:Sxp}(::Type{Nullable{T}}, s::Ptr{S}) length(s) == 1 || error("length of $s must be 1.") @@ -92,51 +92,3 @@ for typ in [:NullableCategoricalArray, :CategoricalArray] end end end - -## DataFrame to sexp conversion. -function sexp(d::AbstractDataFrame) - nr,nc = size(d) - nv = names(d) - rd = protect(allocArray(VecSxp, nc)) - try - for i in 1:nc - rd[i] = sexp(d[nv[i]]) - end - setattrib!(rd,Const.NamesSymbol, sexp([string(n) for n in nv])) - setattrib!(rd,Const.ClassSymbol, sexp("data.frame")) - setattrib!(rd,Const.RowNamesSymbol, sexp(1:nr)) - finally - unprotect(1) - end - rd -end - - -# R formula objects -function sexp(f::Formula) - s = protect(rlang_p(:~,rlang_formula(f.lhs),rlang_formula(f.rhs))) - try - setattrib!(s,Const.ClassSymbol,sexp("formula")) - setattrib!(s,".Environment",Const.GlobalEnv) - finally - unprotect(1) - end - s -end - -function rlang_formula(e::Expr) - e.head == :call || error("invalid formula object") - op = e.args[1] - if op == :& - op = :(:) - end - if length(e.args) > 3 && op in (:+,:*,:(:)) - rlang_p(op, - rlang_formula(Expr(e.head,e.args[1:end-1]...)), - rlang_formula(e.args[end])) - else - rlang_p(op,map(rlang_formula,e.args[2:end])...) - end -end -rlang_formula(e::Symbol) = e -rlang_formula(n::Number) = n diff --git a/src/convert/default.jl b/src/convert/default.jl index c224a4e6..ec1db4c3 100644 --- a/src/convert/default.jl +++ b/src/convert/default.jl @@ -1,11 +1,28 @@ # logic for default rcopy """ -`rcopy` copies the contents of an R object into a corresponding canonical Julia type. +`rcopy(r)` copies the contents of an R object into a corresponding canonical Julia type. """ +rcopy(r::RObject) = rcopy(r.p) +RObject(s) = RObject(sexp(s)) + +# Fallbacks +rcopy{S<:Sxp}(::Type{Any}, s::Ptr{S}) = rcopy(s) + +# NilSxp +sexp(::Void) = sexp(Const.NilValue) +rcopy(::Ptr{NilSxp}) = nothing + +# SymSxp and CharSxp +sexp(s::Symbol) = sexp(SymSxp,s) rcopy(s::SymSxpPtr) = rcopy(Symbol,s) rcopy(s::CharSxpPtr) = rcopy(String,s) +# StrSxp +"Create a `StrSxp` from an Abstract String Array" +sexp{S<:AbstractString}(a::AbstractArray{S}) = sexp(StrSxp,a) +sexp(st::AbstractString) = sexp(StrSxp,st) + function rcopy(s::StrSxpPtr) if anyna(s) rcopy(NullableArray,s) @@ -15,6 +32,33 @@ function rcopy(s::StrSxpPtr) rcopy(Array{String},s) end end + +# IntSxp, RealSxp, CplxSxp, LglSxp +for (J,S) in ((:Integer,:IntSxp), + (:Real, :RealSxp), + (:Complex, :CplxSxp), + (:Bool, :LglSxp)) + @eval begin + sexp{T<:$J}(a::AbstractArray{T}) = sexp($S,a) + sexp(v::$J) = sexp($S,v) + end +end + +function rcopy(s::IntSxpPtr) + if isFactor(s) + if anyna(s) + rcopy(NullableCategoricalArray,s) + else + rcopy(CategoricalArray,s) + end + elseif anyna(s) + rcopy(NullableArray{Int},s) + elseif length(s) == 1 + rcopy(Cint,s) + else + rcopy(Array{Cint},s) + end +end function rcopy(s::RealSxpPtr) if anyna(s) rcopy(NullableArray{Float64},s) @@ -42,22 +86,9 @@ function rcopy(s::LglSxpPtr) rcopy(BitArray,s) end end -function rcopy(s::IntSxpPtr) - if isFactor(s) - if anyna(s) - rcopy(NullableCategoricalArray,s) - else - rcopy(CategoricalArray,s) - end - elseif anyna(s) - rcopy(NullableArray{Int},s) - elseif length(s) == 1 - rcopy(Cint,s) - else - rcopy(Array{Cint},s) - end -end +# VecSxp +sexp(a::AbstractArray) = sexp(VecSxp,a) function rcopy(s::VecSxpPtr) if isFrame(s) rcopy(DataFrame,s) @@ -67,7 +98,10 @@ function rcopy(s::VecSxpPtr) rcopy(Dict{Symbol,Any},s) end end +sexp{K,V<:AbstractString}(d::Associative{K,V}) = sexp(StrSxp,d) +sexp(d::Associative) = sexp(VecSxp,d) +# FunctionSxp rcopy(s::FunctionSxpPtr) = rcopy(Function,s) # TODO diff --git a/src/types.jl b/src/types.jl index 7254d7fd..346ab125 100644 --- a/src/types.jl +++ b/src/types.jl @@ -302,11 +302,8 @@ eval(parse(RObjectDocs * RObjectQuote)) RObject{S<:Sxp}(p::Ptr{S}) = RObject{S}(p) RObject(x::RObject) = x -RObject(x) = RObject(sexp(x)) -# convert{T}(::Type{T}, r::RObject) = convert(T,r.p) - """ Prevent garbage collection of an R object. Object can be released via `release`. @@ -366,7 +363,7 @@ function sexp(p::UnknownSxpPtr) typ = sexpnum(p) 0 ≤ typ ≤ 10 || 13 ≤ typ ≤ 25 || error("Unknown SEXPTYPE $typ") styp = typs[typ+1] - convert(Ptr{styp},p) + Ptr{styp}(p) end sexp(s::SxpPtr) = s sexp(r::RObject) = r.p diff --git a/test/conversion.jl b/test/conversion.jl index 7f2c68e6..fbe9b0b7 100644 --- a/test/conversion.jl +++ b/test/conversion.jl @@ -247,13 +247,13 @@ f1 = RObject(funk) # misc a = RObject(rand(10)) @test length(rcopy(Any, a)) == 10 -@test typeof(RCall.sexp(Cint, 1)) == Cint -@test typeof(RCall.sexp(Float64, 1)) == Float64 -@test typeof(RCall.sexp(Complex128, 1)) == Complex128 +# @test typeof(RCall.sexp(Cint, 1)) == Cint +# @test typeof(RCall.sexp(Float64, 1)) == Float64 +# @test typeof(RCall.sexp(Complex128, 1)) == Complex128 @test typeof(rcopy(Vector{Float64}, a.p)) == Vector{Float64} b = RObject(true) -@test rcopy(Int32(1)) == 1 -@test rcopy(Cint, Int32(1)) == 1 +# @test rcopy(Int32(1)) == 1 +# @test rcopy(Cint, Int32(1)) == 1 @test rcopy(Cint, b.p) == 1 @test rcopy(Vector{Cint}, b.p) == [1] @test rcopy(Array{Cint}, b.p) == [1] From 33c9d918802493ffede126aa0774683597a06443 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Thu, 16 Mar 2017 14:18:07 -0400 Subject: [PATCH 06/26] fix method names --- src/methods.jl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/methods.jl b/src/methods.jl index 0d8f9d8d..cb6f88c0 100644 --- a/src/methods.jl +++ b/src/methods.jl @@ -26,10 +26,10 @@ length(r::RObject) = length(r.p) for sym in (:isArray,:isComplex,:isEnvironment,:isExpression,:isFactor, :isFrame,:isFree,:isFunction,:isInteger,:isLanguage,:isList, :isLogical,:isSymbol,:isMatrix,:isNewList,:isNull,:isNumeric, - :isNumber,:isObject,:isOrdered,:isPairListSxp,:isPrimitiveSxp, + :isNumber,:isObject,:isOrdered,:isPairList,:isPrimitive, :isReal,:isS4,:isString,:isTs,:isUnordered,:isUnsorted, :isUserBinop,:isValidString,:isValidStringF,:isVector, - :isVectorAtomicSxp,:isVectorizable,:isVectorListSxp) + :isVectorAtomic,:isVectorizable,:isVectorList) @eval begin $sym{S<:Sxp}(s::Ptr{S}) = ccall(($(string("Rf_",sym)),libR),Bool,(Ptr{SxpPtrInfo},),s) $sym(r::RObject) = $sym(r.p) From a361254d4ff1debf9289c15ed1e37588599e0445 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Thu, 16 Mar 2017 22:42:00 -0400 Subject: [PATCH 07/26] support both DataArrays and NullableArrays with a lot of refactorings --- src/RCall.jl | 10 +- src/convert/base.jl | 197 +++++++++++++++++---------------------- src/convert/dataframe.jl | 64 ++++++++++++- src/convert/datatable.jl | 46 +++++---- src/convert/default.jl | 100 +++++++++++++------- src/methods.jl | 20 ++-- test/basic.jl | 2 + test/dataframe.jl | 80 +++++++++++++--- 8 files changed, 322 insertions(+), 197 deletions(-) diff --git a/src/RCall.jl b/src/RCall.jl index d9f143d2..22cb487c 100644 --- a/src/RCall.jl +++ b/src/RCall.jl @@ -1,6 +1,14 @@ __precompile__() module RCall -using Compat, DataFrames, DataArrays, NullableArrays, CategoricalArrays +using Compat + +import DataFrames: DataFrame, AbstractDataFrame, Formula +import DataArrays +import DataArrays: DataArray, PooledDataArray, AbstractDataArray, RefArray + +import NullableArrays: NullableArray +import CategoricalArrays +import CategoricalArrays: CategoricalArray, CategoricalPool, NullableCategoricalArray import DataStructures: OrderedDict diff --git a/src/convert/base.jl b/src/convert/base.jl index e39ed70c..e00a68ce 100644 --- a/src/convert/base.jl +++ b/src/convert/base.jl @@ -1,66 +1,22 @@ -# conversion methods for Base Julia types +# conversion to Base Julia types # allow `Int(R"1+1")` +rcopy{T}(::Type{T},r::RObject) = rcopy(T,r.p) convert{T, S<:Sxp}(::Type{T}, r::RObject{S}) = rcopy(T,r.p) convert{S<:Sxp}(::Type{RObject{S}}, r::RObject{S}) = r -rcopy{T}(::Type{T},r::RObject) = rcopy(T,r.p) - -# # used in vector indexing -# for T in [:Cint, :Float64, :Complex128] -# @eval begin -# rcopy(x::$T) = x -# rcopy(::Type{$T}, x::$T) = x -# end -# end - -# """ -# `sexp(S,x)` converts a Julia object `x` to a pointer to a Sxp object of type `S`. -# """ -# # used in vector indexing -# sexp(::Type{Cint},x) = convert(Cint,x) -# sexp(::Type{Float64},x) = convert(Float64,x) -# sexp(::Type{Complex128},x) = convert(Complex128,x) # NilSxp -sexp{S<:Sxp}(::Type{S}, ::Void) = sexp(Const.NilValue) rcopy{T}(::Type{T}, ::Ptr{NilSxp}) = T(nothing) - # SymSxp -"Create a `SymSxp` from a `Symbol`" -sexp(::Type{SymSxp}, s::AbstractString) = ccall((:Rf_install, libR), Ptr{SymSxp}, (Ptr{UInt8},), s) -sexp(::Type{SymSxp}, s::Symbol) = sexp(SymSxp,string(s)) rcopy{T<:Union{Symbol,AbstractString}}(::Type{T},s::Ptr{SymSxp}) = rcopy(T, sexp(unsafe_load(s).name)) - # CharSxp -""" -Create a `CharSxp` from a String. -""" -sexp(::Type{CharSxp}, st::String) = - ccall((:Rf_mkCharLenCE, libR), CharSxpPtr, - (Ptr{UInt8}, Cint, Cint), st, sizeof(st), isascii(st) ? 0 : 1) -sexp(::Type{CharSxp}, st::AbstractString) = sexp(CharSxp, string(st)) -sexp(::Type{CharSxp}, sym::Symbol) = sexp(CharSxp, string(sym)) - rcopy{T<:AbstractString}(::Type{T},s::CharSxpPtr) = convert(T, String(unsafe_vec(s))) rcopy(::Type{Symbol},s::CharSxpPtr) = Symbol(rcopy(AbstractString,s)) rcopy(::Type{Int}, s::CharSxpPtr) = parse(Int, rcopy(s)) - -# Arrays -function sexp{S<:VectorSxp}(::Type{S}, a::AbstractArray) - ra = protect(allocArray(S, size(a)...)) - try - for i in 1:length(a) - ra[i] = a[i] - end - finally - unprotect(1) - end - ra -end - +# VectorSxp fallbacks function rcopy{T,S<:VectorSxp}(::Type{Array{T}}, s::Ptr{S}) protect(s) v = T[rcopy(T,e) for e in s] @@ -76,35 +32,16 @@ function rcopy{T,S<:VectorSxp}(::Type{Vector{T}}, s::Ptr{S}) end # StrSxp -sexp(::Type{StrSxp}, s::CharSxpPtr) = ccall((:Rf_ScalarString,libR),Ptr{StrSxp},(CharSxpPtr,),s) -"Create a `StrSxp` from an `Symbol`" -sexp(::Type{StrSxp},s::Symbol) = sexp(StrSxp,sexp(CharSxp,s)) -"Create a `StrSxp` from an `AbstractString`" -sexp(::Type{StrSxp},st::AbstractString) = sexp(StrSxp,sexp(CharSxp,st)) - rcopy(::Type{Vector}, s::StrSxpPtr) = rcopy(Vector{String}, s) rcopy(::Type{Array}, s::StrSxpPtr) = rcopy(Array{String}, s) rcopy(::Type{Symbol}, s::StrSxpPtr) = rcopy(Symbol,s[1]) rcopy{T<:AbstractString}(::Type{T},s::StrSxpPtr) = rcopy(T,s[1]) - # IntSxp, RealSxp, CplxSxp for (J,S) in ((:Integer,:IntSxp), (:Real, :RealSxp), (:Complex, :CplxSxp)) @eval begin - # Could use Rf_Scalar... methods, but see weird error on Appveyor Windows for Complex. - function sexp(::Type{$S},v::$J) - ra = allocArray($S,1) - unsafe_store!(dataptr(ra),convert(eltype($S),v)) - ra - end - function sexp{T<:$J}(::Type{$S}, a::AbstractArray{T}) - ra = allocArray($S, size(a)...) - copy!(unsafe_vec(ra),a) - ra - end - rcopy{T<:$J}(::Type{T},s::Ptr{$S}) = convert(T,s[1]) function rcopy{T<:$J}(::Type{Vector{T}},s::Ptr{$S}) a = Array{T}(length(s)) @@ -121,16 +58,7 @@ for (J,S) in ((:Integer,:IntSxp), end end - -# Handle LglSxp seperately -sexp(::Type{LglSxp},v::Union{Bool,Cint}) = - ccall((:Rf_ScalarLogical,libR),Ptr{LglSxp},(Cint,),v) -function sexp{T<:Union{Bool,Cint}}(::Type{LglSxp}, a::AbstractArray{T}) - ra = allocArray(LglSxp, size(a)...) - copy!(unsafe_vec(ra),a) - ra -end - +# LglSxp rcopy(::Type{Cint},s::Ptr{LglSxp}) = convert(Cint,s[1]) rcopy(::Type{Bool},s::Ptr{LglSxp}) = s[1]!=0 @@ -179,29 +107,8 @@ function rcopy(::Type{BitArray},s::Ptr{LglSxp}) a end - # VecSxp - -# R does not have a native dictionary type, but named vectors/lists are often -# used to this effect. -function sexp{S<:VectorSxp}(::Type{S},d::Associative) - n = length(d) - vs = protect(allocArray(VecSxp,n)) - ks = protect(allocArray(StrSxp,n)) - try - for (i,(k,v)) in enumerate(d) - ks[i] = string(k) - vs[i] = v - end - - setnames!(vs,ks) - finally - unprotect(2) - end - vs -end - -function rcopy{A<:Associative,S<:VectorSxp}(::Type{A}, s::Ptr{S}) +function rcopy{A<:Associative}(::Type{A}, s::Ptr{VecSxp}) protect(s) local a try @@ -217,26 +124,92 @@ function rcopy{A<:Associative,S<:VectorSxp}(::Type{A}, s::Ptr{S}) a end -function rcopy{A<:Associative,S<:PairListSxp}(::Type{A}, s::Ptr{S}) - protect(s) - local a +# FunctionSxp +function rcopy{S<:FunctionSxp}(::Type{Function}, s::Ptr{S}) + (args...) -> rcopy(rcall_p(s,args...)) +end +function rcopy{S<:FunctionSxp}(::Type{Function}, r::RObject{S}) + (args...) -> rcopy(rcall_p(r,args...)) +end + +# conversion from Base Julia types + +# nothing +sexp{S<:Sxp}(::Type{S}, ::Void) = sexp(Const.NilValue) + +# symbol +sexp(::Type{SymSxp}, s::Symbol) = sexp(SymSxp,string(s)) +sexp(::Type{CharSxp}, sym::Symbol) = sexp(CharSxp, string(sym)) +sexp(::Type{StrSxp},s::Symbol) = sexp(StrSxp,sexp(CharSxp,s)) + +# string +sexp(::Type{SymSxp}, s::AbstractString) = ccall((:Rf_install, libR), Ptr{SymSxp}, (Ptr{UInt8},), s) +sexp(::Type{CharSxp}, st::String) = + ccall((:Rf_mkCharLenCE, libR), CharSxpPtr, + (Ptr{UInt8}, Cint, Cint), st, sizeof(st), isascii(st) ? 0 : 1) +sexp(::Type{CharSxp}, st::AbstractString) = sexp(CharSxp, string(st)) +sexp(::Type{StrSxp}, s::CharSxpPtr) = ccall((:Rf_ScalarString,libR),Ptr{StrSxp},(CharSxpPtr,),s) +sexp(::Type{StrSxp},st::AbstractString) = sexp(StrSxp,sexp(CharSxp,st)) + + +# AbstractArray +function sexp{S<:VectorSxp}(::Type{S}, a::AbstractArray) + ra = protect(allocArray(S, size(a)...)) try - a = A() - K = keytype(a) - V = valtype(a) - for (k,v) in s - a[rcopy(K,k)] = rcopy(V,v) + for i in 1:length(a) + ra[i] = a[i] end finally unprotect(1) end - a + ra end -# Functions -function rcopy{S<:FunctionSxp}(::Type{Function}, s::Ptr{S}) - (args...) -> rcopy(rcall_p(s,args...)) +# number and numeric array +for (J,S) in ((:Integer,:IntSxp), + (:Real, :RealSxp), + (:Complex, :CplxSxp)) + @eval begin + # Could use Rf_Scalar... methods, but see weird error on Appveyor Windows for Complex. + function sexp(::Type{$S},v::$J) + ra = allocArray($S,1) + unsafe_store!(dataptr(ra),convert(eltype($S),v)) + ra + end + function sexp{T<:$J}(::Type{$S}, a::AbstractArray{T}) + ra = allocArray($S, size(a)...) + copy!(unsafe_vec(ra),a) + ra + end + end end -function rcopy{S<:FunctionSxp}(::Type{Function}, r::RObject{S}) - (args...) -> rcopy(rcall_p(r,args...)) + +# bool and boolean array, handle seperately +sexp(::Type{LglSxp},v::Union{Bool,Cint}) = + ccall((:Rf_ScalarLogical,libR),Ptr{LglSxp},(Cint,),v) +function sexp{T<:Union{Bool,Cint}}(::Type{LglSxp}, a::AbstractArray{T}) + ra = allocArray(LglSxp, size(a)...) + copy!(unsafe_vec(ra),a) + ra +end + + +# Associative + +# R does not have a native dictionary type, but named lists is often +# used to this effect. +function sexp(::Type{VecSxp},d::Associative) + n = length(d) + vs = protect(allocArray(VecSxp,n)) + ks = protect(allocArray(StrSxp,n)) + try + for (i,(k,v)) in enumerate(d) + ks[i] = string(k) + vs[i] = v + end + setnames!(vs,ks) + finally + unprotect(2) + end + vs end diff --git a/src/convert/dataframe.jl b/src/convert/dataframe.jl index 93e89518..ba4ee3cc 100644 --- a/src/convert/dataframe.jl +++ b/src/convert/dataframe.jl @@ -1,7 +1,65 @@ # conversion methods for DataArrays, PooledDataArrays and DataFrames +function rcopy{T,S<:VectorSxp}(::Type{DataArray{T}}, s::Ptr{S}) + DataArray(rcopy(Array{T},s), isna(s)) +end +function rcopy{S<:VectorSxp}(::Type{DataArray}, s::Ptr{S}) + DataArray(rcopy(Array,s), isna(s)) +end + +function rcopy(::Type{DataArray}, s::Ptr{IntSxp}) + isFactor(s) && error("$s is a R factor") + DataArray(rcopy(Array,s), isna(s)) +end +function rcopy(::Type{PooledDataArray}, s::Ptr{IntSxp}) + isFactor(s) || error("$s is not a R factor") + refs = DataArrays.RefArray([isna(x) ? zero(Int32) : x for x in s]) + DataArrays.compact(PooledDataArray(refs,rcopy(getattrib(s,Const.LevelsSymbol)))) +end + +function rcopy(::Type{DataFrame}, s::Ptr{VecSxp}) + isFrame(s) || error("s is not a R data frame") + DataFrame(Any[rcopy(c) for c in s], rcopy(Array{Symbol},getnames(s))) +end + +## DataArray to sexp conversion. +for S in (:IntSxp, :RealSxp, :CplxSxp, :LglSxp, :StrSxp) + @eval begin + function sexp(::Type{$S}, v::DataArray) + rv = protect(sexp($S, v.data)) + try + for (i,isna) = enumerate(v.na) + if isna + rv[i] = naeltype($S) + end + end + finally + unprotect(1) + end + rv + end + end +end + +## PooledDataArray to sexp conversion. +function sexp{T<:AbstractString,R<:Integer}(::Type{IntSxp}, v::PooledDataArray{T,R}) + rv = protect(sexp(IntSxp, v.refs)) + try + for (i,r) = enumerate(v.refs) + if r == 0 + rv[i] = naeltype(IntSxp) + end + end + finally + unprotect(1) + end + setattrib!(rv, Const.LevelsSymbol, sexp(v.pool)) + setattrib!(rv, Const.ClassSymbol, sexp("factor")) + rv +end + ## DataFrame to sexp conversion. -function sexp(d::AbstractDataFrame) +function sexp(::Type{VecSxp}, d::AbstractDataFrame) nr,nc = size(d) nv = names(d) rd = protect(allocArray(VecSxp, nc)) @@ -18,9 +76,8 @@ function sexp(d::AbstractDataFrame) rd end - # R formula objects -function sexp(f::Formula) +function sexp(::Type{ExprSxp}, f::Formula) s = protect(rlang_p(:~,rlang_formula(f.lhs),rlang_formula(f.rhs))) try setattrib!(s,Const.ClassSymbol,sexp("formula")) @@ -31,6 +88,7 @@ function sexp(f::Formula) s end +# formula function rlang_formula(e::Expr) e.head == :call || error("invalid formula object") op = e.args[1] diff --git a/src/convert/datatable.jl b/src/convert/datatable.jl index bd19009f..00ba7ef5 100644 --- a/src/convert/datatable.jl +++ b/src/convert/datatable.jl @@ -38,40 +38,38 @@ function rcopy(::Type{NullableCategoricalArray}, s::Ptr{IntSxp}) pool = CategoricalPool(levels, isOrdered(s)) NullableCategoricalArray(refs, pool) end -function rcopy(::Type{DataFrame}, s::Ptr{VecSxp}) - isFrame(s) || error("s is not a R data frame") - DataFrame(Any[rcopy(c) for c in s], rcopy(Array{Symbol},getnames(s))) -end - -# Nullable to sexp conversion. -function sexp{T}(x::Nullable{T}) - if isnull(x) - return sexp(naeltype(T)) - else - return sexp(x.value) - end -end -## NullableArray to sexp conversion. -function sexp(v::NullableArray) - rv = protect(sexp(v.values)) - try - for (i,isna) = enumerate(v.isnull) - if isna - rv[i] = naeltype(eltype(rv)) +# Nullable and NullableArray to sexp conversion. +for S in (:IntSxp, :RealSxp, :CplxSxp, :LglSxp, :StrSxp) + @eval begin + function sexp(::Type{$S}, x::Nullable) + if isnull(x) + return sexp($S, naeltype($S)) + else + return sexp($S, x.value) end end - finally - unprotect(1) + function sexp(::Type{$S}, v::NullableArray) + rv = protect(sexp($S, v.values)) + try + for (i,isna) = enumerate(v.isnull) + if isna + rv[i] = naeltype($S) + end + end + finally + unprotect(1) + end + rv + end end - rv end ## CategoricalArray to sexp conversion. for typ in [:NullableCategoricalArray, :CategoricalArray] @eval begin - function sexp{T<:String,N,R<:Integer}(v::$typ{T,N,R}) + function sexp{T<:String,N,R<:Integer}(::Type{IntSxp}, v::$typ{T,N,R}) rv = protect(sexp(v.refs)) try for (i,ref) = enumerate(v.refs) diff --git a/src/convert/default.jl b/src/convert/default.jl index ec1db4c3..74939147 100644 --- a/src/convert/default.jl +++ b/src/convert/default.jl @@ -4,25 +4,18 @@ `rcopy(r)` copies the contents of an R object into a corresponding canonical Julia type. """ rcopy(r::RObject) = rcopy(r.p) -RObject(s) = RObject(sexp(s)) -# Fallbacks +# Fallback rcopy{S<:Sxp}(::Type{Any}, s::Ptr{S}) = rcopy(s) # NilSxp -sexp(::Void) = sexp(Const.NilValue) rcopy(::Ptr{NilSxp}) = nothing # SymSxp and CharSxp -sexp(s::Symbol) = sexp(SymSxp,s) rcopy(s::SymSxpPtr) = rcopy(Symbol,s) rcopy(s::CharSxpPtr) = rcopy(String,s) # StrSxp -"Create a `StrSxp` from an Abstract String Array" -sexp{S<:AbstractString}(a::AbstractArray{S}) = sexp(StrSxp,a) -sexp(st::AbstractString) = sexp(StrSxp,st) - function rcopy(s::StrSxpPtr) if anyna(s) rcopy(NullableArray,s) @@ -34,34 +27,20 @@ function rcopy(s::StrSxpPtr) end # IntSxp, RealSxp, CplxSxp, LglSxp -for (J,S) in ((:Integer,:IntSxp), - (:Real, :RealSxp), - (:Complex, :CplxSxp), - (:Bool, :LglSxp)) - @eval begin - sexp{T<:$J}(a::AbstractArray{T}) = sexp($S,a) - sexp(v::$J) = sexp($S,v) - end -end - function rcopy(s::IntSxpPtr) if isFactor(s) - if anyna(s) - rcopy(NullableCategoricalArray,s) - else - rcopy(CategoricalArray,s) - end + rcopy(PooledDataArray,s) elseif anyna(s) - rcopy(NullableArray{Int},s) + rcopy(DataArray{Float64},s) elseif length(s) == 1 rcopy(Cint,s) else - rcopy(Array{Cint},s) + rcopy(Array,s) end end function rcopy(s::RealSxpPtr) if anyna(s) - rcopy(NullableArray{Float64},s) + rcopy(DataArray{Float64},s) elseif length(s) == 1 rcopy(Float64,s) else @@ -70,7 +49,7 @@ function rcopy(s::RealSxpPtr) end function rcopy(s::CplxSxpPtr) if anyna(s) - rcopy(NullableArray{Complex128},s) + rcopy(DataArray{Complex128},s) elseif length(s) == 1 rcopy(Complex128,s) else @@ -79,7 +58,7 @@ function rcopy(s::CplxSxpPtr) end function rcopy(s::LglSxpPtr) if anyna(s) - rcopy(NullableArray{Bool},s) + rcopy(DataArray{Bool},s) elseif length(s) == 1 rcopy(Bool,s) else @@ -88,7 +67,6 @@ function rcopy(s::LglSxpPtr) end # VecSxp -sexp(a::AbstractArray) = sexp(VecSxp,a) function rcopy(s::VecSxpPtr) if isFrame(s) rcopy(DataFrame,s) @@ -98,12 +76,68 @@ function rcopy(s::VecSxpPtr) rcopy(Dict{Symbol,Any},s) end end -sexp{K,V<:AbstractString}(d::Associative{K,V}) = sexp(StrSxp,d) -sexp(d::Associative) = sexp(VecSxp,d) # FunctionSxp rcopy(s::FunctionSxpPtr) = rcopy(Function,s) # TODO -rcopy(l::LangSxpPtr) = l -rcopy(r::RObject{LangSxp}) = r +# rcopy(l::LangSxpPtr) = l +# rcopy(r::RObject{LangSxp}) = r + +# logic of default sexp + +""" +`sexp(x)` converts a Julia object `x` to a pointer to a corresponding Sxp Object. +""" + +RObject(s) = RObject(sexp(s)) + +# nothing +sexp(::Void) = sexp(Const.NilValue) + +# symbol +sexp(s::Symbol) = sexp(SymSxp,s) + +# string and string array +sexp{S<:AbstractString}(a::AbstractArray{S}) = sexp(StrSxp,a) +sexp(st::AbstractString) = sexp(StrSxp,st) + +# DataFrames +sexp(d::AbstractDataFrame) = sexp(VecSxp, d) + +# PooledDataArray +sexp(a::PooledDataArray) = sexp(IntSxp,a) +sexp{S<:AbstractString}(a::PooledDataArray{S}) = sexp(IntSxp,a) + +# number +for (J,S) in ((:Integer,:IntSxp), + (:Real, :RealSxp), + (:Complex, :CplxSxp), + (:Bool, :LglSxp)) + @eval begin + sexp{T<:$J}(a::AbstractArray{T}) = sexp($S,a) + sexp{T<:$J}(a::DataArray{T}) = sexp($S,a) + sexp(v::$J) = sexp($S,v) + end +end + +# Fallback: convert abstractArray to VecSxp (R list) +sexp(a::AbstractArray) = sexp(VecSxp,a) + +# associative +sexp(d::Associative) = sexp(VecSxp,d) + +# Nullable +for (J,S) in ((:Integer,:IntSxp), + (:Real, :RealSxp), + (:Complex, :CplxSxp), + (:Bool, :LglSxp), + (:AbstractString, :StrSxp)) + @eval begin + sexp{T<:$J}(x::Nullable{T}) = sexp($S, x) + sexp{T<:$J}(v::NullableArray{T}) = sexp($S, v) + end +end +for typ in [:NullableCategoricalArray, :CategoricalArray] + @eval sexp(v::$typ) = sexp(IntSxp, v) +end diff --git a/src/methods.jl b/src/methods.jl index cb6f88c0..5ddc2ee7 100644 --- a/src/methods.jl +++ b/src/methods.jl @@ -74,13 +74,13 @@ Indexing into `VectorSxp` types uses Julia indexing into the `vec` result, except for `StrSxp` and the `VectorListSxp` types, which must apply `sexp` to the `Ptr{Void}` obtained by indexing into the `vec` result. """ -getindex{S<:VectorAtomicSxp}(s::Ptr{S}, I::Real) = getindex(unsafe_vec(s),I) +getindex{S<:VectorAtomicSxp}(s::Ptr{S}, I::Integer) = getindex(unsafe_vec(s),I) +getindex{S<:VectorAtomicSxp}(s::Ptr{S}, I::Integer...) = getindex(unsafe_array(s),I...) getindex{S<:VectorAtomicSxp}(s::Ptr{S}, I::AbstractVector) = getindex(unsafe_vec(s),I) -getindex{S<:VectorAtomicSxp}(s::Ptr{S}, I::Real...) = getindex(unsafe_array(s),I...) -getindex{S<:VectorListSxp}(s::Ptr{S}, I::Real) = sexp(getindex(unsafe_vec(s),I)) -getindex{S<:VectorListSxp}(s::Ptr{S}, I::AbstractVector) = sexp(getindex(unsafe_vec(s),I)) -getindex{S<:VectorListSxp}(s::Ptr{S}, I::Real...) = sexp(getindex(unsafe_array(s),I...)) +getindex{S<:VectorListSxp}(s::Ptr{S}, I::Integer) = sexp(getindex(unsafe_vec(s),I)) +getindex{S<:VectorListSxp}(s::Ptr{S}, I::Integer...) = sexp(getindex(unsafe_array(s),I...)) +getindex{S<:VectorListSxp}(s::Ptr{S}, I::AbstractVector) = map(sexp, getindex(unsafe_vec(s),I)) """ String indexing finds the first element with the matching name @@ -103,10 +103,10 @@ getindex{S<:VectorListSxp}(r::RObject{S}, I...) = RObject(getindex(sexp(r), I... getindex{S<:VectorListSxp}(r::RObject{S}, I::AbstractArray) = map(RObject,getindex(sexp(r),I)) -function setindex!{S<:VectorAtomicSxp}(s::Ptr{S}, value, I...) +function setindex!{S<:VectorAtomicSxp}(s::Ptr{S}, value, I::Integer...) setindex!(unsafe_array(s), value, I...) end -function setindex!{S<:VectorAtomicSxp}(s::Ptr{S}, value, I) +function setindex!{S<:VectorAtomicSxp}(s::Ptr{S}, value, I::Integer) setindex!(unsafe_vec(s), value, I) end function setindex!(s::Ptr{StrSxp}, value::CharSxpPtr, key::Integer) @@ -299,11 +299,7 @@ naeltype(::Type{RealSxp}) = Const.NaReal naeltype(::Type{CplxSxp}) = complex(Const.NaReal,Const.NaReal) naeltype(::Type{StrSxp}) = sexp(Const.NaString) naeltype(::Type{VecSxp}) = sexp(LglSxp,Const.NaInt) # used for setting -naeltype{S<:Integer}(::Type{S}) = Const.NaInt -naeltype{S<:Real}(::Type{S}) = Const.NaReal -naeltype(::Type{Complex}) = complex(Const.NaReal,Const.NaReal) -naeltype{S<:String}(::Type{S}) = sexp(Const.NaString) -naeltype(::Type{Union{}}) = Const.NaInt +naeltype{S<:Sxp}(::Type{S}) = Const.NaInt """ Check if values correspond to R's sentinel NA values. diff --git a/test/basic.jl b/test/basic.jl index d096e65f..f760b80e 100644 --- a/test/basic.jl +++ b/test/basic.jl @@ -37,6 +37,8 @@ y = "foo" @test rcopy(rcall(:besselI, 1.0, 2.0)) ≈ besseli(2.0,1.0) @test rcopy(rcall(:besselI, 1.0, 2.0, var"expon.scaled"=true)) ≈ besselix(2.0,1.0) +x = reval("LETTERS") + # callbacks function testfn(x,y;a=3,b=4) diff --git a/test/dataframe.jl b/test/dataframe.jl index 82ee982b..d7135a6d 100644 --- a/test/dataframe.jl +++ b/test/dataframe.jl @@ -1,27 +1,83 @@ using NullableArrays,CategoricalArrays,DataFrames -@test isequal(rcopy(Nullable, RObject(1)), Nullable(1)) -@test isequal(rcopy(Nullable, RObject("abc")), Nullable("abc")) -@test rcopy(RObject(Nullable(1))) == 1 -@test isnull(rcopy(Nullable, RObject(Nullable()))) - -v110 = rcopy(NullableArray,reval("c(1L, NA)")) -@test isa(v110,NullableVector) -@test eltype(v110) == Nullable{Int32} -@test isnull(rcopy(NullableArray, RObject(v110[2]))[1]) - +# DataFrame attenu = rcopy(DataFrame,reval(:attenu)) @test isa(attenu,DataFrame) @test size(attenu) == (182,5) @test rcopy(rcall(:dim,RObject(attenu))) == [182,5] @test rcopy(rcall(:dim, RObject(attenu[1:2, :]))) == [2, 5] - dist = attenu[:dist] @test isa(dist,Vector{Float64}) station = attenu[:station] -@test isa(station,NullableCategoricalArray) +@test isa(station,PooledDataArray) + +# DataArray + +# bool +v = DataArray([true,true], [true,false]) +@test isequal(rcopy(DataArray,RObject(v)), v) +v = DataArray([true,true], [false,true]) +@test isequal(rcopy(DataArray,RObject(v)), v) +@test isequal(rcopy(DataArray,R"c(NA,TRUE)"), DataArray([true,true], [true,false])) +@test isequal(rcopy(DataArray,R"c(TRUE, NA)"), DataArray([true,true], [false,true])) +# int64 +v = DataArray([1,2], [true,false]) +@test isequal(rcopy(DataArray,RObject(v)), v) +v = DataArray([1,2], [false,true]) +@test isequal(rcopy(DataArray,RObject(v)), v) +@test isequal(rcopy(DataArray,R"c(NA,1L)"), DataArray([0,1], [true,false])) +@test isequal(rcopy(DataArray,R"c(1L,NA)"), DataArray([1,0], [false,true])) +# int32 +v = DataArray(Int32[1,2], [true,false]) +@test isequal(rcopy(DataArray,RObject(v)), v) +v = DataArray(Int32[1,2], [false,true]) +@test isequal(rcopy(DataArray,RObject(v)), v) +@test isequal(rcopy(DataArray,R"c(NA,1L)"), DataArray(Int32[0,1], [true,false])) +@test isequal(rcopy(DataArray,R"c(1L,NA)"), DataArray(Int32[1,0], [false,true])) +# real +v = DataArray([1.,2.], [true,false]) +@test isequal(rcopy(DataArray,RObject(v)), v) +v = DataArray([1.,2.], [false,true]) +@test isequal(rcopy(DataArray,RObject(v)), v) +@test isequal(rcopy(DataArray,R"c(NA,1)"), DataArray([0,1.], [true,false])) +@test isequal(rcopy(DataArray,R"c(1,NA)"), DataArray([1.,0], [false,true])) +# complex +v = DataArray([0,1.+0*im], [true,false]) +@test isequal(rcopy(DataArray,RObject(v)), v) +v = DataArray([0,1.+0*im], [false,true]) +@test isequal(rcopy(DataArray,RObject(v)), v) +@test isequal(rcopy(DataArray,R"c(NA,1+0i)"), DataArray([0,1.+0*im], [true,false])) +@test isequal(rcopy(DataArray,R"c(1+0i,NA)"), DataArray([1.+0*im,0], [false,true])) +# string +v = DataArray(["","abc"], [true,false]) +@test isequal(rcopy(DataArray,RObject(v)), v) +v = DataArray(["","abc"], [false,true]) +@test isequal(rcopy(DataArray,RObject(v)), v) +@test isequal(rcopy(DataArray,R"c(NA,'NA')"), DataArray(["","NA"], [true,false])) +@test isequal(rcopy(DataArray,R"c('NA',NA)"), DataArray(["NA",""], [false,true])) + +# PooledDataArray +v = PooledDataArray(repeat(["a", "b"], inner = 5)) +@test isequal(rcopy(PooledDataArray,RObject(v)), v) +v = PooledDataArray(repeat(["a", "b"], inner = 5), repeat([true, false], outer = 5)) +@test isequal(rcopy(PooledDataArray,RObject(v)), v) +@test_throws ErrorException rcopy(DataArray,R"factor(c('a','a','c'))") +@test rcopy(PooledDataArray,R"factor(c('a','a','c'))").pool == ["a","c"] +@test rcopy(PooledDataArray,R"factor(c('a',NA,'c'))").pool == ["a","c"] + + +# Nullable +@test isequal(rcopy(Nullable, RObject(1)), Nullable(1)) +@test isequal(rcopy(Nullable, RObject("abc")), Nullable("abc")) +@test rcopy(RObject(Nullable(1))) == 1 +@test isnull(rcopy(Nullable, RObject(Nullable()))) # NullableArrays +v110 = rcopy(NullableArray,reval("c(1L, NA)")) +@test isa(v110,NullableVector) +@test eltype(v110) == Nullable{Int32} +@test isnull(rcopy(NullableArray, RObject(v110[2]))[1]) + # bool v = NullableArray([true,true], [true,false]) @test isequal(rcopy(NullableArray,RObject(v)), v) From e8081f312ea4c3c24ab1b1f2c6f6b340b65c8d2d Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Fri, 17 Mar 2017 00:59:20 -0400 Subject: [PATCH 08/26] support AxisArrays --- REQUIRE | 1 + src/RCall.jl | 4 ++++ src/convert/axisarray.jl | 24 ++++++++++++++++++++++++ src/convert/default.jl | 9 +++++++++ test/conversion.jl | 6 ++++++ test/{dataframe.jl => data.jl} | 2 -- test/runtests.jl | 3 ++- 7 files changed, 46 insertions(+), 3 deletions(-) create mode 100644 src/convert/axisarray.jl rename test/{dataframe.jl => data.jl} (99%) diff --git a/REQUIRE b/REQUIRE index 3ac761cb..860904bd 100644 --- a/REQUIRE +++ b/REQUIRE @@ -3,5 +3,6 @@ DataStructures 0.4.3 DataFrames 0.9 NullableArrays 0.0.10 CategoricalArrays 0.0.6 +AxisArrays 0.0.6 Compat 0.20.0 @windows WinReg 0.2.0 diff --git a/src/RCall.jl b/src/RCall.jl index 22cb487c..97275d4d 100644 --- a/src/RCall.jl +++ b/src/RCall.jl @@ -10,6 +10,9 @@ import NullableArrays: NullableArray import CategoricalArrays import CategoricalArrays: CategoricalArray, CategoricalPool, NullableCategoricalArray +import AxisArrays +import AxisArrays: AxisArray, Axis + import DataStructures: OrderedDict import Base: eltype, show, convert, isascii, isnull, @@ -32,6 +35,7 @@ include("methods.jl") include("convert/base.jl") include("convert/dataframe.jl") include("convert/datatable.jl") +include("convert/axisarray.jl") include("convert/default.jl") include("eventloop.jl") include("eval.jl") diff --git a/src/convert/axisarray.jl b/src/convert/axisarray.jl new file mode 100644 index 00000000..d4ed1891 --- /dev/null +++ b/src/convert/axisarray.jl @@ -0,0 +1,24 @@ +function rcopy{S<:VectorSxp}(::Type{AxisArray}, r::Ptr{S}) + dnames = getattrib(r, Const.DimNamesSymbol) + isnull(dnames) && error("r has no dimnames") + dsym = rcopy(Array{Symbol}, getnames(dnames)) + axes = [Axis{dsym[i]}(rcopy(n)) for (i,n) in enumerate(dnames)] + AxisArray(rcopy(Array, r), axes...) +end + + +for S in (:IntSxp, :RealSxp, :CplxSxp, :LglSxp, :StrSxp) + @eval begin + function sexp(::Type{$S}, aa::AxisArray) + rv = protect(sexp($S, aa.data)) + try + d = OrderedDict( + k => v.val for (k, v) in zip(AxisArrays.axisnames(aa), AxisArrays.axes(aa))) + setattrib!(rv, Const.DimNamesSymbol, sexp(VecSxp, d)) + finally + unprotect(1) + end + rv + end + end +end diff --git a/src/convert/default.jl b/src/convert/default.jl index 74939147..2b821b9d 100644 --- a/src/convert/default.jl +++ b/src/convert/default.jl @@ -141,3 +141,12 @@ end for typ in [:NullableCategoricalArray, :CategoricalArray] @eval sexp(v::$typ) = sexp(IntSxp, v) end + +# AxisArray +for (J,S) in ((:Integer,:IntSxp), + (:Real, :RealSxp), + (:Complex, :CplxSxp), + (:Bool, :LglSxp), + (:AbstractString, :StrSxp)) + @eval sexp{T<:$J}(aa::AxisArray{T}) = sexp($S, aa) +end diff --git a/test/conversion.jl b/test/conversion.jl index fbe9b0b7..7e83b6de 100644 --- a/test/conversion.jl +++ b/test/conversion.jl @@ -234,6 +234,12 @@ d = RObject(Dict(1=>2)) @test Dict{Any,Any}("1" => 2) == rcopy(Dict, d) @test Dict{Int,Int}(1=>2) == rcopy(Dict{Int,Int}, d) +# AxisArray +aa = rcopy(AxisArray, R"Titanic") +@test size(aa) == (4, 2, 2, 2) +@test length(aa.axes[1]) == 4 +@test_throws ErrorException rcopy(AxisArray, R"c(1,1)") +@test names(getattrib(RObject(aa), :dimnames))[1] == :Class # function function funk(x,y) diff --git a/test/dataframe.jl b/test/data.jl similarity index 99% rename from test/dataframe.jl rename to test/data.jl index d7135a6d..62dffebe 100644 --- a/test/dataframe.jl +++ b/test/data.jl @@ -1,5 +1,3 @@ -using NullableArrays,CategoricalArrays,DataFrames - # DataFrame attenu = rcopy(DataFrame,reval(:attenu)) @test isa(attenu,DataFrame) diff --git a/test/runtests.jl b/test/runtests.jl index 9ae775d6..89c82fb4 100644 --- a/test/runtests.jl +++ b/test/runtests.jl @@ -1,3 +1,4 @@ +using NullableArrays,CategoricalArrays,DataFrames,AxisArrays using Base.Test hd = homedir() pd = Pkg.dir() @@ -10,7 +11,7 @@ using RCall tests = ["basic", "conversion", - "dataframe", + "data", "rstr", "library", "repl", From df75f38768d3bb42e34cc70c6595119e367d4e58 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Fri, 17 Mar 2017 03:07:20 -0400 Subject: [PATCH 09/26] fix error messages --- src/convert/dataframe.jl | 6 +++--- src/convert/datatable.jl | 8 ++++---- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/convert/dataframe.jl b/src/convert/dataframe.jl index ba4ee3cc..71038691 100644 --- a/src/convert/dataframe.jl +++ b/src/convert/dataframe.jl @@ -8,17 +8,17 @@ function rcopy{S<:VectorSxp}(::Type{DataArray}, s::Ptr{S}) end function rcopy(::Type{DataArray}, s::Ptr{IntSxp}) - isFactor(s) && error("$s is a R factor") + isFactor(s) && error("s is an R factor") DataArray(rcopy(Array,s), isna(s)) end function rcopy(::Type{PooledDataArray}, s::Ptr{IntSxp}) - isFactor(s) || error("$s is not a R factor") + isFactor(s) || error("s is not an R factor") refs = DataArrays.RefArray([isna(x) ? zero(Int32) : x for x in s]) DataArrays.compact(PooledDataArray(refs,rcopy(getattrib(s,Const.LevelsSymbol)))) end function rcopy(::Type{DataFrame}, s::Ptr{VecSxp}) - isFrame(s) || error("s is not a R data frame") + isFrame(s) || error("s is not an R data frame") DataFrame(Any[rcopy(c) for c in s], rcopy(Array{Symbol},getnames(s))) end diff --git a/src/convert/datatable.jl b/src/convert/datatable.jl index 00ba7ef5..4a3d9b82 100644 --- a/src/convert/datatable.jl +++ b/src/convert/datatable.jl @@ -1,7 +1,7 @@ # conversion methods for NullableArrays, CategoricalArrays and DataTables function rcopy{T,S<:Sxp}(::Type{Nullable{T}}, s::Ptr{S}) - length(s) == 1 || error("length of $s must be 1.") + length(s) == 1 || error("length of s must be 1.") rcopy(NullableArray{T}, s)[1] end @@ -21,18 +21,18 @@ function rcopy{S<:VectorSxp}(::Type{NullableArray}, s::Ptr{S}) end function rcopy(::Type{NullableArray}, s::Ptr{IntSxp}) - isFactor(s) && error("$s is a R factor") + isFactor(s) && error("s is an R factor") NullableArray(rcopy(Array,s), isna(s)) end function rcopy(::Type{CategoricalArray}, s::Ptr{IntSxp}) - isFactor(s) || error("$s is not a R factor") + isFactor(s) || error("s is not an R factor") refs = UInt32[x for x in s] levels = rcopy(Array, getattrib(s,Const.LevelsSymbol)) pool = CategoricalPool(levels, isOrdered(s)) CategoricalArray(refs, pool) end function rcopy(::Type{NullableCategoricalArray}, s::Ptr{IntSxp}) - isFactor(s) || error("$s is not a R factor") + isFactor(s) || error("s is not an R factor") refs = UInt32[isna(x) ? zero(UInt32) : UInt32(x) for x in s] levels = rcopy(Array, getattrib(s,Const.LevelsSymbol)) pool = CategoricalPool(levels, isOrdered(s)) From 9a3f02032f37da858183d1bd5b34ab5c6552ee77 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Fri, 17 Mar 2017 02:01:47 -0400 Subject: [PATCH 10/26] add DataTables and various test fixes --- REQUIRE | 3 +-- src/RCall.jl | 13 +++---------- src/convert/axisarray.jl | 5 ++--- src/convert/dataframe.jl | 6 ++++-- src/convert/datatable.jl | 25 +++++++++++++++++++++++++ src/convert/default.jl | 5 +++++ test/basic.jl | 2 -- test/convert/axisarray.jl | 8 ++++++++ test/{conversion.jl => convert/base.jl} | 8 -------- test/{ => convert}/data.jl | 23 +++++++++++++++++++++-- test/library.jl | 2 +- test/{rstr.jl => render.jl} | 0 test/runtests.jl | 9 +++++---- 13 files changed, 75 insertions(+), 34 deletions(-) create mode 100644 test/convert/axisarray.jl rename test/{conversion.jl => convert/base.jl} (96%) rename test/{ => convert}/data.jl (90%) rename test/{rstr.jl => render.jl} (100%) diff --git a/REQUIRE b/REQUIRE index 860904bd..d5f255aa 100644 --- a/REQUIRE +++ b/REQUIRE @@ -1,8 +1,7 @@ julia 0.5 DataStructures 0.4.3 DataFrames 0.9 -NullableArrays 0.0.10 -CategoricalArrays 0.0.6 +DataTables 0.0.1 AxisArrays 0.0.6 Compat 0.20.0 @windows WinReg 0.2.0 diff --git a/src/RCall.jl b/src/RCall.jl index 97275d4d..8b7f92dc 100644 --- a/src/RCall.jl +++ b/src/RCall.jl @@ -2,16 +2,9 @@ __precompile__() module RCall using Compat -import DataFrames: DataFrame, AbstractDataFrame, Formula -import DataArrays -import DataArrays: DataArray, PooledDataArray, AbstractDataArray, RefArray - -import NullableArrays: NullableArray -import CategoricalArrays -import CategoricalArrays: CategoricalArray, CategoricalPool, NullableCategoricalArray - -import AxisArrays -import AxisArrays: AxisArray, Axis +using DataFrames +using DataTables +using AxisArrays import DataStructures: OrderedDict diff --git a/src/convert/axisarray.jl b/src/convert/axisarray.jl index d4ed1891..07542df0 100644 --- a/src/convert/axisarray.jl +++ b/src/convert/axisarray.jl @@ -2,8 +2,7 @@ function rcopy{S<:VectorSxp}(::Type{AxisArray}, r::Ptr{S}) dnames = getattrib(r, Const.DimNamesSymbol) isnull(dnames) && error("r has no dimnames") dsym = rcopy(Array{Symbol}, getnames(dnames)) - axes = [Axis{dsym[i]}(rcopy(n)) for (i,n) in enumerate(dnames)] - AxisArray(rcopy(Array, r), axes...) + AxisArray(rcopy(Array, r), [Axis{dsym[i]}(rcopy(n)) for (i,n) in enumerate(dnames)]...) end @@ -13,7 +12,7 @@ for S in (:IntSxp, :RealSxp, :CplxSxp, :LglSxp, :StrSxp) rv = protect(sexp($S, aa.data)) try d = OrderedDict( - k => v.val for (k, v) in zip(AxisArrays.axisnames(aa), AxisArrays.axes(aa))) + k => v.val for (k, v) in zip(axisnames(aa), axes(aa))) setattrib!(rv, Const.DimNamesSymbol, sexp(VecSxp, d)) finally unprotect(1) diff --git a/src/convert/dataframe.jl b/src/convert/dataframe.jl index 71038691..b0e21870 100644 --- a/src/convert/dataframe.jl +++ b/src/convert/dataframe.jl @@ -17,9 +17,11 @@ function rcopy(::Type{PooledDataArray}, s::Ptr{IntSxp}) DataArrays.compact(PooledDataArray(refs,rcopy(getattrib(s,Const.LevelsSymbol)))) end -function rcopy(::Type{DataFrame}, s::Ptr{VecSxp}) +function rcopy{T<:AbstractDataFrame}(::Type{T}, s::Ptr{VecSxp}) isFrame(s) || error("s is not an R data frame") - DataFrame(Any[rcopy(c) for c in s], rcopy(Array{Symbol},getnames(s))) + DataFrame( + Any[isFactor(c)? rcopy(PooledDataArray, c) : rcopy(DataArray, c) for c in s], + rcopy(Array{Symbol},getnames(s))) end ## DataArray to sexp conversion. diff --git a/src/convert/datatable.jl b/src/convert/datatable.jl index 4a3d9b82..a671e248 100644 --- a/src/convert/datatable.jl +++ b/src/convert/datatable.jl @@ -39,6 +39,13 @@ function rcopy(::Type{NullableCategoricalArray}, s::Ptr{IntSxp}) NullableCategoricalArray(refs, pool) end +# DataTable +function rcopy{T<:AbstractDataTable}(::Type{T}, s::Ptr{VecSxp}) + isFrame(s) || error("s is not an R data frame") + DataTable( + Any[isFactor(c)? rcopy(NullableCategoricalArray, c) : rcopy(NullableArray, c) for c in s], + rcopy(Array{Symbol},getnames(s))) +end # Nullable and NullableArray to sexp conversion. for S in (:IntSxp, :RealSxp, :CplxSxp, :LglSxp, :StrSxp) @@ -90,3 +97,21 @@ for typ in [:NullableCategoricalArray, :CategoricalArray] end end end + +# DataTable +function sexp(::Type{VecSxp}, d::AbstractDataTable) + nr,nc = size(d) + nv = names(d) + rd = protect(allocArray(VecSxp, nc)) + try + for i in 1:nc + rd[i] = sexp(d[nv[i]]) + end + setattrib!(rd,Const.NamesSymbol, sexp([string(n) for n in nv])) + setattrib!(rd,Const.ClassSymbol, sexp("data.frame")) + setattrib!(rd,Const.RowNamesSymbol, sexp(1:nr)) + finally + unprotect(1) + end + rd +end diff --git a/src/convert/default.jl b/src/convert/default.jl index 2b821b9d..1ccfb20c 100644 --- a/src/convert/default.jl +++ b/src/convert/default.jl @@ -105,6 +105,9 @@ sexp(st::AbstractString) = sexp(StrSxp,st) # DataFrames sexp(d::AbstractDataFrame) = sexp(VecSxp, d) +# DataTables +sexp(d::AbstractDataTable) = sexp(VecSxp, d) + # PooledDataArray sexp(a::PooledDataArray) = sexp(IntSxp,a) sexp{S<:AbstractString}(a::PooledDataArray{S}) = sexp(IntSxp,a) @@ -128,6 +131,8 @@ sexp(a::AbstractArray) = sexp(VecSxp,a) sexp(d::Associative) = sexp(VecSxp,d) # Nullable +sexp(x::Nullable{Union{}}) = sexp(NaInt) + for (J,S) in ((:Integer,:IntSxp), (:Real, :RealSxp), (:Complex, :CplxSxp), diff --git a/test/basic.jl b/test/basic.jl index f760b80e..d096e65f 100644 --- a/test/basic.jl +++ b/test/basic.jl @@ -37,8 +37,6 @@ y = "foo" @test rcopy(rcall(:besselI, 1.0, 2.0)) ≈ besseli(2.0,1.0) @test rcopy(rcall(:besselI, 1.0, 2.0, var"expon.scaled"=true)) ≈ besselix(2.0,1.0) -x = reval("LETTERS") - # callbacks function testfn(x,y;a=3,b=4) diff --git a/test/convert/axisarray.jl b/test/convert/axisarray.jl new file mode 100644 index 00000000..5226a7f6 --- /dev/null +++ b/test/convert/axisarray.jl @@ -0,0 +1,8 @@ +using AxisArrays + +# AxisArray +aa = rcopy(AxisArray, R"Titanic") +@test size(aa) == (4, 2, 2, 2) +@test length(aa.axes[1]) == 4 +@test_throws ErrorException rcopy(AxisArray, R"c(1,1)") +@test names(getattrib(RObject(aa), :dimnames))[1] == :Class diff --git a/test/conversion.jl b/test/convert/base.jl similarity index 96% rename from test/conversion.jl rename to test/convert/base.jl index 7e83b6de..d46c294d 100644 --- a/test/conversion.jl +++ b/test/convert/base.jl @@ -234,13 +234,6 @@ d = RObject(Dict(1=>2)) @test Dict{Any,Any}("1" => 2) == rcopy(Dict, d) @test Dict{Int,Int}(1=>2) == rcopy(Dict{Int,Int}, d) -# AxisArray -aa = rcopy(AxisArray, R"Titanic") -@test size(aa) == (4, 2, 2, 2) -@test length(aa.axes[1]) == 4 -@test_throws ErrorException rcopy(AxisArray, R"c(1,1)") -@test names(getattrib(RObject(aa), :dimnames))[1] == :Class - # function function funk(x,y) x+y @@ -249,7 +242,6 @@ f1 = RObject(funk) @test rcopy(Function, f1)(1,2) == 3 @test rcopy(Function, f1.p)(1,2) == 3 - # misc a = RObject(rand(10)) @test length(rcopy(Any, a)) == 10 diff --git a/test/data.jl b/test/convert/data.jl similarity index 90% rename from test/data.jl rename to test/convert/data.jl index 62dffebe..7d100b30 100644 --- a/test/data.jl +++ b/test/convert/data.jl @@ -1,14 +1,30 @@ +using DataFrames +using DataTables + # DataFrame attenu = rcopy(DataFrame,reval(:attenu)) @test isa(attenu,DataFrame) @test size(attenu) == (182,5) @test rcopy(rcall(:dim,RObject(attenu))) == [182,5] @test rcopy(rcall(:dim, RObject(attenu[1:2, :]))) == [2, 5] +@test rcopy(rcall(:dim, RObject(view(attenu, 1:2)))) == [2, 5] dist = attenu[:dist] -@test isa(dist,Vector{Float64}) +@test isa(dist,DataArray{Float64}) station = attenu[:station] @test isa(station,PooledDataArray) +# DataTable +attenu = rcopy(DataTable,reval(:attenu)) +@test isa(attenu,DataTable) +@test size(attenu) == (182,5) +@test rcopy(rcall(:dim,RObject(attenu))) == [182,5] +@test rcopy(rcall(:dim, RObject(attenu[1:2, :]))) == [2, 5] +@test rcopy(rcall(:dim, RObject(view(attenu, 1:2)))) == [2, 5] +dist = attenu[:dist] +@test isa(dist,NullableArray{Float64}) +station = attenu[:station] +@test isa(station,NullableCategoricalArray) + # DataArray # bool @@ -68,7 +84,7 @@ v = PooledDataArray(repeat(["a", "b"], inner = 5), repeat([true, false], outer = @test isequal(rcopy(Nullable, RObject(1)), Nullable(1)) @test isequal(rcopy(Nullable, RObject("abc")), Nullable("abc")) @test rcopy(RObject(Nullable(1))) == 1 -@test isnull(rcopy(Nullable, RObject(Nullable()))) +@test isnull(rcopy(Nullable, RObject(@compat Nullable(1, false)))) # NullableArrays v110 = rcopy(NullableArray,reval("c(1L, NA)")) @@ -133,3 +149,6 @@ v = NullableCategoricalArray(repeat(["a", "b"], inner = 5), repeat([true, false] @test CategoricalArrays.levels(rcopy(NullableCategoricalArray,R"factor(c('a',NA,'c'))")) == ["a","c"] @test CategoricalArrays.isordered(rcopy(CategoricalArray,R"ordered(c('a','a','c'))")) @test CategoricalArrays.isordered(rcopy(NullableCategoricalArray,R"ordered(c('a',NA,'c'))")) + +#RCall.rlang_formula(parse("a+b")) +@test RCall.rlang_formula(:a) == :a diff --git a/test/library.jl b/test/library.jl index b22d0723..6030bb2f 100644 --- a/test/library.jl +++ b/test/library.jl @@ -1,6 +1,6 @@ # library # Since @rimport and @rlibrary create module objects which may be conflict with other objects, -# it is safer to place them at the end of the test. +# it is safer to place them at the end of the tests. @rimport MASS as mass @test rcopy(rcall(mass.ginv, RObject([1 2; 0 4]))) ≈ [1 -0.5; 0 0.25] @rlibrary MASS diff --git a/test/rstr.jl b/test/render.jl similarity index 100% rename from test/rstr.jl rename to test/render.jl diff --git a/test/runtests.jl b/test/runtests.jl index 89c82fb4..921f3a4c 100644 --- a/test/runtests.jl +++ b/test/runtests.jl @@ -1,19 +1,20 @@ -using NullableArrays,CategoricalArrays,DataFrames,AxisArrays using Base.Test hd = homedir() pd = Pkg.dir() using RCall +using Compat # https://github.com/JuliaStats/RCall.jl/issues/68 @test hd == homedir() @test pd == Pkg.dir() tests = ["basic", - "conversion", - "data", - "rstr", + "convert/base", + "convert/data", + "convert/axisarray", "library", + "render", "repl", ] From 99e6a5cb43b131334b2540664b4a5bc16dcf114d Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Fri, 17 Mar 2017 15:29:07 -0400 Subject: [PATCH 11/26] DataArray and NullableArray Data/DateTime with a lot of other improvements --- src/callback.jl | 31 --------- src/convert/base.jl | 147 +++++++++++++++++++++++++++------------ src/convert/datatable.jl | 2 +- src/convert/datetime.jl | 12 ++-- src/convert/default.jl | 36 ++++++---- src/types.jl | 32 +++++---- test/convert/datetime.jl | 88 ++++++++++++++++++----- 7 files changed, 217 insertions(+), 131 deletions(-) diff --git a/src/callback.jl b/src/callback.jl index ee712e8c..4c5a104d 100644 --- a/src/callback.jl +++ b/src/callback.jl @@ -93,11 +93,6 @@ function registerCFinalizerEx(s::ExtPtrSxpPtr) end -sexp(::Type{ExtPtrSxp}, s::Ptr{ExtPtrSxp}) = s -sexp(::Type{ExtPtrSxp}, r::RObject{ExtPtrSxp}) = sexp(r) -sexp(::Type{ClosSxp}, s::Ptr{ClosSxp}) = s -sexp(::Type{ClosSxp}, r::RObject{ClosSxp}) = sexp(r) - """ Wrap a Julia object an a R `ExtPtrSxpPtr`. @@ -114,30 +109,6 @@ end const juliaCallback = RObject{ExtPtrSxp}() -""" -Wrap a callable Julia object `f` an a R `ClosSxpPtr`. - -Constructs the following R code - - function(...) .External(juliaCallback, fExPtr, ...) - -""" -function sexp(::Type{ClosSxp}, f) - fptr = protect(sexp(ExtPtrSxp,f)) - body = protect(rlang_p(Symbol(".External"), - juliaCallback, - fptr, - Const.DotsSymbol)) - local clos - try - lang = rlang_p(:function, sexp_arglist_dots(), body) - clos = reval_p(lang) - finally - unprotect(2) - end - clos -end - """ Create an argument list for an R function call, with a varargs "dots" at the end. """ @@ -162,5 +133,3 @@ function sexp_arglist_dots(args...;kwargs...) end rarglist end - -sexp(f::Function) = sexp(ClosSxp, f) diff --git a/src/convert/base.jl b/src/convert/base.jl index e00a68ce..1545c2cf 100644 --- a/src/convert/base.jl +++ b/src/convert/base.jl @@ -5,6 +5,19 @@ rcopy{T}(::Type{T},r::RObject) = rcopy(T,r.p) convert{T, S<:Sxp}(::Type{T}, r::RObject{S}) = rcopy(T,r.p) convert{S<:Sxp}(::Type{RObject{S}}, r::RObject{S}) = r +# conversion between numbers which understands different NAs +function rcopy{T<:Number, R<:Number}(::Type{T}, x::R) + if (R <: AbstractFloat && !isnan(x)) || (R == Int32 && !isna(x)) + return T(x) + elseif R == Int32 && T <: AbstractFloat + return T(NaN) + elseif R <: AbstractFloat && T == Int32 + return Const.NaInt + else + return T(x) + end +end + # NilSxp rcopy{T}(::Type{T}, ::Ptr{NilSxp}) = T(nothing) @@ -16,30 +29,28 @@ rcopy{T<:AbstractString}(::Type{T},s::CharSxpPtr) = convert(T, String(unsafe_vec rcopy(::Type{Symbol},s::CharSxpPtr) = Symbol(rcopy(AbstractString,s)) rcopy(::Type{Int}, s::CharSxpPtr) = parse(Int, rcopy(s)) -# VectorSxp fallbacks -function rcopy{T,S<:VectorSxp}(::Type{Array{T}}, s::Ptr{S}) - protect(s) - v = T[rcopy(T,e) for e in s] - ret = reshape(v,size(s)) - unprotect(1) - ret -end -function rcopy{T,S<:VectorSxp}(::Type{Vector{T}}, s::Ptr{S}) - protect(s) - ret = T[rcopy(T,e) for e in s] - unprotect(1) - ret +# IntSxp, RealSxp, CplxSxp, LglSxp, StrSxp, VecSxp to Array{T} +for S in (:IntSxp, :RealSxp, :CplxSxp, :LglSxp, :StrSxp, :VecSxp) + @eval begin + function rcopy{T}(::Type{Array{T}}, s::Ptr{$S}) + protect(s) + v = T[rcopy(T,e) for e in s] + ret = reshape(v,size(s)) + unprotect(1) + ret + end + function rcopy{T}(::Type{Vector{T}}, s::Ptr{$S}) + protect(s) + ret = T[rcopy(T,e) for e in s] + unprotect(1) + ret + end + end end -# StrSxp -rcopy(::Type{Vector}, s::StrSxpPtr) = rcopy(Vector{String}, s) -rcopy(::Type{Array}, s::StrSxpPtr) = rcopy(Array{String}, s) -rcopy(::Type{Symbol}, s::StrSxpPtr) = rcopy(Symbol,s[1]) -rcopy{T<:AbstractString}(::Type{T},s::StrSxpPtr) = rcopy(T,s[1]) - -# IntSxp, RealSxp, CplxSxp +# IntSxp, RealSxp, CplxSxp to their corresponding Julia types. for (J,S) in ((:Integer,:IntSxp), - (:Real, :RealSxp), + (:AbstractFloat, :RealSxp), (:Complex, :CplxSxp)) @eval begin rcopy{T<:$J}(::Type{T},s::Ptr{$S}) = convert(T,s[1]) @@ -107,7 +118,15 @@ function rcopy(::Type{BitArray},s::Ptr{LglSxp}) a end +# StrSxp +rcopy(::Type{Vector}, s::StrSxpPtr) = rcopy(Vector{String}, s) +rcopy(::Type{Array}, s::StrSxpPtr) = rcopy(Array{String}, s) +rcopy(::Type{Symbol}, s::StrSxpPtr) = rcopy(Symbol,s[1]) +rcopy{T<:AbstractString}(::Type{T},s::StrSxpPtr) = rcopy(T,s[1]) + # VecSxp +rcopy(::Type{Array}, s::Ptr{VecSxp}) = rcopy(Array{Any}, s) +rcopy(::Type{Vector}, s::Ptr{VecSxp}) = rcopy(Vector{Any}, s) function rcopy{A<:Associative}(::Type{A}, s::Ptr{VecSxp}) protect(s) local a @@ -124,6 +143,7 @@ function rcopy{A<:Associative}(::Type{A}, s::Ptr{VecSxp}) a end + # FunctionSxp function rcopy{S<:FunctionSxp}(::Type{Function}, s::Ptr{S}) (args...) -> rcopy(rcall_p(s,args...)) @@ -132,6 +152,7 @@ function rcopy{S<:FunctionSxp}(::Type{Function}, r::RObject{S}) (args...) -> rcopy(rcall_p(r,args...)) end + # conversion from Base Julia types # nothing @@ -142,32 +163,10 @@ sexp(::Type{SymSxp}, s::Symbol) = sexp(SymSxp,string(s)) sexp(::Type{CharSxp}, sym::Symbol) = sexp(CharSxp, string(sym)) sexp(::Type{StrSxp},s::Symbol) = sexp(StrSxp,sexp(CharSxp,s)) -# string -sexp(::Type{SymSxp}, s::AbstractString) = ccall((:Rf_install, libR), Ptr{SymSxp}, (Ptr{UInt8},), s) -sexp(::Type{CharSxp}, st::String) = - ccall((:Rf_mkCharLenCE, libR), CharSxpPtr, - (Ptr{UInt8}, Cint, Cint), st, sizeof(st), isascii(st) ? 0 : 1) -sexp(::Type{CharSxp}, st::AbstractString) = sexp(CharSxp, string(st)) -sexp(::Type{StrSxp}, s::CharSxpPtr) = ccall((:Rf_ScalarString,libR),Ptr{StrSxp},(CharSxpPtr,),s) -sexp(::Type{StrSxp},st::AbstractString) = sexp(StrSxp,sexp(CharSxp,st)) - - -# AbstractArray -function sexp{S<:VectorSxp}(::Type{S}, a::AbstractArray) - ra = protect(allocArray(S, size(a)...)) - try - for i in 1:length(a) - ra[i] = a[i] - end - finally - unprotect(1) - end - ra -end # number and numeric array for (J,S) in ((:Integer,:IntSxp), - (:Real, :RealSxp), + (:AbstractFloat, :RealSxp), (:Complex, :CplxSxp)) @eval begin # Could use Rf_Scalar... methods, but see weird error on Appveyor Windows for Complex. @@ -193,9 +192,27 @@ function sexp{T<:Union{Bool,Cint}}(::Type{LglSxp}, a::AbstractArray{T}) ra end +# String +sexp(::Type{SymSxp}, s::AbstractString) = ccall((:Rf_install, libR), Ptr{SymSxp}, (Ptr{UInt8},), s) +sexp(::Type{CharSxp}, st::String) = + ccall((:Rf_mkCharLenCE, libR), CharSxpPtr, + (Ptr{UInt8}, Cint, Cint), st, sizeof(st), isascii(st) ? 0 : 1) +sexp(::Type{CharSxp}, st::AbstractString) = sexp(CharSxp, string(st)) +sexp(::Type{StrSxp}, s::CharSxpPtr) = ccall((:Rf_ScalarString,libR),Ptr{StrSxp},(CharSxpPtr,),s) +sexp(::Type{StrSxp},st::AbstractString) = sexp(StrSxp,sexp(CharSxp,st)) +function sexp{T<:AbstractString}(::Type{StrSxp}, a::AbstractArray{T}) + ra = protect(allocArray(StrSxp, size(a)...)) + try + for i in 1:length(a) + ra[i] = a[i] + end + finally + unprotect(1) + end + ra +end -# Associative - +# Associative to VecSxp # R does not have a native dictionary type, but named lists is often # used to this effect. function sexp(::Type{VecSxp},d::Associative) @@ -213,3 +230,41 @@ function sexp(::Type{VecSxp},d::Associative) end vs end + +# AbstractArray to VecSxp +function sexp(::Type{VecSxp}, a::AbstractArray) + ra = protect(allocArray(VecSxp, size(a)...)) + try + for i in 1:length(a) + ra[i] = a[i] + end + finally + unprotect(1) + end + ra +end + +# Function +""" +Wrap a callable Julia object `f` an a R `ClosSxpPtr`. + +Constructs the following R code + + function(...) .External(juliaCallback, fExPtr, ...) + +""" +function sexp(::Type{ClosSxp}, f) + fptr = protect(sexp(ExtPtrSxp,f)) + body = protect(rlang_p(Symbol(".External"), + juliaCallback, + fptr, + Const.DotsSymbol)) + local clos + try + lang = rlang_p(:function, sexp_arglist_dots(), body) + clos = reval_p(lang) + finally + unprotect(2) + end + clos +end diff --git a/src/convert/datatable.jl b/src/convert/datatable.jl index a671e248..b913f09e 100644 --- a/src/convert/datatable.jl +++ b/src/convert/datatable.jl @@ -81,7 +81,7 @@ for typ in [:NullableCategoricalArray, :CategoricalArray] try for (i,ref) = enumerate(v.refs) if ref == 0 - rv[i] = naeltype(eltype(rv)) + rv[i] = naeltype(IntSxp) end end # due to a bug of CategoricalArrays, we use index(v.pool) instead of index(v) diff --git a/src/convert/datetime.jl b/src/convert/datetime.jl index 062201ef..88704fbf 100644 --- a/src/convert/datetime.jl +++ b/src/convert/datetime.jl @@ -3,27 +3,27 @@ rcopy(::Type{Date}, s::RealSxpPtr) = rcopy(Date, s[1]) rcopy(::Type{DateTime}, s::RealSxpPtr) = rcopy(DateTime, s[1]) -rcopy(::Type{Date}, x::Float64) = convert(Date, x) + Dates.Day(719163) -rcopy(::Type{DateTime}, x::Float64) = convert(DateTime, x*1000) + Dates.Day(719163) +rcopy(::Type{Date}, x::Float64) = isnan(x)? 0: convert(Date, x) + Dates.Day(719163) +rcopy(::Type{DateTime}, x::Float64) = isnan(x)? 0: convert(DateTime, x*1000) + Dates.Day(719163) -function sexp(d::Date) +function sexp(RealSxp, d::Date) res = sexp(RealSxp, convert(Float64, d - Dates.Day(719163))) setclass!(res, sexp("Date")) res end -function sexp(a::AbstractArray{Date}) +function sexp(RealSxp, a::AbstractArray{Date}) res = sexp(RealSxp, convert(AbstractArray{Float64}, a - Dates.Day(719163))) setclass!(res, sexp("Date")) res end -function sexp(d::DateTime) +function sexp(RealSxp, d::DateTime) res = sexp(RealSxp, convert(Float64, d - Dates.Day(719163)) / 1000) setclass!(res, sexp(["POSIXct", "POSIXt"])) setattrib!(res, "tzone", sexp("UTC")) res end -function sexp(a::AbstractArray{DateTime}) +function sexp(RealSxp, a::AbstractArray{DateTime}) res = sexp(RealSxp, convert(AbstractArray{Float64}, a - Dates.Day(719163)) / 1000) setclass!(res, sexp(["POSIXct", "POSIXt"])) setattrib!(res, "tzone", sexp("UTC")) diff --git a/src/convert/default.jl b/src/convert/default.jl index 1ccfb20c..b23a58a3 100644 --- a/src/convert/default.jl +++ b/src/convert/default.jl @@ -95,28 +95,25 @@ RObject(s) = RObject(sexp(s)) # nothing sexp(::Void) = sexp(Const.NilValue) -# symbol +# Symbol sexp(s::Symbol) = sexp(SymSxp,s) -# string and string array -sexp{S<:AbstractString}(a::AbstractArray{S}) = sexp(StrSxp,a) -sexp(st::AbstractString) = sexp(StrSxp,st) - -# DataFrames +# DataFrame sexp(d::AbstractDataFrame) = sexp(VecSxp, d) -# DataTables +# DataTable sexp(d::AbstractDataTable) = sexp(VecSxp, d) # PooledDataArray sexp(a::PooledDataArray) = sexp(IntSxp,a) sexp{S<:AbstractString}(a::PooledDataArray{S}) = sexp(IntSxp,a) -# number +# Number, Array and DataArray for (J,S) in ((:Integer,:IntSxp), - (:Real, :RealSxp), + (:AbstractFloat, :RealSxp), (:Complex, :CplxSxp), - (:Bool, :LglSxp)) + (:Bool, :LglSxp), + (:AbstractString, :StrSxp)) @eval begin sexp{T<:$J}(a::AbstractArray{T}) = sexp($S,a) sexp{T<:$J}(a::DataArray{T}) = sexp($S,a) @@ -124,17 +121,17 @@ for (J,S) in ((:Integer,:IntSxp), end end -# Fallback: convert abstractArray to VecSxp (R list) +# Fallback: convert AbstractArray to VecSxp (R list) sexp(a::AbstractArray) = sexp(VecSxp,a) -# associative +# Associative sexp(d::Associative) = sexp(VecSxp,d) # Nullable sexp(x::Nullable{Union{}}) = sexp(NaInt) for (J,S) in ((:Integer,:IntSxp), - (:Real, :RealSxp), + (:AbstractFloat, :RealSxp), (:Complex, :CplxSxp), (:Bool, :LglSxp), (:AbstractString, :StrSxp)) @@ -149,9 +146,20 @@ end # AxisArray for (J,S) in ((:Integer,:IntSxp), - (:Real, :RealSxp), + (:AbstractFloat, :RealSxp), (:Complex, :CplxSxp), (:Bool, :LglSxp), (:AbstractString, :StrSxp)) @eval sexp{T<:$J}(aa::AxisArray{T}) = sexp($S, aa) end + +# DataTime +sexp(d::Date) = sexp(RealSxp, d) +sexp(d::AbstractArray{Date}) = sexp(RealSxp, d) +sexp(d::NullableArray{Date}) = sexp(RealSxp, d) +sexp(d::DateTime) = sexp(RealSxp, d) +sexp(d::AbstractArray{DateTime}) = sexp(RealSxp, d) +sexp(d::NullableArray{DateTime}) = sexp(RealSxp, d) + +# Function +sexp(f::Function) = sexp(ClosSxp, f) diff --git a/src/types.jl b/src/types.jl index 346ab125..5b42ded8 100644 --- a/src/types.jl +++ b/src/types.jl @@ -216,21 +216,6 @@ const S4SxpPtr = Ptr{S4Sxp} @compat const FunctionSxpPtr{S<:FunctionSxp} = Ptr{S} -""" -Element types of R vectors. -""" -eltype(::Type{LglSxp}) = Cint -eltype(::Type{IntSxp}) = Cint -eltype(::Type{RealSxp}) = Float64 -eltype(::Type{CplxSxp}) = Complex128 -eltype(::Type{CharSxp}) = UInt8 -eltype(::Type{RawSxp}) = UInt8 - -eltype(::Type{StrSxp}) = Ptr{CharSxp} -eltype(::Type{VecSxp}) = UnknownSxpPtr -eltype(::Type{ExprSxp}) = UnknownSxpPtr - - RObjectDocs = """ \"\"\" @@ -303,6 +288,23 @@ eval(parse(RObjectDocs * RObjectQuote)) RObject{S<:Sxp}(p::Ptr{S}) = RObject{S}(p) RObject(x::RObject) = x +""" +Element types of R vectors. +""" +eltype(::Type{LglSxp}) = Cint +eltype(::Type{IntSxp}) = Cint +eltype(::Type{RealSxp}) = Float64 +eltype(::Type{CplxSxp}) = Complex128 +eltype(::Type{CharSxp}) = UInt8 +eltype(::Type{RawSxp}) = UInt8 + +eltype(::Type{StrSxp}) = Ptr{CharSxp} +eltype(::Type{VecSxp}) = UnknownSxpPtr +eltype(::Type{ExprSxp}) = UnknownSxpPtr + +eltype{S<:Sxp}(s::Ptr{S}) = eltype(S) +eltype{S<:Sxp}(s::RObject{S}) = eltype(S) + """ Prevent garbage collection of an R object. Object can be released via `release`. diff --git a/test/convert/datetime.jl b/test/convert/datetime.jl index 653e68b4..7ccf34fc 100644 --- a/test/convert/datetime.jl +++ b/test/convert/datetime.jl @@ -6,8 +6,8 @@ r = RObject(d) @test rcopy(getclass(r)) == "Date" @test length(r) == 1 @test size(r) == (1,) -@test rcopy(r) === d -@test rcopy(R"as.Date($s)") == d +@test rcopy(Date, r) === d +@test rcopy(Date, R"as.Date($s)") == d @test rcopy(R"identical(as.Date($s), $d)") s = ["2001-01-01", "1111-11-11", "2012-12-12"] @@ -17,8 +17,8 @@ r = RObject(d) @test rcopy(getclass(r)) == "Date" @test length(r) == length(d) @test size(r) == size(d) -@test rcopy(r) == d -@test rcopy(R"as.Date($s)") == d +@test rcopy(Array{Date}, r) == d +@test rcopy(Array{Date}, R"as.Date($s)") == d @test rcopy(R"identical(as.Date($s), $d)") d = Date[] @@ -27,8 +27,33 @@ r = RObject(d) @test rcopy(getclass(r)) == "Date" @test length(r) == length(d) @test size(r) == size(d) -@test rcopy(r) == d -@test rcopy("as.Date(character(0))") == Date[] +@test rcopy(Array{Date}, r) == d +@test rcopy(R"as.Date(character(0))") == Date[] + +# DataArray date +s = DataArray(["0001-01-01", "2012-12-12"], [true, false]) +d = DataArray(Date.(s.data), s.na) +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == "Date" +@test length(r) == length(d) +@test size(r) == size(d) +@test rcopy(DataArray{Date}, r).na == d.na +@test rcopy(DataArray{Date}, r).data[!d.na] == d.data[!d.na] +@test rcopy(R"identical(as.Date($s), $d)") +@test rcopy(R"identical(as.character($d), $s)") + +s = DataArray(["0001-01-01"], [true]) +d = DataArray(Date.(s.data), s.na) +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == "Date" +@test length(r) == length(d) +@test size(r) == size(d) +@test all(rcopy(DataArray{Date}, r).na) +@test rcopy(R"identical(as.Date(NA), $d)") +@test rcopy(R"identical(as.character(NA), $s)") + # nullable date s = NullableArray(["0001-01-01", "2012-12-12"], [true, false]) @@ -38,8 +63,8 @@ r = RObject(d) @test rcopy(getclass(r)) == "Date" @test length(r) == length(d) @test size(r) == size(d) -@test rcopy(r).isnull == d.isnull -@test rcopy(r).values[!d.isnull] == d.values[!d.isnull] +@test rcopy(NullableArray{Date}, r).isnull == d.isnull +@test rcopy(NullableArray{Date}, r).values[!d.isnull] == d.values[!d.isnull] @test rcopy(R"identical(as.Date($s), $d)") @test rcopy(R"identical(as.character($d), $s)") @@ -50,7 +75,7 @@ r = RObject(d) @test rcopy(getclass(r)) == "Date" @test length(r) == length(d) @test size(r) == size(d) -@test all(rcopy(r).isnull) +@test all(rcopy(NullableArray{Date}, r).isnull) @test rcopy(R"identical(as.Date(NA), $d)") @test rcopy(R"identical(as.character(NA), $s)") @@ -64,8 +89,8 @@ r = RObject(d) @test rcopy(getattrib(r, "tzone")) == "UTC" @test length(r) == 1 @test size(r) == (1,) -@test rcopy(r) === d -@test rcopy(R"as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S')") == d +@test rcopy(DateTime, r) === d +@test rcopy(DateTime, R"as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S')") == d @test rcopy(R"identical(as.character($d, '%Y-%m-%dT%H:%M:%S'), $s)") s = ["2001-01-01T01:01:01", "1111-11-11T11:11:00", "2012-12-12T12:12:12"] @@ -76,8 +101,8 @@ r = RObject(d) @test rcopy(getattrib(r, "tzone")) == "UTC" @test length(r) == length(d) @test size(r) == size(d) -@test rcopy(r) == d -@test rcopy(R"as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S')") == d +@test rcopy(Array{DateTime},r) == d +@test rcopy(Array{DateTime},R"as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S')") == d @test rcopy(R"identical(as.character($d, '%Y-%m-%dT%H:%M:%S'), $s)") d = DateTime[] @@ -87,8 +112,35 @@ r = RObject(d) @test rcopy(getattrib(r, "tzone")) == "UTC" @test length(r) == length(d) @test size(r) == size(d) -@test rcopy(r) == d -@test rcopy("as.POSIXct(character(0))") == Date[] +@test rcopy(Array{DateTime},r) == d +@test rcopy(Array{DateTime},R"as.POSIXct(character(0))") == Date[] + +# DataArray dateTime +s = DataArray(["0001-01-01", "2012-12-12T12:12:12"], [true, false]) +d = DataArray(DateTime.(s.data), s.na) +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == ["POSIXct", "POSIXt"] +@test rcopy(getattrib(r, "tzone")) == "UTC" +@test length(r) == length(d) +@test size(r) == size(d) +@test rcopy(DataArray{DateTime}, r).na == d.na +@test rcopy(DataArray{DateTime}, r).data[!d.na] == d.data[!d.na] +@test rcopy(R"identical(as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S'), $d)") +@test rcopy(R"identical(as.character($d, '%Y-%m-%dT%H:%M:%S'), $s)") + +s = DataArray(["0001-01-01"], [true]) +d = DataArray(DateTime.(s.data), s.na) +r = RObject(d) +@test isa(r,RObject{RealSxp}) +@test rcopy(getclass(r)) == ["POSIXct", "POSIXt"] +@test rcopy(getattrib(r, "tzone")) == "UTC" +@test length(r) == length(d) +@test size(r) == size(d) +@test all(rcopy(DataArray{DateTime}, r).na) +@test rcopy(R"identical(as.POSIXct(NA_character_, 'UTC'), $d)") +@test rcopy(R"identical(as.character(NA), $s)") + # nullable dateTime s = NullableArray(["0001-01-01", "2012-12-12T12:12:12"], [true, false]) @@ -99,8 +151,8 @@ r = RObject(d) @test rcopy(getattrib(r, "tzone")) == "UTC" @test length(r) == length(d) @test size(r) == size(d) -@test rcopy(r).isnull == d.isnull -@test rcopy(r).values[!d.isnull] == d.values[!d.isnull] +@test rcopy(NullableArray{DateTime}, r).isnull == d.isnull +@test rcopy(NullableArray{DateTime}, r).values[!d.isnull] == d.values[!d.isnull] @test rcopy(R"identical(as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S'), $d)") @test rcopy(R"identical(as.character($d, '%Y-%m-%dT%H:%M:%S'), $s)") @@ -112,6 +164,6 @@ r = RObject(d) @test rcopy(getattrib(r, "tzone")) == "UTC" @test length(r) == length(d) @test size(r) == size(d) -@test all(rcopy(r).isnull) +@test all(rcopy(NullableArray{DateTime}, r).isnull) @test rcopy(R"identical(as.POSIXct(NA_character_, 'UTC'), $d)") @test rcopy(R"identical(as.character(NA), $s)") From e0a6859cbdb3b28c8de089e9f21671f9ac1fc132 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Sat, 18 Mar 2017 01:45:56 -0400 Subject: [PATCH 12/26] sanitize column names in dataframe conversions --- src/convert/dataframe.jl | 8 ++++++-- src/convert/datatable.jl | 8 ++++++-- test/basic.jl | 6 ++++++ test/render.jl | 5 ----- 4 files changed, 18 insertions(+), 9 deletions(-) diff --git a/src/convert/dataframe.jl b/src/convert/dataframe.jl index b0e21870..13a2ab1c 100644 --- a/src/convert/dataframe.jl +++ b/src/convert/dataframe.jl @@ -17,11 +17,15 @@ function rcopy(::Type{PooledDataArray}, s::Ptr{IntSxp}) DataArrays.compact(PooledDataArray(refs,rcopy(getattrib(s,Const.LevelsSymbol)))) end -function rcopy{T<:AbstractDataFrame}(::Type{T}, s::Ptr{VecSxp}) +function rcopy{T<:AbstractDataFrame}(::Type{T}, s::Ptr{VecSxp}; sanitize::Bool=true) isFrame(s) || error("s is not an R data frame") + vnames = rcopy(Array{Symbol},getnames(s)) + if sanitize + vnames = [Symbol(replace(string(v), '.', '_')) for v in vnames] + end DataFrame( Any[isFactor(c)? rcopy(PooledDataArray, c) : rcopy(DataArray, c) for c in s], - rcopy(Array{Symbol},getnames(s))) + vnames) end ## DataArray to sexp conversion. diff --git a/src/convert/datatable.jl b/src/convert/datatable.jl index b913f09e..5941b842 100644 --- a/src/convert/datatable.jl +++ b/src/convert/datatable.jl @@ -40,11 +40,15 @@ function rcopy(::Type{NullableCategoricalArray}, s::Ptr{IntSxp}) end # DataTable -function rcopy{T<:AbstractDataTable}(::Type{T}, s::Ptr{VecSxp}) +function rcopy{T<:AbstractDataTable}(::Type{T}, s::Ptr{VecSxp}; sanitize::Bool=true) isFrame(s) || error("s is not an R data frame") + vnames = rcopy(Array{Symbol},getnames(s)) + if sanitize + vnames = [Symbol(replace(string(v), '.', '_')) for v in vnames] + end DataTable( Any[isFactor(c)? rcopy(NullableCategoricalArray, c) : rcopy(NullableArray, c) for c in s], - rcopy(Array{Symbol},getnames(s))) + vnames) end # Nullable and NullableArray to sexp conversion. diff --git a/test/basic.jl b/test/basic.jl index d096e65f..c9759ed2 100644 --- a/test/basic.jl +++ b/test/basic.jl @@ -94,3 +94,9 @@ b = reval("b=c(4,5,6)") @test rcopy(a*b)==rcopy(R"a*b") @test rcopy(a/b)==rcopy(R"a/b") @test rcopy(a^b)==rcopy(R"a^b") + +# misc +iris = rcopy(reval(:iris)) +model = R"lm(Sepal_Length ~ Sepal_Width,data=$iris)" +@test rcopy(RCall.getclass(model)) == "lm" +@test isapprox(rcopy(R"sum($iris$Sepal_Length)"), sum(iris[:Sepal_Length]), rtol=4*eps()) diff --git a/test/render.jl b/test/render.jl index b8cde230..121b1d41 100644 --- a/test/render.jl +++ b/test/render.jl @@ -43,8 +43,3 @@ cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum." y = \$β """)[3] == 3 - -iris = rcopy(reval(:iris)) -model = R"lm(Sepal.Length ~ Sepal.Width,data=$iris)" -@test rcopy(RCall.getclass(model)) == "lm" -@test isapprox(rcopy(R"sum($iris$Sepal.Length)"), sum(iris[Symbol("Sepal.Length")]), rtol=4*eps()) From bf53b9b88dfc8e7ebc4599ce10e78e431e9a3b94 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Sat, 18 Mar 2017 14:45:44 -0400 Subject: [PATCH 13/26] fix Date/DateTime for v0.6 --- src/convert/datetime.jl | 14 +++++++------- test/convert/datetime.jl | 8 ++++---- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/convert/datetime.jl b/src/convert/datetime.jl index 88704fbf..bea2a0b1 100644 --- a/src/convert/datetime.jl +++ b/src/convert/datetime.jl @@ -3,28 +3,28 @@ rcopy(::Type{Date}, s::RealSxpPtr) = rcopy(Date, s[1]) rcopy(::Type{DateTime}, s::RealSxpPtr) = rcopy(DateTime, s[1]) -rcopy(::Type{Date}, x::Float64) = isnan(x)? 0: convert(Date, x) + Dates.Day(719163) -rcopy(::Type{DateTime}, x::Float64) = isnan(x)? 0: convert(DateTime, x*1000) + Dates.Day(719163) - +rcopy(::Type{Date}, x::Float64) = Date(Dates.UTInstant(Dates.Day((isnan(x)? 0: x) + 719163))) +rcopy(::Type{DateTime}, x::Float64) = + DateTime(Dates.UTInstant(Dates.Millisecond(((isnan(x)? 0: x) + 62135683200) * 1000))) function sexp(RealSxp, d::Date) - res = sexp(RealSxp, convert(Float64, d - Dates.Day(719163))) + res = sexp(RealSxp, Float64(Dates.value(d)) - 719163) setclass!(res, sexp("Date")) res end function sexp(RealSxp, a::AbstractArray{Date}) - res = sexp(RealSxp, convert(AbstractArray{Float64}, a - Dates.Day(719163))) + res = sexp(RealSxp, map((x) -> Float64(Dates.value(x)) - 719163, a)) setclass!(res, sexp("Date")) res end function sexp(RealSxp, d::DateTime) - res = sexp(RealSxp, convert(Float64, d - Dates.Day(719163)) / 1000) + res = sexp(RealSxp, Float64(Dates.value(d) / 1000) - 62135683200) setclass!(res, sexp(["POSIXct", "POSIXt"])) setattrib!(res, "tzone", sexp("UTC")) res end function sexp(RealSxp, a::AbstractArray{DateTime}) - res = sexp(RealSxp, convert(AbstractArray{Float64}, a - Dates.Day(719163)) / 1000) + res = sexp(RealSxp, map((x) -> Float64(Dates.value(x) / 1000) - 62135683200, a)) setclass!(res, sexp(["POSIXct", "POSIXt"])) setattrib!(res, "tzone", sexp("UTC")) res diff --git a/test/convert/datetime.jl b/test/convert/datetime.jl index 7ccf34fc..3b5f991f 100644 --- a/test/convert/datetime.jl +++ b/test/convert/datetime.jl @@ -39,7 +39,7 @@ r = RObject(d) @test length(r) == length(d) @test size(r) == size(d) @test rcopy(DataArray{Date}, r).na == d.na -@test rcopy(DataArray{Date}, r).data[!d.na] == d.data[!d.na] +@test rcopy(DataArray{Date}, r).data[map(!,d.na)] == d.data[map(!,d.na)] @test rcopy(R"identical(as.Date($s), $d)") @test rcopy(R"identical(as.character($d), $s)") @@ -64,7 +64,7 @@ r = RObject(d) @test length(r) == length(d) @test size(r) == size(d) @test rcopy(NullableArray{Date}, r).isnull == d.isnull -@test rcopy(NullableArray{Date}, r).values[!d.isnull] == d.values[!d.isnull] +@test rcopy(NullableArray{Date}, r).values[map(!,d.isnull)] == d.values[map(!,d.isnull)] @test rcopy(R"identical(as.Date($s), $d)") @test rcopy(R"identical(as.character($d), $s)") @@ -125,7 +125,7 @@ r = RObject(d) @test length(r) == length(d) @test size(r) == size(d) @test rcopy(DataArray{DateTime}, r).na == d.na -@test rcopy(DataArray{DateTime}, r).data[!d.na] == d.data[!d.na] +@test rcopy(DataArray{DateTime}, r).data[map(!,d.na)] == d.data[map(!,d.na)] @test rcopy(R"identical(as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S'), $d)") @test rcopy(R"identical(as.character($d, '%Y-%m-%dT%H:%M:%S'), $s)") @@ -152,7 +152,7 @@ r = RObject(d) @test length(r) == length(d) @test size(r) == size(d) @test rcopy(NullableArray{DateTime}, r).isnull == d.isnull -@test rcopy(NullableArray{DateTime}, r).values[!d.isnull] == d.values[!d.isnull] +@test rcopy(NullableArray{DateTime}, r).values[map(!,d.isnull)] == d.values[map(!,d.isnull)] @test rcopy(R"identical(as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S'), $d)") @test rcopy(R"identical(as.character($d, '%Y-%m-%dT%H:%M:%S'), $s)") From 20d939e8889e7dd93d95cf9cae90dd927939b1f2 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Sun, 19 Mar 2017 01:57:22 -0400 Subject: [PATCH 14/26] improve Sxp getindex and setindex! --- src/convert/base.jl | 3 +- src/convert/datatable.jl | 2 +- src/methods.jl | 59 ++++++++++++++++++++++++++++++++++++---- 3 files changed, 56 insertions(+), 8 deletions(-) diff --git a/src/convert/base.jl b/src/convert/base.jl index 1545c2cf..cdce20e2 100644 --- a/src/convert/base.jl +++ b/src/convert/base.jl @@ -19,7 +19,8 @@ function rcopy{T<:Number, R<:Number}(::Type{T}, x::R) end # NilSxp -rcopy{T}(::Type{T}, ::Ptr{NilSxp}) = T(nothing) +rcopy{T}(::Type{T}, ::Ptr{NilSxp}) = nothing +rcopy{T<:AbstractArray}(::Type{T}, ::Ptr{NilSxp}) = T() # SymSxp rcopy{T<:Union{Symbol,AbstractString}}(::Type{T},s::Ptr{SymSxp}) = rcopy(T, sexp(unsafe_load(s).name)) diff --git a/src/convert/datatable.jl b/src/convert/datatable.jl index 5941b842..a6635144 100644 --- a/src/convert/datatable.jl +++ b/src/convert/datatable.jl @@ -42,7 +42,7 @@ end # DataTable function rcopy{T<:AbstractDataTable}(::Type{T}, s::Ptr{VecSxp}; sanitize::Bool=true) isFrame(s) || error("s is not an R data frame") - vnames = rcopy(Array{Symbol},getnames(s)) + vnames = rcopy(Vector{Symbol},getnames(s)) if sanitize vnames = [Symbol(replace(string(v), '.', '_')) for v in vnames] end diff --git a/src/methods.jl b/src/methods.jl index 5ddc2ee7..bebf46e2 100644 --- a/src/methods.jl +++ b/src/methods.jl @@ -120,7 +120,6 @@ function setindex!(s::Ptr{StrSxp}, value::AbstractString, key::Integer) setindex!(s,sexp(CharSxp,value),key) end - function setindex!{S<:Union{VecSxp,ExprSxp},T<:Sxp}(s::Ptr{S}, value::Ptr{T}, key::Integer) 1 <= key <= length(s) || throw(BoundsError()) ccall((:SET_VECTOR_ELT,libR), Ptr{T}, @@ -130,8 +129,23 @@ end function setindex!{S<:Union{VecSxp,ExprSxp}}(s::Ptr{S}, value, key::Integer) setindex!(s,sexp(value),key) end +""" +Set element of a VectorSxp by a label. +""" +function setindex!{S<:VectorSxp, T<:Sxp}(s::Ptr{S}, value::Ptr{T}, label::AbstractString) + ls = unsafe_vec(getnames(s)) + for (i,l) in enumerate(ls) + if rcopy(l) == label + s[i] = value + return + end + end + throw(BoundsError()) +end +setindex!{S<:VectorSxp, T<:Sxp}(s::Ptr{S}, value::Ptr{T}, label::Symbol) = setindex!(s, value, string(label)) +setindex!{S<:VectorSxp}(s::Ptr{S}, value, label) = setindex!(s, sexp(value), label) -setindex!(r::RObject, value, keys...) = setindex!(sexp(r), value, keys...) +setindex!{S<:VectorSxp}(r::RObject{S}, value, keys...) = setindex!(sexp(r), value, keys...) @@ -178,7 +192,8 @@ function next{S<:PairListSxp,T<:PairListSxp}(s::Ptr{S},state::Ptr{T}) end done{S<:PairListSxp,T<:PairListSxp}(s::Ptr{S},state::Ptr{T}) = state == sexp(Const.NilValue) -"extract the i-th element of LangSxp l" + +"extract the i-th element of a PairListSxp" function getindex{S<:PairListSxp}(l::Ptr{S},I::Integer) 1 ≤ I ≤ length(l) || throw(BoundsError()) for i in 2:I @@ -186,10 +201,23 @@ function getindex{S<:PairListSxp}(l::Ptr{S},I::Integer) end car(l) end - getindex{S<:PairListSxp}(r::RObject{S},I::Integer) = RObject(getindex(sexp(r),I)) -"assign value v to the i-th element of LangSxp l" +"extract an element from a PairListSxp by label" +function getindex{S<:PairListSxp}(s::Ptr{S}, label::AbstractString) + ls = unsafe_vec(getnames(s)) + for (i,l) in enumerate(ls) + if rcopy(l) == label + return s[i] + end + end + throw(BoundsError()) +end +getindex{S<:PairListSxp}(s::Ptr{S}, label::Symbol) = getindex(s,string(label)) +getindex{S<:PairListSxp}(s::RObject{S}, label) = RObject(getindex(s.p,label)) + + +"assign value v to the i-th element of a PairListSxp" function setindex!{S<:PairListSxp,T<:Sxp}(l::Ptr{S},v::Ptr{T},I::Integer) 1 ≤ I ≤ length(l) || throw(BoundsError()) for i in 2:I @@ -201,6 +229,24 @@ function setindex!{S<:PairListSxp}(s::Ptr{S}, value, key::Integer) setindex!(s,sexp(value),key) end +""" +Set element of a PairListSxp by a label. +""" +function setindex!{S<:PairListSxp, T<:Sxp}(s::Ptr{S}, value::Ptr{T}, label::AbstractString) + ls = unsafe_vec(getnames(s)) + for (i,l) in enumerate(ls) + if rcopy(l) == label + s[i] = value + return + end + end + throw(BoundsError()) +end +setindex!{S<:PairListSxp, T<:Sxp}(s::Ptr{S}, value::Ptr{T}, label::Symbol) = setindex!(s, value, string(label)) +setindex!{S<:PairListSxp}(s::Ptr{S}, value, label) = setindex!(s, sexp(value), label) + +setindex!{S<:PairListSxp}(r::RObject{S}, value, label) = setindex!(sexp(r), value, label) + "Return a particular attribute of an RObject" function getattrib{S<:Sxp}(s::Ptr{S}, sym::Ptr{SymSxp}) @@ -227,6 +273,7 @@ setattrib!(r::RObject, sym, t) = setattrib!(r.p, sym, t) attributes(s::SxpHead) = sexp(s.attrib) attributes(s::Sxp) = attributes(s.head) attributes{S<:Sxp}(s::Ptr{S}) = attributes(unsafe_load(s)) +attributes{S<:Sxp}(s::RObject{S}) = RObject(attributes(s.p)) function size{S<:Sxp}(s::Ptr{S}) @@ -246,7 +293,7 @@ getnames(r::RObject) = RObject(getnames(sexp(r))) """ Returns the names of an R vector, the result is converted to a Julia symbol array. """ -names(r::RObject) = rcopy(Array{Symbol}, getnames(sexp(r))) +names(r::RObject) = rcopy(Vector{Symbol}, getnames(sexp(r))) """ Set the names of an R vector. From 5aaee3102e9750396930812621065e4a6980bb88 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Sun, 19 Mar 2017 02:05:26 -0400 Subject: [PATCH 15/26] split DataFrames and DataTables tests --- test/convert/dataframe.jl | 70 +++++++++++++++++++++++++ test/convert/{data.jl => datatable.jl} | 71 +------------------------- test/runtests.jl | 3 +- 3 files changed, 73 insertions(+), 71 deletions(-) create mode 100644 test/convert/dataframe.jl rename test/convert/{data.jl => datatable.jl} (57%) diff --git a/test/convert/dataframe.jl b/test/convert/dataframe.jl new file mode 100644 index 00000000..11b2a811 --- /dev/null +++ b/test/convert/dataframe.jl @@ -0,0 +1,70 @@ +using DataFrames + +# DataFrame +attenu = rcopy(DataFrame,reval(:attenu)) +@test isa(attenu,DataFrame) +@test size(attenu) == (182,5) +@test rcopy(rcall(:dim,RObject(attenu))) == [182,5] +@test rcopy(rcall(:dim, RObject(attenu[1:2, :]))) == [2, 5] +@test rcopy(rcall(:dim, RObject(view(attenu, 1:2)))) == [2, 5] +dist = attenu[:dist] +@test isa(dist,DataArray{Float64}) +station = attenu[:station] +@test isa(station,PooledDataArray) + +# DataArray + +# bool +v = DataArray([true,true], [true,false]) +@test isequal(rcopy(DataArray,RObject(v)), v) +v = DataArray([true,true], [false,true]) +@test isequal(rcopy(DataArray,RObject(v)), v) +@test isequal(rcopy(DataArray,R"c(NA,TRUE)"), DataArray([true,true], [true,false])) +@test isequal(rcopy(DataArray,R"c(TRUE, NA)"), DataArray([true,true], [false,true])) +# int64 +v = DataArray([1,2], [true,false]) +@test isequal(rcopy(DataArray,RObject(v)), v) +v = DataArray([1,2], [false,true]) +@test isequal(rcopy(DataArray,RObject(v)), v) +@test isequal(rcopy(DataArray,R"c(NA,1L)"), DataArray([0,1], [true,false])) +@test isequal(rcopy(DataArray,R"c(1L,NA)"), DataArray([1,0], [false,true])) +# int32 +v = DataArray(Int32[1,2], [true,false]) +@test isequal(rcopy(DataArray,RObject(v)), v) +v = DataArray(Int32[1,2], [false,true]) +@test isequal(rcopy(DataArray,RObject(v)), v) +@test isequal(rcopy(DataArray,R"c(NA,1L)"), DataArray(Int32[0,1], [true,false])) +@test isequal(rcopy(DataArray,R"c(1L,NA)"), DataArray(Int32[1,0], [false,true])) +# real +v = DataArray([1.,2.], [true,false]) +@test isequal(rcopy(DataArray,RObject(v)), v) +v = DataArray([1.,2.], [false,true]) +@test isequal(rcopy(DataArray,RObject(v)), v) +@test isequal(rcopy(DataArray,R"c(NA,1)"), DataArray([0,1.], [true,false])) +@test isequal(rcopy(DataArray,R"c(1,NA)"), DataArray([1.,0], [false,true])) +# complex +v = DataArray([0,1.+0*im], [true,false]) +@test isequal(rcopy(DataArray,RObject(v)), v) +v = DataArray([0,1.+0*im], [false,true]) +@test isequal(rcopy(DataArray,RObject(v)), v) +@test isequal(rcopy(DataArray,R"c(NA,1+0i)"), DataArray([0,1.+0*im], [true,false])) +@test isequal(rcopy(DataArray,R"c(1+0i,NA)"), DataArray([1.+0*im,0], [false,true])) +# string +v = DataArray(["","abc"], [true,false]) +@test isequal(rcopy(DataArray,RObject(v)), v) +v = DataArray(["","abc"], [false,true]) +@test isequal(rcopy(DataArray,RObject(v)), v) +@test isequal(rcopy(DataArray,R"c(NA,'NA')"), DataArray(["","NA"], [true,false])) +@test isequal(rcopy(DataArray,R"c('NA',NA)"), DataArray(["NA",""], [false,true])) + +# PooledDataArray +v = PooledDataArray(repeat(["a", "b"], inner = 5)) +@test isequal(rcopy(PooledDataArray,RObject(v)), v) +v = PooledDataArray(repeat(["a", "b"], inner = 5), repeat([true, false], outer = 5)) +@test isequal(rcopy(PooledDataArray,RObject(v)), v) +@test_throws ErrorException rcopy(DataArray,R"factor(c('a','a','c'))") +@test rcopy(PooledDataArray,R"factor(c('a','a','c'))").pool == ["a","c"] +@test rcopy(PooledDataArray,R"factor(c('a',NA,'c'))").pool == ["a","c"] + +#RCall.rlang_formula(parse("a+b")) +@test RCall.rlang_formula(:a) == :a diff --git a/test/convert/data.jl b/test/convert/datatable.jl similarity index 57% rename from test/convert/data.jl rename to test/convert/datatable.jl index 7d100b30..3f7c4e16 100644 --- a/test/convert/data.jl +++ b/test/convert/datatable.jl @@ -1,18 +1,5 @@ -using DataFrames using DataTables -# DataFrame -attenu = rcopy(DataFrame,reval(:attenu)) -@test isa(attenu,DataFrame) -@test size(attenu) == (182,5) -@test rcopy(rcall(:dim,RObject(attenu))) == [182,5] -@test rcopy(rcall(:dim, RObject(attenu[1:2, :]))) == [2, 5] -@test rcopy(rcall(:dim, RObject(view(attenu, 1:2)))) == [2, 5] -dist = attenu[:dist] -@test isa(dist,DataArray{Float64}) -station = attenu[:station] -@test isa(station,PooledDataArray) - # DataTable attenu = rcopy(DataTable,reval(:attenu)) @test isa(attenu,DataTable) @@ -25,60 +12,6 @@ dist = attenu[:dist] station = attenu[:station] @test isa(station,NullableCategoricalArray) -# DataArray - -# bool -v = DataArray([true,true], [true,false]) -@test isequal(rcopy(DataArray,RObject(v)), v) -v = DataArray([true,true], [false,true]) -@test isequal(rcopy(DataArray,RObject(v)), v) -@test isequal(rcopy(DataArray,R"c(NA,TRUE)"), DataArray([true,true], [true,false])) -@test isequal(rcopy(DataArray,R"c(TRUE, NA)"), DataArray([true,true], [false,true])) -# int64 -v = DataArray([1,2], [true,false]) -@test isequal(rcopy(DataArray,RObject(v)), v) -v = DataArray([1,2], [false,true]) -@test isequal(rcopy(DataArray,RObject(v)), v) -@test isequal(rcopy(DataArray,R"c(NA,1L)"), DataArray([0,1], [true,false])) -@test isequal(rcopy(DataArray,R"c(1L,NA)"), DataArray([1,0], [false,true])) -# int32 -v = DataArray(Int32[1,2], [true,false]) -@test isequal(rcopy(DataArray,RObject(v)), v) -v = DataArray(Int32[1,2], [false,true]) -@test isequal(rcopy(DataArray,RObject(v)), v) -@test isequal(rcopy(DataArray,R"c(NA,1L)"), DataArray(Int32[0,1], [true,false])) -@test isequal(rcopy(DataArray,R"c(1L,NA)"), DataArray(Int32[1,0], [false,true])) -# real -v = DataArray([1.,2.], [true,false]) -@test isequal(rcopy(DataArray,RObject(v)), v) -v = DataArray([1.,2.], [false,true]) -@test isequal(rcopy(DataArray,RObject(v)), v) -@test isequal(rcopy(DataArray,R"c(NA,1)"), DataArray([0,1.], [true,false])) -@test isequal(rcopy(DataArray,R"c(1,NA)"), DataArray([1.,0], [false,true])) -# complex -v = DataArray([0,1.+0*im], [true,false]) -@test isequal(rcopy(DataArray,RObject(v)), v) -v = DataArray([0,1.+0*im], [false,true]) -@test isequal(rcopy(DataArray,RObject(v)), v) -@test isequal(rcopy(DataArray,R"c(NA,1+0i)"), DataArray([0,1.+0*im], [true,false])) -@test isequal(rcopy(DataArray,R"c(1+0i,NA)"), DataArray([1.+0*im,0], [false,true])) -# string -v = DataArray(["","abc"], [true,false]) -@test isequal(rcopy(DataArray,RObject(v)), v) -v = DataArray(["","abc"], [false,true]) -@test isequal(rcopy(DataArray,RObject(v)), v) -@test isequal(rcopy(DataArray,R"c(NA,'NA')"), DataArray(["","NA"], [true,false])) -@test isequal(rcopy(DataArray,R"c('NA',NA)"), DataArray(["NA",""], [false,true])) - -# PooledDataArray -v = PooledDataArray(repeat(["a", "b"], inner = 5)) -@test isequal(rcopy(PooledDataArray,RObject(v)), v) -v = PooledDataArray(repeat(["a", "b"], inner = 5), repeat([true, false], outer = 5)) -@test isequal(rcopy(PooledDataArray,RObject(v)), v) -@test_throws ErrorException rcopy(DataArray,R"factor(c('a','a','c'))") -@test rcopy(PooledDataArray,R"factor(c('a','a','c'))").pool == ["a","c"] -@test rcopy(PooledDataArray,R"factor(c('a',NA,'c'))").pool == ["a","c"] - # Nullable @test isequal(rcopy(Nullable, RObject(1)), Nullable(1)) @@ -135,6 +68,7 @@ v = NullableArray(["","abc"], [false,true]) @test isequal(rcopy(NullableArray,R"c(NA,'NA')"), NullableArray(["","NA"], [true,false])) @test isequal(rcopy(NullableArray,R"c('NA',NA)"), NullableArray(["NA",""], [false,true])) + # CategoricalArrays v = CategoricalArray(repeat(["a", "b"], inner = 5)) @test isequal(rcopy(CategoricalArray,RObject(v)), v) @@ -149,6 +83,3 @@ v = NullableCategoricalArray(repeat(["a", "b"], inner = 5), repeat([true, false] @test CategoricalArrays.levels(rcopy(NullableCategoricalArray,R"factor(c('a',NA,'c'))")) == ["a","c"] @test CategoricalArrays.isordered(rcopy(CategoricalArray,R"ordered(c('a','a','c'))")) @test CategoricalArrays.isordered(rcopy(NullableCategoricalArray,R"ordered(c('a',NA,'c'))")) - -#RCall.rlang_formula(parse("a+b")) -@test RCall.rlang_formula(:a) == :a diff --git a/test/runtests.jl b/test/runtests.jl index 0f96db71..1a3b86db 100644 --- a/test/runtests.jl +++ b/test/runtests.jl @@ -11,7 +11,8 @@ using Compat tests = ["basic", "convert/base", - "convert/data", + "convert/dataframe", + "convert/datatable", "convert/datetime", "convert/axisarray", "library", From 50b1e80a62d9edbdf26b538058ad62e89a06f387 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Sun, 19 Mar 2017 02:12:11 -0400 Subject: [PATCH 16/26] remove DataTables support from this branch --- REQUIRE | 1 - src/RCall.jl | 3 ++- src/convert/datatable.jl | 52 +++++++++++++++++++-------------------- src/convert/default.jl | 2 +- test/convert/datatable.jl | 23 ++++++++--------- 5 files changed, 41 insertions(+), 40 deletions(-) diff --git a/REQUIRE b/REQUIRE index d5f255aa..7551097a 100644 --- a/REQUIRE +++ b/REQUIRE @@ -1,7 +1,6 @@ julia 0.5 DataStructures 0.4.3 DataFrames 0.9 -DataTables 0.0.1 AxisArrays 0.0.6 Compat 0.20.0 @windows WinReg 0.2.0 diff --git a/src/RCall.jl b/src/RCall.jl index a73ebb4e..6fe4f08d 100644 --- a/src/RCall.jl +++ b/src/RCall.jl @@ -3,7 +3,8 @@ module RCall using Compat using DataFrames -using DataTables +# using DataTables +using NullableArrays, CategoricalArrays using AxisArrays import DataStructures: OrderedDict diff --git a/src/convert/datatable.jl b/src/convert/datatable.jl index a6635144..fd6aaeb0 100644 --- a/src/convert/datatable.jl +++ b/src/convert/datatable.jl @@ -40,16 +40,16 @@ function rcopy(::Type{NullableCategoricalArray}, s::Ptr{IntSxp}) end # DataTable -function rcopy{T<:AbstractDataTable}(::Type{T}, s::Ptr{VecSxp}; sanitize::Bool=true) - isFrame(s) || error("s is not an R data frame") - vnames = rcopy(Vector{Symbol},getnames(s)) - if sanitize - vnames = [Symbol(replace(string(v), '.', '_')) for v in vnames] - end - DataTable( - Any[isFactor(c)? rcopy(NullableCategoricalArray, c) : rcopy(NullableArray, c) for c in s], - vnames) -end +# function rcopy{T<:AbstractDataTable}(::Type{T}, s::Ptr{VecSxp}; sanitize::Bool=true) +# isFrame(s) || error("s is not an R data frame") +# vnames = rcopy(Vector{Symbol},getnames(s)) +# if sanitize +# vnames = [Symbol(replace(string(v), '.', '_')) for v in vnames] +# end +# DataTable( +# Any[isFactor(c)? rcopy(NullableCategoricalArray, c) : rcopy(NullableArray, c) for c in s], +# vnames) +# end # Nullable and NullableArray to sexp conversion. for S in (:IntSxp, :RealSxp, :CplxSxp, :LglSxp, :StrSxp) @@ -103,19 +103,19 @@ for typ in [:NullableCategoricalArray, :CategoricalArray] end # DataTable -function sexp(::Type{VecSxp}, d::AbstractDataTable) - nr,nc = size(d) - nv = names(d) - rd = protect(allocArray(VecSxp, nc)) - try - for i in 1:nc - rd[i] = sexp(d[nv[i]]) - end - setattrib!(rd,Const.NamesSymbol, sexp([string(n) for n in nv])) - setattrib!(rd,Const.ClassSymbol, sexp("data.frame")) - setattrib!(rd,Const.RowNamesSymbol, sexp(1:nr)) - finally - unprotect(1) - end - rd -end +# function sexp(::Type{VecSxp}, d::AbstractDataTable) +# nr,nc = size(d) +# nv = names(d) +# rd = protect(allocArray(VecSxp, nc)) +# try +# for i in 1:nc +# rd[i] = sexp(d[nv[i]]) +# end +# setattrib!(rd,Const.NamesSymbol, sexp([string(n) for n in nv])) +# setattrib!(rd,Const.ClassSymbol, sexp("data.frame")) +# setattrib!(rd,Const.RowNamesSymbol, sexp(1:nr)) +# finally +# unprotect(1) +# end +# rd +# end diff --git a/src/convert/default.jl b/src/convert/default.jl index b23a58a3..0779c16f 100644 --- a/src/convert/default.jl +++ b/src/convert/default.jl @@ -102,7 +102,7 @@ sexp(s::Symbol) = sexp(SymSxp,s) sexp(d::AbstractDataFrame) = sexp(VecSxp, d) # DataTable -sexp(d::AbstractDataTable) = sexp(VecSxp, d) +# sexp(d::AbstractDataTable) = sexp(VecSxp, d) # PooledDataArray sexp(a::PooledDataArray) = sexp(IntSxp,a) diff --git a/test/convert/datatable.jl b/test/convert/datatable.jl index 3f7c4e16..139d1add 100644 --- a/test/convert/datatable.jl +++ b/test/convert/datatable.jl @@ -1,16 +1,17 @@ -using DataTables +# using DataTables +using NullableArrays, CategoricalArrays # DataTable -attenu = rcopy(DataTable,reval(:attenu)) -@test isa(attenu,DataTable) -@test size(attenu) == (182,5) -@test rcopy(rcall(:dim,RObject(attenu))) == [182,5] -@test rcopy(rcall(:dim, RObject(attenu[1:2, :]))) == [2, 5] -@test rcopy(rcall(:dim, RObject(view(attenu, 1:2)))) == [2, 5] -dist = attenu[:dist] -@test isa(dist,NullableArray{Float64}) -station = attenu[:station] -@test isa(station,NullableCategoricalArray) +# attenu = rcopy(DataTable,reval(:attenu)) +# @test isa(attenu,DataTable) +# @test size(attenu) == (182,5) +# @test rcopy(rcall(:dim,RObject(attenu))) == [182,5] +# @test rcopy(rcall(:dim, RObject(attenu[1:2, :]))) == [2, 5] +# @test rcopy(rcall(:dim, RObject(view(attenu, 1:2)))) == [2, 5] +# dist = attenu[:dist] +# @test isa(dist,NullableArray{Float64}) +# station = attenu[:station] +# @test isa(station,NullableCategoricalArray) # Nullable From 38ce40d663da2f64aef3a20560c8f016e0d815f7 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Sun, 19 Mar 2017 02:29:08 -0400 Subject: [PATCH 17/26] update REQUIRE --- REQUIRE | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/REQUIRE b/REQUIRE index 7551097a..be9131c1 100644 --- a/REQUIRE +++ b/REQUIRE @@ -1,6 +1,8 @@ julia 0.5 -DataStructures 0.4.3 +DataStructures 0.5.0 DataFrames 0.9 +NullableArrays 0.1.0 +CategoricalArrays 0.1.0 AxisArrays 0.0.6 Compat 0.20.0 @windows WinReg 0.2.0 From 78e881d10edbef36da6c6302462f079100b45caa Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Sun, 19 Mar 2017 02:39:28 -0400 Subject: [PATCH 18/26] dispatch correct rcopy for Data/DataTime objects --- src/convert/default.jl | 14 +++++++++++--- test/convert/datetime.jl | 26 +++++++++++++------------- 2 files changed, 24 insertions(+), 16 deletions(-) diff --git a/src/convert/default.jl b/src/convert/default.jl index 0779c16f..de0ba194 100644 --- a/src/convert/default.jl +++ b/src/convert/default.jl @@ -39,12 +39,20 @@ function rcopy(s::IntSxpPtr) end end function rcopy(s::RealSxpPtr) + classes = rcopy(Vector, getclass(s)) + if "Date" in classes + T = Date + elseif "POSIXct" in classes && "POSIXt" in classes + T = DateTime + else + T = Float64 + end if anyna(s) - rcopy(DataArray{Float64},s) + rcopy(DataArray{T},s) elseif length(s) == 1 - rcopy(Float64,s) + rcopy(T,s) else - rcopy(Array{Float64},s) + rcopy(Array{T},s) end end function rcopy(s::CplxSxpPtr) diff --git a/test/convert/datetime.jl b/test/convert/datetime.jl index 3b5f991f..d1a5d24b 100644 --- a/test/convert/datetime.jl +++ b/test/convert/datetime.jl @@ -17,8 +17,8 @@ r = RObject(d) @test rcopy(getclass(r)) == "Date" @test length(r) == length(d) @test size(r) == size(d) -@test rcopy(Array{Date}, r) == d -@test rcopy(Array{Date}, R"as.Date($s)") == d +@test rcopy(r) == d +@test rcopy(R"as.Date($s)") == d @test rcopy(R"identical(as.Date($s), $d)") d = Date[] @@ -27,7 +27,7 @@ r = RObject(d) @test rcopy(getclass(r)) == "Date" @test length(r) == length(d) @test size(r) == size(d) -@test rcopy(Array{Date}, r) == d +@test rcopy(r) == d @test rcopy(R"as.Date(character(0))") == Date[] # DataArray date @@ -38,8 +38,8 @@ r = RObject(d) @test rcopy(getclass(r)) == "Date" @test length(r) == length(d) @test size(r) == size(d) -@test rcopy(DataArray{Date}, r).na == d.na -@test rcopy(DataArray{Date}, r).data[map(!,d.na)] == d.data[map(!,d.na)] +@test rcopy(r).na == d.na +@test rcopy(r).data[map(!,d.na)] == d.data[map(!,d.na)] @test rcopy(R"identical(as.Date($s), $d)") @test rcopy(R"identical(as.character($d), $s)") @@ -89,8 +89,8 @@ r = RObject(d) @test rcopy(getattrib(r, "tzone")) == "UTC" @test length(r) == 1 @test size(r) == (1,) -@test rcopy(DateTime, r) === d -@test rcopy(DateTime, R"as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S')") == d +@test rcopy(r) === d +@test rcopy(R"as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S')") == d @test rcopy(R"identical(as.character($d, '%Y-%m-%dT%H:%M:%S'), $s)") s = ["2001-01-01T01:01:01", "1111-11-11T11:11:00", "2012-12-12T12:12:12"] @@ -101,8 +101,8 @@ r = RObject(d) @test rcopy(getattrib(r, "tzone")) == "UTC" @test length(r) == length(d) @test size(r) == size(d) -@test rcopy(Array{DateTime},r) == d -@test rcopy(Array{DateTime},R"as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S')") == d +@test rcopy(r) == d +@test rcopy(R"as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S')") == d @test rcopy(R"identical(as.character($d, '%Y-%m-%dT%H:%M:%S'), $s)") d = DateTime[] @@ -112,8 +112,8 @@ r = RObject(d) @test rcopy(getattrib(r, "tzone")) == "UTC" @test length(r) == length(d) @test size(r) == size(d) -@test rcopy(Array{DateTime},r) == d -@test rcopy(Array{DateTime},R"as.POSIXct(character(0))") == Date[] +@test rcopy(r) == d +@test rcopy(R"as.POSIXct(character(0))") == Date[] # DataArray dateTime s = DataArray(["0001-01-01", "2012-12-12T12:12:12"], [true, false]) @@ -124,8 +124,8 @@ r = RObject(d) @test rcopy(getattrib(r, "tzone")) == "UTC" @test length(r) == length(d) @test size(r) == size(d) -@test rcopy(DataArray{DateTime}, r).na == d.na -@test rcopy(DataArray{DateTime}, r).data[map(!,d.na)] == d.data[map(!,d.na)] +@test rcopy(r).na == d.na +@test rcopy(r).data[map(!,d.na)] == d.data[map(!,d.na)] @test rcopy(R"identical(as.POSIXct($s, 'UTC', '%Y-%m-%dT%H:%M:%S'), $d)") @test rcopy(R"identical(as.character($d, '%Y-%m-%dT%H:%M:%S'), $s)") From 9a96eeae69247c1d8b4429f01dd05bd304d26d51 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Tue, 21 Mar 2017 14:08:19 -0400 Subject: [PATCH 19/26] using constructor String instead of string --- src/convert/base.jl | 2 +- test/convert/base.jl | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/convert/base.jl b/src/convert/base.jl index cdce20e2..2d7ab7b0 100644 --- a/src/convert/base.jl +++ b/src/convert/base.jl @@ -198,7 +198,7 @@ sexp(::Type{SymSxp}, s::AbstractString) = ccall((:Rf_install, libR), Ptr{SymSxp} sexp(::Type{CharSxp}, st::String) = ccall((:Rf_mkCharLenCE, libR), CharSxpPtr, (Ptr{UInt8}, Cint, Cint), st, sizeof(st), isascii(st) ? 0 : 1) -sexp(::Type{CharSxp}, st::AbstractString) = sexp(CharSxp, string(st)) +sexp(::Type{CharSxp}, st::AbstractString) = sexp(CharSxp, String(st)) sexp(::Type{StrSxp}, s::CharSxpPtr) = ccall((:Rf_ScalarString,libR),Ptr{StrSxp},(CharSxpPtr,),s) sexp(::Type{StrSxp},st::AbstractString) = sexp(StrSxp,sexp(CharSxp,st)) function sexp{T<:AbstractString}(::Type{StrSxp}, a::AbstractArray{T}) diff --git a/test/convert/base.jl b/test/convert/base.jl index d46c294d..b1c4b7f4 100644 --- a/test/convert/base.jl +++ b/test/convert/base.jl @@ -30,6 +30,13 @@ r = RObject(v) @test rcopy(Array{Symbol}, r)[2] == Symbol(v[2]) @test isa(RCall.sexp(StrSxp, :a), Ptr{StrSxp}) +s = SubString{String}["a","b"] +r = RObject(s) +@test isa(r,RObject{StrSxp}) +@test length(r) == length(s) +@test rcopy(r) == s +@test rcopy(r[1]) == s[1] + # logical r = RObject(false) From 5ba6fd68f7f846d9a1a4dc2f70dd0b0cf68ed946 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Tue, 21 Mar 2017 17:43:39 -0400 Subject: [PATCH 20/26] update docs --- docs/make.jl | 1 + docs/src/conversions.md | 108 +++++++++++++++++++++++++++++++++++++ docs/src/gettingstarted.md | 17 ++++-- src/functions.jl | 6 +++ 4 files changed, 127 insertions(+), 5 deletions(-) create mode 100644 docs/src/conversions.md diff --git a/docs/make.jl b/docs/make.jl index 1ea5dca3..7e6aee8a 100644 --- a/docs/make.jl +++ b/docs/make.jl @@ -8,6 +8,7 @@ makedocs( "Introduction" => "index.md", "Installation" => "installation.md", "Getting Started" => "gettingstarted.md", + "Conversions" => "conversions.md", "Internal" => "internal.md" ] ) diff --git a/docs/src/conversions.md b/docs/src/conversions.md new file mode 100644 index 00000000..b8ebe9cd --- /dev/null +++ b/docs/src/conversions.md @@ -0,0 +1,108 @@ +# Conversions + +RCall supports conversions to and from most base Julia types and popular Statistics packages, e.g., `DataFrames`, `DataArrays`, `NullableArrays`, `CategoricalArrays` and `AxisArrays`. + +```@setup 1 +using RCall +using DataFrames +using AxisArrays +``` + +## Base Julia Types + +```@example 1 +# Julia -> R +a = RObject(1) +``` + +```@example 1 +# R -> Julia +rcopy(a) +``` + +```@example 1 +# Julia -> R +a = RObject([1.0, 2.0]) +``` + +```@example 1 +# R -> Julia +rcopy(a) +``` + +## Dictionaries + +```@example 1 +# Julia -> R +d = Dict(:a => 1, :b => [4, 5, 3]) +r = RObject(d) +``` + +```@example 1 +# R -> Julia +rcopy(r) +``` + +## Date + +```@example 1 +# Julia -> R +d = Date(2012, 12, 12) +r = RObject(d) +``` + +```@example 1 +# R -> Julia +rcopy(r) +``` + +## DateTime + +```@example 1 +# julia -> R +d = DateTime(2012, 12, 12, 12, 12, 12) +r = RObject(d) +``` + +```@example 1 +# R -> Julia +rcopy(r) +``` + +## DataFrames and DataArrays + +```@example 1 +d = DataFrame([[1.0, 4.5, 7.0]], [:x]) +# Julia -> R +r = RObject(d) +``` + +```@example 1 +# R -> Julia +rcopy(r) +``` + +In default, the column names of R data frames are sanitized such that `foo.bar` +would be replaced by `foo_bar`. + +```@example 1 +rcopy(R"data.frame(a.b = 1:3)") +``` + +To avoid the sanitization, use `sanitize` option. +```@example 1 +rcopy(R"data.frame(a.b = 1:10)"; sanitize = false) +``` + +## AxisArrays + +```@example 1 +# Julia -> R +aa = AxisArray([1,2,3], Axis{:name}(["a", "b", "c"])) +r = RObject(aa) +``` + +```@example 1 +# R -> Julia +rcopy(r) +``` diff --git a/docs/src/gettingstarted.md b/docs/src/gettingstarted.md index cd84a490..c6f99ac7 100644 --- a/docs/src/gettingstarted.md +++ b/docs/src/gettingstarted.md @@ -16,7 +16,7 @@ RCall provides multiple ways to allow R interacting with Julia. - R REPL mode - [`@rput`](@ref) and [`@rget`](@ref) macros - `R""` string macro -- A low level API: [`reval`](@ref), [`rcall`](@ref) and [`rcopy`](@ref) etc. +- RCall API: [`reval`](@ref), [`rcall`](@ref) and [`rcopy`](@ref) etc. ## R REPL mode The R REPL mode allows real time switching between the Julia prompt and R prompt. Press `$` to activate the R REPL mode and the R prompt will be shown. (Press `backspace` to leave R REPL mode in case you did not know.) @@ -140,13 +140,20 @@ The [`rcopy`](@ref) function converts `RObject`s to Julia objects. It uses a var ```@repl 1 rcopy(R"c(1)") -rcopy(R"c(1,2)") -rcopy(R"list(1,'zz')") -rcopy(R"list(a=1,b='zz')") +rcopy(R"c(1, 2)") +rcopy(R"list(1, 'zz')") +rcopy(R"list(a=1, b='zz')") ``` It is possible to force a specific conversion by passing the output type as the first argument: ```@repl 1 -rcopy(Array{Int},R"c(1,2)") +rcopy(Array{Int}, R"c(1,2)") +``` + +Converters and Constructors could also be used specifically to yield the desired type. + +```@repl 1 +convert(Array{Float64}, R"c(1,2)") +Float64(R"1+3") ``` diff --git a/src/functions.jl b/src/functions.jl index f76ff352..1fbd374b 100644 --- a/src/functions.jl +++ b/src/functions.jl @@ -27,6 +27,12 @@ Evaluate a function in the global environment. The first argument corresponds to the function to be called. It can be either a FunctionSxp type, a SymSxp or a Symbol.""" rcall_p(f,args...;kwargs...) = reval_p(rlang_p(f,args...;kwargs...)) + +""" +Evaluate a function in the global environment. The first argument corresponds +to the function to be called. It can be either a RObject{FunctionSxp} type or +a Symbol which refers to a function in the R environment. +""" rcall(f,args...;kwargs...) = RObject(rcall_p(f,args...;kwargs...)) @compat (f::RObject{S}){S<:Union{SymSxp,LangSxp,PromSxp,FunctionSxp}}(args...;kwargs...) = rcall(f,args...;kwargs...) From 22f10d9252423b93af911641285345dbcddbe533 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Tue, 21 Mar 2017 17:44:37 -0400 Subject: [PATCH 21/26] 1d/2d axisarray conversion --- src/convert/axisarray.jl | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/convert/axisarray.jl b/src/convert/axisarray.jl index 07542df0..d2bd9dbf 100644 --- a/src/convert/axisarray.jl +++ b/src/convert/axisarray.jl @@ -13,7 +13,9 @@ for S in (:IntSxp, :RealSxp, :CplxSxp, :LglSxp, :StrSxp) try d = OrderedDict( k => v.val for (k, v) in zip(axisnames(aa), axes(aa))) - setattrib!(rv, Const.DimNamesSymbol, sexp(VecSxp, d)) + setattrib!(rv, Const.ClassSymbol, "array") + setattrib!(rv, Const.DimSymbol, collect(size(aa))) + setattrib!(rv, Const.DimNamesSymbol, d) finally unprotect(1) end From ad86bb64da4eef43ad0028c778656acf697417c7 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Tue, 21 Mar 2017 17:45:19 -0400 Subject: [PATCH 22/26] fix scalar conversion --- src/convert/base.jl | 13 +++++++++---- src/convert/default.jl | 6 +++--- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/src/convert/base.jl b/src/convert/base.jl index 2d7ab7b0..00a23d10 100644 --- a/src/convert/base.jl +++ b/src/convert/base.jl @@ -1,8 +1,8 @@ # conversion to Base Julia types # allow `Int(R"1+1")` -rcopy{T}(::Type{T},r::RObject) = rcopy(T,r.p) -convert{T, S<:Sxp}(::Type{T}, r::RObject{S}) = rcopy(T,r.p) +rcopy{T}(::Type{T},r::RObject; kwargs...) = rcopy(T, r.p; kwargs...) +convert{T, S<:Sxp}(::Type{T}, r::RObject{S}) = rcopy(T, r.p) convert{S<:Sxp}(::Type{RObject{S}}, r::RObject{S}) = r # conversion between numbers which understands different NAs @@ -12,7 +12,9 @@ function rcopy{T<:Number, R<:Number}(::Type{T}, x::R) elseif R == Int32 && T <: AbstractFloat return T(NaN) elseif R <: AbstractFloat && T == Int32 - return Const.NaInt + return T(Const.NaInt) + elseif R <: AbstractFloat && T <: Integer + error("Cannot convert $R(NaN) to type $T.") else return T(x) end @@ -54,7 +56,7 @@ for (J,S) in ((:Integer,:IntSxp), (:AbstractFloat, :RealSxp), (:Complex, :CplxSxp)) @eval begin - rcopy{T<:$J}(::Type{T},s::Ptr{$S}) = convert(T,s[1]) + rcopy{T<:$J}(::Type{T},s::Ptr{$S}) = rcopy(T,s[1]) function rcopy{T<:$J}(::Type{Vector{T}},s::Ptr{$S}) a = Array{T}(length(s)) copy!(a,unsafe_vec(s)) @@ -69,6 +71,9 @@ for (J,S) in ((:Integer,:IntSxp), rcopy(::Type{Array},s::Ptr{$S}) = rcopy(Array{eltype($S)},s) end end +# handle scalar RealSxp to Integer conversion +rcopy{T<:Integer}(::Type{T},s::Ptr{RealSxp}) = rcopy(T,s[1]) + # LglSxp rcopy(::Type{Cint},s::Ptr{LglSxp}) = convert(Cint,s[1]) diff --git a/src/convert/default.jl b/src/convert/default.jl index de0ba194..c94db3d2 100644 --- a/src/convert/default.jl +++ b/src/convert/default.jl @@ -3,7 +3,7 @@ """ `rcopy(r)` copies the contents of an R object into a corresponding canonical Julia type. """ -rcopy(r::RObject) = rcopy(r.p) +rcopy(r::RObject; kwargs...) = rcopy(r.p; kwargs...) # Fallback rcopy{S<:Sxp}(::Type{Any}, s::Ptr{S}) = rcopy(s) @@ -75,9 +75,9 @@ function rcopy(s::LglSxpPtr) end # VecSxp -function rcopy(s::VecSxpPtr) +function rcopy(s::VecSxpPtr; kwargs...) if isFrame(s) - rcopy(DataFrame,s) + rcopy(DataFrame,s; kwargs...) elseif isnull(getnames(s)) rcopy(Array{Any},s) else From 34d54c30557d0183994ad4af3f98e12860807cae Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Tue, 21 Mar 2017 17:52:34 -0400 Subject: [PATCH 23/26] convert to DataArray --- src/convert/default.jl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/convert/default.jl b/src/convert/default.jl index c94db3d2..1b475c8c 100644 --- a/src/convert/default.jl +++ b/src/convert/default.jl @@ -18,7 +18,7 @@ rcopy(s::CharSxpPtr) = rcopy(String,s) # StrSxp function rcopy(s::StrSxpPtr) if anyna(s) - rcopy(NullableArray,s) + rcopy(DataArray,s) elseif length(s) == 1 rcopy(String,s) else From f3ab3acba7971b1e41bff34cb6a91ddecec33173 Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Tue, 21 Mar 2017 18:27:54 -0400 Subject: [PATCH 24/26] improve scalar conversions --- src/convert/base.jl | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/convert/base.jl b/src/convert/base.jl index 00a23d10..c7214a0d 100644 --- a/src/convert/base.jl +++ b/src/convert/base.jl @@ -51,12 +51,18 @@ for S in (:IntSxp, :RealSxp, :CplxSxp, :LglSxp, :StrSxp, :VecSxp) end end +# IntSxp, RealSxp, CplxSxp, LglSxp scalar conversion +for S in (:IntSxp, :RealSxp, :CplxSxp, :LglSxp) + @eval begin + rcopy{T<:Number}(::Type{T},s::Ptr{$S}) = rcopy(T,s[1]) + end +end + # IntSxp, RealSxp, CplxSxp to their corresponding Julia types. for (J,S) in ((:Integer,:IntSxp), (:AbstractFloat, :RealSxp), (:Complex, :CplxSxp)) @eval begin - rcopy{T<:$J}(::Type{T},s::Ptr{$S}) = rcopy(T,s[1]) function rcopy{T<:$J}(::Type{Vector{T}},s::Ptr{$S}) a = Array{T}(length(s)) copy!(a,unsafe_vec(s)) @@ -71,9 +77,6 @@ for (J,S) in ((:Integer,:IntSxp), rcopy(::Type{Array},s::Ptr{$S}) = rcopy(Array{eltype($S)},s) end end -# handle scalar RealSxp to Integer conversion -rcopy{T<:Integer}(::Type{T},s::Ptr{RealSxp}) = rcopy(T,s[1]) - # LglSxp rcopy(::Type{Cint},s::Ptr{LglSxp}) = convert(Cint,s[1]) From f15c0934ef4f0b7183af23ffc880130815cba56f Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Tue, 21 Mar 2017 18:28:02 -0400 Subject: [PATCH 25/26] improve test coverage --- test/convert/base.jl | 17 +++++++++++++++++ test/convert/dataframe.jl | 8 +++++++- 2 files changed, 24 insertions(+), 1 deletion(-) diff --git a/test/convert/base.jl b/test/convert/base.jl index b1c4b7f4..6d46bb0c 100644 --- a/test/convert/base.jl +++ b/test/convert/base.jl @@ -57,6 +57,10 @@ r = RObject(v) # integer +@test rcopy(Int, R"TRUE") == 1 +@test rcopy(Int, R"1") == 1 +@test rcopy(Array{Int}, R"c(1,2,3)") == [1,2,3] + x = 7 r = RObject(x) @test isa(r,RObject{IntSxp}) @@ -65,6 +69,7 @@ r = RObject(x) @test rcopy(r) === convert(Cint,x) @test r[1] === convert(Cint,x) + v = -7:3 r = RObject(v) @test isa(r,RObject{IntSxp}) @@ -122,6 +127,10 @@ r = RObject(a) # real +@test rcopy(Float64, R"TRUE") == 1.0 +@test rcopy(Float64, R"1L") == 1.0 +@test rcopy(Array{Float64}, R"c(1L,2L,3L)") == [1.0,2.0,3.0] + x = 7.0 r = RObject(x) @test isa(r,RObject{RealSxp}) @@ -241,6 +250,14 @@ d = RObject(Dict(1=>2)) @test Dict{Any,Any}("1" => 2) == rcopy(Dict, d) @test Dict{Int,Int}(1=>2) == rcopy(Dict{Int,Int}, d) +# list +a = Any[1, 1:10] +r = RObject(a) +@test isa(r, RObject{VecSxp}) +@test isa(rcopy(r), Array{Any}) +@test isa(rcopy(Array, r), Array{Any}) + + # function function funk(x,y) x+y diff --git a/test/convert/dataframe.jl b/test/convert/dataframe.jl index 11b2a811..05ca0a18 100644 --- a/test/convert/dataframe.jl +++ b/test/convert/dataframe.jl @@ -21,6 +21,7 @@ v = DataArray([true,true], [false,true]) @test isequal(rcopy(DataArray,RObject(v)), v) @test isequal(rcopy(DataArray,R"c(NA,TRUE)"), DataArray([true,true], [true,false])) @test isequal(rcopy(DataArray,R"c(TRUE, NA)"), DataArray([true,true], [false,true])) +@test isa(rcopy(R"c(TRUE, NA)"), DataArray) # int64 v = DataArray([1,2], [true,false]) @test isequal(rcopy(DataArray,RObject(v)), v) @@ -28,6 +29,7 @@ v = DataArray([1,2], [false,true]) @test isequal(rcopy(DataArray,RObject(v)), v) @test isequal(rcopy(DataArray,R"c(NA,1L)"), DataArray([0,1], [true,false])) @test isequal(rcopy(DataArray,R"c(1L,NA)"), DataArray([1,0], [false,true])) +@test isa(rcopy(R"c(1L,NA)"), DataArray) # int32 v = DataArray(Int32[1,2], [true,false]) @test isequal(rcopy(DataArray,RObject(v)), v) @@ -35,6 +37,7 @@ v = DataArray(Int32[1,2], [false,true]) @test isequal(rcopy(DataArray,RObject(v)), v) @test isequal(rcopy(DataArray,R"c(NA,1L)"), DataArray(Int32[0,1], [true,false])) @test isequal(rcopy(DataArray,R"c(1L,NA)"), DataArray(Int32[1,0], [false,true])) +@test isa(rcopy(R"c(1L,NA)"), DataArray) # real v = DataArray([1.,2.], [true,false]) @test isequal(rcopy(DataArray,RObject(v)), v) @@ -42,6 +45,7 @@ v = DataArray([1.,2.], [false,true]) @test isequal(rcopy(DataArray,RObject(v)), v) @test isequal(rcopy(DataArray,R"c(NA,1)"), DataArray([0,1.], [true,false])) @test isequal(rcopy(DataArray,R"c(1,NA)"), DataArray([1.,0], [false,true])) +@test isa(rcopy(R"c(1,NA)"), DataArray) # complex v = DataArray([0,1.+0*im], [true,false]) @test isequal(rcopy(DataArray,RObject(v)), v) @@ -49,6 +53,7 @@ v = DataArray([0,1.+0*im], [false,true]) @test isequal(rcopy(DataArray,RObject(v)), v) @test isequal(rcopy(DataArray,R"c(NA,1+0i)"), DataArray([0,1.+0*im], [true,false])) @test isequal(rcopy(DataArray,R"c(1+0i,NA)"), DataArray([1.+0*im,0], [false,true])) +@test isa(rcopy(R"c(1+0i,NA)"), DataArray) # string v = DataArray(["","abc"], [true,false]) @test isequal(rcopy(DataArray,RObject(v)), v) @@ -56,7 +61,7 @@ v = DataArray(["","abc"], [false,true]) @test isequal(rcopy(DataArray,RObject(v)), v) @test isequal(rcopy(DataArray,R"c(NA,'NA')"), DataArray(["","NA"], [true,false])) @test isequal(rcopy(DataArray,R"c('NA',NA)"), DataArray(["NA",""], [false,true])) - +@test isa(rcopy(R"c('NA',NA)"), DataArray) # PooledDataArray v = PooledDataArray(repeat(["a", "b"], inner = 5)) @test isequal(rcopy(PooledDataArray,RObject(v)), v) @@ -65,6 +70,7 @@ v = PooledDataArray(repeat(["a", "b"], inner = 5), repeat([true, false], outer = @test_throws ErrorException rcopy(DataArray,R"factor(c('a','a','c'))") @test rcopy(PooledDataArray,R"factor(c('a','a','c'))").pool == ["a","c"] @test rcopy(PooledDataArray,R"factor(c('a',NA,'c'))").pool == ["a","c"] +@test isa(rcopy(R"factor(c('a',NA,'c'))"), PooledDataArray) #RCall.rlang_formula(parse("a+b")) @test RCall.rlang_formula(:a) == :a From f1c55d419876a156e4cec4a7a530fae89173465c Mon Sep 17 00:00:00 2001 From: Randy Lai Date: Wed, 22 Mar 2017 16:53:15 -0400 Subject: [PATCH 26/26] support NamedArrays --- REQUIRE | 1 + docs/src/conversions.md | 19 +++++++++++++++++-- src/RCall.jl | 3 ++- src/convert/axisarray.jl | 2 -- src/convert/default.jl | 3 ++- src/convert/namedarray.jl | 23 +++++++++++++++++++++++ test/convert/namedarray.jl | 8 ++++++++ test/runtests.jl | 1 + 8 files changed, 54 insertions(+), 6 deletions(-) create mode 100644 src/convert/namedarray.jl create mode 100644 test/convert/namedarray.jl diff --git a/REQUIRE b/REQUIRE index be9131c1..88b7c73f 100644 --- a/REQUIRE +++ b/REQUIRE @@ -4,5 +4,6 @@ DataFrames 0.9 NullableArrays 0.1.0 CategoricalArrays 0.1.0 AxisArrays 0.0.6 +NamedArrays 0.5.3 Compat 0.20.0 @windows WinReg 0.2.0 diff --git a/docs/src/conversions.md b/docs/src/conversions.md index b8ebe9cd..f7309293 100644 --- a/docs/src/conversions.md +++ b/docs/src/conversions.md @@ -1,10 +1,11 @@ # Conversions -RCall supports conversions to and from most base Julia types and popular Statistics packages, e.g., `DataFrames`, `DataArrays`, `NullableArrays`, `CategoricalArrays` and `AxisArrays`. +RCall supports conversions to and from most base Julia types and popular Statistics packages, e.g., `DataFrames`, `DataArrays`, `NullableArrays`, `CategoricalArrays` `NamedArrays` and `AxisArrays`. ```@setup 1 using RCall using DataFrames +using NamedArrays using AxisArrays ``` @@ -94,11 +95,25 @@ To avoid the sanitization, use `sanitize` option. rcopy(R"data.frame(a.b = 1:10)"; sanitize = false) ``` +## NamedArrays + +```@example 1 +# Julia -> R +aa = NamedArray([1,2,3], [["a", "b", "c"]], [:id]) +r = RObject(aa) +``` + +```@example 1 +# R -> Julia +rcopy(r) +``` + + ## AxisArrays ```@example 1 # Julia -> R -aa = AxisArray([1,2,3], Axis{:name}(["a", "b", "c"])) +aa = AxisArray([1,2,3], Axis{:id}(["a", "b", "c"])) r = RObject(aa) ``` diff --git a/src/RCall.jl b/src/RCall.jl index 6fe4f08d..a527de43 100644 --- a/src/RCall.jl +++ b/src/RCall.jl @@ -5,7 +5,7 @@ using Compat using DataFrames # using DataTables using NullableArrays, CategoricalArrays -using AxisArrays +using AxisArrays, NamedArrays import DataStructures: OrderedDict @@ -31,6 +31,7 @@ include("convert/dataframe.jl") include("convert/datatable.jl") include("convert/datetime.jl") include("convert/axisarray.jl") +include("convert/namedarray.jl") include("convert/default.jl") include("eventloop.jl") include("eval.jl") diff --git a/src/convert/axisarray.jl b/src/convert/axisarray.jl index d2bd9dbf..2165d34e 100644 --- a/src/convert/axisarray.jl +++ b/src/convert/axisarray.jl @@ -5,7 +5,6 @@ function rcopy{S<:VectorSxp}(::Type{AxisArray}, r::Ptr{S}) AxisArray(rcopy(Array, r), [Axis{dsym[i]}(rcopy(n)) for (i,n) in enumerate(dnames)]...) end - for S in (:IntSxp, :RealSxp, :CplxSxp, :LglSxp, :StrSxp) @eval begin function sexp(::Type{$S}, aa::AxisArray) @@ -13,7 +12,6 @@ for S in (:IntSxp, :RealSxp, :CplxSxp, :LglSxp, :StrSxp) try d = OrderedDict( k => v.val for (k, v) in zip(axisnames(aa), axes(aa))) - setattrib!(rv, Const.ClassSymbol, "array") setattrib!(rv, Const.DimSymbol, collect(size(aa))) setattrib!(rv, Const.DimNamesSymbol, d) finally diff --git a/src/convert/default.jl b/src/convert/default.jl index 1b475c8c..f6d327b0 100644 --- a/src/convert/default.jl +++ b/src/convert/default.jl @@ -152,13 +152,14 @@ for typ in [:NullableCategoricalArray, :CategoricalArray] @eval sexp(v::$typ) = sexp(IntSxp, v) end -# AxisArray +# AxisArray and NamedArray for (J,S) in ((:Integer,:IntSxp), (:AbstractFloat, :RealSxp), (:Complex, :CplxSxp), (:Bool, :LglSxp), (:AbstractString, :StrSxp)) @eval sexp{T<:$J}(aa::AxisArray{T}) = sexp($S, aa) + @eval sexp{T<:$J}(aa::NamedArray{T}) = sexp($S, aa) end # DataTime diff --git a/src/convert/namedarray.jl b/src/convert/namedarray.jl new file mode 100644 index 00000000..5c3f2b4d --- /dev/null +++ b/src/convert/namedarray.jl @@ -0,0 +1,23 @@ +function rcopy{S<:VectorSxp}(::Type{NamedArray}, r::Ptr{S}) + dnames = getattrib(r, Const.DimNamesSymbol) + isnull(dnames) && error("r has no dimnames") + d = [rcopy(Vector{String}, n) for n in dnames] + NamedArray(rcopy(Array, r), d, rcopy(Vector{Symbol}, getnames(dnames))) +end + +for S in (:IntSxp, :RealSxp, :CplxSxp, :LglSxp, :StrSxp) + @eval begin + function sexp(::Type{$S}, na::NamedArray) + rv = protect(sexp($S, na.array)) + try + d = OrderedDict( + k => v for (k, v) in zip(dimnames(na), names(na))) + setattrib!(rv, Const.DimSymbol, collect(size(na))) + setattrib!(rv, Const.DimNamesSymbol, d) + finally + unprotect(1) + end + rv + end + end +end diff --git a/test/convert/namedarray.jl b/test/convert/namedarray.jl new file mode 100644 index 00000000..8ef3abbc --- /dev/null +++ b/test/convert/namedarray.jl @@ -0,0 +1,8 @@ +using NamedArrays + +# NamedArray +aa = rcopy(NamedArray, R"Titanic") +@test size(aa) == (4, 2, 2, 2) +@test length(names(aa)[1]) == 4 +@test_throws ErrorException rcopy(NamedArray, R"c(1,1)") +@test names(getattrib(RObject(aa), :dimnames))[1] == :Class diff --git a/test/runtests.jl b/test/runtests.jl index 1a3b86db..fa5af7b9 100644 --- a/test/runtests.jl +++ b/test/runtests.jl @@ -15,6 +15,7 @@ tests = ["basic", "convert/datatable", "convert/datetime", "convert/axisarray", + "convert/namedarray", "library", "render", "repl",