[R] Strange behavior using .Fortran
Uli Flenker; Raum 704
uli at biochem.dshs-koeln.de
Fri Jul 16 14:06:35 CEST 1999
First of all, sorry for sending my stuff twice!
Concerning my problems, thanks to Prof Brian Ripley now everything works
fine. I really did not read the assumptions of the Fortran code carefully
enough. That's when you start to learn programming using awk, Perl and so
on, where you don't have to care about array sizes!
Uli Flenker
Institute of Biochemistry
German Sports University Cologne
Carl-Diem-Weg 6
50933 Koeln / Germany
Phone 0049/0221/4982-493
-494
On Fri, 16 Jul 1999, Prof Brian Ripley wrote:
> You need to read the assumptions:
>
> SUBROUTINE EXCHNG (X, M, Y, N, SX, SY)
> C
> C ALGORITHM AS 304.2 APPL.STATIST. (1996), VOL.45, NO.3
> C
> C Exchanges the sample data. Assumes both X and Y have been
> C previously dimensioned to at least max(M, N) elements
>
> and you have not done this! Try
>
> fisher.ts.test <- function(x,y)
> {
> nx <- length(x)
> ny <- length(y)
> xx <- yy <- double(max(nx, ny))
> xx[1:nx] <- x
> yy[1:ny] <- y
> .Fortran("fisher", xx, as.integer(nx),
> yy, as.integer(ny),
> total=integer(1),
> possib=integer(1),
> P=double(1),
> ierr=integer(1)
> )
> }
>
> I also suggest you compile by
>
> R SHLIB fisher.f
>
> as you will then get, correctly, a shared library with an .so extension.
>
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
More information about the R-help
mailing list