Skip to content

Commit 1725486

Browse files
yannrichetyannrichet
authored
add uniform samlping (no need for libs)
1 parent 39358cd commit 1725486

File tree

5 files changed

+210
-16
lines changed

5 files changed

+210
-16
lines changed

‎build.xml‎

Lines changed: 29 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,35 @@
88

99
<target name="dist" depends="dist-algorithm"/> <!-- dist-ioplugin: copy just the plugin ascii files -->
1010

11-
<target name="test" depends="test-algorithm"/> <!-- test-ioplugin: test the plugin ascii files -->
12-
11+
<target name="test">
12+
<fileset id="does" dir="${doe.dir}" includes="*.R"/>
13+
<pathconvert pathsep="," property="does.list" refid="does">
14+
<map from="${doe.dir}/" to=""/>
15+
</pathconvert>
16+
17+
<for list="${does.list}" param="doe" delimiter=",">
18+
<sequential>
19+
<property name="@{doe}" value="@{doe}"/>
20+
<script language="javascript">
21+
arr = project.getProperty('@{doe}');
22+
project.setProperty('@{doe}.name', arr.replace('.R',''));
23+
</script>
24+
25+
<delete dir="${test.cases.dir}" />
26+
<mkdir dir="${test.cases.dir}" />
27+
<copy todir="${test.cases.dir}" failonerror="false">
28+
<fileset dir="${test.cases.dir}.${@{doe}.name}">
29+
<include name="**" />
30+
</fileset>
31+
</copy>
32+
33+
<antcall target="test-algorithm">
34+
<param name="algorithm.name" value="${@{doe}.name}"/>
35+
</antcall>
36+
</sequential>
37+
</for>
38+
</target>
39+
1340
<target name="super.install" depends="install"/>
1441
<target name="super.clean" depends="clean"/>
1542

‎src/main/doe/RandomSampling.R‎

Lines changed: 23 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -61,23 +61,23 @@ getNextDesign <- function(algorithm,X,Y) {
6161
displayResults <- function(algorithm,X,Y) {
6262
Y = Y[,1]
6363

64-
algorithm$files <- paste0("hist_",algorithm$i-1,".png",sep="")
64+
algorithm$files <- paste0("hist.png",sep="")
6565
png(file=algorithm$files,bg="transparent",height=600,width = 600)
66-
hist(Y,xlab=algorithm$output, main=paste("Histogram of" , algorithm$output))
66+
hist(na.omit(Y),xlab=algorithm$output, main=paste("Histogram of" , algorithm$output))
6767
dev.off()
6868

69-
html=paste0("<HTML name='summary'>mean=",mean(Y),"<br/>",
70-
"standard deviation=",sd(Y),"<br/>",
71-
"median=",median(Y),"<br/>",
72-
"quantile 0.05=",quantile(Y,0.05),"<br/>",
73-
"quantile 0.95=",quantile(Y,0.95),"<br/>",
69+
html=paste0("<HTML name='summary'>mean=",mean(Y,na.rm=TRUE),"<br/>",
70+
"standard deviation=",sd(Y,na.rm=TRUE),"<br/>",
71+
"median=",median(Y,na.rm=TRUE),"<br/>",
72+
"quantile 0.05=",quantile(Y,0.05,na.rm=TRUE),"<br/>",
73+
"quantile 0.95=",quantile(Y,0.95,na.rm=TRUE),"<br/>",
7474
"<img src='", algorithm$files, "' width='600' height='600'/></HTML>")
7575

76-
m=paste("<mean>",mean(Y),"</mean>")
77-
sd=paste("<sd>",sd(Y),"</sd>")
78-
sd=paste("<median>",median(Y),"</median>")
79-
q05=paste("<q05>",quantile(Y,0.05),"</q05>")
80-
q95=paste("<q95>",quantile(Y,0.95),"</q95>")
76+
m=paste("<mean>",mean(Y,na.rm=TRUE),"</mean>")
77+
sd=paste("<sd>",sd(Y,na.rm=TRUE),"</sd>")
78+
sd=paste("<median>",median(Y,na.rm=TRUE),"</median>")
79+
q05=paste("<q05>",quantile(Y,0.05,na.rm=TRUE),"</q05>")
80+
q95=paste("<q95>",quantile(Y,0.95,na.rm=TRUE),"</q95>")
8181

8282
return(paste(html,m,sd,q05,q95,collapse=';'))
8383
}
@@ -88,7 +88,16 @@ displayResults <- function(algorithm,X,Y) {
8888
#' @returnType String
8989
#' @return HTML string of analysis
9090
displayResultsTmp <- function(algorithm,X,Y) {
91-
displayResults(algorithm,X,Y)
91+
Y = Y[,1]
92+
93+
algorithm$files <- paste0("hist_",nrow(Y),".png",sep="")
94+
png(file=algorithm$files,bg="transparent",height=600,width = 600)
95+
hist(na.omit(Y),xlab=algorithm$output, main=paste("Histogram of" , algorithm$output))
96+
dev.off()
97+
98+
html=paste0("<HTML name='hist'><img src='", algorithm$files, "' width='600' height='600'/></HTML>")
99+
100+
return(html)
92101
}
93102

94103
##############################################################################################
@@ -122,4 +131,4 @@ displayResultsTmp <- function(algorithm,X,Y) {
122131
# }
123132
# }
124133
#
125-
# print(displayResults(gd,Xi,Yi))
134+
# print(displayResults(gd,Xi,Yi))

‎src/main/doe/UniformSampling.R‎

Lines changed: 132 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,132 @@
1+
#help: Random uniform sampling
2+
#tags: uncertainties
3+
#options: sample_size='100'; seed='1'
4+
#input: x=list(min=0,max=1)
5+
#output: y=0.99
6+
7+
#' constructor and initializer of R session
8+
UniformSampling <- function(opts) {
9+
uniformsampling = new.env()
10+
11+
uniformsampling$sample_size <- as.integer(opts$sample_size)
12+
uniformsampling$seed <- as.integer(opts$seed)
13+
14+
return(uniformsampling)
15+
}
16+
17+
#' first design building. All variables are set in [min,max]
18+
#' @param input variables description (min/max, properties, ...)
19+
#' @param output values of interest description
20+
getInitialDesign <- function(algorithm,input,output) {
21+
algorithm$input = input
22+
algorithm$output = output
23+
set.seed(algorithm$seed)
24+
X = matrix(runif(algorithm$sample_size * length(input)),ncol=length(input))
25+
names(X) <- names(input)
26+
return(from01(X,algorithm$input))
27+
}
28+
29+
#' iterated design building.
30+
#' @param X data frame of current doe variables
31+
#' @param Y data frame of current results
32+
#' @return data frame or matrix of next doe step
33+
getNextDesign <- function(algorithm,X,Y) {
34+
return(NULL)
35+
}
36+
37+
#' final analysis. Return HTML string
38+
#' @param X data frame of doe variables
39+
#' @param Y data frame of results
40+
#' @return HTML string of analysis
41+
displayResults <- function(algorithm,X,Y) {
42+
Y = Y[,1]
43+
44+
algorithm$files <- paste0("hist.png",sep="")
45+
png(file=algorithm$files,bg="transparent",height=600,width = 600)
46+
hist(na.omit(Y),xlab=algorithm$output, main=paste("Histogram of" , algorithm$output))
47+
dev.off()
48+
49+
html=paste0("<HTML name='summary'>mean=",mean(Y,na.rm=TRUE),"<br/>",
50+
"standard deviation=",sd(Y,na.rm=TRUE),"<br/>",
51+
"median=",median(Y,na.rm=TRUE),"<br/>",
52+
"quantile 0.05=",quantile(Y,0.05,na.rm=TRUE),"<br/>",
53+
"quantile 0.95=",quantile(Y,0.95,na.rm=TRUE),"<br/>",
54+
"<img src='", algorithm$files, "' width='600' height='600'/></HTML>")
55+
56+
m=paste("<mean>",mean(Y,na.rm=TRUE),"</mean>")
57+
sd=paste("<sd>",sd(Y,na.rm=TRUE),"</sd>")
58+
sd=paste("<median>",median(Y,na.rm=TRUE),"</median>")
59+
q05=paste("<q05>",quantile(Y,0.05,na.rm=TRUE),"</q05>")
60+
q95=paste("<q95>",quantile(Y,0.95,na.rm=TRUE),"</q95>")
61+
62+
return(paste(html,m,sd,q05,q95,collapse=';'))
63+
}
64+
65+
#' temporary analysis. Return HTML string
66+
#' @param X data frame of doe variables
67+
#' @param Y data frame of results
68+
#' @returnType String
69+
#' @return HTML string of analysis
70+
displayResultsTmp <- function(algorithm,X,Y) {
71+
Y = Y[,1]
72+
73+
algorithm$files <- paste0("hist_",nrow(Y),".png",sep="")
74+
png(file=algorithm$files,bg="transparent",height=600,width = 600)
75+
hist(na.omit(Y),xlab=algorithm$output, main=paste("Histogram of" , algorithm$output))
76+
dev.off()
77+
78+
html=paste0("<HTML name='hist'><img src='", algorithm$files, "' width='600' height='600'/></HTML>")
79+
80+
return(html)
81+
}
82+
83+
from01 = function(X, inp) {
84+
nX = names(X)
85+
for (i in 1:ncol(X)) {
86+
namei = nX[i]
87+
X[,i] = X[,i] * (inp[[ namei ]]$max-inp[[ namei ]]$min) + inp[[ namei ]]$min
88+
}
89+
return(X)
90+
}
91+
92+
to01 = function(X, inp) {
93+
nX = names(X)
94+
for (i in 1:ncol(X)) {
95+
namei = nX[i]
96+
X[,i] = (X[,i] - inp[[ namei ]]$min) / (inp[[ namei ]]$max-inp[[ namei ]]$min)
97+
}
98+
return(X)
99+
}
100+
101+
##############################################################################################
102+
# @test
103+
# f <- function(X) matrix(apply(X,1,function (x) {
104+
# x1 <- x[1] * 15 - 5
105+
# x2 <- x[2] * 15
106+
# (x2 - 5/(4 * pi^2) * (x1^2) + 5/pi * x1 - 6)^2 + 10 * (1 - 1/(8 * pi)) * cos(x1) + 10
107+
# }),ncol=1)
108+
# # f1 = function(x) f(cbind(.5,x))
109+
#
110+
# options = list(sample_size = 100, seed = 1)
111+
# a = UniformSampling(options)
112+
#
113+
# X0 = getInitialDesign(a, input=list(x1=list(min=0,max=1),x2=list(min=0,max=1)), "y")
114+
# Y0 = f(X0)
115+
# # X0 = getInitialDesign(a, input=list(x2=list(min=0,max=1)), NULL)
116+
# # Y0 = f1(X0)
117+
# Xi = X0
118+
# Yi = Y0
119+
#
120+
# finished = FALSE
121+
# while (!finished) {
122+
# Xj = getNextDesign(a,Xi,Yi)
123+
# if (is.null(Xj) | length(Xj) == 0) {
124+
# finished = TRUE
125+
# } else {
126+
# Yj = f1(Xj)
127+
# Xi = rbind(Xi,Xj)
128+
# Yi = rbind(Yi,Yj)
129+
# }
130+
# }
131+
#
132+
# print(displayResults(a,Xi,Yi))

src/test/cases/branin.R renamed to src/test/cases.RandomSampling/branin.R

File renamed without changes.

‎src/test/cases.UniformSampling/branin.R‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
## This file should provide following objects, when loaded:
2+
# f : function
3+
# input.f : list of input dimensions, contains list of properties like lower & upper bounds of each dimensions
4+
# output.f : list of output dimensions
5+
# *.f : list of math properties. To be compared with algorithm results
6+
# [print.f] : method to print/plot the function for information
7+
8+
f <- function(x) {
9+
x1 <- x[,1]*15-5
10+
x2 <- x[,2]*15
11+
matrix((x2 - 5/(4*pi^2)*(x1^2) + 5/pi*x1 - 6)^2 + 10*(1 - 1/(8*pi))*cos(x1) + 10,ncol=1)
12+
}
13+
input.f = list(
14+
x1=list(min=0,max=1),
15+
x2=list(min=0,max=1)
16+
)
17+
output.f = "branin"
18+
mean.f = 53.93
19+
20+
library(testthat)
21+
22+
test = function(algorithm_file) {
23+
results = run.algorithm(algorithm_file, options=list(`model[x]`=list(x1="Unif(0,1)",x2="Unif(0,1)")),fun=list(input=input.f,output=output.f,fun=f))
24+
if (!isTRUE(test_that("branin mean",{expect_equal(as.numeric(results$mean),mean.f,tolerance = .1)}))) quit(status=1)
25+
}
26+

0 commit comments

Comments
 (0)