NEW Sharing area
User documentation
Admin documentation
Development resources
Download
Private area

#help=First-order local optimization algorithm<br/>http://en.wikipedia.org/wiki/Gradient_descent #type=Optimization #output=minimum #parameters=nmax=100,delta=0.1,epsilon=0.01 # iteration index i = 0 #' constructor and initializer of R session init <- function() { # all parameters are initialy strings, so you have to put as global non-string values nmax <<- as.integer(nmax) delta <<- as.numeric(delta) epsilon <<- as.numeric(epsilon) } askfinitedifferences <- function(x) { xd <- as.array(x); for (i in 1:length(x)) { xdi <- as.array(x); if (xdi[i] + epsilon > 1.0) { xdi[i] <- xdi[i] - epsilon; } else { xdi[i] <- xdi[i] + epsilon; } xd <- rbind(xd,xdi,deparse.level = 0) } xd } gradient <- function(xd,yd) { d = ncol(xd) grad = rep(0,d) for (i in 1:d) { grad[i] = (yd[i+1] - yd[1]) / (xd[i+1,i] - xd[1,i]) } grad } #' first design building. All variables are set in [0,1]. d is the dimension, or number of variables #' @param d number of variables initDesign <- function(d) { return(askfinitedifferences(rep(0.5,d))); } #' iterated design building. #' @param X data frame of current doe variables (in [0,1]) #' @param Y data frame of current results #' @return data frame or matrix of next doe step nextDesign <- function(X,Y) { if (i>nmax) return(); d = ncol(X) n = nrow(X) prevXn = as.matrix(X[(n-d):n,]) prevYn = as.matrix(Y[(n-d):n,1]) if (i > 1) if (Y[n-d,1] > Y[n-d-d,1]) { delta <<- delta / 2 prevXn = as.matrix(X[(n-d-d-1):(n-d-1),]) prevYn = as.matrix(Y[(n-d-d-1):(n-d-1),1]) } grad = gradient(prevXn,prevYn) grad = grad / sqrt(sum(grad * grad)) xnext = t(prevXn[1,] - (grad * delta)) for (t in 1:d) { if (xnext[t] > 1.0) { xnext[t] = 1.0; } if (xnext[t] < 0.0) { xnext[t] = 0.0; } } i <<- i+1 return(askfinitedifferences(xnext)); } #' final analysis. All variables are set in [0,1]. Return HTML string #' @param X data frame of doe variables (in [0,1]) #' @param Y data frame of results #' @return HTML string of analysis analyseDesign <- function(X,Y) { m = min(Y) x = as.matrix(X)[Y==m,] analyse.files <<- paste("pairs_",i-1,".png",sep="") resolution <- 600 html=paste(sep="<br/>",paste("<HTML>minimum is ",m),paste(sep="","found at ",paste(collapse="= ",capture.output(x)),"<br/><img src='",analyse.files,"' width='",resolution,"' height='",resolution,"'/></HTML>")) plotmin=paste("<Plot1D name='min'>",m,"</Plot1D>") d = dim(X)[2] if (d == 1) { plotx=paste("<Plot1D name='argmin'>",paste(x),"</Plot1D>") } else if (d == 2) { plotx=paste("<Plot2D name='argmin'>[",paste(collapse=",",x),"]</Plot2D>") } else { plotx=paste("<PlotnD name='argmin'>[",paste(collapse=",",x),"]</PlotnD>") } png(file=analyse.files,bg="transparent",height=resolution,width = resolution) red = (as.matrix(Y)-min(Y))/(max(Y)-min(Y)) pairs(X,col=rgb(r=red,g=0,b=1-red),Y=Y[[1]],d=d,panel=panel.vec) dev.off() return(paste(html,plotmin,plotx)) } panel.vec <- function(x, y , col, Y, d, ...) { #points(x,y,col=col) for (i in 1:(length(x)/(d+1))) { n0 = 1+(i-1)*(d+1) x0 = x[n0] y0 = y[n0] for (j in 1:d) { if (x[n0+j] != x0) { dx = (Y[n0]-Y[n0+j])/(max(Y)-min(Y)) #break; } } for (j in 1:d) { if (y[n0+j] != y0) { dy = (Y[n0]-Y[n0+j])/(max(Y)-min(Y)) #break; } } points(x=x0,y=y0,col=col[n0],pch=20) lines(x=c(x0,x0+dx),y=c(y0,y0+dy),col=col[n0]) if (exists("x0p")) { lines(x=c(x0p,x0),y=c(y0p,y0),col=col[n0],lty=3) } x0p=x0 y0p=y0 } } #' temporary analysis. All variables are set in [0,1]. Return HTML string #' @param X data frame of doe variables (in [0,1]) #' @param Y data frame of results #' @returnType String #' @return HTML string of analysis analyseDesignTmp <- function(X,Y) { analyseDesign(X,Y) }