Segmentation Fault when using glmnet mex with MATLAB - matlab

Question

My jobs have been suffering due to segmentation faults when calling glmnet (downloaded from here:http://web.stanford.edu/~hastie/glmnet_matlab/download.html) from my MATLAB code. I call the glmnet routine thousands of times. I have noticed the following peculiarities about the problem occurence:
The problem is more frequent when the size of my input matrices are larger.
I use both gaussian and poisson distribution in separate jobs, and I notice that the problem is more frequent when fitting the Poisson distribution (which also takes usually longer to converge, so might involve more loops internally?)
Since there haven't been reports of segmentation faults for the R version for these two distributions, my suspicion is that the problem, likely a memory leak, might lie in the mex interface rather than the core glmnet Fortran code, which I am pasting below. Any insights into where a memory leak might be happening is greatly appreciated! Apologies for the lengthy code dump.
Thanks!
subroutine mexFunction(nlhs, plhs, nrhs, prhs)
C-----------------------------------------------------------------------
mwpointer plhs(*), prhs(*)
mwpointer mxCreateDoubleMatrix, mxGetPr, mxCreateNumericArray
integer nlhs, nrhs
mwsize mxGetM, mxGetN, mxGetNzmax
integer mxIsNumeric
integer mxIsSparse
C-----------------------------------------------------------------------
C Input
real parm,flmin,thr, intr
integer ka,no,ni,nr,nc,ne,nx,nlam,isd,maxit,kopt,isparse,nnz,jsd
real, dimension (:), allocatable :: x,y,w,vp,ulam,cl,sr,xs,o,d,
$ flog,a
integer, dimension (:), allocatable :: ix,jx,jd,irs,jcs
mwpointer pr
C Output
integer lmu,nlp,jerr
real dev0
real, dimension (:), allocatable :: a0,ca,alm,dev,rsq
integer, dimension (:), allocatable :: ia,nin
C Temporary
mwpointer temp_pr
mwsize temp_m, temp_n, temp_nzmax, dims(3)
integer task,i
C For internal parameters
real fdev, devmax, eps, big, pmin, prec, exmx
integer mnlam, mxit
C Check for proper number of arguments.
if (nrhs .eq. 0) then
task = -1;
else
temp_pr = mxGetPr(prhs(1))
call getinteger(temp_pr,task,1)
endif
C Get input
if (task .eq. -1) then
call get_int_parms(fdev,eps,big,mnlam,devmax,pmin,exmx)
call get_bnorm(prec,mxit)
plhs(1) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(1))
call putreal(fdev,temp_pr,1)
plhs(2) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(2))
call putreal(devmax,temp_pr,1)
plhs(3) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(3))
call putreal(eps,temp_pr,1)
plhs(4) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(4))
call putreal(big,temp_pr,1)
plhs(5) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(5))
call putinteger(mnlam,temp_pr,1)
plhs(6) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(6))
call putreal(pmin,temp_pr,1)
plhs(7) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(7))
call putreal(exmx,temp_pr,1)
plhs(8) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(8))
call putreal(prec,temp_pr,1)
plhs(9) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(9))
call putinteger(mxit,temp_pr,1)
return
endif
if (task .eq. 0) then
temp_pr = mxGetPr(prhs(2))
call getreal(temp_pr,fdev,1)
temp_pr = mxGetPr(prhs(3))
call getreal(temp_pr,devmax,1)
temp_pr = mxGetPr(prhs(4))
call getreal(temp_pr,eps,1)
temp_pr = mxGetPr(prhs(5))
call getreal(temp_pr,big,1)
temp_pr = mxGetPr(prhs(6))
call getinteger(temp_pr,mnlam,1)
temp_pr = mxGetPr(prhs(7))
call getreal(temp_pr,pmin,1)
temp_pr = mxGetPr(prhs(8))
call getreal(temp_pr,exmx,1)
temp_pr = mxGetPr(prhs(9))
call getreal(temp_pr,prec,1)
temp_pr = mxGetPr(prhs(10))
call getinteger(temp_pr,mxit,1)
call chg_fract_dev(fdev)
call chg_dev_max(devmax)
call chg_min_flmin(eps)
call chg_big(big)
call chg_min_lambdas(mnlam)
call chg_min_null_prob(pmin)
call chg_max_exp(exmx)
call chg_bnorm(prec, mxit)
return
endif
c$$$ -----------------Gaussian--------------------
c$$$ ---input---
if (task .eq. 10 .or. task .eq. 11) then
if (task .eq. 11) then
temp_pr = mxGetPr(prhs(3))
temp_m = mxGetM(prhs(3))
no = temp_m
temp_n = mxGetN(prhs(3))
ni = temp_n
allocate(x(1:no*ni))
call getreal(temp_pr,x,no*ni)
else
temp_m = mxGetM(prhs(4))
no = temp_m
temp_pr = mxGetPr(prhs(3))
temp_m = mxGetM(prhs(3))
nnz = temp_m
allocate(xs(1:nnz))
call getreal(temp_pr,xs,nnz)
temp_pr = mxGetPr(prhs(19))
allocate(irs(1:nnz))
call getinteger(temp_pr,irs,nnz)
temp_pr = mxGetPr(prhs(20))
temp_n = mxGetM(prhs(20))
ni = temp_n - 1
allocate(jcs(1:(ni+1)))
call getinteger(temp_pr,jcs,(ni+1))
endif
temp_pr = mxGetPr(prhs(2))
call getreal(temp_pr,parm,1)
temp_pr = mxGetPr(prhs(4))
allocate(y(1:no))
call getreal(temp_pr,y,no)
temp_pr = mxGetPr(prhs(5))
temp_m = mxGetM(prhs(5))
temp_n = mxGetN(prhs(5))
allocate(jd(temp_m*temp_n))
call getinteger(temp_pr,jd,temp_m*temp_n)
temp_pr = mxGetPr(prhs(6))
allocate(vp(1:ni))
call getreal(temp_pr,vp,ni)
temp_pr = mxGetPr(prhs(7))
call getinteger(temp_pr,ne,1)
temp_pr = mxGetPr(prhs(8))
call getinteger(temp_pr,nx,1)
temp_pr = mxGetPr(prhs(9))
call getinteger(temp_pr,nlam,1)
temp_pr = mxGetPr(prhs(10))
call getreal(temp_pr,flmin,1)
temp_pr = mxGetPr(prhs(11))
temp_m = mxGetM(prhs(11))
temp_n = mxGetN(prhs(11))
allocate(ulam(1:temp_m * temp_n))
call getreal(temp_pr,ulam,temp_m * temp_n)
temp_pr = mxGetPr(prhs(12))
call getreal(temp_pr,thr,1)
temp_pr = mxGetPr(prhs(13))
call getinteger(temp_pr,isd,1)
temp_pr = mxGetPr(prhs(14))
allocate(w(1:no))
call getreal(temp_pr,w,no)
temp_pr = mxGetPr(prhs(15))
call getinteger(temp_pr,ka,1)
temp_pr = mxGetPr(prhs(16))
allocate(cl(1:2*ni))
call getreal(temp_pr,cl,2*ni)
temp_pr = mxGetPr(prhs(17))
call getinteger(temp_pr,intr,1)
temp_pr = mxGetPr(prhs(18))
call getinteger(temp_pr,maxit,1)
c$$$ ---prepare output---
allocate(ia(1:nx))
call zerointeger(ia,nx)
allocate(nin(1:nlam))
call zerointeger(nin,nlam)
allocate(alm(1:nlam))
call zeroreal(alm,nlam)
allocate(a0(1:nlam))
call zeroreal(a0,nlam)
allocate(ca(1:nx*nlam))
call zeroreal(ca,nx*nlam)
allocate(rsq(1:nlam))
call zeroreal(rsq,nlam)
c$$$ ---computation----
if (task .eq. 11) then
call elnet(ka,parm,no,ni,x,y,w,jd,vp,cl,ne,nx,nlam,flmin,
$ ulam,thr,isd,intr,maxit,lmu,a0,ca,ia,nin,rsq,alm,
$ nlp,jerr)
else
call spelnet(ka,parm,no,ni,xs,jcs,irs,y,w,jd,vp,cl,ne,nx,
$ nlam,flmin,ulam,thr,isd,intr,maxit,lmu,a0,ca,ia,nin,
$ rsq,alm,nlp,jerr)
endif
c$$$ ----output-----
plhs(1) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(1))
call putinteger(lmu,temp_pr,1)
plhs(4) = mxCreateDoubleMatrix(nx,1,0)
temp_pr = mxGetPr(plhs(4))
call putinteger(ia,temp_pr,nx)
plhs(5) = mxCreateDoubleMatrix(lmu,1,0)
temp_pr = mxGetPr(plhs(5))
call putinteger(nin,temp_pr,lmu)
plhs(7) = mxCreateDoubleMatrix(lmu,1,0)
temp_pr = mxGetPr(plhs(7))
call putreal(alm,temp_pr,lmu)
plhs(8) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(8))
call putinteger(nlp,temp_pr,1)
plhs(9) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(9))
call putinteger(jerr,temp_pr,1)
plhs(2) = mxCreateDoubleMatrix(lmu,1,0)
temp_pr = mxGetPr(plhs(2))
call putreal(a0,temp_pr,lmu)
plhs(3) = mxCreateDoubleMatrix(nx,lmu,0)
temp_pr = mxGetPr(plhs(3))
call putreal(ca,temp_pr,nx*lmu)
plhs(6) = mxCreateDoubleMatrix(lmu,1,0)
temp_pr = mxGetPr(plhs(6))
call putreal(rsq,temp_pr,lmu)
deallocate(y)
deallocate(jd)
deallocate(vp)
deallocate(ulam)
deallocate(a0)
deallocate(ca)
deallocate(ia)
deallocate(nin)
deallocate(alm)
deallocate(w)
deallocate(rsq)
deallocate(cl)
if (task .eq. 11) then
deallocate(x)
else
deallocate(xs)
deallocate(irs)
deallocate(jcs)
endif
return
endif
c$$$ --------------end of Gaussian---------------------------
c$$$ ---------------Poisson--------------------------
c$$$ ---input---
if (task .eq. 50 .or. task .eq. 51) then
if (task .eq. 51) then
temp_pr = mxGetPr(prhs(3))
temp_m = mxGetM(prhs(3))
no = temp_m
temp_n = mxGetN(prhs(3))
ni = temp_n
allocate(x(1:no*ni))
call getreal(temp_pr,x,no*ni)
else
temp_m = mxGetM(prhs(4))
no = temp_m
temp_pr = mxGetPr(prhs(3))
temp_m = mxGetM(prhs(3))
nnz = temp_m
allocate(xs(1:nnz))
call getreal(temp_pr,xs,nnz)
temp_pr = mxGetPr(prhs(19))
allocate(irs(1:nnz))
call getinteger(temp_pr,irs,nnz)
temp_pr = mxGetPr(prhs(20))
temp_n = mxGetM(prhs(20))
ni = temp_n - 1
allocate(jcs(1:(ni+1)))
call getinteger(temp_pr,jcs,(ni+1))
endif
temp_pr = mxGetPr(prhs(2))
call getreal(temp_pr,parm,1)
temp_pr = mxGetPr(prhs(4))
allocate(y(1:no))
call getreal(temp_pr,y,no)
temp_pr = mxGetPr(prhs(5))
temp_m = mxGetM(prhs(5))
temp_n = mxGetN(prhs(5))
allocate(jd(temp_m*temp_n))
call getinteger(temp_pr,jd,temp_m*temp_n)
temp_pr = mxGetPr(prhs(6))
allocate(vp(1:ni))
call getreal(temp_pr,vp,ni)
temp_pr = mxGetPr(prhs(7))
call getinteger(temp_pr,ne,1)
temp_pr = mxGetPr(prhs(8))
call getinteger(temp_pr,nx,1)
temp_pr = mxGetPr(prhs(9))
call getinteger(temp_pr,nlam,1)
temp_pr = mxGetPr(prhs(10))
call getreal(temp_pr,flmin,1)
temp_pr = mxGetPr(prhs(11))
temp_m = mxGetM(prhs(11))
temp_n = mxGetN(prhs(11))
allocate(ulam(1:temp_m * temp_n))
call getreal(temp_pr,ulam,temp_m * temp_n)
temp_pr = mxGetPr(prhs(12))
call getreal(temp_pr,thr,1)
temp_pr = mxGetPr(prhs(13))
call getinteger(temp_pr,isd,1)
temp_pr = mxGetPr(prhs(14))
allocate(w(1:no))
call getreal(temp_pr,w,no)
temp_pr = mxGetPr(prhs(15))
allocate(cl(1:2*ni))
call getreal(temp_pr,cl,2*ni)
temp_pr = mxGetPr(prhs(16))
call getinteger(temp_pr,intr,1)
temp_pr = mxGetPr(prhs(17))
call getinteger(temp_pr,maxit,1)
temp_pr = mxGetPr(prhs(18))
allocate(o(1:no))
call getreal(temp_pr,o,no)
c$$$ ---prepare output---
allocate(ia(1:nx))
call zerointeger(ia,nx)
allocate(nin(1:nlam))
call zerointeger(nin,nlam)
allocate(alm(1:nlam))
call zeroreal(alm,nlam)
allocate(a0(1:nlam))
call zeroreal(a0,nlam)
allocate(ca(1:nx*nlam))
call zeroreal(ca,nx*nlam)
allocate(dev(1:nlam))
call zeroreal(dev,nlam)
c$$$ ---computation----
if (task .eq. 51) then
call fishnet(parm,no,ni,x,y,o,w,jd,vp,cl,ne,nx,nlam,flmin,
$ ulam,thr,isd,intr,maxit,lmu,a0,ca,ia,nin,dev0,dev,alm,
$ nlp,jerr)
else
call spfishnet(parm,no,ni,xs,jcs,irs,y,o,w,jd,vp,cl,ne,nx,
$ nlam,flmin,ulam,thr,isd,intr,maxit,lmu,a0,ca,ia,
$ nin,dev0,dev,alm,nlp,jerr)
endif
c$$$ ----output-----
plhs(1) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(1))
call putinteger(lmu,temp_pr,1)
plhs(4) = mxCreateDoubleMatrix(nx,1,0)
temp_pr = mxGetPr(plhs(4))
call putinteger(ia,temp_pr,nx)
plhs(5) = mxCreateDoubleMatrix(lmu,1,0)
temp_pr = mxGetPr(plhs(5))
call putinteger(nin,temp_pr,lmu)
plhs(7) = mxCreateDoubleMatrix(lmu,1,0)
temp_pr = mxGetPr(plhs(7))
call putreal(alm,temp_pr,lmu)
plhs(8) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(8))
call putinteger(nlp,temp_pr,1)
plhs(9) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(9))
call putinteger(jerr,temp_pr,1)
plhs(2) = mxCreateDoubleMatrix(lmu,1,0)
temp_pr = mxGetPr(plhs(2))
call putreal(a0,temp_pr,lmu)
plhs(3) = mxCreateDoubleMatrix(nx,lmu,0)
temp_pr = mxGetPr(plhs(3))
call putreal(ca,temp_pr,nx*lmu)
plhs(6) = mxCreateDoubleMatrix(lmu,1,0)
temp_pr = mxGetPr(plhs(6))
call putreal(dev,temp_pr,lmu)
plhs(10) = mxCreateDoubleMatrix(1,1,0)
temp_pr = mxGetPr(plhs(10))
call putreal(dev0,temp_pr,1)
plhs(11) = mxCreateDoubleMatrix(no,1,0)
temp_pr = mxGetPr(plhs(11))
call putreal(o,temp_pr,no)
deallocate(y)
deallocate(jd)
deallocate(vp)
deallocate(ulam)
deallocate(a0)
deallocate(ca)
deallocate(ia)
deallocate(nin)
deallocate(alm)
deallocate(cl)
deallocate(o)
deallocate(dev)
if (task .eq. 51) then
deallocate(x)
else
deallocate(xs)
deallocate(irs)
deallocate(jcs)
endif
return
endif
c$$$ --------------------end of Poisson------------------
return
end
C End of subroutine mexFunction
subroutine real8toreal(x, y, size)
integer size
real*8 x(size)
real y(size)
do 10 i=1,size
y(i)= x(i)
10 continue
return
end
subroutine realtoreal8(x, y, size)
integer size
real x(size)
real*8 y(size)
do 20 i=1,size
y(i)= x(i)
20 continue
return
end
subroutine real8tointeger(x, y, size)
integer size
real*8 x(size)
integer y(size)
do 30 i=1,size
y(i)= x(i)
30 continue
return
end
subroutine integertoreal8(x, y, size)
integer size
integer x(size)
real*8 y(size)
do 40 i=1,size
y(i)= x(i)
40 continue
return
end
subroutine getreal(pr,x,size)
mwpointer pr
integer size
real x(size)
real*8, dimension (:), allocatable :: temp
allocate(temp(1:size))
call mxCopyPtrToReal8(pr,temp,size)
call real8toreal(temp,x,size)
deallocate(temp)
return
end
subroutine getinteger(pr,x,size)
mwpointer pr
integer size
integer x(size)
real*8, dimension (:), allocatable :: temp
allocate(temp(1:size))
call mxCopyPtrToReal8(pr,temp,size)
call real8tointeger(temp,x,size)
deallocate(temp)
return
end
subroutine putreal(x,pr,size)
mwpointer pr
integer size
real x(size)
real*8, dimension (:), allocatable :: temp
allocate(temp(1:size))
call realtoreal8(x,temp,size)
call mxCopyReal8ToPtr(temp,pr,size)
deallocate(temp)
return
end
subroutine putinteger(x,pr,size)
mwpointer pr
integer size
integer x(size)
real*8, dimension (:), allocatable :: temp
allocate(temp(1:size))
call integertoreal8(x,temp,size)
call mxCopyReal8ToPtr(temp,pr,size)
deallocate(temp)
return
end
subroutine zeroreal(x,size)
integer size
real x(size)
do 90 i=1,size
x(i) = 0
90 continue
return
end
subroutine zerointeger(x,size)
integer size
integer x(size)
do 100 i=1,size
x(i) = 0
100 continue
return
end

Answer 1

First thing I would do is clean up the MATLAB API interface stuff. Remember that in Fortran you do not get automatic type promotion in function/subroutine argument lists like you do in C/C++. So it is important to get the signatures exact. You should NEVER be passing literal integers to MATLAB API functions. You should be passing variables that are typed exactly as the API specifies to ensure that there is not a mismatch. E.g., take this code:
subroutine getreal(pr,x,size)
mwpointer pr
integer size
real x(size)
real*8, dimension (:), allocatable :: temp
allocate(temp(1:size))
call mxCopyPtrToReal8(pr,temp,size)
call real8toreal(temp,x,size)
deallocate(temp)
return
end
The signature for mxCopyPtrToReal8 in the API is:
subroutine mxCopyPtrToReal8(px, y, n)
mwPointer px
real*8 y(n)
mwSize n
So you have a potential mismatch because the default Fortran integer might not match mwSize. Also, size is the name of a Fortran instrinsic function, so a different name for your variable would probably be more appropriate.
I would change that subroutine to:
subroutine getreal(pr,x,sizex)
mwpointer pr
mwSize sizex
real x(sizex)
real*8, dimension (:), allocatable :: temp
allocate(temp(1:sizex))
call mxCopyPtrToReal8(pr,temp,sizex)
call real8toreal(temp,x,sizex)
deallocate(temp)
return
end
Now you are ensured that sizex is the appropriate type. You would also need to change the types of the variables in the calling routine.
(SIDE NOTE: Actually, I wouldn't do any of what you are doing ... I would simply write a loop to copy the values directly from the mxArray into your real array without extra copies and memory allocation/deallocation)
Another example is this:
integer ...,nx,...
:
integer lmu,...
:
plhs(3) = mxCreateDoubleMatrix(nx,lmu,0)
Should be replaced with:
mwSize nx, lmu
integer*4 :: ComplexFlag = 0
:
plhs(3) = mxCreateDoubleMatrix(nx,lmu,ComplexFlag)
And, frankly, you have lots of assignment loops that can be replace by simple statements. E.g.,
call real8toreal(temp,x,sizex)
can be replaced with:
x = temp
And this:
allocate(ia(1:nx))
call zerointeger(ia,nx)
allocate(nin(1:nlam))
call zerointeger(nin,nlam)
allocate(alm(1:nlam))
call zeroreal(alm,nlam)
allocate(a0(1:nlam))
call zeroreal(a0,nlam)
allocate(ca(1:nx*nlam))
call zeroreal(ca,nx*nlam)
allocate(dev(1:nlam))
call zeroreal(dev,nlam)
can be replaced with this:
allocate(ia(1:nx))
ia = 0
allocate(nin(1:nlam))
nin = 0
allocate(alm(1:nlam))
alm = 0.0
allocate(a0(1:nlam))
a0 = 0.0
allocate(ca(1:nx*nlam))
ca = 0.0
allocate(dev(1:nlam))
dev = 0.0
etc.