# Differences

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

Link to this comparison view

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])
+ }
+}
+
+#' 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) {
+}
+
+#' 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])
+ }
+
+ 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
+}
+
+#' 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