## PART 1 { F1 <- function(x, a) { return(x^4/2 + a*x^2 - x/2 + a/4) } FUN<-function(){ par(mar = c(3,3,3,3)) curve( F1(x,-2), from=-2.5, to=2.5, n=100, xlab="", ylab="", ylim = c(-4,4), xaxs = "i", yaxs = "i", lty=1, lwd=2, las=1, tck=0.02) for (i in -1:2) { curve( F1(x,i), from=-2.5, to=2.5, n=100, xlab="", ylab="", lty=3+i, lwd=2, add = TRUE) } axis(2, at = c(-3,-1,1,3), labels = c(-3,-1,1,3), col="black", las=1, tck=0.02) axis(3, labels = FALSE, col="black", las=1, tck=0.02) axis(4, at = -2:2, labels = FALSE, col="black", las=1, tck=0.02) text(0, -3.5, labels = expression(f(x,a) == x^4 / 2 + a*x^2 - x/2 + a/4), col = "black") FUN() } legend(-2,-2.0,legend="a=2",col="black",lty=FALSE,bty="n",xjust = 1, yjust = 1,cex=0.5) legend(-2,-2.3,legend=" 1",col="black",lty=FALSE,bty="n",xjust = 1, yjust = 1,cex=0.5) legend(-2,-2.6,legend=" 0",col="black",lty=FALSE,bty="n",xjust = 1, yjust = 1,cex=0.5) legend(-2,-2.9,legend=" -1",col="black",lty=FALSE,bty="n",xjust = 1, yjust = 1,cex=0.5) legend(-2,-3.2,legend=" -2",col="black",lty=FALSE,bty="n",xjust = 1, yjust = 1,cex=0.5) legend(-1.5,-2.0,legend="",col="black",lty=5,bty="n",xjust = 1, yjust = 1,cex=0.5) legend(-1.5,-2.3,legend="",col="black",lty=4,bty="n",xjust = 1, yjust = 1,cex=0.5) legend(-1.5,-2.6,legend="",col="black",lty=3,bty="n",xjust = 1, yjust = 1,cex=0.5) legend(-1.5,-2.9,legend="",col="black",lty=2,bty="n",xjust = 1, yjust = 1,cex=0.5) legend(-1.5,-3.2,legend="",col="black",lty=1,bty="n",xjust = 1, yjust = 1,cex=0.5) } ## PART 2 svg(filename="test.svg", width=12, height=8, pointsize=12) { x <- seq(-3, 3, length=50) y <- seq(-2, 2, length=50) f <- function(x,y) { return(x^4/2 + y*x^2 - x/2 + y/4) } z <- outer(x, y, f) # Create a function interpolating colors in the range of specified colors # Generate the desired number of colors from this palette # 10x3 kinds of colors nbcol <- 50 jet.colors1 <- colorRampPalette( c("#0000ff", "#00ff00") ) color1 <- jet.colors1(nbcol) jet.colors2 <- colorRampPalette( c("#00ff00", "#ffff00") ) color2 <- jet.colors2(nbcol) jet.colors3 <- colorRampPalette( c("#ffff00", "#cc0000") ) color3 <- jet.colors3(nbcol) color<-matrix(c(color1, color2, color3), ncol=1) # Compute the z-value at the facet centres zfacet <- z[-1, -1] + z[-1, -length(y)] + z[-length(x), -1] + z[-length(x), -length(y)] # Recode facet z-values into color indices facetcol <- cut(zfacet, breaks=nbcol*3) title <- expression(f(x,y)==x^4/2 + y*x^2 - x/2 + y/4) par(bg = "white") res <- persp(x, y, z, col = color[facetcol], theta = 45, phi =30, expand = 0.5, xlab = "x", ylab = "y", zlab = "z", zlim = c(-20,60), box=TRUE, axes=TRUE, border=NA, ltheta = 120, shade = 0.5, ticktype = "detailed", main=title) } dev.off() # This not works! for(i in -2:2) lines (trans3d(x=x, y = c(i,i), z = -20, pmat = res), col = "black") for(i in -3:3) lines (trans3d(x=c(i,i), y = y, z = -20, pmat = res), col = "black") lines (trans3d(x=c(-2,2), y = 0, z = z, pmat = res), col = "black") # lines (trans3d(x = 0, y, z = 0, pmat = res), col = "black") res # I Googled evey keyword to find how to add grid lines, ending winth noting, # so I gave up persp function. ###################### ### Another Methad ### ###################### library("rgl") vertcol <- cut(z, nbcol*3) persp3d(x, y, z, col=color[vertcol],smooth=FALSE,lit=FALSE, xlab="x", ylab="y", zlab="z", zlim = c(-20,60) #,main=title ## Herer is a bug with title ) grid3d(c("x+", "y+", "z"))