[R] Building from a source-code library under windows
In-Sun Nam
inam at man.ac.uk
Thu Jun 27 14:56:55 CEST 2002
Dear All,
I have a pair of .cpp and .def file can be compiled using VC++ and works
perfectly well in S-PLUS.
I wanted to do the same for R; so I followed the guidline given in "Building
from a source-code library under Windows" as much as possible and manage to
compile them using VC++ and call it from R. But it gives different answer
from the one called from S-Plus.
I know that I did something wrong likely at the compiling procedure or the
calling from R procedure, but I don't know what; it is even harder to debug
something when it doesn't crash!!
Does anyone have any idea how I can improve this situation?
Your help will be very much appreciated.
In-Sun
( the relevant details are as follows)
############
# COMPILE #
############
set R_HOME=C:\progra~1\R\rw1051
path;
PATH=%SystemRoot%\system32;%SystemRoot%;C:\PROGRA~1\R\rw1051\tools;C:\PROGRA
~1\R\rw1051\MinGW\bin
PATH=%path%;C:\PROGRA~1\perl\bin;C:\PROGRA~1\R\rw1051\bin;C:\PROGRA~1\R\rw10
51\share\perl\R
PATH=%path%;C:\PROGRA~1\pfe;C:\Progra~1\DevStu~1\VC\bin;C:\Progra~1\DevStu~1
\Shared~1\bin
PATH=%path%;C:\Progra~1\DevStu~1\VC\include
## go to the directory that you want to make the outputs
cd C:\Rtest
lib /def:%R_HOME%\src\gnuwin32\R.exp /out:Rdll.lib /machine:IX86
set INCLUDE=C:\Progra~1\DevStu~1\VC\include
cl /MT /Ox /DDLL_LOAD /D "Win32" /I\INCLUDE /c zotcilag.cpp
link /dll /def:zotcilag.def /out:zotcilag.dll *.obj Rdll.lib
/LIBPATH:C:\Progra~1\DevStu~1\VC\lib
##############
# Calling from R #
##############
dyn.load("c:\\rtest\\zotcilag.dll")
/* construct a function containing; same as one in S-plus"
Odata$dv <- .C("nlme_two_comp_zero_CI_lag",
as.integer(length(Odata$ID)),
as.double(rev(Odata$order)[1]),
as.double(cbind(
Odata$TIME,
Odata$ITIME,
Odata$CL,
Odata$CLD,
Odata$V1,
Odata$VSS,
Odata$Tlag,
as.character(Odata$ID),
Odata$order
)),
as.integer(length(Ddata$ID)),
as.double(rev(Ddata$order)[1]),
as.double(cbind(
Ddata$TIME,
Ddata$DOSE,
as.character(Ddata$ID), # factor
Ddata$order,
as.character(Ddata$EVID)
)),
as.integer(LogParam),
as.integer(LogResp),
resp= as.double(rep(0.00,length(Odata$ID))),
NAOK=T)$resp
##############
# CPP and DEF #
##############
;******************************************
; zero order Two Compartment constant infusion with lag time
;******************************************
LIBRARY ZOTCIlag
EXPORTS
DllMain
nlme_two_comp_zero_CI_lag
#=======
#if defined(DLL_LOAD)
#include <windows.h>
#include <Math.h>
/* Standard DLL entry/exit procedure */
BOOL __stdcall
DllMain(HINSTANCE hDllInstance, DWORD dwReason, LPVOID
lpReserved)
{
switch (dwReason) {
case DLL_PROCESS_ATTACH:
/* initialization code here */
break;
case DLL_PROCESS_DETACH:
/* clean-up code here */
break;
}
return(TRUE);
}
#endif
void
nlme_two_comp_zero_CI_lag (long int *norow, double *maxoorder, double
*OMAT,
long int *ndrow, double *maxdorder, double *DMAT,
long int *logparam, long int *logresp, double *Resp)
{
long int i, j, No = *norow, Nd = *ndrow, LogParam = *logparam, LogResp =
*logresp;
double Tdiff, a, b, k21, origReset, counterDose, id, T1, constReseti,
constResetj,
MaxOORDER = *maxoorder, MaxDORDER = *maxdorder,
*OTime, *ITIME, *CL, *CLD, *V1, *VSS, *Tlag, *OID, *OORDER,
*DTime, *DDose, *DID, *DORDER, *DEVID,
*OrigDTime, *OrigDDose, *OrigDID, *OrigDORDER, *OrigDEVID,
*tempDTime, *tempDDose, *tempDID, *tempDORDER, *tempDEVID;
OTime = OMAT;
ITIME = OMAT + No;
CL = OMAT + No * 2;
CLD = OMAT + No * 3;
V1 = OMAT + No * 4;
VSS = OMAT + No * 5;
Tlag = OMAT + No * 6;
OID = OMAT+ No * 7;
OORDER = OMAT + No *8; /* */
DTime = DMAT;
DDose = DMAT + Nd;
DID = DMAT + Nd * 2;
DORDER = DMAT + Nd * 3; /* */
DEVID = DMAT + Nd * 4; /* */
OrigDTime = DTime;
OrigDDose = DDose;
OrigDID = DID;
OrigDORDER = DORDER;
OrigDEVID = DEVID;
origReset = 999999.0;
counterDose = 0.0;
constReseti = 0.0;
for(i = No; i >0 && constReseti==0.0;
){
*Resp= 0.0;
constResetj=0.0;
if(LogParam==1.0){
*ITIME = exp(*ITIME);
*Tlag = exp(*Tlag);
*CL = exp(*CL);
*CLD = exp(*CLD);
*V1 = exp(*V1);
*VSS = exp(*VSS);
}
a = (((*CL/ *V1) + (*CLD/ *V1) + (*CLD/ (*VSS - *V1))) +
sqrt(pow((*CL/ *V1) + (*CLD/ *V1) + (*CLD/ (*VSS - *V1)), 2.0) -
4.0 * (*CL/ *V1) * (*CLD/ (*VSS - *V1)))) / 2.0;
b = (((*CL/ *V1) + (*CLD/ *V1) + (*CLD/ (*VSS - *V1))) -
sqrt(pow((*CL/ *V1) + (*CLD/ *V1) + (*CLD/ (*VSS - *V1)), 2.0) -
4.0 * (*CL/ *V1) * (*CLD/ (*VSS - *V1)))) / 2.0;
k21 = *CLD/ (*VSS - *V1);
if(*OID !=id){
origReset =999999.0;
counterDose = 0.0;
}
for(j = Nd; j >0 && constResetj==0.0 ; j--){
if(*OORDER > origReset){
/* run once for the first subject of a case; notice where is the first*/
OrigDTime = tempDTime; /* first dose info. shifted*/
OrigDDose = tempDDose;
OrigDID = tempDID;
OrigDORDER = tempDORDER;
OrigDEVID = tempDEVID;
counterDose = 0.0;
DTime = OrigDTime; /* starting dose shifted */
DDose = OrigDDose;
DID = OrigDID;
DORDER = OrigDORDER;
DEVID = OrigDEVID;
origReset = 999999.0; /* this loop will not be used again until origReset is resetted */
}
if(*OORDER < origReset && ((*DID==*OID && *DEVID==4.0) ||
(*DID!=*OID && *DEVID == 1.0)) && counterDose==0.0){
/* run once for the first subject of a case; to know where is the end*/
if(*DORDER < *OORDER){ /* false starting */
*Resp = 0.0; /* reset Resp*/
*DEVID = 1.0;
OrigDTime = DTime;
OrigDDose = DDose ;
OrigDID = DID ;
OrigDORDER = DORDER ;
OrigDEVID = DEVID ;
}
else{
origReset = *DORDER; /* reset max. order*/
tempDTime = DTime; /* last dose info*/
tempDDose = DDose;
tempDID = DID;
tempDORDER = DORDER;
tempDEVID = DEVID;
*DEVID = 1.0;
counterDose = 1.0;
}
}
if(*OORDER < origReset && *DID==*OID && *DEVID==1.0 && *DORDER <
*OORDER){
Tdiff = *OTime - (*DTime + *Tlag);
if(Tdiff < *ITIME )
T1 = 0.0;
else
T1 = Tdiff - *ITIME ;
if(Tdiff>0)
*Resp = *Resp + *DDose / *ITIME *
( ((a - k21)/((a - b) * *V1)) *
(exp(-a * T1) - exp(-a * Tdiff)) / a +
((k21 - b)/((a - b) * *V1)) *
(exp(-b * T1) - exp(-b * Tdiff)) / b);
}
if(*DORDER==MaxDORDER)
constResetj = 1.0; /* to handle overflow problem */
else{ DID++;
DTime++;
DDose++;
DORDER++;
DEVID++;
}
}
DTime = OrigDTime; /* go back to First dose info*/
DDose = OrigDDose;
DID = OrigDID;
DORDER = OrigDORDER;
DEVID = OrigDEVID;
id = *OID;
if(LogResp==1.0){
*Resp = log(*Resp);
}
if(LogParam==1.0){
*ITIME = log(*ITIME);
*Tlag = log(*Tlag);
*CL = log(*CL);
*CLD = log(*CLD);
*V1 = log(*V1);
*VSS = log(*VSS);
}
if(*OORDER==MaxOORDER)
constReseti = 1.0;
else{ /* to handle overflow problem */
OID++;
OTime++;
OORDER++;
ITIME++;
CL++;
CLD++;
V1++;
VSS++;
Tlag++;
Resp++;
}
}
}
In-Sun Nam
School of Pharmacy and Pharmaceutical Sciences
University of Manchester
Oxford Road
Manchester
M13 9PL
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
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