get n dimensional Fortran array from subroutine output into R? - r

I have the following Fortran subroutine:
subroutine test(d, i, nMCd, DF, X)
integer, intent(in) :: d, i, nMCd
double precision, intent(in), dimension(i,nMCd) :: DF
double precision, intent(out), dimension(i) :: X
X = DF(:,d)+DF(:,d)
end subroutine test
I am able to compile it for R load it and run it. But instead of getting an array I'm getting a single number.
system("R CMD SHLIB ./Fortran/mytest.f90")
dyn.load("./Fortran/mytest.so")
input <- data.frame(A=c(11,12), B=c(21, 22))
.Fortran("test", d = as.integer(1), i = nrow(input), nMCd = ncol(input), DF = unlist(input), X = as.numeric(1))
What am I doing wrong?!
My output looks like
$d
[1] 1
$i
[1] 2
$nMCd
NULL
$DF
A1 A2 B1 B2
11 12 21 22
$X
[1] 22
The R version of this is:
input[,1]+input[,1]

I haven't figured out what this was supposed to do because I don't program in FORTRAN (And you didn't say what you expected in a language that I do read) but this is an experiment that delivers the sum of the items in the first columns of the input object, which might make some sense when I look at the code with the inputs. It seems possible that sending 1 for d to extract from DF(:,d)+ DF(:,d) might mean you wanted the sums of first columns. Notice that I just supplied an empty 4 element vector to X and made its Fortran dimensions the same as DF:
Source in file:
subroutine test(d, i, nMCd, DF, X)
integer, intent(in) :: d, i, nMCd
double precision, intent(in), dimension(i,nMCd) :: DF
double precision, intent(out), dimension(i,nMCd) :: X(i)
X = DF(:,d)+DF(:,d)
end subroutine test
R code:
input <- data.frame(A=c(11,12), B=c(21, 22))
.Fortran("test", d = as.integer(1), i = nrow(input), nMCd = ncol(input),
DF = unlist(input), X = numeric(4))
#--- result------
$d
[1] 1
$i
[1] 2
$nMCd
[1] 2
$DF
A1 A2 B1 B2
11 12 21 22
$X
[1] 22 24 0 0
Further experiment, still without any knowledge of Fortran, trying to add the items in the first row together:
X = DF(d,:)+DF(d,:)
Produced:
$X
[1] 22 42 0 0

Related

Arguments of different types in a same Fortran subroutine

I want to define a subroutine in modern fortran (90 or newer) to print a matrix (with integer or real numbers) or vectors (with integer o numbers).
SUBROUTINE print_matrix_vector( A )
! WHAT TYPE CAN I WRITE TO A ???
END SUBROUTINE
Of course, I wanted to call a subrutine
CALL print_matrix_vector( A )
independent if A is a matrix of real or integer numbers, and if A is a vector of real or integer numbers.
Thanks in advance for your comments. I think this is something very usual, but I did not find nothing clear.
So Fortran uses interface statements to declare overloads to functions. I have done the exact same thing recently. The key is to create an interface, I call show which is used as an alias for all the separate functions needed.
interface show
procedure show_vector_i, show_vector_r, show_vector_d
procedure show_matrix_i, show_matrix_r, show_matrix_d
end interface
Here is the output first.
Display Matrices/Vectors
vector=
1
2
3
4
matrix=
1 5 9 13
2 6 10 14
3 7 11 15
4 8 12 16
A=
4.47723 3.36660 1.48809 -.752551
6.36660 7.19091 6.67333 5.54482
7.48809 9.67333 10.1187 9.77902
8.24745 11.5448 12.7790 13.0861
u=
6.36660
7.19091
6.67333
5.54482
v=
3.36660
7.19091
9.67333
11.5448
and the code
program FortranConsole1
use, intrinsic :: iso_fortran_env
implicit none
interface show
procedure show_matrix_i, show_matrix_r, show_matrix_d
procedure show_vector_r, show_vector_d
end interface
integer :: row(16), matrix(4,4), i
real(real64), allocatable, target :: A(:,:)
real(real64), pointer :: B(:,:)
real(real64), allocatable :: v(:), u(:)
row = [(i,i=1,16)]
matrix = reshape( row, [4, 4])
print *, "Display Matrices/Vectors"
print *, ""
print *, "vector="
call show(row(1:4))
print *, "matrix="
call show(matrix)
A = dble(matrix)
A = sqrt( matmul( transpose(A), A) ) - A
print *, "A="
call show(A)
v = A(:,2)
u = A(2,:)
print *, "u="
call show(u)
print *, "v="
call show(v)
contains
subroutine show_vector_i(v, w)
! Display the vector 'v' in a single column
! v : the array of real numbers
! w : the column width. default = 5
! s : sig. figures w-5 (calculated)
integer, intent(in) :: v(:)
integer, intent(in), optional :: w
integer :: i,n,wt
character(len=16) :: fmt
if(present(w)) then
wt = w
else
wt = 5
end if
n = size(v)
write( fmt, "(a,g0,a)") "(*(g",wt,".0))"
write( * , fmt ) ( v(i), new_line("A"), i=1,n )
end subroutine
subroutine show_vector_r(v, w)
! Display the vector 'v' in a single column
! v : the array of real numbers
! w : the column width. deafult = 12
! s : sig. figures w-5 (calculated)
real(real32), intent(in) :: v(:)
integer, intent(in), optional :: w
integer :: i,n,dg,wt
character(len=16) :: fmt
if(present(w)) then
wt = w
else
wt = 12
end if
dg = wt - 6
n = size(v)
write( fmt, "(a,g0,a,g0,a)") "(*(g",wt,".",dg,"))"
write( * , fmt ) ( v(i), new_line("A"), i=1,n )
end subroutine
subroutine show_vector_d(v, w)
! Display the vector 'v' in a single column
! v : the array of real numbers
! w : the column width. deafult = 12
! s : sig. figures w-5 (calculated)
real(real64), intent(in) :: v(:)
integer, intent(in), optional :: w
call show_vector_r(real(v),w)
end subroutine
subroutine show_matrix_i(A, w)
! Display the matrix 'A' in columns
! A : the array of integers
! w : the column width. Default = 5
integer, intent(in) :: A(:,:)
integer, intent(in), optional :: w
integer :: i,j,n,m, wt
character(len=16) :: fmt
if(present(w)) then
wt = w
else
wt = 5
end if
n = size(A,1)
m = size(A,2)
write( fmt, "(a,g0,a)") "(*(g",wt,".0))"
write( * , fmt ) ( (A(i,j),j=1,m), new_line("A"), i=1,n )
end subroutine
subroutine show_matrix_r(A, w)
! Display the matrix 'A' in columns
! A : the array of real numbers
! w : the column width. deafult = 12
! s : sig. figures w-5 (calculated)
real(real32), intent(in) :: A(:,:)
integer, intent(in), optional :: w
integer :: i,j,n,m,dg,wt
character(len=16) :: fmt
if(present(w)) then
wt = w
else
wt = 12
end if
dg = wt - 6
n = size(A,1)
m = size(A,2)
write( fmt, "(a,g0,a,g0,a)") "(*(g",wt,".",dg,"))"
write( * , fmt ) ( (A(i,j),j=1,m), new_line("A"), i=1,n )
end subroutine
subroutine show_matrix_d(A,w)
! Display the matrix 'A' in columns
! A : the array of dble numbers
! w : the column width. default = 12
! Converts 'A' into single precision and calls `show_matrix_r`
real(real64), intent(in) :: A(:,:)
integer, intent(in), optional :: w
call show_matrix_r(real(A),w)
end subroutine
end program FortranConsole1
In reality, the functions should be in a module file in order to be reused again and again in different programs.

Outer constructor that has the same number of arguments as the field values

How can I define an outer constructor that has same number of arguments as the field values? What I want to do is something like this:
struct data
x
y
end
function data(x, y)
return data(x-y, x*y)
end
But it obviously causes stackoverflow.
Based on the various helpful comments, thanks to all, I changed my answer. Here is an example in Julia 1.0.0 of what you may be after. I am learning Julia myself, so maybe further comments can improve this example code.
# File test_code2.jl
struct Data
x
y
Data(x, y) = new(x - y, x * y)
end
test_data = Data(105, 5)
println("Constructor example: test_data = Data(105, 5)")
println("test_data now is...: ", test_data)
#= Output
julia> include("test_code2.jl")
Constructor example: test_data = Data(105, 5)
test_data now is...: Data(100, 525)
=#
This works for me
julia> struct datatype
x
y
end
julia> function datatype_create(a,b)
datatype(a - b, a * b)
end
datatype_create (generic function with 1 method)
julia> methods(datatype_create)
# 1 method for generic function "datatype_create":
[1] datatype_create(a, b) in Main at none:2
julia> methods(datatype)
# 1 method for generic function "(::Type)":
[1] datatype(x, y) in Main at none:2
julia> a = datatype_create(105,5)
datatype(100, 525)
julia> b = datatype_create(1+2im,3-4im)
datatype(-2 + 6im, 11 + 2im)
julia> c = datatype_create([1 2;3 4],[4 5;6 7])
datatype([-3 -3; -3 -3], [16 19; 36 43])
julia> d = datatype_create(1.5,0.2)
datatype(1.3, 0.30000000000000004)
If you are absolutely Ideologically Hell Bent on using an outer constructor, then you can do something like this
julia> datatype(a,b,dummy) = datatype(a - b,a * b)
datatype
julia> e = datatype(105,5,"dummy")
datatype(100, 525)
Antman's solution using the power of MACRO
julia> macro datatype(a,b)
return :( datatype($a - $b , $a * $b) )
end
#datatype (macro with 1 method)
julia> f = #datatype( 105 , 5 )
datatype(100, 525)

Call FORTRAN subroutine with allocatables in R?

This is a follow-up question to my previous Fortran question.
I have a working Fortran program that has a subroutine that filters an array. This is the program:
program test
integer, parameter :: n = 3
integer, parameter :: m = 4
double precision, dimension(n,m) :: A
double precision, dimension(:,:), allocatable :: B
A(1,:) = [11, 22, 43, 55]
A(2,:) = [15, 56, 65, 63]
A(3,:) = [54, 56, 32, 78]
print*, 'A :'
print*, int(A)
CALL extractB(A, B)
print*, 'B'
print*, int(B)
contains
subroutine extractB(A, B)
implicit none
double precision, dimension(:,:), intent(in) :: A
double precision, dimension(:,:), allocatable :: B
integer :: nrowB, i, pos
nrowB = count( A(:,2)==56)
allocate( B(nrowB, size(A,2)-1 ) )
pos = 1
do i = 1, size(A,1)
if(A(i,2)==56)then
B(pos,1) = A(i,1)
B(pos,2:) = A(i,3:)
pos = pos+1
end if
end do
end subroutine extractB
end program
The program compiles, runs, and it does what it has to do very well.
I want to call the extractB subroutine with R. I have asked similar questions and found was able to make them work, but this one is somehow different and not working.
My fortran subrutine is in the mytest.f90 file and has this code:
subroutine extractB(A, B)
implicit none
double precision, dimension(:,:), intent(in) :: A
double precision, dimension(:,:), allocatable :: B
integer :: nrowB, i, pos
nrowB = count( A(:,2)==56)
allocate( B(nrowB, size(A,2)-1 ) )
pos = 1
do i = 1, size(A,1)
if(A(i,2)==56)then
B(pos,1) = A(i,1)
B(pos,2:) = A(i,3:)
pos = pos+1
end if
end do
end subroutine extractB
I compile it in R and load the library with these commands:
system("R CMD SHLIB ./Fortran/mytest.f90")
dyn.load("./Fortran/mytest.so")
Then, in R, i create and pass a data frame to the subroutine
A = data.frame(c(11,15,54), c(22,56,56), c(43,65,32), c(55,63,78))
X<-.Fortran("extractB", A = unlist(A), B = numeric(6))
After that R crashes
*** caught segfault ***
address (nil), cause 'unknown'
Traceback:
1: .Fortran("extractB", A = unlist(A), B = numeric(6))
Possible actions:
1: abort (with core dump, if enabled)
2: normal R exit
3: exit R without saving workspace
4: exit R saving workspace
Selection:
If I change the subroutine by removing setting the dimensions by hand:
subroutine extract(A, B)
implicit none
double precision, dimension(3,4), intent(in) :: A
double precision, dimension(2,3) :: B
integer :: i, pos
pos = 1
do i = 1, size(A,1)
if(A(i,2)==56)then
B(pos,1) = A(i,1)
B(pos,2:) = A(i,3:)
pos = pos+1
end if
end do
end subroutine extract
recompile the library, and reload it. I can run
X<-.Fortran("extract", A = unlist(A), B = numeric(6))
dim(X$A) <- dim(A)
dim(X$B) <- c(2,3)
and get what I want
> X
$A
[,1] [,2] [,3] [,4]
[1,] 11 22 43 55
[2,] 15 56 65 63
[3,] 54 56 32 78
$B
[,1] [,2] [,3]
[1,] 15 65 63
[2,] 54 32 78
Any way of fixing this?
Thanks a lot for the help!
Though, as Vladimir F pointed out, this will not work with allocatables like this, you can allocate memory, that can be used by another language in Fortran. But you should use the pointer attribute in that case. However, you will not be able to make use of assumed shape arrays either. Instead of inferring the size of A, you should pass it in explicitly.
If you are willing to change the interface for this, you can get your functionality with something along these lines, (see also M. S. B.s answer to a related question):
subroutine extractB(A_ptr, lenX, lenY, B_ptr, nrowB) bind(c,name=extractB)
use iso_c_binding
implicit none
type(c_ptr), value :: A_ptr
integer(kind=c_int), value :: lenX, lenY
type(c_ptr) :: B_ptr
integer(kind=c_int) :: nrowB
real(kind=c_double), pointer :: A(:,:)
real(kind=c_double), pointer :: B(:,:)
integer :: i, pos
c_f_pointer(A_ptr, A, [lenX, lenY])
nrowB = count( A(:,2)==56)
allocate( B(nrowB, size(A,2)-1 ) )
!...
B_ptr = c_loc(B)
end subroutine extractB

Writing Fortran matrix multiplication subroutine to be called in R

I'm trying to write a Fortran subroutine that does some matrix multiplication. I use R to create the inputs:
set.seed(7232015)
#############
# meta data #
#############
B <- 200 # (actually millions)
D <- 100 # number of markov chain monte carlo draws (actually 4,000)
T <- 8 # number of quarters
#########
# input #
#########
input <- data.frame(
treat = sample(0:1, B, T), # treatment indicator
time = sample(1:T, B, T), # time
weight = rnorm(B), # weight
pred = rnorm(B), # predictions (x \hat\beta)
eresid = exp(rnorm(B))
) # exp(resid) exp(y - x \hat\beta)
thetaTime <- matrix(rnorm(T * D), T, D) # time-by-treatment intrxn
theta <-
thetaTime[input$time,] # pull off the relevant value for ea obs
rm(list=setdiff(ls(), c("input", "theta", "T")))
And I have an R function that does what I need:
test2 <- function(d, DF, theta, T){
D <- ncol(theta)
B <- nrow(DF)
DF$epredC <- exp(DF$pred + theta[,d] * (DF$treat == 1))
DF$epredT <- exp(DF$pred - theta[,d] * (DF$treat == 0))
DF$diff <-
as.vector(
DF$eresid %*% matrix(
DF$epredT, nrow = B, ncol = B, byrow = T
)
)
return(DF$diff)
}
x <- test2(d = 1, DF = input, theta = theta, T = T)
The Fortran subroutine should create exaclty the vector x of size 200 in this example.
This is the fortran code I wrote:
subroutine test3(d, i, nMCd, DF, theta, C)
integer, intent(in) :: d, i, nMCd
double precision, intent(in), dimension(i,5) :: DF
double precision, intent(in), dimension(i,nMCd) :: theta
double precision, dimension(i) :: epredC, epredT
double precision, intent(out), dimension(i) :: C
C=0.0d0
epredC = exp(DF(:,4) + (theta(:,d) * DF(:,1)))
epredT = exp(DF(:,4) + (theta(:,d) * (1-DF(:,1))))
do jj=1, i
do j=1, i
C(jj) = C(jj) + DF(j,5)*epredT(jj)
end do
end do
end subroutine test3
I am able to compile it and run it on R
system("R CMD SHLIB ./Fortran/mytest.f90")
dyn.load("./Fortran/mytest.so")
X <- .Fortran("test3", d = as.integer(1), i = nrow(input),
nMCd = nrow(theta), DF = unlist(input),
theta = unlist(theta),
C = numeric(nrow(input)))
But in R x[1]=415.937 and in Fortran X$C[1]=10414.94
What am I doing wrong? Thanks!
I know my do loop is wrong, but I cannot figure out why...
If I change my fortran subroutine to this, it works as it should
subroutine test5(d, i, nMCd, DF, theta, C)
integer, intent(in) :: d, i, nMCd
double precision, intent(in), dimension(i,5) :: DF
double precision, intent(in), dimension(i,nMCd) :: theta
double precision, dimension(i) :: epredC, epredT
double precision, intent(out), dimension(i) :: C
double precision, dimension(i,i) :: B
C=0.0d0
B=0.0d0
epredC = exp(DF(:,4) + (theta(:,d) * DF(:,1)))
epredT = exp(DF(:,4) + (theta(:,d) * (1-DF(:,1))))
do j=1,i
B(:,j)=epredT(j)
end do
C = matmul(DF(:,5), B)
end subroutine test5
Is this method or the loop more efficient in Fortran?

ZeroDivisionError: Inverse does not exist

The problem is 2 is non invertible at Integer Mode Ring (6). I would like to divide the result into 2 as an ordinary integer. In another word, I like to escape from integer mode ring's trap and bring the result to ordinary integer and then divide it into 2.
def fast_exponentiation(c, L, q):
Zq = IntegerModRing(q) # create Z_q
g2 = c
result = 1
while True:
y = L % 2
result = Zq(result) * Zq(g2 ** y)
g2 = Zq(g2 * g2)
L = L >> 1
if L == 0:
break
return result
e = fast_exponentiation(2, 4, 6)
print e / 2
If you want to turn e into an Integer again, you have a few options: call Integer (the target object), or ZZ or IntegerRing, the target parent.
sage: e
1
sage: parent(e)
Ring of integers modulo 6
sage: ZZ(e)
1
sage: parent(ZZ(e))
Integer Ring
And so:
sage: e = ZZ(e)
sage: e/2
1/2
sage: e//2
0
or whatever else you'd like.

Resources