R/curveGE.R

In biogeom: Biological Geometries

curveGE <- function(expr, P, phi = seq(0, 2*pi, len=2000),
             m = 1, simpver = NULL, nval = 1,
             fig.opt = FALSE, deform.fun = NULL, Par = NULL,
             xlim = NULL, ylim = NULL, unit = NULL, main = ""){

    if((is.null(deform.fun) & !is.null(Par)) | 
        (!is.null(deform.fun) & is.null(Par)))
stop("'Par' should be provided when 'deform.fun' is not null.")

    phi      <- sort(phi, decreasing = FALSE)
    x0       <- P[1]
    y0       <- P[2]
    theta    <- P[3]
    npar     <- length(P)
  
    r        <- expr(P=P[4:npar], phi=phi, m=m, 
                simpver=simpver, nval=nval)
    x        <- r*cos(phi)
    y        <- r*sin(phi)

    if(!is.null(deform.fun)){  
      Resu <- deform.fun(Par=Par, z=cbind(x,y))
      x    <- Resu$x
      y    <- Resu$y
    }

    x.rot    <- x*cos(theta) - y*sin(theta)
    y.rot    <- y*cos(theta) + x*sin(theta)  
    r.rot    <- sqrt(x.rot^2 + y.rot^2)
    x.coordi <- x.rot + x0
    y.coordi <- y.rot + y0
    

    if(fig.opt == "T" | fig.opt == "TRUE"){

        if(is.null(xlim)) xlim <- NULL
        if(is.null(ylim)) ylim <- NULL

        if(!is.null(xlim)) xlim <- xlim
        if(!is.null(ylim)) ylim <- ylim

        if(!is.null(unit)){
  xlabel <- bquote(paste(italic("x")," (", .(unit),")", sep="")) 
  ylabel <- bquote(paste(italic("y")," (", .(unit),")", sep=""))
        }
        if(is.null(unit)){
          xlabel <- bquote( italic("x") ) 
          ylabel <- bquote( italic("y") )
        }

        dev.new()
        plot( x.coordi, y.coordi, asp=1, xlab=xlabel, ylab=ylabel, 
              pch=1, cex=2, cex.lab=1.5, cex.axis=1.5, type="l", 
              lwd=2, xlim=xlim, ylim=ylim )
        abline(h=y0, lty=2, col=4)
        abline(v=x0, lty=2, col=4)   
        title(main=main, cex.main=1.5, col.main=4, font.main=1)

        ru <- expr(P=P[4:npar], phi=0, m=m, 
                   simpver=simpver, nval=nval)
        xu <- ru*cos(0)
        yu <- ru*sin(0)


        if(!is.null(deform.fun)){  
          Right <- deform.fun(Par=Par, z=cbind(xu,yu))
          xu    <- Right$x
          yu    <- Right$y
        }
        
        xv <- xu*cos(theta) - yu*sin(theta)
        yv <- yu*cos(theta) + xu*sin(theta) 
        xv <- xv + x0
        yv <- yv + y0 

        temp <- xv - x0        

        if(temp != 0){
            slope <- (yv-y0)/(xv-x0)
            abline(-slope*x0+y0, slope, col=1, lty=2)
        }
        if(temp == 0){
            abline(v = x0, col = 1, lty=2)
        }

        points(x0, y0, cex=2, pch=16, col=2)
        points(xv, yv, cex=2, pch=1, col=4)

    }
    list(x = x.coordi, y = y.coordi, r = r.rot)
}