user:algorithm:gradientdescent_r [Promethee]

Differences

This shows you the differences between two versions of the page.

Link to this comparison view

user:algorithm:gradientdescent_r [2012/02/06 16:05]
richet
user:algorithm:gradientdescent_r [2015/10/06 07:58] (current)
Line 1: Line 1:
 +<code r>
 +#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)
 +}
 +</code>
© IRSN - All right reserved - Legal information