lhs/0000755000175100001440000000000012752322544011064 5ustar hornikuserslhs/inst/0000755000175100001440000000000012752234762012045 5ustar hornikuserslhs/inst/doc/0000755000175100001440000000000012752234771012612 5ustar hornikuserslhs/inst/doc/augmentLHS_Example.Rtex0000644000175100001440000001576612752234771017157 0ustar hornikusers\documentclass[a4paper]{article} \usepackage{Sweave} % to allow for Sweave \usepackage{fullpage} % for fullpage layout \usepackage{graphicx} % for figure inclusion \usepackage{amsmath} % for equation writing and subequations \usepackage{subfigure} % for subfigure numbering \title{An Example of Augmenting a Latin Hypercube} \author{Rob Carnell} \date{22 November 2007} \begin{document} \maketitle % Comment required to put the vignette into the package index %\VignetteIndexEntry{An Example of Augmenting a Latin Hypercube} %\VignetteKeyword{lhs} %\VignetteKeyword{latin hypercube} % --------------------------- Functions ---------------------------------------- \begin{Scode}{echo=FALSE} require(lhs) graph2DaugmentLHS1 <- function(sims, extras) { A <- randomLHS(sims, 2) B <- augmentLHS(A, extras) plot.default(A[,1], A[,2], type="n", ylim=c(0,1), xlim=c(0,1), xlab="x1", ylab="x2", xaxs="i", yaxs="i", main="" ) for(i in 1:length(A[,1])) { rect(floor(A[i,1]*sims)/sims, floor(A[i,2]*sims)/sims, ceiling(A[i,1]*sims)/sims, ceiling(A[i,2]*sims)/sims, col="grey") } points(A[,1], A[,2], pch=19, col="red") abline(v=(0:sims)/sims, h=(0:sims)/sims) return(list(A=A,B=B,sims=sims,extras=extras)) } graph2DaugmentLHS2 <- function(X) { A <- X$A B <- X$B sims <- X$sims extras <- X$extras plot.default(A[,1], A[,2], type="n", ylim=c(0,1), xlim=c(0,1), xlab="x1", ylab="x2", xaxs="i", yaxs="i", main="" ) N <- sims + extras for(i in 1:length(B[,1])) { rect(floor(B[i,1]*N)/N, floor(B[i,2]*N)/N, ceiling(B[i,1]*N)/N, ceiling(B[i,2]*N)/N, col="grey") } points(A[,1], A[,2], pch=19, col="red") points(B[((sims+1):(sims+extras)),1], B[((sims+1):(sims+extras)),2], pch=19, col="blue") abline(v=(0:N)/N, h=(0:N)/N) } #X <- graph2DaugmentLHS1(5,5) #graph2DaugmentLHS2(X) \end{Scode} % --------------------------- Text ------------------------------------------ Suppose that a computer simulation study is being designed that requires expensive runs. A Latin hypercube design is desired for this simulation so that the expectation of the simulation output can be estimated efficiently given the distributions of the input variables. Latin hypercubes are most often used in highly dimensional problems, but the example shown is of small dimension. Suppose further that the total extent of funding is uncertain. Enough money is available for 5 runs, and there is a chance that there will be enough for 5 more. However, if the money for the additional 5 runs does not materialize, then the first 5 runs must be a Latin hypercube alone. A design for this situation can be created using the \texttt{lhs} package.\\ First create a random Latin hypercube using the \texttt{randomLHS(n, k)} command: \begin{Scode} A <- randomLHS(5,2) \end{Scode} An example of this hypercube is shown in Figure \ref{fig:original5}. Note that the $Latin$ property of the hypercube requires that each of the 5 equal probability intervals be filled (i.e. each row and each column is filled with one point). Also notice that the exact location of the design point is randomly sampled from within that cell using a uniform distribution for each marginal variable.\\ \begin{figure}[p] \begin{center} \begin{Scode}{fig=TRUE,echo=FALSE} set.seed(10) X <- graph2DaugmentLHS1(5, 5) \end{Scode} \caption{A randomly produced Latin Hypercube with uniform marginal distributions for 2 parameters with 5 simulations.} \label{fig:original5} \end{center} \end{figure} Next, in order to augment the design with more points use \texttt{augmentLHS(lhs, m)}. The following will add 5 more points to the design: \begin{Scode} B <- augmentLHS(A, 5) \end{Scode} The \texttt{augmentLHS} function works by re-dividing the original design into $n+m$ intervals (e.g. 5+5=10) keeping the original design points exactly in the same position. It then randomly fills the empty row-column sets. The results are shown in Figure \ref{fig:augmented10}.\\ \begin{figure}[p] \begin{center} \begin{Scode}{fig=TRUE,echo=FALSE} graph2DaugmentLHS2(X) \end{Scode} \caption{A randomly produced Latin Hypercube of 5 points (red) with 5 augmented points (blue). Each parameter has a uniform marginal distribution.} \label{fig:augmented10} \end{center} \end{figure} The \texttt{augmentLHS} function uses the following algorithm (see the documentation for \texttt{augmentLHS}): \begin{itemize} \item Create a new $(n+m)$ by $k$ matrix to hold the candidate points after the design has been re-partitioned into $(n+m)^{2}$ cells, where $n$ is number of points in the original $lhs$ matrix.\\ \item Then randomly sweep through each column (1\ldots$k$) in the repartitioned design to find the missing cells.\\ \item For each column (variable), randomly search for an empty row, generate a random value that fits in that row, record the value in the new matrix. The new matrix can contain more than $m$ points unless $m = 2n$, in which case the new matrix will contain exactly $m$ filled rows.\\ \item Finally, keep only the first $m$ rows of the new matrix. It is guaranteed that there will be $m$ full rows (points) in the new matrix. The deleted rows are partially full. The additional candidate points are selected randomly because of the random search used to find empty cells.\\ \end{itemize} Also notice that because the original points are randomly placed within the cells, depending on how you bin the marginal distributions, a histogram (of x1 for example) will not necessarily be exactly uniform.\\ Now, the augmenting points do not necessarily form a Latin Hypercube themselves. The original design and augmenting points may form a Latin Hypercube, or there may be more than one point per row in the augmented design. If the augmented points are equal to the number of original points, then a strictly uniform Latin hypercube is guaranteed. An example of an augmented design which is not uniform in the marginal distributions is given in Figure \ref{fig:badAugment}. The commands were: \begin{Scode} A <- randomLHS(7, 2) B <- augmentLHS(A, 3) \end{Scode}\\ \begin{figure}[p] \centering \subfigure[Original design with 7 points.]{ \label{fig:badAugment:a} %% label for first subfigure \begin{Scode}{fig=TRUE,echo=FALSE} set.seed(12) X <- graph2DaugmentLHS1(7, 3) \end{Scode} } \hspace{0.5in} \subfigure[Augmented design with 3 additional points. Note that row 9 has 2 points and row 3 has none.]{ \label{fig:badAugment:b} %% label for second subfigure \begin{Scode}{fig=TRUE,echo=FALSE} graph2DaugmentLHS2(X) \end{Scode} } \caption{Augmented Latin hypercube design with a non-uniform marginal distribution.} \label{fig:badAugment} %% label for entire figure \end{figure} \end{document} lhs/inst/doc/augmentLHS_Example.pdf0000644000175100001440000035053512752234762017002 0ustar hornikusers%PDF-1.5 % 5 0 obj << /Length 3158 /Filter /FlateDecode >> stream xڥZIsFWULݍST9TsHPd$^@@]9Xzy-[|7εFZ元wە)Ϸ*k:8۝nu|1oGe ^ /_oWf<ks/UsTX=57+rhf߰Mv9; Hf\U䦖iָo>*& Xj4yS y&M}2U*aOX|AQ Vq8{?kIrx{r}Oq.'~{:ށ ;"@b*H_HV6Hedg) pfەuܟD1eޔ%Yx;$ѫeskMO}8^er=l{y'#O#lD')z7} Ɲ3_o#K[ASQv8" ŇBUkBuRp_7^gqI⭑9Qv[[eS=C Qix ,#HWS!xDF9zGij Gf@g;:MupYݻ=rߋZ;`|Sev -T"¢qGv~f k+\Dff,NӟHM'؏rn#T1 ֢ae.xE` i|0vZMVhÑ4}7/#X,Pv@e1g+j1Y{|NXgiuإk O&( JeOaiUd+1†I|xs a{ V5a˻ TڍWd0aeˆaFFNY0H"psc3[[ Ю]!C-' DQK?i #b>D:ab(`>rIkbhk2>$X/c^+?e?A*caokZ.i+˼מ!s]qD.Sdr𸀆OA!ZӃz*nS!{-[t]K kŔj{B|Z/-3KV8JpU #oxhKvp(X=LZױT'NcQ5pnBQ& uU!rF=n2pvPpU+E) S,(U@fw3i_s-mǘ4m^O< R'TǑG99gF+_%|OE"( _`$}qyBT^.H"NDž$W )r{+R5C CZ{/+VxݏIC"Cu,Y͙g=hp&Gꖐ<̹L%iU|&}JFXڐ`=&;Q bhY-|DG)J#Xe1ЍY63nvAV0SSh^/l+cs.ޖ(l~p-Ҏ]J] r ժҹ.wepR lk*">y?OJR'i<lOˍR/"BWW -{v%( YE =X}Jhsv62rZ ( $ͼ-kvڥAh%6 D mM}ᜢ`I2>qpkEcX_ԷKn]-% 8sWR6#SOdqѺ{OI?uΫEzPs7.T$KWkF*^XT*M !SJࢊݱTX~ F]k}5܅ت2[.J8A=١Ӭ1 q]qTBXA~B\$V9;%v:oI2*+*d'QTX~]uPW3$xW)ʪb[0K6}99nu5"_ې6|.Y6ӆ|sesşC& wN2E҅-YE˔Ͼ 염:U_1̒-dF箹vXXgOiɵ!>{u-OЇHц]Rkzp/3 Ȝ4i_ss\rRd.W8 q~!4@"Y.俭[O Ы|ԧbtNdk4&!eVT-I[T%ȅAM4,#eN!\>ZQ9v\&l4ľ|[4jJ|vp8g_oX -ZǤȧZCs(Py. AT5G\oc$nb55NNhv{ItMlf7Bpn "bu[O9jpLL׭j9.UL'Nr(71{ *}: 4m u"=庼YU$A_ endstream endobj 18 0 obj << /Length 295 /Filter /FlateDecode >> stream xUQMO0 WiZn qA qn 5=vȉ8npeZ*>d-BŕRx <{`c/}me]5fSHmYӲwЎ{'rK"/ Nn\6sONn!6^ݒ> /ExtGState << >>/ColorSpace << /sRGB 22 0 R >>>> /Length 587 /Filter /FlateDecode >> stream xV=o0+nl^xWm-Z@S EJ"Ox_$=wO;wP>w_3w(8xB t6Gؿe-ʈthNf{2͌KѺOfƕR('3 s%8ǗHO6<%axw p> d"lyw/gKcQ^VRc/lrjDokFU1Wp2 &̸4 )̸"x2 <ʝ MEtP$Zd4hTTk*&]j jTF,6=vU-q2<-x\p~oHPO{KWlFi,6,:(+-l_ ^JN(l{4:"sk8eWVh:R]m9y"Q;D5j14gpMVi!^OB7@WwYW|RjT?mHb VW1oasp'=~56.:\իNPNP? endstream endobj 24 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 27 0 obj << /Length 341 /Filter /FlateDecode >> stream xuRMo0 +r RmZmemh4-gc9AZJC!(L>Til7SX<{!z33}źK!V .ױnnc,$әg"W+3yBn|d+'s^M9#lԲyC@) ̡ԦԛSg5G,Gvi2aBE^ȕ`V/{ܼZZ y2dI7CDwzω`qpw`Mٝi0 }50Jg)52VUN$ endstream endobj 2 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./augmentLHS_Example-005.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 28 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 29 0 R/F2 30 0 R>> /ExtGState << >>/ColorSpace << /sRGB 31 0 R >>>> /Length 762 /Filter /FlateDecode >> stream xWMo0Wό?k+@Rٕ8 Nն~>رƍ6aN޼dcQ])Tp-_?]àAkVPZP]v>663eOd9P$v,p6<8@x2+N΀fř ͊/-W☓sI#I&%v@$J2Xw@ovp{b -vG>,|6Y ;d`q;5k==''7ѬĈp6\'[dV,V<gdЮlnkmj|kdB-&FcCQ@-ImɈ6pKStEljN9[<-0uW 1ShF-Kt #(Xl7uUu5@^`:1[i]b n@#Y,j8I"B-!5':;EcYwWA1:0C$ۣa/KJhyR) CCMѻt:>9KЁe`G7IJbpCo%g$`HYƾ,cltGʂJvE!/6Vvh!si<۝>;{V?Uqvg7.TdwyևԠC;œ6poC!Cwor. }ɍCwoR.l ZvBC2z0h endstream endobj 33 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 38 0 obj << /Length 880 /Filter /FlateDecode >> stream xڭVnP+XT0UUɑUMk?$)6M33C sgnys{?wYF8Yd }F,8Hܦ=מ5= ֎$J+ϏRRø>)vg8m'2ܖy^4gX²hlkvVSaKQ|ܾ&|a`JRmy#oi=z3~/9,OpeѐRc.)b#8AfKٍM-CTW`nP ؝^ `l E( HlId+Fx}gu"_)To4uɦcYnG,7nL0F҄˭oA-i*}QȤ-79*;_gCA`},8KӉlp1*WǙgA.G&Q% N%ͺ躔ڤ)跀xKѧ,N6K-B^x8q>aпY G.e,; DCxX*"lG<եs!+ڍ2f~^kvSϾ#F ^H^Y.źNסMGGʂVfX|5p+xb6d %anI+ Dغ|dHeMq |J.Bg>d鼑-P. ;p`>{p۽LWB51[2"ztUQﹴ^i}maInQ-׳z~2Q@$݅>/$i'C^> stream xڝRM0W3J)7dK$mU{fl]\PԎgy޳ "eBZc8/sX+^-cJ侼qy_SY"}2o 0#QfפWޖ(+- 0Cl2v=s/:&`1(\V뙕ߛ]srQZ߲o0,~M[@S]V{\KJ fhxw α~ c&p _阱=',js*|\s`qpt3_` y7l8έ `چt Ģhc9uX0o)#Zy :۴dT[<:>qJE0@kH透`!2F_p7qNVEz endstream endobj 34 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./augmentLHS_Example-007.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 43 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 44 0 R/F2 45 0 R>> /ExtGState << >>/ColorSpace << /sRGB 46 0 R >>>> /Length 689 /Filter /FlateDecode >> stream xVMoA ﯘ#pǞk*@RI$SCV"9dz6UugP)T{{Ǎ֪~_SoߕV?Twԧ%V֪Ge5B-{ aX;>y@x'oxc UOҭ7~+y84| /"{TozvnbĔմB4Q<3QՆ,8QNjs~2 9!D{aFdFxrxr6ޠ+_`Ko+:@dE5`Qh!ᒥdE¢yE,jgxӴ0lǍA<@:qūE]٩>cc)?Rv>`_s^mƩIǜi!o#ȩdɍ{xxIGy fAw~/h1(udy!&qK3l/;AQ叼0㽣awczwxYBN1@j  qaz |l wƁs\ qYJ;^WC}Ν 3y_u)~|]C :bPp l ;dlj@3׳5'8}LW ٭7=} (=j@Y&-`G endstream endobj 48 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 35 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./augmentLHS_Example-008.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 49 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 50 0 R/F2 51 0 R>> /ExtGState << >>/ColorSpace << /sRGB 52 0 R >>>> /Length 767 /Filter /FlateDecode >> stream xWM1 ϯxc JJ8LdGQ=ϯqg;Eq'P<=n_>~ s:# ߾ )~ (8`t@jh-f(pJ( PU<'gJ) *x6+> D_!'Iy@/26<)4oIa8<oC ewŒgԌmg+75lYI9`{rCz!Fd gyy2Of(g H[l6x 565M>5iIP jdupMRtҬ \*]I nUT"U5 ɜi~8ǎA\@2z_ܰUC#mbSDb~⹍i#krqk ǫC0qTѰDs%uË0)֫ zk%- Z$bn')סLj列o9b^CG)|{AqiFR_YhUU `=5?qvr09\rWdwYR\0.& n[HVC!CB8]nlW! ơuHc8R]( endstream endobj 54 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 65 0 obj << /Length1 1549 /Length2 7985 /Length3 0 /Length 9004 /Filter /FlateDecode >> stream xڍTm-t Ԁ4Ctw0 0 Jw7tR  ] q{:gZ̳}Y.8yYuue y(v|&3 #BB@@u8 ^ P@(@ sT0Ipآ`xDD8HH;B` BB:A]8 Ay- vss9"6Y9nP-@8B)4@q3l?pk38@.fqu*4؟jpG2 ;"@0(` u4ԸP(f;䀄\AP]G;C u͑wkY!0ݽ{p5\{ 7¬ӰrApàN.ebL@Pm7@@p6qB;5 rP.:yxVP0 ` [ 0ɏϓ¬01bn QSFp <@~a݃ϿfU t ~f4XV[h W&@ 'U)88g39B< n9w+PCȟ8W[i͝9yڡH;J )q h/, |w{ f [D!wsp;+ 9;<$q^PT?)qIeH*cf5Vvpǔ%[": bL&9`#[vF3AOT{Uɞ+e`x> L1֡ϪI3Y}NYB& ySmωBS+p7|)zq)X^iڊ.tܒ:QC5{T"K{1 ՓLtƝtpG2C8 tkY@[ H8B}+hJO|NpeHzо[_c2ȦvegKJ9ۢ6ҏۋ}13.M4ՖR)$!s|z 5eGiu 9Z1HUձ{z'%BDY_ eȄZD~mam~9Ԃ " 7^&z8g}ldÆZADr"X[#;y#js2 Ŭ fD9V/]ɞU_M{>1zIhx\=o)|2J" ,N"|ۺQN}#)q*goPc{ڐߓTQ-O`d+zYu [cPa4Y,^yo{ْ?|c&W| >zЋ Z3[jE܇QH@~8>1Va|LХGS)6c5ؿ?K@%(EVc^<`ej AsguT|N() Z>?ا֌흒Ln Ow 8z#]|ʋDW0I@^lb Gڢq svEeo/m(tw}A㿦ɘaIFi/cxeWܛeOAyv"xnN-f],ry,dY% ?*"Xr"-r72dZp3jiNp,.ƞ;Jҋ/_j8^,om< t#.?i__Ko׭x7R} PsS^!C12#!|t#ަt*Ӵ *ϖyJ'_yBEƔm*x&2wVEptwZʥu TRccfdPuѮr/ŽV#ģX5`3P=($טsn:aʴ2ۼ5Cr Ve N啍,X]&/)iwTzXOchN (,|?Aq&햯y#D.pJ4i#_ߜ\MK2a`l冮IHGc{jؓ%-x8}Mߤ88|dkV-AJ;YE5:Ng*S"oV\Lvʨu9$y^KMIO-z8kEa>MQjWH7"CMwDJ[  %lZ\vX^Y<G"4EZ'y&Ԑ,l^sطd'-jStZ0/~1u!.qRmLw w h.AZQs{&UZ/X|i'b4Q3b9կz8{ҋgkv^ֽ/fb2z(0'>͈{ݿփ a.@+ U'&E}CYv!>&QJ8ir뀶A Ԣ:4ÁnO-&/|WmLn{!E^7_Y2Zx–qRH\qD;g/V?r0|DZ'~5qk7pÆ71oYGqV:0^(dOb:w|k|vnl!ct*#욲CSD=v~\:bS5i"N5klɹH4FydsVkxnRt^aeO'6;z,EflFO^U &Ҍ&a/jD)V0e>iSz,Û[׮Ԝ˹!i RhoeHGCW}- V1=6'W'qI s׽#?c(Vd"@oR):t ~ߡ/n&EJ'7M<wX{Ĥ1ۮ=ȏܙ17MhwS)*uEs)([&h%#(х ρ &D'Axt ͡}\Vg7@<)ƢwhuA7om 5y.Nd!yn$6^yv]?IikNV^b $4Cغk7w)aQfv1^u x˵GNF/7Bۍ&s :X<ƶ\;^hrj'83iJJJ/(>!Rh]2 1"M+I[azG/"˲#'.VgW;t8~$o\%]oICw ;y:+t~U+3Yj2y1CL,]i,D`ɒqOOdH,|uo$To%/6T22؏" Myݧ|h;+/*-regol} BSK)6ѰN\4,;>c4rCׅ{Im+ [H%`51n*.{D sxW7u=͑|ҏ"$ob[^$e_͡g T)L,`e?Y$PR`-We m}ZX 0e0{tbSu:B /Y3@½+jkFm5{Jոz0E y7Xm5qdfW%C$aŠQ:Kq4,6oMvc%QX"zAN.,=i) ]@nld8kwar6}Qsmc WK޽o_RJj BN:ǜWd>/ZhT/ ۶oz+s *8 dY=иrsƟ @TgVHXPd^Jef6zvq)CdUQڻX ߣ ^GeH~}s_zbnF<2f)%#-`lS oy =-5 ~ĥ-E"A abE!Qf'\`0WK~oR4l k*AP%Fͅ*@?yUg g;oTMfoz✅O޼$Lw$3aO+J ]Ľ~$>IΫ-+1uexz0t%bʨPp Bi̗+c!+? r{8Ys1^:лM#ħ`W&؉Rt\,s݂H\?Ʋ0&y|3)/}6@[Ss}EP +3 /i%h UEՈr3Oх_ƇPNZUGC im{i&K65E ᮪i>\t8ֻ ߓA5(0~T}~fYD$ƇüUtҷc aINuK_|jcZ2X+tm۱/iL$bI(IuH0(\A[`!͡Ȳfv 'v+y Yn`+orD}gtIe9Si޾Lw hS$>*\QmծyWV13{&Gа<>/i"d= ɬ}~SY|$c5Խl2]n+IsU2Zm <{~#T+L3?#'Bꋢ=C]rAдjׄ9ZD,DC b(f6q[w#&%HF:qLEPj $Yp w93r܆//!$~pte^[a9 2(pUP(Ŗ?lH6|Q_թ _.[nk.Z. ]Ϧ(蠚SUx0%z=>_YmO>&&JO= fq0ЍitBXV8z;2D5毴g!OK) ?NnB/ {c-Hã_}䙙72T|um.Z52'\< _1dm'dr=?pV5&K6j:рv %WܵaL#FHhʟTZGrKGH%NơGmP7Ⱦ,1ZʸYUe cƢ8*چn} `+}p7N HhȘr,f4/zMiJ5rmߛ^)b w2gY{b ߫O?rgjF0Lu.sz|$EqcRR,>(K j{FnyxW0"]~h4Ff4f< ¶}uz*,vo^hH5P._>jO5 }p4* دc`Q[S"sVds!* $> stream xڌt[-tl[fǶm[tmX۶w{GQ̅\{9 1P΅ "`bbe`bb%'Wt KtrG&j'gov09x9y,LL wYv@gXr{O'Ks e20sss:Y\,+TM,.Łݝ֙\nbP:܀lRKPt] 0X?2\LN*Rݿe@wm w_Dv':yZڙ,mqY:_F6FnF6F .0oy&N. Ζ6Idbv"@;gؿ'j4('N/jv@)|`́.v&&&NnV0`^/_o{ه pqrz?,33` 4a @L}^v6>_FQyUI)OXMgag0dF?Qpw[P{dsy^.;Xo7$jcomdkiVvu 9ߡ{\>Cet*ZXs 6v@E{g˿.ǁ/X\(g 1OsI1;{ӿ`d q1@[`g 0wD9B8?z0q2  `8Q#Rb0qn}A{1/b|?6,&? 3G_|H2?,࿼ ;_!_~{W}~ZG-<,vcArX~hn? b~x,^c;+?cnC??,Q `qE0X8Qُ#0qc(!L^@-?._3.ۛXՇt< ϐiR{/9u>#B%Sdm8 % Q .z6B%*y1Wk](<j'WyuQk)Mʅ'_26_!R>MX2Kg5MBOMz4{w?3N$O {Z䭽ikRŹ Gut[0Ekhu`ѣ(*=2!KFr]sod@%nb]Y3FMAK5Zǽz7ew,I@KFǵom#;ݾ%?㛻3ӈYDd|(wԥBG[vKz0 ~e.db?g[t)cseU/=CB V10 /y뱔Jr*L2O"لmūA"6)޽H O's*8%(æ!>{ a}#{*[!y_~(t9+IE}*~ؙ1&=Sv#mEP*~q+%,Z9 Y[-ũ rRߩHM0+UrSOMmmr 7G>Tr*GBSB6)(TW/"="RB QK>;u27/9xX6(`N"Ξ~ASh7~0 n;_!3St;_EcbznFQtSSmma7)'p:?n<ؘn]&%Ax9Z[|d\X@Xc6JTO{bοn8^趵)d>98?%eNk0`SwaIxEh KdwxP!FP(0ͨR$#}\BӅ}2 ząƑ]`!7O2 IsdZwMH Io)FAz9^@& ӄÖyK粝} UO;;rMuEZ2 Ǘ'4X<eMwOvnψ콞Ξ&~N cooٗn ^?KYBr==ibF^L1.xZ^#`ڱ\SџdKx=rcQ&RvHX?7{*SdLl1 ,(HNm5ª lWəR!h O7zl:XxՅUe1E 6lxuQ-jB؉C&@Gpy+/'tbQh\~2z񱗃3@߉+wP[`M-|ǘ"~EՓ4mINnaR_uM̶k"ZզGZ.!{N2bCw^rقY.3Vީp) >^m35xs[~ Kpx[ vH|nItż 6ƅ~*=aqJn(Myᨍa挡hW0ҔƠ;zV)b.uE "V+0(doZupqUo o>ˈ?NՆƼ;kx*f|.e3V{Qdo}l5+ࠐg_6 G+e\dQ~y(9 Nn2)Y7DEs-;OpiXqk>űBBB#na6MZ{ K ˓{]L27tFK˥iWlX>/!ɢVPXOk\5f!ת,x Ec$ZKY<_t~ $oAUk[V]zl0?`5Ea(Pަmp˕ƕ|gFkq־f#l)9e~UYc|6>Cie*D[u7BAX|b)02 -*>rSA҇R.Ik(ZނD@g*HhbPͭ"ӷʞg U/4|y;h!h`]|M"bG}JE}S(dq$S ܧ1᠔;UNO|QâV-8X[Lpd4e}8Ҧ y{JfN)5gŏ\q,:#-諾WNivv`ҲypT)&a eě6V.3{0 ek W @[_"Pݶ/d7VoSќlϝ{n7hF.3Ѝ=᠉EDL4^3am;;+O׌fP9GmAAih:|fKNk6>YLeP/U=vmMBx&Q1\-lJ81,#8UhΧ'{D,7bH 2 # GE\ c(F ytd-4V[-I] G3vGrNvכ&gFTeJt.:\c-6 (lr_7_f{FN!jR/-N 3v᫸\=WɜSn]a|M{iٻ=_沞N@R[H^P[6*xst=죗غ ͐%U;s[!D%I Zds-t#& k΂j\Du2Iݫe-*Nh蒍 6g"f>ݼHCUQ Wv Ǧ%H.ѳpo1ۗl_ꘫ" ~ :@s[< ^=.OJW@J99^ mhXV^wN]Nj9!,B)\POЩی ,'ufK\ߡUepBPTeʌ4v͇+ls .JyBf-)2i "FSso׊|8(dyd5t}^yJ1qؘ>́wΘ92x!Rf<pǨXvA;n7ĩ!|׾嵬QH=~ Pi{v_Shkl>kyD%F p9NQ 16䟯v.}@_ MVY(JǏl{5c1ݯqSi|hϞk-啓i:> ߿}dc+LXNtg?%$Lr RޤIej+$9 Scdqy}r+m-y`VP9>mXS$yxkFzEkYjbzIPb?gk;42*]|[ jol%3@&(OzűL%dh01*% 7[{A-* +BD\Y9rV|r ~[3uQ9ommHS%"NCXCBCpfدR }y!"If:dgHUsup_gpx`|}AJYJCƼ-_XoTFyʭQV[\F3 {pٹF"9ێ!֋K8>~yLL*kLe쀗'$_.?2"1pFzd|@aC'2aS_2BuVԺ5yW>ޓoɷ s=w7Ɣge6uiCCPӐ!+1"wB剝z( J2F[@9t\#FfʰҌ,i)FU KPa>c5LN],NJ*rvcij ׋/ !Cѻb!Sj"9=/$]6-vp !|<&vJSˡwïhsIСT$S`_Q`:U+H|PH@zUeut>b_EA-po=.)Lj<K''p( \۴xFE'H$h.(Q3?H_3o+) sНV>*/c4$IER 89d";I#)ik٢- LHt 1}KCVtұ-@C1NfuK.J>hN9/U״@x4,v*w~^0*'NXtQN+~C7ӥ7L"#䁶U 
Zn9FD4C,ཱུ}6'a63:)ݏPz%P)Iٸs@/%q0VvͬЏ.5 ;C[~[p\@Ɔ_ u$JsDoM! x+fW[ߚ`Ӕ~SKkWS#8 쥢i➘XmV.ZOhz?, 5({f_۔`QK|%aj!P&h"1Z}Qn4 %u\ȥcb|^jCoS+|6I+mA(evk{'F)ӻmx *"<嶨3!)el:b"5yz*7ث70\XsR:pEk(KHC8~uNex0 IhQCֲ8{Rռt7|qwv %N&ZBx4=yw+A֞*5{:ww#Lbegc你<0$%7NOj0W-FiS"5$p_D9Z1<~?Iw|R-Q|&ZNb͸(SFj7mF:2jm /JЉ5:`-@ Zí;{V^Q0^,Hք,QHIQjmw'FM=/z/l49˄~+3/ ?X\sS-7iVMk0,1`2cl0lh/mZF}uL-,ZV~߅d]4 _A]Yop IFE "ebkS{q9]L):2Vz"V61ڸ;<7SvKrň.E.%A.M>s;q/ b/Rew%rhz-9SO|{UA6KQk Pt"|d͑y {ͺU|*{!5a`K2qe3h鋸^m*+jdz,5a8soJX0ƳN)!$Vn'yӖ 1c61"/%x( -!mZFVl#W ]qj LoL҈)OR>rxv@F:AuzJkm^~a)OnXW~L7$գ;Ww3rNfMsytmwm"afJO3K`8Ys|7m& dNN kOKiT(ɰ;o++޸D P:Dg\~uh.پpm;1_|Z >%S؎jH*fcWV hO5@ |; aژ <{u@څ& e[iŲ/%Q@ wv; KYSU,MoIoqte蹚xm?~T 8O|P.E1BN藪AY5dFLe' B}]b(80&"k&b2Sq.O6Fb(VvuXHwX9~w[fsұ;.!. )՞юxyLGqy%M9n@ΛgU { p^9_v++ E N"0nV-KpKg̮"C.-H|6Ud1ij dr&in@~ԭ:Ntgun6A05=S8-1)׹GyJWKT3znWaf;mFPV&/NTeB;& S/7,=v'nRQc+ʺIg`uUv&V{J3{q51E F3]X%WWXj#LbXs:wBs8a0wƏө O:)zzIa  <1H$"Uڣp(4mzKgǷSmd۲> 9`DA-<`Xl Ǡtg?4SwW3ު8ީ=-JOt*a=홟'(򡙓gz]jմV2DBv;e`FV39==Q}:-g$}fBvde ~PSUqQS3=F\$3OCp~XclHK-,!YhCHt։6gD0g 5BJ0)!; +`r2)'WHkDг'Ex9X{ڲ)nhCTy"A{7M>I=hR2x}-4Rhy0i{҈(۵&iz^m] xk WZJQW!eIsDL^D&6t[w&)`5 \L[Ify*ZV_trICL+ׂ~xaWBU_̍TgfdYô65R_~*f vvbAVb46W`i-,k2lTLDmBہ^d~! ;lt)iWY0qpcHf>tcM ,GLiL\G]p.efJ`?ӂEDX=ٹ]PD"& Ae <S}Cw,~ŭpC׹A4tmq\1ZCh虽 5GFO84 =GCq$ Kr8f{#!m{ :?LzvF?L\rs[?o튯Djօj4u֓g@daç8j *aFDA:_ NL/Rc%fΩ{R&x4?*իr5 l2!-2ŁnƋmkr3zr7:Zoae.^DmXTHpx6w1b?S{+<R0$sњ6xu@iW->׈HEkh 9\˕W܌ <צԯM*i:.E<*vrI3]dE{bI?|PV~!iO_JcW~eǁ|T٬y(М}>L҅~l Tt۩eJwuąlm~ oKfʵCuG$kiϡnV$ ]} js4W1;t:gq!ypj4aN0ʡ߁DjjKA\2p)TȿNʹeg>t26?<čR@bWR <*Z-\*𠝾#^뻛>p{v:qتj^ ^SNaNXʆtʝ;l8F̖ a8%$)^y':NUq!]Ϯ+R@9Ka;(Wtϰ(XlǬ|i :gⶽ2~i * qҋ?F&Pb'GD3Q$,qIA#WҫlQ(;a-s,97~\BܝبN})|ӼJgEUWFm%i~+J@ 7 ;ٜ*sB$r5Brf g$hwbJUhZɼWyW/ނ{oqOR/Q>3H Vj־g"oBǏ4Sqf?GZ?IPEZv}e]mx= qTehiåY5WȖwv{A%)WaymI AԱf gxa&kt?i+5YH~qu?\?O1궉c?ti4ҴVE@}.UJ5. &ֻFCHhAAF ն 's4^(tm#Epk*NZa~C[8΢Bw~ Rtt06 39=fB ަo!XWNQ\޺=Ab\5FߠhKIA<30dwI{O Y(LQݣX wvis6)pq!_"Z/w4ͥ?5@֚q C->\s'c/seGg^BDs_8pYOY>3ɗWb^Rݏ6# g"݌y]5y|Hz,F*i'J,> 0VmZ+b<$5*~2| 8&șc)՝5 )G[:.LO0 xCl< XE B,ܗ:nĸ. T_ ;+U \F4DKd!lϼ#'kx r[=[9k8)q>m, pe25jB㞝ò[W[gTW$h+ôs<DbF"}z5=9HXe5i<$UDG'ش`{2$i8Rõns?+o'p q&vVoQh!WA2t,}uguu(3V!T8w_"ZgX^Vf EAF$ďݘt,;Q$]3A,FQf >QF/NgLq~eUpm dxN2|3$xi땫TaڋgzB;)O޵%B8%W\`+SSp ">Lx).'Im pWSؼdwTHF>)1DU1atM<ȉ[hSz/|ژG+̘^NwY02?cqȗ"c{D`\ytf2L2̕(JJi! bnuSa+lE"ˉbʈ[UBQ@a~~2V՗Tۅk(/kAXbjK+=8r-U4)Gu g3N_xfй%ZZ*x`N At"`[ށc FH$T-hyӛUH891U^%/[p~=)eJMRzI:ɂHJrk~1,9LO PAL%b糕@ |;Uuw#0!h_YԜ]mbZ&*bt[a[tc|74tԧ3B<:f`5am MV6 KR0u,\Ccni;s7,Kc~1nlq!"ƊgXBԊï k,Lz_:QQ0ə͍W|ħ6p&ٜ$2-]_4s",/Vg:%UvL ;|>% .ªp:& v&gDɉu_뾗rW8)+[o+P1ųeH;`p~ɐʒ1zlbس$ìRʗcd cae;p4\NaB45jˎʵ} ( =@3)Oݩ:! 5Bn6lǚw͛/W+HF\1oHO~ƃI&fNn[B[0,qUJ-R+~"Vl4x/bm"ogutр1&Mol@V"eY҅<̄"`)g WbOvǝ53Hq[3Zcp&Ikb*.$Wwօ],8Tϔ~ɧO :0^ZtU@7yg'l8?XN6Π;Zlzc; S{T 3Ra`W4 LA-}iiw(Ad$C܂R.C Er r@z]:rny^lF~Ϳ%F\k]8 d<)!6_ =mg`zh..4[T5}|;d<{$ ɭ߀M㴘~)v m}z:OZt/0 ~5;xT@?sLnBkQ)*@A}(0p\U*ٞLJQ'Ahc˙3Y9)Hyݚ5mrs}!d%J ^p]gª+C]]PSDiPDAd0[P-Ol@YC /]a=m22E S.ǝw94ضjM: GLyֱ2<'ƉyD2:_3XDtu{ M;Omv`~8 >ARm(F!2UY1nCЈY$3Vi~`sf1+;&'S@e_q%rgS@z6V@ Ѻ@H'QF.y1( xfM[d$ck -T^1NJqNv@E j=D*Ц\Tkl'xO\5M0h:v"p7u4 ¡&lGsHʶ<$d_3SIɸ՛Nxi4QD}u[bR;p7=MR-pEQ"0jgƳiO;#h٤mT>unϜZf[^ ݥ~+E}I_R7lI@MigfjJ<ވ{"?l+wuv`?-9^QsM]e!x4J6"~Ⱦ)M"F{]m?7bFQB㴄KOWyx9ʯRDy럩l`xL~AH˧ջC^J4zXg}}*epi4%u7 Km8L^CPwfc`=78A~p'qڶe)Sq:{HN1&E{5/U; nޔ<Ʈ`痰"?>}zR== c -A}j7ĄOY['U* B} lSSNA <\0Q??SVud f~ /Ml #u7i^S0}c}EVuzhY8b["t!b9RI};3 -S!#WV@$ݦ;ۂr\mgJvG̜ZPIIF^3:Lhj:sFj4>:"Hd _.#b#y)-ӘH6+)sNanS 1 3lBo,S\iLoHt w}WM;+[>Md c碷HdJˇN(=Tb=xiM\؜e96-6)ju:vB endstream endobj 69 0 obj << /Length1 1596 /Length2 8455 /Length3 0 /Length 9499 /Filter /FlateDecode >> stream xڍT-Z-)B)`R(NkGg̽{+k%ٟ&-].5pquܼXLLz`_f,& +@py[<ƩC!UWOXOD+@(L osT3sylV+6#-\@,P+0JJڹ8𸻻s[8:sCalw@  4,A2bفBm\-` l8?fBA0cs@ 3XN_q]߅?-N0`v4ո]. @ gc1[Gs\).8eqq}>y0 d8v?ouxlk$]x!7 BMXlA.!^^^1A ]^  `H=`y9[.0W׿`+% d'~|x=>Le 8xkkqo߳gP8K@/|SPbIqv*X6wЀ>J`G/yxGW)mv+Qɮ.[} du5*.:=F"X)cy0u~k\|{7+p[*@ֿ_H`Yx`>ʋ_H pC.)Gz>( x~@"(?Go$iz=/u8x<\迠 7| r8 '<6s >"OO{|Bx@ 8 k~j%& Hε5*5Ŵe5kwCOf \]?,m(.yhCkIn}*Agbkno`m/-& o{fU7xZW=JޒЙ-Jط%\1/,R'`zJ>U\NJ>asKC wb4&JILҢXĐ&uW9itL?h: `muzؑ&Chsj locȿZZ&o3Wmn_ͬq[c\LzNm;Ye@:G)vZs9jh]/ĚQb&g6 ka2͖Qu}DXY+IS=.)lmĕLi|M\Qؚjx=khaӑO\%q4dkƫN Qu܋=oaGX/Q\ \5Y*GJv=Qށ^HDgPdPܥ e#Lzni/@נ '_CSk^Y/??IG9)7!B}ȁ)XA4bJvѾcl!H3jtoأ;C6$YrN4  2zt!mpß<2~qgF%ѳ.J6FtӚ*ɧTՖ֞K[ת2׋.hWIyGpsJ,7q^N63vc1`;cZұext2œ #O+j'8]RE>h1e"L޿砊pa!^SA˷bDxBo[p<Ԕ~}z^ $LmG!C̈́fc9ZܹY8#(**G`{iGgg̶K̷r|eAԓĔ% &K݆~;k™RW_,j+!>st[y!mC5;Ö=V$V?[0BQNe 1s?o[K1q| K jQ  }qaɖ^B_TB@_C|-"7I^HMXL3rJn%ٺ}FsU2+\,η째1J4ޯ{g$NwӅX,v[KKF}?R?OGoЦf߄x2[EKD$fSFv`&G52QÄJ3⩁f qyS9͂Nsux.7?^XpڰB1ٖ7L蹍ޑꑰ$+-RlI{VJ~eFTeVOSh3[4#KAe[NxA8/Qiz^:2!I뵏Wa\Ce!L2TڢgJmօhMKCPf;$sN4(&^cs~ד9>Z}Q}=ϰlTT)`Sl]*^3RcUʤ?[^2$RyKO+oʺļ1 ^sR!/gb3:sKCt(V>_G.$HI1M"HYvH8{%LzʒBc\`ܞ]iv7׋.V}*8*}`d@Nc"ڱj䘛{Z'sIvGs3uJ?bp'$ #<^!|](:{k\ uܨ83;wɋ7xUSx^$ҁ bcQԾJ^a\_Dߟ:_U!C^Wqm&c#Q2nMxVf)A:_'y0rW9v|Ȍ汬xgzw|V;^u@ݘ*]zmY[T;5:KTjS:n[kvlķ~ǹhb۹sTU7%f.)>vBorBNFtaBʵ1BZ P  OCz[\ &[)Pqj9n5Pύ*9gͬD *pܑS/A~M!j3{T*]KփtK.D|q߬ 2im\"Mzot]˩{a$nͥ>vmVUxk4){b1א)|!Bׯx~M5`a%U_yx>ڳ15GMN伤#QU"„"&jO, lUid_t Fd+,! GPJq|]2sHUulyv|b@#)iti8#RM-%lbw/yH*-R07oO6 :rd(fHpS߉p3TN]=S!lcb="ɝp38l= _  ې\n-D G ǫta`n2Cp3q50 ɽ n 3~m&}>-p1%,d1db?|W*IxNۥ)E&%Fn+$u`hfE<,d+Uu-hͨML(M/`DA3a^AQ,3LG/zb.jkn&! B՞zwVX[|IsB9 <8-3h-EgE'Yf>TOepcn}S}_LPt1GM$ƌދ& i EhmDjx诩 *"R.D|N[2 W7WB#r(`?b{= 5BTV(n5$|}#0Sqm[>":B "s8kh3yJ0# J6 (^ - 9~۬%g:nͩ$1-Ғ ]zſ?mwNB {OT$2ZrΫmӒpr0#Ġ8.3!?Wzvk><*ZԑiYQ71 V{6 ʎ8I7כdW(kD?ՐMAviSٳ|g ,Od5&91"X(u ؿ:l _}{ӓRU@rQs] (xܓwr [ĥ\iWxTm%vxm) b&+C|yo~yoZؼ/ (\rM 4T}fKV:kSi6kb.mo'!#$W>dzhz꩙ZՁNy^,pCRD/?%]f4细WTisAU(~TGK>Vu|T{'ƙ\vƭXNty88WLD6Ό0h(8,XߐVZ+RީZvMǴNfc}xA*/' Գ$q CeU2>>bQ,ya i44(ݨc$+uG/⠝sy>-5b|ʹ@ #{rU\NG&j('"Bgͼ:AnZlJL56Lq.~q[6m@{<"zzWc5O IwP^WG#gzYʡ9^ǮDtKp*{u}Ŗ:5os[eˑ{4hicGBmh3,؅OR{.'9Y?|b[8/ʆO 82b{rE7O>>DRY}ea9f#: 5ڨTw wSIuF.hJ7޽9ݶ'ג'ж[w IM]3~Ng F$qF$JtHrܭv Xg. MU%!CHUZs[=1>C"Xewτ+;UCH$S52UФ}u}O h:s7=`F1kξn R#6r67,D刺쯜SCr,b>jUfҪmǪW2tHV AzYte9#sW9s;1 :0f&V%'pzKCQ;H'  }W&~\uJK5M"UK>eXOL&E(?(ѨrO"du_z1 $ hl'9tsFޟ##8V6U|^)aug?jë^PЫD6< 1pxݏ4F_Cӓ{F& X$dZn))lSc f(Wdp>m2bOSu<|G>OhUj:w  d¥L'WV熕fάf_l"ֳNdǿ/6i$ZSHd>.X/7u`⋢HljҮ ̉_S5"  H@S!8EU%8֜쯷GpcP,+J}Q{$80εa$~(F]=!_gN€43.r=#uOrL&!wwF&`]2*t=ư"roHA7T[/S'n&312> z6nep^еĥ~Jh b'=e!JY Ǟ|ƅ(vSZ{6zw.|ʝ3'u˻'wcKGwD]~r> bm+SDcrG[@0msV&oX kwQR aW(y{EKYyL` OH@SeC (%@yK3mB;tFz;R >gQ깗pq~$؆T/^c%׊;Nn%xr/"NqO) znⳣ$JPtyN>>H(ȥ{e!S}h֭>wѰw]_̣ۃn*( q<݃#qOdo}-ĔVC*JQZ݄iUW잋bi/?Ow^w~ny3zħ$)+!+߷ɾwѯ|>?7WU*xA I WD"J_))emy<*Y2T#n;'Yd ,CscdxuqRy$PS'5urP/CFqԇ32R\VH|V3T}eU`]s K tݳ隆yf3,_re o#r8UӘE7gÚ$PP~g:Y~hRqyj?' ŒلϞ;s?$s V{zL?u,=<47f*NOb$x:G^Rlw ǿ`Nam9#Zu>_u ݽjOոm-3dI9,I5LWh:-}reωT8Xd5_o;{Nd-/wo]sނ&p|ɧN=a"sFř$ A#wx/$J~6fuU./x8MK(ժ_:Huʠ &~{¢UFO3g7  غD*r pc~+u'O tV q3rVpnRm7 LmLd5b h$VMބ\:QH/<ƿѮ niZ~+ 0A-a r0rѱQǸk|Q^IŖXc>Sd ~!"kCWjkŌ[ԝs{?r˼0s=L- @D-ܜ"hDة]_57 ?w-c%4k*GسE=3۞Dd$.(4/30 Չ,eI7\LsY`X* ,hOd?=%߸ fQ>nNmpIMM}凋r$@&* ]Nua5)_ i3'7 WW e %iA>BH$Hdeb㑬Dk `T%])["Rҋg;NGwΨF)Ьkxyqg^ 1}>Cn;T¢4dsȶ{oqro,Kh +>X]H /(NQ+ޔ+py(u ~좞(ttb4@ujJw endstream endobj 71 0 obj << /Length1 1678 /Length2 9784 /Length3 0 /Length 10856 /Filter /FlateDecode >> stream xڍP-nA5 4ָkpw \Kn nᑙ3sUUWѽ}{DIA(ub`adʫpY((@N@Gؖ_@cWk< l `a|aaf23s'3v2`[#(dnZ??&4nnN?6@-@hZ 6ɎՕƑ`.@Cp9YT@)` Oe5 vUjm_3mMUi9`? olH661ۺlf k @QB͉`lk;ob 6ɍWs4q992:KdMzⶦ`#&ggl3ovL {g_!&l@'333'7hX0Wsdm~Uiz̀_.@3ߎF,,S#dh'~m :{,ߟ鿎)?$H}""`7'dx71诳1C(mkp)#審kch]A:@?lyH,I8[[qۀ xdg׭jdy)NƯ!lkn5%@n@S%ş#.[lJ`G?}3z}O_{ N]Rl{X9>_Nj򺠦@?&h vzM~wIO `qA^o `2q>^YLF,|e5d0 /Jl/lda0  d09 q|d}ev|ev8;8>Jkgx@7 <؄7Ȳ6ZߕawbW3sѡ.*3`F8ime[Zhk=\hKrדan+7#~· jB{^^V_!;e(r흹P1\$˖Bw>">M3DGR}̚%ub 8wCș|!C>f+`t?Z؅GK}16E)r,ݳs$Z3(kLq8‚ _l7F0}tCM>rO3X[ҭF8hsu7|"3U <ܱ5;,j Xozg7Յs|p^mtmu$ɥ\7Ji{)F?Z0yQl%'5J䥠6vOH'\DUkmz[sgIa#c]{V>3 { ܅c%Pnk^кmYL6J&!eq͟kiN}y&b| ~[ S՗mZ?l W#8o8f@ZBl}AjT­_=]Ē)i߹_/fCa8~*qp%}^h󚪶́%7q՘ī.|rX! ([Ɵq_{2Ym[5C_ڕ)>?#=J+W/<#$nG"Q]00|"Meޯ~jˎ{ :N$\|Ίj|-njv5'6n܂mCJ+"~`ݵkȂކo_JfD~tU? GWD)\ EZniR<̨/4fɶަS1"KuAms1,y TBbxrSLVV. )6 ^U6\u8#[hCm;5" Dg̫$Ėq!$47'},nulN36;=ySxIqbԲ #Q)!| EDK5*iѥnyL-ݑqs7(qEíI%Śj=k~N$?f',h駞Q,9}M(-O8-fBWR՜Ú:d{.Ջ b|pJ瓺K[7v+.e+sǚmof*pP݃3*|GF艂J Oz$xnU9旤*bO0p~̲b!jiuKAF/WRv`92}A,CZ}JLYZsmkPripLۈ`L<;2UXt-YNE/uHi%7jw\LZ#jx8UD\Xo}4G4"k-bßݝLb5݃ma"LeGУ ͳ_>c;Q/dTzM(Kvq2հМRag6PùZdu>.Jκ(RBklo<}>Dvk&.kHج? >``\c-Ҭ,RP/\c)QJY-0緮W]tmԎǎV֜u}2 XA,r>Fr2z`QKYU 9+#ja tc?g$@If@TG RNKɰZ#HoFy!UKpXcKC4@px^[w3c&jSk+/ҕmJ-wS}UfwtHzXZ;0ir(e*}fgCVy~MJY_roߩZN 2UjN\oA$vov:aZj;+!,0\J(ns̺Srt#ME9! !ߠa-_\)" m#-Rny'ŷH%J9 Gb3q~w/Ee^rFOt Tb[TJu,< :QHX][u9ċɡRga*ABCF9{W5qqF9$6i໦0PKyUzN?1 (%S]kS]JEڬQFb?̔fe|-,|^iwZ%dS6@\ @oC5/'tpNt3<㓓loP l4$~WqZwš&0_*aRT qDŽwմ\s-y##54^RQҴΔkX`WOiTζœԘ2Ǚr j^^_RQcm:,Hpn&'xzh<Pʷ ߜ  fwhѿ  }Ǥ!տPJ D;Qt]_~Cn~JoGMou4Q>!6Z#XS7 䋎{Zz5"e@g%Pa\,W=V;P{LܓN"4lK&4TZS[_7jԦ5&!b~T[Ha8W %S _7| #L%69՜G>jDlG,G#+53&VJa[$r*f}BW%AGxJ,w9W@`қxe(,u7 lOH)YGԀ / aGҐdWsr*LC,W΂z3bַUm\Q',OJ)},}M:w h9t R$q@a5 0OVHr)O{ŸrFod\Ob]usn_?z0 쐻GE`ioXKB 姥lYDFvj| ԝSW.SvkAH{"q,5?:tY(鐀_]@V2eU y:8+]#m6uƪzұtbBNQ)OE&uٶ pÙV]O%QgG$<ԑI@HiOW]F "6gD Q@z 84#}6G^k<ܨZQHȖ&ۇd6kxD+qo>>uZ1fxHC0';x4$=-G0k+zַޅmؓ8@GP gӖV{XYKwNmDHsE RvTs^I{Ue=RW2F:ŶxH];g%]mխ-BwvLNO4=|~1xR!x&4;at9bׯ}mTﺉ+%K-7ߗQD QA{?!"1z9)0{Wd|v D ]4ctZe4/Q5)HM1P˘i@4 M~]Nr*GЇoʰN.e Κ' p{đxO70GWY_SئuV,(H{咻Lct~&rR݋3eSV{0iaz%Vv}{ETE M) );jLێnUѬK |vwY #{&XSVCjlNk' Iy` *Ku*0Z 8ɮ'Q~wd|x->~X?O;`,=}G"er)C~rWz=pJnѢe t>˙f-?(Kz^z;q [ xAql!NZ`xz XJnL.'ԃ9Vy*~k8P~9D1aK~ I1d'L9sw78T"˧xyғghUL{ܟ6թBdS qt=aBrv= U{AGCڣS\:fqT[DsaO!|*f$RB'2}70E˿gˆB8 9/G i )q _ɍ9-O3)bƀxIcu/Qg_pdoe L5G=S j.þ蠯BPBl!q#٨Fx 1E+jF'@۫>l4 >8 \m`-=}6.hm3d*6g{zcIʳug]Ɏg/͜&C6]w3Q-]hۏR)X7(uR=οj;IN7`o1Jc,I,!Lح{TgkQlN C۾HF O$8:?1i33 C})zs|wn{v72GlA%*d*A۸}R ݽW^?1zB>uԼg˜[$TQ<ę.R2Qj,u @Ɉ)C s0{f<+ Z ؾa+^F< TŸBc⁐\aIv!ʾ#!$[M1 :O>^hspcxfo w[T icR X"v<##DNiqjܱY+Zj(,xS.7޾%XAh 嵮bv47-'kE%HR'S)&:FpsS(aj(,Gz@T53{=)wNД7tp!T+j4iW#-1BdViI ̤A.+asӂ B8]8D|5ƻQt^mG=QB!EٰTw;OʝJs{ɸw51hп/S;v_Ql朗290KN sҸYU7nz oabUR~޲H2 W1^J9DXlD|rLGA{.&SѨ4]^",t*Lx UMr&j  Vragk6 EdPtGaCKw5QSNK“XpwhX8W4fBWHJȆ9z ;y2.j}yGi]ʢ_kJwh{7vUІi5DԻOQ;+v=MTPt[/'Ps*"[R9OA0lIU4R}$SKH x ( hU$'˭{'Óz$k.S&dd1.ʿ![%^ҋUج {K*gTEoLt+U8n1jjYH˴V)|Ӟj^GM{nry\StT'Y4{䴽h.n?Ƌ84~H|Fb+Dhd 8> *P46_vLwD~6LLA狳K&3xgnn)'Z,xT ,^ ,s"WDOqpۣˍV㍦~fXJ#>}dƄz`>OLY83jN"\IP?7.>4;oZS˾1Yr"ZvdzL_2ˎpцSV"}Ai^:˼ӗq'ucٲ LaT¬-wwbw9, Vb})N^zjG;m~Î#s'/)If\#OKpu<|k7(Nf; y[tc /5@B[㐑致){U/D.߲<9Ʋ=.N *ӞCmq&Y;kxäKAp= VrZHM}iR!Yh]dߟ['f&hRYWW`E5(y!iP-+cjZ މ6RC+2g I𼑂[xx:^jC89Jl~ C=2aTD=- Ưw ʯZD*?~P9 $)-&`ǩi:Ygcg]TxPWBl[P9]f="li>t-(PV1u4 sE1B tӣ i%8ڕ\2hd`k ?Af`` }|,G ^)g&ڌhYj@t:n.6h-1Dv{2{(|_LkM2?"`rw*K•[ޜnx">= ! :E,B`wY4;M wf!%AB\7Yl(w yk6Ch6lE)4 )KY;~1I/ϟ}yFafxA:±{a\#?V}s=S#XaV*qV; Ď@y?阫#6 zV'Qr _ ZPY/sܫ>ݙ 9*Z]0ܙaimeEa"!2\>^ ƒݚYc(!p,QEZyKDU']I6:XK2 #Ml\8wGDbWi/[RaJ sPmoa4rT )2xfCJ+#@/D0l2bTPNltZA+w h:4MhzG0*ZŪWoM0eGLW˼j_|CZpCv!ES(PÀlrDNE6vVxV$ټTpUԮ|X>6_eȶ[WǽLǐ(=oC ndwb߮p)<1d~OiR*8y]XVc"PrX=>g3󲆲ܭE+{"6 Z!ӄ4}\"\l{-SZK38ChRZs,ݡYxdE̬KI0z <DVT]J;#e]icη0l> stream xڍVTۦ$F2 iݝRc  J Ҋ RJ4W}|yB$i9 e DcjP?3P_ F}|h@ (BdeeD~p EX78_a86_ܰX/9_ Cc\E Hobb>)x'G|Qp _h4#@!b@N`h@]p6+B=}| u>8l Axa}|~/Y嬊F"(8 끠m@Q?./ ξ^ sg `,`n_f^N/3!8/Op_b|!0, @AǛ. xA_+;(7dfn,.t'*.!qq ~olQ.hw ?5!]1(mR`MPy4|=={~Dxǫ}4~.Pj c_zPd(\=D"l_={"Pp#g( Ç5So?J.͜4@wR@?ߺPh,>tAcaѿ|1n<_ߓ a 4]o+EWGV, 0;4di/"1i}tp ɢSNOMFVW=P5SZ > n lAcxߥP]6>jbx.ic|yNOYIB c 9C\:€8f>m6, GTu?J l}b%>iN,Q D$xK|muf+e}?JD3b:H /"յS~NmgCmw3׏//Idž\cOܟRcM2֠B^eC澆(mI1*PuR8ؗcg%13}b^#V:Jn{bHʪb}1)(Ńq˘\mlE<:WؼK%2PS (Րށ}N]vE$o'rjGpT"5J j%1տ;xfDeRre2 \3ٱ-]\Mr]~L[}QY$ic}jLQ *6.T% E#Gs!=dG3OCF&gV_^^xhS-ϐ2n1Hн4fl&f^G-lҴt{R9V$ӄ_b{ƵGEؑ N[3zfw!?u}||lSrT ´U$ %}H/i[3 ַ=rեI8q.L"'@¬I a/~ohs2?-:es+LvnHD\Bu4U8*@7")"Zf\dV nOZ4/<@}kȻу+IB7"DŽ8a㳚n~mNhUn/TDex'q,~:^A$?fcN@r_7T?Qpʳm׹Q$el7I/ >1 d_eΚ?K}^ eaI5dz ZMü]u]-*14ko:M9&Ӳ]<9.v[Nk)ÅּN'e|ZurJ),_Fs]e"y0$O)mY^)٪'!bIa(V4s7]< o320\$}Jmj0Ps9-urnELmtf ^=AGKG*˜1$LvĽv?@fµ8_V=ad3!8o K{Rg,օn(ez"/tfM7WemZL""zyTstn#\KumDxDZ/A/$ƂGFuIӱ)W$N B_kˊW?lZspYٕDCbp1b&HIFU&O ]qkꢭ:Ak5pNzv+pmEp C2^֙n=.KƎh?bQm&짌 }fb<|]k-b^-f ? 8[p2̘M~[1e+iԮ9 CJQm qcZoؑ ^-%&W!m@emɚU2 <AWYt1jZ /H|>!B>s7;ˬ~lama&Vm~%3^`[eyxroa=M1!O{zf^=otXc`sO S,ˍ˳scmdGqD&նq~A:[*UܿO)%3=nе4 Cbo? 1 N+ XpI~qZ'e4 ^,g5K6p4FnmG9t_eeO?xqoerXHq~0U|~m ܍7ƒ˳QiGS_d6UYy?ӆV?7JQeۆwMUOrʤsl2IiK=ĂPC<̒E;]l۩a2}b`ZF'Eks@ J&ʂ4wrTt.[#*bf6'xٍpg`D}Zu'F)&y}̣ ǻYL#R'{1Bǯnq 6 dbg/)(|mf[HTAfQ+鋥b>&1ʹY[~%\IsSv[ ~m7#q,܏7c?`s,ZȃըN8>B Gՠn3Wvxm nUV֔VQ1\1]/">u(ʠRn&l*j6CHץQ=1 8HslVZ )$|><pzUdj@j=v190ٿk^2uU|(9$D_i&Wo:WXΤG8X+ꗩzS ;ʻN5)!KazkyOQt;K@9wr}BO1O|E(pcTUP>ww\GPUeAӷˡ?؅q.̀4$Sַ_s\c08X2seLW\-rXr4,&zCd9$9pƠɼg5yjʹڭU4OJ`p6I. 5.l;jTtYB!e'*z o$Jљ}{$霿Ns?MYg2$ŭ FT&g}Vq+3Hx){wg<|>L6%å)^I>OXXUwժ%m`6Fjb(K>+,vU*Q[S}>%gji@т\[؀Rhx0!Y.67wS 79v.&:͆ W\ia.`W[7QFN۾1?Tjћk{REi燧1a1]홗7]E GU,0kX3 y鄘^-:Q%}Π>T9$5Bz*F#,IT]]V-% 'H~z րw =+^]-Jy|oI.;щ\B ygkrUQr1]pttd`)y\Zd4JJƛv31;Wb^#5~92S$XvJ\)w 9KH]f,Sdߝ{@D5Nȏm1SǶW;HJtj5ufLrSzm=Vd- Gl71>/{)+}ci+}4yp&/{]CcXWvmoIXjȿԒ'5*AMȴ ~ؤ8 ^N̟M,O> iӈ]aU]i /gTB%2Nc5oszWsӏ5*3JTpAa sdObj4 sAȵ{ /&.S ϵa%:<ry,}R I*t%K!*S"[n{z._y)X fG endstream endobj 75 0 obj << /Length1 1791 /Length2 10598 /Length3 0 /Length 11732 /Filter /FlateDecode >> stream xڍT.[q[qww $CqP)RܽxB)nmbә;3Zﭬow'Ԛ:RK< eȨipqrpqCA?h@W7{X_zWY&k}6S 7/[@[P %C0@Pnh2goW{[;sLVn!!A)'f:=gt V@`B99===9,8 lO{@tZ Pp&ƁFеwSzZstT@ƪ7#=m؃ yU `yYX>. /x;7+W{g=yd9 Q+ֽ9 y[AݙSlTYsqq q.u:C664_7  77 ڃ,;j0z Vhˋ+7 o:KyN3.vb!2e^In1]JP=hkBhqwo=ہyhxT*9߃~#|l2}K,B_ ^C_&wT+?ŚX, A)PXN/򦟨XxK|6xo|VБS_M2JS~[^:@5 :`U)0 1'8!p"58,CH"?}Zl:r>CY7,6|[i!\db]y2v5k#)}J'PIvft,ұ[mĖԷLBg4}Dq 5^UO.Fu^q'n#WNb:IN5VaD9!.j*Ǚf^& Txp}A8gJPxy aj75u[&-@<3aHDёzBe=w&<SvY_,㏫chv9{=Sӏc6<ѭgWQA^Gz0]N]%VcMt­Hڕarz8 S8y[8L_1ONY#r/ƼNjE{C4L=c*>S짶-;wd38w`e0%>SF=?ň^rdD@2({Q4*P擡?P g&(kD7XY"e2S!gG!>ۄDtTpYӫZ׷,Fρޝ yGAT¨}+$=5g'>& ZyȔO;ۊa1{֗^/ɲIoa?f`d  +E)HhU*N~:ޜ͉>gOgcˍ&MMt>u/hk! SE2ч|[>*@ZY_xjj< e7*#,rw5V 9a.gZ!2e{R;odC2\(AljPrZ-4C,Qmih-p?5D^IWq#A<<*#;GŮŞ7JxBT KۃYŲU2F>ұ)7Z~ s-V s|NSƟ{ߎMY@R0F9z8Ugs SK _VѦ`VI]kd9̛z$H~SnP'0Sʸɶn+*d7ў֍wmhjyG?}`e@p1pޤU.lD ]J}E_,T=pLzZuFߙ\#I zi i'l8ay0FpJ ~iXz9S`2s3IPL@,'"N QRpf@2">~1[b}`N~ ky4˝gԣ=ybF?CF徶zWz!2NŸҰ8e^.w…[O&ac#&U$dg>.P$Lr9 L6>QۦYM (p-ڀ&Ʉp7D#ǯÍZ .CfmìP8 .t2ҙeUqgO),)lz`pE4|( 7$ս|L $n 8xnR˼~ܽ?qey~i!ЂC7r`c>GgG1vٱ8(EJ ßnN{=[ o'ZݷR?c^Q_$ö 3bOɓmwJ-:^9*wJrhTN_)8r4"ť4?"f#F*߫/'!0u=e[|c pf] ոkuk-O۔^ 0PMMTc;U9.M0u T2Ɗ0ya#5A+R:p5/Ebjd 1o"JIN^ps_>&}2BU'OY|ZdؑU:j[{{$HIm3EZn[estZVTǻRo^{بWS'E'~}zW1ׅW_ eufwmN?[|2=םZO$Ab%:̟\RA_73o٫}š+S8)Ob .Z|R}7̀':Py@I/l026r`_#f!7t|,y> +]D7Fs"O[]$"ͩ|X[(M#+*?_~ݷm8s0 JŻW<Ćz$׊iH:~ԂWF A*B|ur)/@;W_o0l: GY9"ӊ#u,r|fsZQ`V.ӏk"S&: 9/hwΏe+c۳?yQGp9sTP~gjXݺF.KIHxi ;s.Nٲ!ދ$\TWЀz- )$HM8Anݶ^t>XVܒЯ6sAq 4c@_FkG`ѣ$c1kw:$s'¡o(.zޓh<($ MP_bS +}=X+Ud'D A|9[|o^xM1➼ZM "|Bsxۆ zO:uB 򱴧zӛ]}7@u5hYG _ ͸=p#EFD*?MF is|gʖ-H\Q1.Q ZfMY\ jw%{ia} ;h=;ˡm(a7s&ߖJ +ֱyٌ]r]hKfä?4zZ t`(OB]<~]\KkdpzыJоMx1j<-VQ9X-D}NiT_NkGI#mu o&֍}u b,VO١+|M؄&Οu%G^}p?qDaFʭrBцx9n Aj)P ,MX;nRn+E},Ě $lKy*&۞B4RgoQP8^tg ˯{ݕfjMVp+K`B`-n'NjeKWSmnڌH_phM,{=PT:j=,M9>9ha:f~DlG(䡀9xX^v~$fZj),Q1G1DqXcR ]M=]y-Fi3;)%A"uۡT*GKᐢʒ!˙֛.Y6tKmW`3Z ШKtA>U|o ;'q iv״k? (ިǓ.zM~Veu=8ʲD6Jby¾&fn+h3Yj-%jS:g~uWMׂ7 K'V$SOMK|{=\(GI0gɎ[y@ IӘGjIK1&C>2w/Ia?澑rwyb/ ^,Kt "UUu ;|sA;*jFHr,4]g  ꛞYaMl݂HpVW@` vRg:|:%HQf+Ķ֘Rvѝ&.걐$m_`G؅_]̂ KG*Qps$fv[ Nhm]]^r=\H@_h5e⽨k Qu;f nqU\<a MXnNdFXĘXV7ScW\ؒLAx_D/_?e+}E>%2Omvjņ1FZ*Wu*S')9PBjtV'o+i""8JkT+/dV{F4_ux%J'_-Sg>4Wc e,1 .vu$ec_ȿeX@<6Y bwJ[ٖؔt.R#yQ+dBkL *\GQ[.x+&M?=KX0? ~ ԫJGGzv4X,{D7 Qb\ 9$pz}㒡tvW'/jPQ3a,eܟքpXdmN76R S#չ%69pI:+f>C`TT*yY ߦH:3x?`9Ӛ˫FSXbvv @׊ WqYhSm33XpXZ=9{ӕ벒 (x@imu8J˛7mM-ޅJ]h|ٙDR&{drt_Na:v]:xUuY{AB/C;6+Kͺc~P&o  HE &%sa@/6b1U:CbNO+r2ZzoR8[HbI0]06+RN $j{F& /yUbW1& Տ;_)|2Yu/ىܦTKtyIVzϑL=Wi-h|89^jf!t(O怒D{ /:,w=juh(dA?ci [p[dE,yu'kNhz\4"i&.Z/I=n=E+a[iiИ87}]V85E&d2UqyRbt>@'x3!KIBM"m=g'E7>Oxm7A)Y /Y?/ErSn3?03xX0U)t?hɇ 4 Pk*~Y~m:f3z~85#l񉣪X&4k ZEx(M~R8ؾ*lj)dM iPGXSK"y WTe2q.I=.R6XHPk ,Y߿$&Yutm7>^wWKTĵew]f ,gx*;Z3usad"PefԯV7Eq@:c|!Y\6бf5`Z[덞2[I&j+][,kx}V[2ũ"<Z˜OX끳 [K>(FO e)|y-R'HTU7o'6`_`p8V}f_&7Hyx'TG=ORwwarbCN[󢹡XfJ?i rTBnܬ~T01 9P#n/ Ҭ rqG'X"0`%WR<1;B$`ҼT.S/STM|unCQDp"r-IP)'dݚ2þχl+NlV;vӇH^~6naMAf? "ZM̺b,2x]%4LE/^+f>Σ+]) ^uq y4f(z$3qAw{<7#ބfi|7q"bJNKuKЯ*08Z&8k*{tJПɓE}P0ٽOO4xçxEFt h$@61ĆRLOM;\YQW|ǂ(lDYͷs|Mv-q)LHB$s-ip~ ]ݠLx@9MY7+i^^i;j`wqؓ!D=.AoOLÀn(5{ 7WiG:cUCq8>q65XϚ ,RdCJ3ƖD%=gXO`.2WAi d%M!jV<<_nY6Ah!:z G`6F|I@1Jz)͌G ?Fdx% ʧS ZO`Rg q euT TJ7 =L^OgK5g >ᩢD_ciKF1$ů$ޏZ!UK?AI.&+Z@ђ_'O֠xS}LA:{r@)Ex^͡ {c3CX:! m0AU{o9:4Z]S.cAM0}̕ bR_!QU7 T=/ʉsIfȭZxnDk`MXwfd)ޡAΎ~Prݖb}9pltb1}Qi+"PMX5QB]rLT"j܆)veެ`ݜW3ȃFgBK70lk4qG:De0׉ BR-#4.!YC=@yji$Fw$ِ~"* B^7a`64Co/xtB܈d=dztJnj<_B,cO4(.nOu]pEZ׬d !-6(0vcOY>5ߠAy?y(80^l<@\+1b$l˽P# RmmN.^fK6;A ^CN>u R(R~g6Fݽ=x/Huྮz)rC>O/;Y6$OXG_q=< endstream endobj 77 0 obj << /Length1 1804 /Length2 9633 /Length3 0 /Length 10776 /Filter /FlateDecode >> stream xڍvuTz6!HP0tIww C "%% --9~w0{g~~kh4%`9( VV@ As`0] P'a] أN{BJ.00 d@k*@ v`:{Bl`d ` vX 1 a ,rt〺ڊ1*{C7+W3̍ K_a-d- ut;0~'q[=Nޛ_8A=|6'k_X;s:A\2Ut` >.{YqJ K؇3` b~``[XC`K- OG5o \!^cr~3}3k_T7ao sB{i/Oy dӉ?{A x`V\g.(B0 @0{$**N۪`k*@dt}/?S$ T#=T~K<Nߒ[p>>4:c@F?M r8WS7u` ʴG +S'P?t? 2͂n)_-9Qx"}~BdK>ŃCҦy)dj/l/PGIb ̆슨.9n 2.8caV^"1ljy3M [uyuV~VbM*7mxI1c,YEz^4 D!3 BvdZ!VϸQ'[oLޭHb՘V߯ǐYY/E<1'.f=]8Kj *Ѱq9HQ=yWe񥁺-b>үaГN~ a (A@,?3)%iJO+IN#S|: ƥu;l%sIM&w ;}QRG^ݴ )ߓ&ldĨsi*ʍUF z+gHA[48(/%ɨU9pL: Ɵ/{U_P$Xo4r+j୛'.>b23u!Q~ɐ$7ֵqQ$mu`i}+u^EAQIN*|[ɿMz/gmp 5_,-9[۞I(:T|hnt&6mbp\ǭnqE>=oƅ Q+iE3 H PlvR.4COF/KɠM8^j$trgrH mE7irUƟn[+roz!jHjbJfشdU] ĕ-uE#p;#Yɫpњ^p?!S1;/ /_}iXT_UEhm`rGle◛+k |=a*oV5 4lެ-)5!cehI5 LٸËrw)*Ub/eepG:n/KИs˟H@7?)"IՂ:}0*߇"PQBlX#o|uZʽ4nP/AYՏmbNz|$EٶNk> VVq_@k@A{0F[?"gIh2,p9-}DV$gpT7dTp UDQa|:&= RUIG1;_] 9 :,uL4bs5&4/ߎ̹VhޑU}%|p8E;GF$ko;೧Gm;&c4RYꃎ^G64af̖m0b7>Pՙe0 =cם5v  'Z[w'Y,:QNE>ZRK9Nbge9<UuKǧ8! *@HE{+XM]Dv5{xC=˻P0c8lҧdoVϙug1V( Ftڔ6ecMCOJli=c= W*+< O5vk~7hyU?>BIÒ7*7T6uYAFӶ.یljzֱvӦIҗ'4n_oY9DkfweW<1{8@UbU*zn&O>wt~Tf>.Cdkln?O])oXD{ jSurxaQ– 'ak n?6D*ND sb^[~F|;jqBe1_⧹ Ҵp1Fs1_:|aMV0hCc!!=ۙ0ZVJoK=[$OMSBs-ߨȲ,>˭leEΛ-\4 $pe-Z4RafFO%IBn~*Ǿ:5ȒJ2p¹ͲlǔyOf9$Op|Y}r3KsQ8-/`-јXu!0%DDr BAMb,KGS_uy#R)= >pWCim^ p`A{g5B-(BMVFB =uP7^qn *XLΆ|!V%֭+<ltO6d"鼶VCF-ߠ-f]`Wq=)')VQz0L|k[reTqOIW~sgweӇ[L1f "MKY6E,$p?Wl:7{3ծʟ}vi^w)xb)8dȩZYArFI=5b[ȳIU>5`}%nͳ:71SSK0OC<Z7jwſ~wauc'Q0^Nt }Ul"|$MУP!chEڎԺHXȕ xIݕAr7Ͻ*moCzbjMDb?<+ӝ7:鄢Go\J|4}%iGliJ)犫$lݬV‹6 b,~xA,~n&Eqx{k1H~<;uqj%y |ȌOu{@aq9w^ۊu8mᗮV+e O'#y~ ۯg 6RT܃fl9XZvi#E$pʟZo^a] @Y1iSQ&+wvMOr[$<<` pd;AB.n!cCX vn2f^ [Rc-^Syu[N歁Q&I_z'/s_G&Yax}}sx~H|[:88)vu0%.k[8oιJGSbn*M/5ԴV^zœGR)bJ=8ܮU?Pk)PBi~KntHvs pNm\X&9=ei-mFvf8 umȅbQ>ԒT=U\@`̮3) x΅6+>S^C Քu-z*$AI.j/ExAD嗝bn%1kOa(^[Bӡm:sě[ x5ߏnb)P9,U 2cNŘ[렓&M9%"Q|#ǕARu߅dB zcapwu*MdwyЇ{'쿄?7a#t%g"goq6JVS?mg0%k ܦ5NjwG+;ÃP, O /r1E<>/_ x$jcV>.H2'(2L)Y_Bcel}*BWPMB¢W0YǗ5 oy.+B4Rxi.Wo}zJh d{OǏAlMD%Bk^AII"ɆfQX{6Az1H*gq%* m^vu-'b*KÔd# f@2,5HB5ulU,̶1ɲH/<^Ƃ/~ntb<|<)g`xn@>[SΑammS$ZVr'M>#FIA5X1;~F?:%Nw_yZD{U1.Ţ!C{yvVe|"ۥک_cIVU!\lΉ8y=Tح5/r& $/d$:lnb$꓿ϰYMYa'wc\ľxihϱoR)u-";δ"\WQxպ;8Vy`xU4w'6h||>%跸bاQ<ɼ Sln_Fnб~K_VΝ "W*=\~LlGi'rcW8);{SJ鹲~pD00oBHXoRX|V280v<[1ٰrhI̾Wu; ے!ܤR/>!]M<^$^r Đm$(GAϺD LrZa(QUrѝ+®oJ,($voL=)8o><//q_vXP؄cnr㉔S--OT2*oTWІ3!܄f}LP]ƕJn7N!^uܖ)ajH#;5>Drc'wh`Hn TUB"•%N`kkdöabvHV7\WRy.oq?b!.Pə0> pZ\>,T`uMZZ4Fj Ux8APB}B*;ud>t唃؋=nC~?ρp*FB>Y¶ILFQu$S6p7 &Dcimpcw6Xc<r.1ufT4UAa+T!Oέb4gMz}}C殓 Ac.KKcTu^ZjOe oI>CgpIZfH=0\8fz6$T\XD;0NCq9/Uwf Ty4+Fps)K eS-_IQW*m Cy: ro ^/"PPIDM|oA %}ZHi +ٟCa $+V C隸$NpA-n]:'aOϜpDTd6PGaN<N*'6Y^jkjk-Ze}a 0.|~bJ5ވUoOR>8o1g:L9w9t:jr^¾c3,%eWpUlK[//) {6e4ȰSOE^ r Aiuvjbv@JG%O~Dd̜]ך]"?hZvы^?mؚi[<-iw\9 Mks泊*e;ؘ`rE7%o/ԐDIt͜J-kA\{o~}\_wϥ(R#*M+L+O]%3 _nBв]LSsmWO!<Ƚ ; .EFr6W~;9nnTcuJgv+* Ϟd#EiǬL}RӵA Yfc/ g?f2;ʛEQnL=ycV*"yeZntR}-k3gr o% $; ,`{Y8*m'R8ĽH(BC2T ਔ!q s&ݧF;[syΌ֬<&xu *;g*#ã{%3_<&G)99wAZYMюV8eB&S4tH4ә3 XIZ*CzG".^$oY@Kɸu^}S-!uz#04<{K, ZGC^aR[(ܺ6F3֥-&̅d11M¬xCo4Zn$zKg*8<"53!^ka-~}E>C7~f0ZW~b1j$!՜vdEa?s c[SC9pEBz=bA(`x.,VMir ՙz2ݧ.xǝ]J<$}D05,/u/𡕑EUօ_plhKKz^5ۨX3ښ-cN% < :@XZ0VfQݼ(<=i$g"b@Ƣ>2m?EAf(U&*Zi)7\?o[nVJ(ʺϋ~B2|$@iq1ǟHq4hfriq+ ޮǏ( >֋FKv`Jg2f$|Oi<{Tsib#J|]I&ZW&P3 ۥvLooGN/Q8+ tm~A h~NӲ$PNv,|J:~BBC6p+qдd'_z*f g,nR ]RyWKI8XpOG1 K~Mz#ПN?SĂḧͱ 3r / _m ?N pfs wl*YQ4͐\\ (hcPٻ̡G< qWEBM:%dKU Ȱ+3P2 _|Ywվ`''tZGXËFJtbM߄|FK2R9jts-[FNB3@hQtvTg]\JٮLnN vz.(6S%x4 ^RprԱw^*ʘPe*!S.f, TOe9q%Bl Nd^ab8*Q;07xA]ptn(>­kcNxi)e0Yx&sIy%f@t iן`û , O.n8Ƽ9a7sF#-}L'OS3{߸J/mRv.~0xQy ,f77ZX- RikõKR9稾C3i=ݹZozDf_H:|y݇ endstream endobj 79 0 obj << /Length1 1690 /Length2 10299 /Length3 0 /Length 11375 /Filter /FlateDecode >> stream xڍT.LI Ԁ 10CwwwJ#!%-!H7R4\q>׺wZ3RiL20 + PRYS Մ8ـh߂!0,$ 'P*89|@Nvv a@)  TAZI)f @>?܁` T9Ym2l03B [99 lYa" @WPvpSlQc5 *4`N 0I`1C\`SvP XOf_rr'_޿A8`v ;j ؀2JNnN@!rAl@Oʈb͑w6KC%a`#w}RS;(7@-~0wcӂBR<,N@vvv~.N v3b@hD ?<A.`3ߊF9 h @D-Owٟ֏OfڸcLj$ե% dpyx?T œZRx4\ T`O k g;.DjiFBe n`s5@`5#{d`gə{zS tQQj3}z<@_<<@O5@6V(hs)'MO dSi @A@Gz6A _)տSw@6A ?i٠O`{z6` I|p9 >OE:kfOx `7`qf&d]zIԕe{4vC J2CUf/.Mi %{æ:7-^w- ¾C^r42M{{hs_Ⱥ~ ~Sū~W:e_4Cg5KLBʈw=sk/gR! }So3zc\ӱDod^ѼgqalvVՑ^JvJxD6#4-l:h&v5vXL2=F;haL.(*;Hk=-6 +Rd?w; 3Jh=Ǐv4ʤ(8 ~mV%b fɠ?H$l{ވ^⭇+YMx<)^Yw=rDRjb _+&[dGCw/;Knq_Z2n9@ 66jE\G-m &J~{-Ž7{ 3j 9EC~E&-yLzbIahƴZ@c#vl#d݉^Mw- TEՄVkҏއxW<+D-@}%~{t1gj|?4,GY݉6:sVnftm%ѭL9Zdu~^gg.+V%dxVk|H]'DL_F˯"W=)Omez^gե.ͦr(|#_VUUÊ`YbTg y$\eX\H;Q~o'!Z$+{n/>3}֝>{;Uibjp(eCT]FEr?yGZ0FpF?u@Y CLI_aus+Ԯ=m)x_vWo"}ʉ GMrQ .Fv7 y&^RGK2݂u[x^;P,"*& qT{l U7 P@Q({ A<Ʉ)u vxZYoC[b5BCBa`u'`dG̵?k R!B]Pu}ɮove5Y;^J5sI ~‹k|£[C=E肵>=TaU*%oݗohZ :JׄIBE>y8uj= HV;s ,H쿌cmj{eZPΗv蜱:HYȚJ߱j Ø;Ј>J({X"`jiy oUoKyaW8y"G|ZGfݟQC*cQw =/>](ISqFfx\ÍtŦzX],ꈠv'y=yH5S|^}lP$?vgkZJ =_к9Pӷ3B_z6d7fЙ;֑P|7>葷Rh B"ѝ bPM#NRB 頀f{19uzx^}MTѓp&tU߇쳈Ӥ F_>JP#nX̩wNjq&jjMc+%= AY7Qޣc_[xzǻ{O [2f$r̛^n~Schx5*-adCȣB-~jDxmgMw{IY6M%rʎg[91j@֑8V(uƐs9DqRq^Rt6M^&[Eh=GႽCV 7RG,7A=GA.qbhh:x:v0bIbEpQ1944̟#֥96a(誸!|Axܞk~g8!#_44[.^йqRI5J[`g^Sз\hÍy(a!cVRt7I.QsY~|*4aoM Sr|m񹜆(sxH{wSzdO! a}mϨBWc6xI>c^FihA> =+M&f#8VfnAvzV;Jr!/RpMV'Jd9dOFJY_v3,.`@Y9~~+SUԶK;Lu(%ʳoS#JR~t*=;G6A(\n@9uoițN,/Mf 9umU–6>'cOJ#ytZSWZ* -shO#6RڙRŃ_pМ&葲Pgj0{Axt,O~f6W!*L9 ĮOա (EWuEۻ:ZKmv.jH7AX;v*.x?T ]MK4$%joB"Qw ]mꗮ J'4[){@g`xћ38 's:f=OM>mwNJ:3l8t&3gmuugQ4ɏ#&޲DC f ϾHyȷN/1c?Ⱥ'us(6i +eäN0uA`EL#?&4*/k¶M."Eu *c14q%5fg\{yh-\lh* Gvm7npM7a.g3XpeZh[*)F(!Z|Oʤ )jc;܇0ngngX 9h>(%}Sŕgy M?5 p*]>1e5p2fc.?9)6u\؋0ЃwgptE'F?V[-n ZiԯsoU!n(YrXpT$%Tq\} jE^τz孴u*%5kqA1ӯ8ރsӝfwU[e.Gˍ#s?CoGR&> 8 #4 p>F?Q:hB575#ae1—R@"A\Or/#B5@퐽voK06ьT3|:GҙH(/Y1"~3-V,`;ѵ\7f0,kTxu*/!Ћax gbH:6>hp)%ӭ 27+{JAOńSM-SMkl)ŀr8̭8N{r5CE&`W 8|v1,kq?˙@^A rsvZspsFw!|^vd3DiqVKb}D~& Jk_7kB^ʙ2 M ?Vٞ eN獄ol'+VqpU(_`+OSʌ4JDk4+ SFao&RYtki/fuI{98Bl߶Zf,GUH %Wb%BP@}7-_mp^nG Q,ƷF|k9o6ݗ Gxe*dOF~?`Cb&`L*VeD)H?q׺1si,"ͺun|a7Zݟ}0)L ExZ:)5֘"Cg!SnDMOґlf0\q*/50͝0Kzqbl_(f}gp|>Sf(V̇VV 7XU#HKMtR[{2݈/svM$ L wMVEMޱoOܞ -&3I,wsXǽ˺Ҡ#-Mb-?}<,BUSMu' Vwk8>xLq_l4!Z eGU}/R1Dwdi|ߥN8 `UƑάйңYA羼62Փf~l"gHr "C0(<`Ƞ 5Z$.dZcn,E\b2V"ťP=+FϯF~ taq-RVdn6}.ie>Tf B&;0l]w3N)82W"r|qB mz}q}z-b :/K_4ߙd=g$zFܛ5H#6'=g 6ddYBQ}U`4NXYRE0tsϮ-ivs{Ȋ Ou<%sN6f>j ;1_f>CҠ)-Z|m3NyK55AMDU]">ӗkSɳZ%g@:Գ:j}NwrDJg^gMsDUKUё"YdMֶ5!;Lb~ӷtFyTdMpb <[lq3]Q"V"zKKuˬO@h*>!DC_0 T#ũ6HVX9ҿ9?p|/Ygpl—ySF-Pz=?ZJqۉ}:O}|:ʷbkW]#[V{Զc𙆦d{q҆18tc mܾ˸F +dcg0۩| hT;:U-Jx!?[ALr36_筞"BG ԇKqUo_ǃN oxv*- c>.u!)G|[ˬ[1 ?CПsLm/1XF!9IJ@τsR .b2ʨEƅ?!Wol!dHLV\"-Xե"cb4zތ:EVvˋgf2%ɓ3{:-6e>I3^k>**pik/;006W(.3$zH,4QYr6ك5;)§W 1̶ |4/c/GG3rS5ehC"#&):k،if.frLdѠw 966=HB:MDrtZ4 :5-l h'm̊OoeNj~X/q{E$wOXw{zflUfҲU[^0y[\hD퇂pF}038Gxכֿ]E6ٗ;%n*ÄY?RMY ΋f$9Au넦 aU~W[%L٫`l}|#8qˁb qF4UtsZԸ \!rgjD#Fn-S6)Z^-n TӭiIV'6sG Ld&6-8,Iw>/dk@TU]BĵO7zKְʩV-UjI.~cj:QV8اэ)JAZHE#~ h|Ki^O5bfX6{5&=#q##&nي#ʹ'87BmʢfYBpdk Tc(gqz 5M1 *?_%$FYRV2MEf߽=؏WH~g33?צӄ sБ`+D;W!KYƹn9 endstream endobj 81 0 obj << /Length1 721 /Length2 4672 /Length3 0 /Length 5264 /Filter /FlateDecode >> stream xmrg4ju :ѣ D%.E13 3ѣN"D'щ5DF^7]Zz>쳟˥A!0HDT`n `P<V2`pb 2^ `@D!c ȹ*➋`+\7"=`tBTʹ @F`N6NH@ CqA- p'0h8oM8?Ю,Z-A t4x5â>_//u'!p$ A!dM m<?wt-w p f?wrCQ t1p 0YP_z9 $N醀#VB- ]O?ڏcN;z?<50 ⯽bP? \""X7Oa#i|žc4׻9$ #d |r o Y {igKX /(lok} (V{"B-XOΞuZjuӘ'OM{$ަ,}'OίmE3;1|KyzI!TB3`eda0$3;6/3?=KqrytnEGu2rHtn%MbԈpsڧ BJ ;`e`FX(8WD"Q/]*\ұaRƨoV@~CM…bԙe3'3'>]}TJT!{QyŦr؞{ } 2%.Evpz#J, Jc9u}-*;\pf4ѫ&wϯ,3o;!@ LGl** 7$WWpYQ5Ϛ5# o9-ͰEq?sHf =R=]q'b."_{88  8ixxs=e26R>-MԜy$l$Hr*ReK\w:(_``M:ǦBԲmhR@NP >ѝU%' 13atLjgt4O ")<u@VoYA38IG 4_?)o~[u.ᅬpLw$,ttQ[ \6Qb})Ŏ72K@w>T8~5,N乁c-Tlv#$I2<-fJLZ摳lru^Pd<=.m1MMf+km(=[3/71,(m}!\.·ڔe=D{ωM^ E2 !w/3+H6= M4A'Z,Dƞi*s\F. ONޜՍ 6 ۹,W!#%Xfo߷90 )!Us*@>i}ޟ|Gv-z C-d9Du1N,tA po%ǞMݩvIeʾ&Ĵ6flVk;;v^-YlM.#&l^D3 KYOhlu9ZM:IQtf\jwwŶLaG|-;+qm@٧ N4 8$ZTcg3-KVn*?CmY;S^cyס8'"R\R.E(/^,j&Ny[뙧}x0Q;>vdJKo7f>!ʏs5hr\TesnX͈S)lY,W%!%?b:I9;D>b60*/꘤p&8y\/+5D 8ǒܚsϩRXKIHdݢxN m& V}ih6{͎Q z|yń'<3reh;Xy3E ="A`.jbZ_+2f%vI^ف7Ҥz3q|Po_-g畈 eWGߚ&PJ/$/32pDqDwu&:`O#4) =lp7X\~\m+r-]hQ"eG>xTh "#Ud5i\*!' xAE@}oU4gnş5Y,tl:/IZo8io'"v){gdXߟ;ٺE+u7{</&Uiѝ*v|0l (kN1S#k>w?{Y9Ay|'?8*Yf dW(jP ]~:e!=0iټ౱]PEf-|ѝ6%~R)'ryhz`v,z5bphѵ1[$1ʪ{Jb~Կ s;_<9|9t*ʝX|Jy~>M۩^L(ݡ ֣KHڪzԴDjt³ޘy&m=t9+r[lS3΄QDgy+3f^x_hiޠdd357hm Oڻ;=F!}7;\+9n"jqK5T灁?"(l ,A]Dn,,fhaP)Feɻ3o52i@{;H8dg%lo VUÜ{#gZ#K 2f}{UZIݴzEW1M;7I^_w󱛍^1cŐ=!m endstream endobj 84 0 obj << /Producer (pdfTeX-1.40.13) /Creator (TeX) /CreationDate (D:20120713082104+02'00') /ModDate (D:20120713082104+02'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.4-1.40.13 (TeX Live 2012/Debian) kpathsea version 6.1.0) >> endobj 14 0 obj << /Type /ObjStm /N 60 /First 461 /Length 2451 /Filter /FlateDecode >> stream xZ[s~Wc\)3)W,$DI/zfD,,EUbK|tO/2L0͢g3"iXǔdVt0'SIǂL9Ula4s%h-Ԙ1&ZLP0X;<>*f4!ʖ:UL3CpxdȔYF)N|CLy =oY%A -@ߑY,b1ǷRBfioA0J\Th s>1a>K7ȱM`+V@hBF/5ր1P C# , Ob UAVֳg-~e\2K/[3l,vh>Slyj8-{Uq0.lmi U R&NjhO?%ʞ=cأTaP]Ed1V\ז'T"d=/gX(?b wat3)Y5p& z;.=g쿓b|Su|6Ϟ$`yPjKۖOje#j{nYzF⯊[CiC2TSƋrUݢŏQ׬\ RUCb|Vi>KMsSo|ʢY9(NO%/Yɻդ;J~[t'!?)1Sn[{TL)oG^y'ͻ0X6̇b2GO-Ht\t˫m_6Y_vs[ClWMUvjZaZ?"r>v{F YFo\[K; h y3]/%P6n^W3m򠗷H=ۥ$V6ȘැX\Ͻ)fuY!۾.sG/ CERmʆ4պm:P5-AYwN%zՎZrP׃YQ`mYK7rf3q h\ : 6XZkencLMvnw41Y1ȘJԒ{֥ummbl#\ 1DS H}N%CdaF{4TLdDT7K)RHG0#N,H%f=öqHc Hb$#$1JjwL`??=9KKrS.d"\l~YI+=)>͡(TrK8nVd5ZsTh&;ZخZE].s A"К2,G(3rti\:6pK˜HZv4#^˷N)R=>.Z$ލF{umOJFv}t#:! s4>J>o2x(Yx"$cƻ.):f+04K/噵íYʦQ @M.Z15S`YrBztL'՗}2#m]%*+C@閂fyV>2IPHc/S[g@JAg"iu2Z ()RXݮ7[d#mQW.61ܞNdn^36e1tO"afoF멼iwRKoN89=}):EywqZ*r8S'eտcHTRY1χ}dLO%goH\YF#a}pse|S8>czA9VMh |\NQ)''Lʒ>g*'5>T_=ITvdjb߇i=KܖKy0 67.^'~X*' kuX7#ImJ0XI={>x~>|9WID Iرqn>H?8Wu7: +W4ڦ׎5zr󓋋]>SԔ"D`H5qɐRj#{̃diC>Y+' HVmZj/9;<=ꀫLLTۉOli!vBa雓AM !MگxMĊ ^|0(׮ UԮpu׫ק5үd:&gpRRm՛Lon6tMWjN{#ܯbS kJ_FЭ6u=[tuG fS5R5=,vy=rmh24#+vQaC}z\|o8uA__Peop&MqkVp7):zU* ;:?Y)?GV%o3 endstream endobj 85 0 obj << /Type /XRef /Index [0 86] /Size 86 /W [1 3 1] /Root 83 0 R /Info 84 0 R /ID [<25150485F4F052527D7F99F5FC596117> <25150485F4F052527D7F99F5FC596117>] /Length 244 /Filter /FlateDecode >> stream x%ϻ/asN֥բ-,1XLf@bM6Xm,~.>ϛ$YIIVW))12Qw`j{Pص?bz!e: ~4}V,j? @! '՞ZUc/ CV5V!jF``&sLL T`˰b&qmպyf?X/"I#R.>F*?6HK4KkO i endstream endobj startxref 118638 %%EOF lhs/inst/doc/augmentLHS_Example.R0000644000175100001440000000545712752234771016432 0ustar hornikusers### R code from vignette source 'augmentLHS_Example.Rtex' ################################################### ### code chunk number 1: augmentLHS_Example.Rtex:20-67 ################################################### require(lhs) graph2DaugmentLHS1 <- function(sims, extras) { A <- randomLHS(sims, 2) B <- augmentLHS(A, extras) plot.default(A[,1], A[,2], type="n", ylim=c(0,1), xlim=c(0,1), xlab="x1", ylab="x2", xaxs="i", yaxs="i", main="" ) for(i in 1:length(A[,1])) { rect(floor(A[i,1]*sims)/sims, floor(A[i,2]*sims)/sims, ceiling(A[i,1]*sims)/sims, ceiling(A[i,2]*sims)/sims, col="grey") } points(A[,1], A[,2], pch=19, col="red") abline(v=(0:sims)/sims, h=(0:sims)/sims) return(list(A=A,B=B,sims=sims,extras=extras)) } graph2DaugmentLHS2 <- function(X) { A <- X$A B <- X$B sims <- X$sims extras <- X$extras plot.default(A[,1], A[,2], type="n", ylim=c(0,1), xlim=c(0,1), xlab="x1", ylab="x2", xaxs="i", yaxs="i", main="" ) N <- sims + extras for(i in 1:length(B[,1])) { rect(floor(B[i,1]*N)/N, floor(B[i,2]*N)/N, ceiling(B[i,1]*N)/N, ceiling(B[i,2]*N)/N, col="grey") } points(A[,1], A[,2], pch=19, col="red") points(B[((sims+1):(sims+extras)),1], B[((sims+1):(sims+extras)),2], pch=19, col="blue") abline(v=(0:N)/N, h=(0:N)/N) } #X <- graph2DaugmentLHS1(5,5) #graph2DaugmentLHS2(X) ################################################### ### code chunk number 2: augmentLHS_Example.Rtex:85-86 ################################################### A <- randomLHS(5,2) ################################################### ### code chunk number 3: augmentLHS_Example.Rtex:97-99 ################################################### set.seed(10) X <- graph2DaugmentLHS1(5, 5) ################################################### ### code chunk number 4: augmentLHS_Example.Rtex:110-111 ################################################### B <- augmentLHS(A, 5) ################################################### ### code chunk number 5: augmentLHS_Example.Rtex:120-121 ################################################### graph2DaugmentLHS2(X) ################################################### ### code chunk number 6: augmentLHS_Example.Rtex:158-160 ################################################### A <- randomLHS(7, 2) B <- augmentLHS(A, 3) ################################################### ### code chunk number 7: augmentLHS_Example.Rtex:167-169 ################################################### set.seed(12) X <- graph2DaugmentLHS1(7, 3) ################################################### ### code chunk number 8: augmentLHS_Example.Rtex:176-177 ################################################### graph2DaugmentLHS2(X) lhs/inst/unitTests/0000755000175100001440000000000012752234762014047 5ustar hornikuserslhs/inst/unitTests/runit_optAugmentLHS.r0000644000175100001440000000447512752234762020157 0ustar hornikusers################################################################################ # # Program Name: runit_optAugmentLHS.R # Purpose: To provide test functions for optAugmentLHS.R # Author: Rob Carnell # Date: June 2006 # # Required Functions: optAugmentLHS.R # Required Packages: RUnit # R version: 2.3.0 (>=2.0.0) # ################################################################################ test.optAugmentLHS <- function(){ a <- matrix(c( 0.6180257, 0.04072546, 0.4351729, 0.89893706, 0.1350518, 0.57555028, 0.7858432, 0.49711298, 0.9439103, 0.76395668, 0.1830144, 0.26001034 ), nrow=6, ncol=2, byrow=TRUE) b <- matrix(c( 0.1383291, 0.1783548, 0.87107438, 0.3419933, 0.4984879, 0.09815034, 0.9836697, 0.9921542, 0.57375508, 0.6827262, 0.0522494, 0.83049003, 0.5045188, 0.7365888, 0.20014368, 0.1971579, 0.5684597, 0.43593985 ), nrow=6, ncol=3, byrow=TRUE) checkException(optAugmentLHS(randomLHS(10, 4), NA), silent=TRUE) checkException(optAugmentLHS(randomLHS(10, 4), NaN), silent=TRUE) checkException(optAugmentLHS(randomLHS(10, 4), Inf), silent=TRUE) checkException(optAugmentLHS(randomLHS(10, 4), 2, NA), silent=TRUE) checkException(optAugmentLHS(randomLHS(10, 4), 2, NaN), silent=TRUE) checkException(optAugmentLHS(randomLHS(10, 4), 2, Inf), silent=TRUE) f <- function() { temp <- randomLHS(10, 4) temp[1][1] <- NA optAugmentLHS(temp, 5) } checkException(f(), silent=TRUE) f <- function() { temp <- randomLHS(10, 4) temp[1][1] <- 2 optAugmentLHS(temp, 5) } checkException(f(), silent=TRUE) f <- function() { set.seed(1976) optAugmentLHS(randomLHS(4, 2), 2) } checkTrue(checkLatinHypercube(f())) if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), a, tolerance=1E-7) } f <- function() { set.seed(1977) optAugmentLHS(randomLHS(3, 3), 3, 3) } checkTrue(checkLatinHypercube(f())) if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), b, tolerance=1E-7) } } lhs/inst/unitTests/runit_improvedLHS.r0000644000175100001440000000426712752234762017660 0ustar hornikusers################################################################################ # # Program Name: runit_ImprovedLHS.R # Purpose: To provide test functions for improvedLHS.R # Author: Rob Carnell # Date: June 2006 # # Required Functions: improvedLHS.R # Required Packages: RUnit # R version: 2.3.0 (>=2.0.0) # ################################################################################ test.improvedLHS <- function(){ a <- matrix(c( 0.07555028, 0.2306772, 0.49711298, 0.5012294, 0.52791861, 0.9600331, 0.92798023, 0.3731828 ), nrow=4, ncol=2, byrow=TRUE) b <- matrix(c( 0.2825281, 0.7544882, 0.0980865, 0.8011583, 0.2411404, 0.4773251, 0.5437211, 0.3497079, 0.8586682 ), nrow=3, ncol=3, byrow=TRUE) d <- c( 5, 10, 3, 8, 1, 9, 6, 7, 4, 2, 2, 6, 3, 1, 10, 4, 5, 8, 9, 7 ) checkException(improvedLHS(10.1, 2), silent=TRUE) checkException(improvedLHS(-1, 2), silent=TRUE) checkException(improvedLHS(10, 2.5), silent=TRUE) checkException(improvedLHS(10, -30), silent=TRUE) checkException(improvedLHS(10, 2, 4.3), silent=TRUE) checkException(improvedLHS(10, 2, -2), silent=TRUE) checkException(improvedLHS(NA, 2), silent=TRUE) checkException(improvedLHS(NaN, 2), silent=TRUE) checkException(improvedLHS(Inf, 2), silent=TRUE) checkException(improvedLHS(10, NA, 2), silent=TRUE) checkException(improvedLHS(10, NaN, 2), silent=TRUE) checkException(improvedLHS(10, Inf, 2), silent=TRUE) checkException(improvedLHS(10, 2, NA), silent=TRUE) checkException(improvedLHS(10, 2, NaN), silent=TRUE) checkException(improvedLHS(10, 2, Inf), silent=TRUE) f <- function() { set.seed(1976) improvedLHS(4, 2) } #checkEqualsNumeric(f(), a, tolerance=1E-7) checkTrue(checkLatinHypercube(f())) f <- function() { set.seed(1977) improvedLHS(3, 3, 5) } #checkEqualsNumeric(f(), b, tolerance=1E-7) checkTrue(checkLatinHypercube(f())) f <- function() { set.seed(1978) .C("improvedLHS_C", as.integer(10), as.integer(2), as.integer(3), integer(2*10))[[4]] } #checkEqualsNumeric(f(), d, tolerance=1E-7) } lhs/inst/unitTests/runit_geneticLHS.r0000644000175100001440000000644512752234762017451 0ustar hornikusers################################################################################ # # Program Name: runit_geneticLHS.R # Purpose: To provide test functions for geneticLHS.R # Author: Rob Carnell # Date: June 2006 # # Required Functions: geneticLHS.R # Required Packages: RUnit # R version: 2.3.0 (>=2.0.0) # ################################################################################ test.geneticLHS <- function(){ a <- matrix(c( 0.4137913, 0.004286313, 0.5290463, 0.866422933, 0.2091800, 0.523384498, 0.9041168, 0.340987296 ), nrow=4, ncol=2, byrow=TRUE) b <- matrix(c( 0.9092260, 0.1063563, 0.5931998, 0.3674236, 0.9118653, 0.2013260, 0.1838634, 0.6143440, 0.6896409 ), nrow=3, ncol=3, byrow=TRUE) d <- matrix(c( 0.75663344, 0.1033584, 0.84292532, 0.5872683, 0.41514455, 0.9170010, 0.01262253, 0.7645178, 0.30541787, 0.3835217 ), nrow=5, ncol=2, byrow=TRUE) checkException(geneticLHS(10.1, 2), silent=TRUE) checkException(geneticLHS(-1, 2), silent=TRUE) checkException(geneticLHS(10, 2.5), silent=TRUE) checkException(geneticLHS(10, -30), silent=TRUE) checkException(geneticLHS(10, 2, 4.3), silent=TRUE) checkException(geneticLHS(10, 2, -2), silent=TRUE) checkException(geneticLHS(10, 2, 4, -1), silent=TRUE) checkException(geneticLHS(10, 2, 4, 1.5), silent=TRUE) checkException(geneticLHS(10, 2, 4, 4, -.1), silent=TRUE) checkException(geneticLHS(10, 2, 4, 4, 1.1), silent=TRUE) checkException(geneticLHS(NA, 2), silent=TRUE) checkException(geneticLHS(NaN, 2), silent=TRUE) checkException(geneticLHS(Inf, 2), silent=TRUE) checkException(geneticLHS(10, NA), silent=TRUE) checkException(geneticLHS(10, NaN), silent=TRUE) checkException(geneticLHS(10, Inf), silent=TRUE) checkException(geneticLHS(10, 2, NA), silent=TRUE) checkException(geneticLHS(10, 2, NaN), silent=TRUE) checkException(geneticLHS(10, 2, Inf), silent=TRUE) checkException(geneticLHS(10, 2, 2, NA), silent=TRUE) checkException(geneticLHS(10, 2, 2, NaN), silent=TRUE) checkException(geneticLHS(10, 2, 2, Inf), silent=TRUE) checkException(geneticLHS(10, 2, 2, 4, NA), silent=TRUE) checkException(geneticLHS(10, 2, 2, 4, NaN), silent=TRUE) checkException(geneticLHS(10, 2, 2, 4, Inf), silent=TRUE) f <- function() { set.seed(1976) suppressMessages(geneticLHS(4, 2)) } checkTrue(checkLatinHypercube(f())) if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), a, tolerance=1E-7) } f <- function() { set.seed(1977) suppressMessages(geneticLHS(3, 3, 6)) } checkTrue(checkLatinHypercube(f())) if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), b, tolerance=1E-7) } f <- function() { set.seed(1978) suppressMessages(geneticLHS(5, 2, 6, 4, .5)) } checkTrue(checkLatinHypercube(f())) if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), d, tolerance=1E-7) } } lhs/inst/unitTests/runit_randomLHS.r0000644000175100001440000000421412752234762017303 0ustar hornikusers################################################################################ # # Program Name: runit_randomLHS.R # Purpose: To provide test functions for randomLHS.R # Author: Rob Carnell # Date: June 2006 # # Required Functions: randomLHS.R # Required Packages: RUnit # R version: 2.3.0 (>=2.0.0) # ################################################################################ test.randomLHS <- function() { checkException(randomLHS(10.1, 2), silent=TRUE) checkException(randomLHS(-1, 2), silent=TRUE) checkException(randomLHS(10, 2.5), silent=TRUE) checkException(randomLHS(10, -30), silent=TRUE) checkException(randomLHS(NA, 2), silent=TRUE) checkException(randomLHS(NaN, 2), silent=TRUE) checkException(randomLHS(Inf, 2), silent=TRUE) checkException(randomLHS(10, NA), silent=TRUE) checkException(randomLHS(10, NaN), silent=TRUE) checkException(randomLHS(10, Inf), silent=TRUE) A <- randomLHS(4,2) checkTrue(all(A > 0 & A < 1)) checkTrue(checkLatinHypercube(A)) checkException(randomLHS(10.1, 2, preserveDraw=TRUE), silent=TRUE) checkException(randomLHS(-1, 2, preserveDraw=TRUE), silent=TRUE) checkException(randomLHS(10, 2.5, preserveDraw=TRUE), silent=TRUE) checkException(randomLHS(10, -30, preserveDraw=TRUE), silent=TRUE) checkException(randomLHS(NA, 2, preserveDraw=TRUE), silent=TRUE) checkException(randomLHS(NaN, 2, preserveDraw=TRUE), silent=TRUE) checkException(randomLHS(Inf, 2, preserveDraw=TRUE), silent=TRUE) checkException(randomLHS(10, NA, preserveDraw=TRUE), silent=TRUE) checkException(randomLHS(10, NaN, preserveDraw=TRUE), silent=TRUE) checkException(randomLHS(10, Inf, preserveDraw=TRUE), silent=TRUE) checkException(randomLHS(10, 10, preserveDraw=8), silent=TRUE) A <- randomLHS(4, 2, preserveDraw=TRUE) checkTrue(all(A > 0 & A < 1)) checkTrue(checkLatinHypercube(A)) set.seed(4) A <- randomLHS(5, 3, preserveDraw=TRUE) set.seed(4) B <- randomLHS(5, 5, preserveDraw=TRUE) checkEqualsNumeric(A, B[,1:3], tolerance=1E-6) checkTrue(checkLatinHypercube(A)) checkTrue(checkLatinHypercube(B)) } lhs/inst/unitTests/runit_optSeededLHS.r0000644000175100001440000000723212752234762017742 0ustar hornikusers################################################################################ # # Program Name: runit_optSeededLHS.R # Purpose: To provide test functions for optSeededLHS.R # Author: Rob Carnell # Date: June 2006 # # Required Functions: optSeededLHS.R # Required Packages: RUnit # R version: 2.3.0 (>=2.0.0) # ################################################################################ test.optSeededLHS <- function() { a <- matrix(c(0.6180257, 0.49711298, 0.4351729, 0.89893706, 0.1350518, 0.57555028, 0.7858432, 0.04072546, 0.1830144, 0.26001034, 0.9439103, 0.76395668 ), nrow=6, ncol=2, byrow=TRUE) b <- matrix(c(0.1383291, 0.1783548, 0.83049003, 0.3419933, 0.4984879, 0.09815034, 0.1971579, 0.9921542, 0.57375508, 0.6827262, 0.7365888, 0.87107438, 0.5045188, 0.0522494, 0.43593985, 0.9836697, 0.5684597, 0.20014368 ), nrow=6, ncol=3, byrow=TRUE) d <- c( 0.996613897, 0.484630660, 0.266861663, 0.669602700, 0.513479382, 0.628102959, 0.495412583, 0.437709079, 0.719244803, 0.317626305, 0.885710407, 0.786240186, 0.174220855, 0.092432279, 0.666634688, 0.832565101, 0.241787113, 0.906217329, 0.098890415, 0.271876831, 0.551860859, 0.130397376, 0.462662571, 0.942768167, 0.845221401, 0.149395456, 0.007741981, 0.591189585, 0.376615843, 0.204320178 ) checkException(optSeededLHS(randomLHS(10, 4), NA), silent=TRUE) checkException(optSeededLHS(randomLHS(10, 4), NaN), silent=TRUE) checkException(optSeededLHS(randomLHS(10, 4), Inf), silent=TRUE) checkException(optSeededLHS(randomLHS(10, 4), 2, NA), silent=TRUE) checkException(optSeededLHS(randomLHS(10, 4), 2, NaN), silent=TRUE) checkException(optSeededLHS(randomLHS(10, 4), 2, Inf), silent=TRUE) checkException(optSeededLHS(randomLHS(10, 4), 2, 5, NA), silent=TRUE) checkException(optSeededLHS(randomLHS(10, 4), 2, 5, NaN), silent=TRUE) checkException(optSeededLHS(randomLHS(10, 4), 2, 5, Inf), silent=TRUE) f <- function() { temp <- randomLHS(10, 4) temp[1][1] <- NA optSeededLHS(temp, 5) } checkException(f(), silent=TRUE) f <- function() { temp <- randomLHS(10, 4) temp[1][1] <- 2 optSeededLHS(temp, 5) } checkException(f(), silent=TRUE) # Can't use suppressMessages here since the messages come from Rprintf # have to use capture.output... f <- function() { set.seed(1976) sTemp <- capture.output(rtemp <- optSeededLHS(randomLHS(4, 2), 2)) rtemp } checkTrue(checkLatinHypercube(f())) if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), a, tolerance=1E-7) } f <- function() { set.seed(1977) sTemp <- capture.output(rtemp <- optSeededLHS(randomLHS(3, 3), 3, 3, .05)) rtemp } checkTrue(checkLatinHypercube(f())) if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), b, tolerance=1E-7) } f <- function() { set.seed(1979) temp2 <- augmentLHS(randomLHS(10,2), 5) temp2 <- c(t(temp2)) sTemp <- capture.output( rTemp <- .C("optSeededLHS_C", as.integer(15), as.integer(2), as.integer(3), as.double(0.1), as.double(temp2), as.integer(choose(15,2)+1), as.integer(TRUE)) ) rTemp[[5]] } if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), d, tolerance=1E-7) } } lhs/inst/unitTests/runit_maximinLHS.r0000644000175100001440000000422712752234762017471 0ustar hornikusers################################################################################ # # Program Name: runit_maximinLHS.R # Purpose: To provide test functions for maximinLHS.R # Author: Rob Carnell # Date: June 2006 # # Required Functions: maximinLHS.R # Required Packages: RUnit # R version: 2.3.0 (>=2.0.0) # ################################################################################ test.maximinLHS <- function(){ a <- matrix(c( 0.07555028, 0.2306772, 0.49711298, 0.5012294, 0.52791861, 0.9600331, 0.92798023, 0.3731828 ), nrow=4, ncol=2, byrow=TRUE) b <- matrix(c( 0.2825281, 0.08782156, 0.4314198, 0.8011583, 0.90780705, 0.1439918, 0.5437211, 0.34970794, 0.8586682 ), nrow=3, ncol=3, byrow=TRUE) d <- c( 7, 1, 9, 3, 8, 4, 6, 10, 5, 2, 8, 2, 6, 4, 9, 10, 5, 3, 1, 7 ) checkException(maximinLHS(10.1, 2), silent=TRUE) checkException(maximinLHS(-1, 2), silent=TRUE) checkException(maximinLHS(10, 2.5), silent=TRUE) checkException(maximinLHS(10, -30), silent=TRUE) checkException(maximinLHS(10, 2, 4.3), silent=TRUE) checkException(maximinLHS(10, 2, -2), silent=TRUE) checkException(maximinLHS(NA, 2), silent=TRUE) checkException(maximinLHS(NaN, 2), silent=TRUE) checkException(maximinLHS(Inf, 2), silent=TRUE) checkException(maximinLHS(10, NA), silent=TRUE) checkException(maximinLHS(10, NaN), silent=TRUE) checkException(maximinLHS(10, Inf), silent=TRUE) checkException(maximinLHS(10, 2, NA), silent=TRUE) checkException(maximinLHS(10, 2, NaN), silent=TRUE) checkException(maximinLHS(10, 2, Inf), silent=TRUE) f <- function() { set.seed(1976) maximinLHS(4, 2) } # checkEqualsNumeric(f(), a, tolerance=1E-7) checkTrue(checkLatinHypercube(f())) f <- function() { set.seed(1977) maximinLHS(3, 3, 5) } # checkEqualsNumeric(f(), b, tolerance=1E-7) checkTrue(checkLatinHypercube(f())) f <- function() { set.seed(1978) .C("maximinLHS_C", as.integer(10), as.integer(2), as.integer(3), integer(2*10))[[4]] } # checkEqualsNumeric(f(), d, tolerance=1E-7) } lhs/inst/unitTests/runit_augmentLHS.r0000644000175100001440000000634212752234762017467 0ustar hornikusers################################################################################ # # Program Name: runit_augmentLHS.R # Purpose: To provide test functions for augmentLHS.R # Author: Rob Carnell # Date: June 2006 # # Required Functions: augmentLHS.R # Required Packages: RUnit # R version: 2.3.0 (>=2.0.0) # ################################################################################ test.augmentLHS <- function(){ a <- matrix(c( 0.61802566, 0.04072546, 0.43517287, 0.89893706, 0.13505177, 0.57555028, 0.78584321, 0.49711298, 0.69500775, 0.71004887, 0.94796751, 0.13730839, 0.36447982, 0.77853392, 0.03875566, 0.33133683 ), nrow=8, ncol=2, byrow=TRUE) b <- matrix(c( 0.1383291, 0.1783548, 0.87107438, 0.3419933, 0.4984879, 0.09815034, 0.9836697, 0.9921542, 0.57375508, 0.6827262, 0.0522494, 0.83049003, 0.5045188, 0.7365888, 0.43593985, 0.1971579, 0.5684597, 0.20014368 ), nrow=6, ncol=3, byrow=TRUE) d <- matrix(c( 0.8563343, 0.2321231, 0.3426021, 0.6052802, 0.1022039, 0.7157418 ), nrow=6, ncol=1) checkException(augmentLHS(randomLHS(10, 4), NA), silent=TRUE) checkException(augmentLHS(randomLHS(10, 4), NaN), silent=TRUE) checkException(augmentLHS(randomLHS(10, 4), Inf), silent=TRUE) f <- function() { temp <- randomLHS(10, 4) temp[1][1] <- NA augmentLHS(temp, 5) } checkException(f(), silent=TRUE) f <- function() { temp <- randomLHS(10, 4) temp[1][1] <- 2 augmentLHS(temp, 5) } checkException(f(), silent=TRUE) f <- function() { set.seed(1976) augmentLHS(randomLHS(4, 2), 4) } checkTrue(checkLatinHypercube(f())) if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), a, tolerance=1E-7) } f <- function() { set.seed(1977) augmentLHS(randomLHS(3, 3), 3) } checkTrue(checkLatinHypercube(f())) if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), b, tolerance=1E-7) } f <- function() { set.seed(1977) augmentLHS(randomLHS(4, 1), 2) } checkTrue(checkLatinHypercube(f())) if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), d, tolerance=1E-7) } # this test addresses a bug where an error ocurred on adding 1 row in # augmentLHS f <- function() { temp <- randomLHS(7, 2) temp <- augmentLHS(temp,1) nrow(temp) } if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEquals(f(), 8) } # this test addresses a bug submitted on 8/8/2016 A <- matrix(c(0.0625000,0.3750000,0.9166667,0.5208333,0.7500000,0.2083333, 0.04166667,0.66666667,0.37500000,0.97916667,0.52083333,0.27083333), nrow=6, ncol=2) checkTrue(all(!is.na(augmentLHS(A, m=10)))) } lhs/inst/unitTests/runit_optimumLHS.r0000644000175100001440000000754412752234762017526 0ustar hornikusers################################################################################ # # Program Name: runit_optimumLHS.R # Purpose: To provide test functions for optimumLHS.R # Author: Rob Carnell # Date: June 2006 # # Required Functions: optimumLHS.R # Required Packages: RUnit # R version: 2.3.0 (>=2.0.0) # ################################################################################ test.optimumLHS <- function() { a <- matrix(c( 0.36802566, 0.1851729, 0.63505177, 0.7858432, 0.04072546, 0.6489371, 0.82555028, 0.4971130 ), nrow=4, ncol=2, byrow=TRUE) b <- matrix(c( 0.4716624, 0.008659989, 0.9836697, 0.1783548, 0.498487852, 0.3254876, 0.8710744, 0.764817002, 0.5737551 ), nrow=3, ncol=3, byrow=TRUE) g <- matrix(c( 0.429337175, 0.1827792, 0.815301533, 0.4926609, 0.717167385, 0.9219567, 0.273122603, 0.7318439, 0.008915384, 0.2470201 ), nrow=5, ncol=2, byrow=TRUE) d <- c(5, 5, 2, 7, 7, 1, 10, 3, 1, 4, 9, 9, 3, 2, 6, 8, 4, 10, 8, 6) checkException(optimumLHS(10.1, 2), silent=TRUE) checkException(optimumLHS(-1, 2), silent=TRUE) checkException(optimumLHS(10, 2.5), silent=TRUE) checkException(optimumLHS(10, -30), silent=TRUE) checkException(optimumLHS(10, 2, 4.3), silent=TRUE) checkException(optimumLHS(10, 2, -2), silent=TRUE) checkException(optimumLHS(10, 2, 3, -1), silent=TRUE) checkException(optimumLHS(10, 2, 3, 1.5), silent=TRUE) checkException(optimumLHS(10, 2, 3, 1), silent=TRUE) checkException(optimumLHS(10, 2, 3, 0), silent=TRUE) checkException(optimumLHS(NA, 2), silent=TRUE) checkException(optimumLHS(NaN, 2), silent=TRUE) checkException(optimumLHS(Inf, 2), silent=TRUE) checkException(optimumLHS(10, NA), silent=TRUE) checkException(optimumLHS(10, NaN), silent=TRUE) checkException(optimumLHS(10, Inf), silent=TRUE) checkException(optimumLHS(10, 2, NA), silent=TRUE) checkException(optimumLHS(10, 2, NaN), silent=TRUE) checkException(optimumLHS(10, 2, Inf), silent=TRUE) checkException(optimumLHS(10, 2, 2, NA), silent=TRUE) checkException(optimumLHS(10, 2, 2, NaN), silent=TRUE) checkException(optimumLHS(10, 2, 2, Inf), silent=TRUE) f <- function() { set.seed(1976) sTemp <- capture.output(rTemp <- optimumLHS(4, 2)) rTemp } checkTrue(checkLatinHypercube(f())) if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), a, tolerance=1E-7) } f <- function() { set.seed(1977) sTemp <- capture.output(rTemp <- optimumLHS(3, 3, 5)) rTemp } checkTrue(checkLatinHypercube(f())) if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), b, tolerance=1E-7) } f <- function() { set.seed(1978) sTemp <- capture.output(rTemp <- optimumLHS(5, 2, 5, .5)) rTemp } checkTrue(checkLatinHypercube(f())) if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), g, tolerance=1E-7) } f <- function() { set.seed(1979) temp <- matrix(0, nrow=10, ncol=2) for(j in 1:2) { temp[ ,j] <- order(runif(10)) } temp <- c(t(temp)) sTemp <- capture.output( rTemp <- .C("optimumLHS_C", as.integer(10), as.integer(2), as.integer(3), as.double(0.1), as.integer(temp), as.integer(choose(10,2)+1), as.integer(TRUE))) rTemp[[5]] } if (!grepl("sun",R.version$platform) && !grepl("sparc", R.version$platform) && !grepl("solaris", R.version$platform)) { checkEqualsNumeric(f(), d, tolerance=1E-7) } } lhs/tests/0000755000175100001440000000000012752234762012232 5ustar hornikuserslhs/tests/runTests.R0000644000175100001440000000615312752234762014211 0ustar hornikusers# function based on BiocGenerics:::testPackage("MyPackage") # from this web page in 2013, http://master.bioconductor.org/developers/how-to/unitTesting-guidelines/ # however, I copied it to eliminate the dependency on bioconductor testPackage <- function (pkgname, subdir = "unitTests", pattern = "^runit_.*\\.[Rr]$") { .failure_details <- function(result) { res <- result[[1L]] if (res$nFail > 0 || res$nErr > 0) { Filter(function(x) length(x) > 0, lapply(res$sourceFileResults, function(fileRes) { names(Filter(function(x) x$kind != "success", fileRes)) })) } else list() } require(pkgname, quietly = TRUE, character.only = TRUE) || stop("package '", pkgname, "' not found") dir <- system.file(subdir, package = pkgname) if (nchar(dir) == 0L) stop("unable to find unit tests, no '", subdir, "' dir") require("RUnit", quietly = TRUE) || stop("RUnit package not found") RUnit_opts <- getOption("RUnit", list()) RUnit_opts$verbose <- 0L RUnit_opts$silent <- TRUE RUnit_opts$verbose_fail_msg <- TRUE options(RUnit = RUnit_opts) ## The default RNG for RUnit is rngKind = "Marsaglia-Multicarry", ## rngNormalKind = "Kinderman-Ramage") ## This sets the default to the R default 2.9.2 suite <- defineTestSuite(name = paste(pkgname, "RUnit Tests"), dirs = dir, testFileRegexp = pattern, rngKind = "Mersenne-Twister", rngNormalKind = "Inversion") #suite <- defineTestSuite(name = paste(pkgname, "RUnit Tests"), # dirs = dir, testFileRegexp = pattern, rngKind = "default", # rngNormalKind = "default") result <- runTestSuite(suite) cat("\n\n") printTextProtocol(result, showDetails = FALSE) ## Default report name pathReport <- file.path(dir, "Result") ## Report to stdout and text files and html printTextProtocol(result, showDetails=FALSE, fileName=paste(pathReport, "Summary.txt", sep="")) printTextProtocol(result, showDetails=TRUE, fileName=paste(pathReport, ".txt", sep="")) printHTMLProtocol(result, fileName=paste(pathReport, ".html", sep="")) if (length(details <- .failure_details(result)) > 0) { cat("\nTest files with failing tests\n") for (i in seq_along(details)) { cat("\n ", basename(names(details)[[i]]), "\n") for (j in seq_along(details[[i]])) { cat(" ", details[[i]][[j]], "\n") } } cat("\n\n") stop("unit tests failed for package ", pkgname) } result } checkLatinHypercube <- function(X) { # check that the matrix is a latin hypercube g <- function(Y) { # check that this column contains all the cells breakpoints <- seq(0,1,length=length(Y)+1) h <- hist(Y, plot=FALSE, breaks=breakpoints) all(h$counts == 1) } # check all the columns all(apply(X, 2, g)) } testPackage("lhs") lhs/src/0000755000175100001440000000000012752234771011657 5ustar hornikuserslhs/src/optimumLHS_R.cpp0000644000175100001440000002003612752234771014706 0ustar hornikusers/* * * optimumLHS_R.cpp: A C++ routine for creating Optimum Latin Hypercube Samples * used in the LHS package * Copyright (C) 2012 Robert Carnell * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * */ #include "defines.h" /* * Arrays are passed into this routine to allow R to allocate and deallocate * memory within the wrapper function. * * Dimensions: oldHypercube N x K * optimalityRecordLength = N choose 2 + 1 * Parameters: * N: The number of points to be sampled * K: The number of dimensions (or variables) needed * maxSweeps: The maximum number of times the exchange algorithm * is applied across the columns. Therefor if * MAXSWEEPS =5 and K = 6 then 30 exchange operations * could be used. * eps: The minimum fraction gained in optimality that is * desired to continue the iterations as a fraction of * the gain from the first interchange * References: Please see the package documentation * */ /* * Return an optimized hypercube according to the criteria given * */ void optimumLHS_C(int* N, int* K, int* maxSweeps, double* eps, int* oldHypercube, int* optimalityRecordLength, int* bVerbose) { size_t nOptimalityRecordLength = static_cast(*optimalityRecordLength); size_t nsamples = static_cast(*N); size_t nparameters = static_cast(*K); bool isVerbose = (*bVerbose == 0)? false : true; size_t nMaxSweeps = static_cast(*maxSweeps); double eps_change = *eps; int extraColumns = 0; double gOptimalityOld; double optimalityChangeOld = 0.0; double optimalityChange; int test; size_t iter, posit, optimalityRecordIndex; matrix_unsafe oldHypercube_new = matrix_unsafe(nsamples, nparameters, oldHypercube, true); matrix newHypercube = matrix(nsamples, nparameters, true); std::vector optimalityRecord = std::vector(nOptimalityRecordLength); std::vector interchangeRow1 = std::vector(nOptimalityRecordLength); std::vector interchangeRow2 = std::vector(nOptimalityRecordLength); /* find the initial optimality measure */ gOptimalityOld = utilityLHS::sumInvDistance(oldHypercube_new.values, static_cast(nsamples), static_cast(nparameters)); if (isVerbose) PRINT_MACRO("Beginning Optimality Criterion %f \n", gOptimalityOld); #if PRINT_RESULT utilityLHS::lhsPrint(nsamples, nparameters, oldHypercube, 1); #endif test = 0; iter = 0; while (test == 0) { if (iter == nMaxSweeps) break; iter++; /* iterate over the columns */ for (size_t j = 0; j < nparameters; j++) { optimalityRecordIndex = 0; /* iterate over the rows for the first point from 0 to N-2 */ for (size_t i = 0; i < (nsamples - 1); i++) { /* iterate over the rows for the second point from i+1 to N-1 */ for (size_t k = (i + 1); k < nsamples; k++) { /* put the values from oldHypercube into newHypercube */ for (size_t row = 0; row < nsamples; row++) { for (size_t col = 0; col < nparameters; col++) { newHypercube(row, col) = oldHypercube_new(row, col); } } /* exchange two values (from the ith and kth rows) in the jth column * and place them in the new matrix */ newHypercube(i, j) = oldHypercube_new(k, j); newHypercube(k, j) = oldHypercube_new(i, j); /* store the optimality of the newly created matrix and the rows that * were interchanged */ optimalityRecord[optimalityRecordIndex] = utilityLHS::sumInvDistance(newHypercube.values, nsamples, nparameters); interchangeRow1[optimalityRecordIndex] = i; interchangeRow2[optimalityRecordIndex] = k; optimalityRecordIndex++; } } /* once all combinations of the row interchanges have been completed for * the current column j, store the old optimality measure (the one we are * trying to beat) */ optimalityRecord[optimalityRecordIndex] = gOptimalityOld; interchangeRow1[optimalityRecordIndex] = 0; interchangeRow2[optimalityRecordIndex] = 0; /* Find which optimality measure is the lowest for the current column. * In other words, which two row interchanges made the hypercube better in * this column */ posit = 0; for (size_t k = 0; k < nOptimalityRecordLength; k++) { if (optimalityRecord[k] < optimalityRecord[posit]) posit = k; } /* If the new minimum optimality measure is better than the old measure */ if (optimalityRecord[posit] < gOptimalityOld) { /* put oldHypercube in newHypercube */ for (size_t row = 0; row < nsamples; row++) { for (size_t col = 0; col < nparameters; col++) { newHypercube(row, col) = oldHypercube_new(row, col); } } /* Interchange the rows that were the best for this column */ newHypercube(interchangeRow1[posit], j) = oldHypercube_new(interchangeRow2[posit], j); newHypercube(interchangeRow2[posit], j) = oldHypercube_new(interchangeRow1[posit], j); /* put newHypercube back in oldHypercube for the next iteration */ for (size_t row = 0; row < nsamples; row++) { for (size_t col = 0; col < nparameters; col++) { oldHypercube_new(row, col) = newHypercube(row, col); } } /* if this is not the first column we have used for this sweep */ if (j > 0) { /* check to see how much benefit we gained from this sweep */ optimalityChange = std::fabs(optimalityRecord[posit] - gOptimalityOld); if (optimalityChange < eps_change * optimalityChangeOld) { test = 1; if (isVerbose) PRINT_MACRO("Algorithm stopped when the change in the inverse distance measure was smaller than %f \n", ((eps_change) * optimalityChangeOld)); } } /* if this is first column of the sweep, then store the benefit gained */ else { optimalityChangeOld = std::fabs(optimalityRecord[posit] - gOptimalityOld); } /* replace the old optimality measure with the current one */ gOptimalityOld = optimalityRecord[posit]; } /* if the new and old optimality measures are equal */ else if (optimalityRecord[posit] == gOptimalityOld) { test = 1; if (isVerbose) PRINT_MACRO("Algorithm stopped when changes did not impove design optimality\n"); } /* if the new optimality measure is worse */ else if (optimalityRecord[posit] > gOptimalityOld) { ERROR_MACRO("Unexpected Result: Algorithm produced a less optimal design\n"); test = 1; } /* if there is a reason to exit... */ if (test == 1) break; extraColumns++; } } /* if we made it through all the sweeps */ if (iter == nMaxSweeps) { if (isVerbose) PRINT_MACRO("%d full sweeps completed\n", nMaxSweeps); } /* if we didn't make it through all of them */ else { if (isVerbose) PRINT_MACRO("Algorithm used %d sweep(s) and %d extra column(s)\n", iter-1, extraColumns); } if (isVerbose) PRINT_MACRO("Final Optimality Criterion %f \n", gOptimalityOld); #if _DEBUG test = utilityLHS::lhsCheck(static_cast(nsamples), static_cast(nparameters), oldHypercube_new.values, 1); if (test == 0) { /* the error function should send an error message through R */ ERROR_MACRO("Invalid Hypercube\n"); } #endif #if PRINT_RESULT utilityLHS::lhsPrint(nsamples, nparameters, oldHypercube_new.values, 1); #endif } lhs/src/improvedLHS_R.cpp0000644000175100001440000001520312752234771015041 0ustar hornikusers/* * * improvedLHS_R.cpp: A C routine for creating Improved Latin Hypercube Samples * used in the LHS package * Copyright (C) 2012 Robert Carnell * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * */ #include "defines.h" /* * Arrays are passed into this routine to allow R to allocate and deallocate * memory within the wrapper function. * The R internal random numer generator is used so that R can set.seed for * testing the functions. * This code uses ISO C90 comment styles and layout * Dimensions: result K x N * avail K x N * point1 K x DUP(N-1) * list1 DUP(N-1) * vec K * Parameters: * N: The number of points to be sampled * K: The number of dimensions (or variables) needed * dup: The duplication factor which affects the number of points * that the optimization algorithm has to choose from * References: Please see the package documentation * */ void improvedLHS_C(int* N, int* K, int* dup, int* result) { size_t nsamples = static_cast(*N); size_t nparameters = static_cast(*K); size_t duplication = static_cast(*dup); matrix_unsafe m_result = matrix_unsafe(nparameters, nsamples, result); /* the length of the point1 columns and the list1 vector */ size_t len = duplication * (nsamples - 1); /* create memory space for computations */ matrix avail = matrix(nparameters, nsamples); matrix point1 = matrix(nparameters, len); std::vector list1 = std::vector(len); std::vector vec = std::vector(nparameters); /* optimum spacing between points */ double opt = static_cast(nsamples) / ( std::pow(static_cast(nsamples), (1.0 / static_cast(nparameters)))); /* the square of the optimum spacing between points */ double opt2 = opt * opt; /* index of the current candidate point */ size_t point_index; /* index of the optimum point */ size_t best; /* the squared distance between points */ unsigned int distSquared; /* * the minimum difference between the squared distance and the squared * optimum distance */ double min_all; /* The minumum candidate squared distance between points */ unsigned int min_candidate; /* initialize the avail matrix */ for (size_t row = 0; row < nparameters; row++) { for (size_t col = 0; col < nsamples; col++) { avail(row, col) = static_cast(col + 1); } } /* * come up with an array of K integers from 1 to N randomly * and put them in the last column of result */ #ifndef VISUAL_STUDIO GetRNGstate(); #endif for (size_t row = 0; row < nparameters; row++) { m_result(row, nsamples-1) = static_cast(std::floor(unif_rand() * static_cast(nsamples) + 1.0)); } /* * use the random integers from the last column of result to place an N value * randomly through the avail matrix */ for (size_t row = 0; row < nparameters; row++) { avail(row, static_cast(m_result(row, nsamples-1) - 1)) = static_cast(nsamples); } /* move backwards through the result matrix columns */ for (size_t count = nsamples - 1; count > 0; count--) { for (size_t row = 0; row < nparameters; row++) { for (size_t col = 0; col < duplication; col++) { /* create the list1 vector */ for (size_t j = 0; j < count; j++) { list1[j + count*col] = avail(row, j); } } /* create a set of points to choose from */ for (size_t col = count * duplication; col > 0; col--) /* Note: can't do col = count*duplication - 1; col >= 0 because it throws a warning at W4 */ { point_index = static_cast(std::floor(unif_rand() * static_cast(col))); point1(row, col-1) = list1[point_index]; list1[point_index] = list1[col-1]; } } min_all = DBL_MAX; best = 0; for (size_t col = 0; col < duplication * count - 1; col++) { min_candidate = UINT_MAX; for (size_t j = count; j < nsamples; j++) { distSquared = 0; /* * find the distance between candidate points and the points already * in the sample */ for (size_t k = 0; k < nparameters; k++) { vec[k] = point1(k, col) - m_result(k, j); distSquared += vec[k] * vec[k]; } /* original code compared dist1 to opt, but using the squareroot * function and recasting distSquared to a double was unncessary. * dist1 = sqrt((double) distSquared); * if (min_candidate > dist1) min_candidate = dist1; */ /* * if the distSquard value is the smallest so far place it in * min candidate */ if (min_candidate > distSquared) min_candidate = distSquared; } /* * if the difference between min candidate and opt2 is the smallest so * far, then keep that point as the best. */ if (std::fabs(static_cast(min_candidate) - opt2) < min_all) { min_all = std::fabs(static_cast(min_candidate) - opt2); best = col; } } /* take the best point out of point1 and place it in the result */ for (size_t row = 0; row < nparameters; row++) { m_result(row, count - 1) = point1(row, best); } /* update the numbers that are available for the future points */ for (size_t row = 0; row < nparameters; row++) { for (size_t col = 0; col < nsamples; col++) { if (avail(row, col) == m_result(row, count - 1)) { avail(row, col) = avail(row, count-1); } } } } /* * once all but the last points of result are filled in, there is only * one choice left */ for (size_t row = 0; row < nparameters; row++) { m_result(row, 0u) = avail(row, 0u); } #if _DEBUG int test = utilityLHS::lhsCheck(static_cast(nsamples), static_cast(nparameters), m_result.values, 1); if (test == 0) { /* the error function should send an error message through R */ ERROR_MACRO("Invalid Hypercube\n"); } #endif #if PRINT_RESULT utilityLHS::lhsPrint(N, K, m_result.values, 0); #endif #ifndef VISUAL_STUDIO /* Give the state of the random number generator back to R */ PutRNGstate(); #endif } lhs/src/defines.h0000644000175100001440000000404012752234771013443 0ustar hornikusers/* * * defines.h: A C++ header used in the LHS package * Copyright (C) 2012 Robert Carnell * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * */ #ifndef DEFINES #define DEFINES #include #include #include #include #include #include #include #include /* VISUAL_STUDIO is defined as a preprocessor directive in the Visual Studio build */ /* in visual studio, the following warnings are disabled * 4514 "unreferenced inline function has been removed" * 4820 "2 bytes padding added after data member" * 4710 "function not inlined" */ #ifndef VISUAL_STUDIO #include "R.h" #include "Rmath.h" #else #include #ifndef MATHLIB_STANDALONE #define MATHLIB_STANDALONE #include "Rmath.h" #endif #endif #include "simpleMatrix.h" #define PRINT_RESULT 0 #ifndef VISUAL_STUDIO #define PRINT_MACRO Rprintf #define ERROR_MACRO error #else #define PRINT_MACRO printf #define ERROR_MACRO printf #endif /* include after PRINT_MACRO is defined */ #include "utilityLHS_R.h" extern "C" { void improvedLHS_C(int* N, int* K, int* DUP, int* result); void maximinLHS_C(int* N, int* K, int* DUP, int* result); void optimumLHS_C(int* N, int* K, int* MAXSWEEPS, double* EPS, int* pOld, int* JLen, int* bVerbose); void optSeededLHS_C(int* N, int* K, int* MAXSWEEPS, double* EPS, double* pOld, int* JLen, int* bVerbose); } #endif lhs/src/utilityLHS_R.h0000644000175100001440000000667212752234771014376 0ustar hornikusers/* * * utilityLHS_R.h: A C++ header used in the LHS package * Copyright (C) 2012 Robert Carnell * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * */ #ifndef UTILITYLHS_R #define UTILITYLHS_R #include class utilityLHS { public: static int lhsCheck(int N, int K, int * result, int bTranspose); static void rank(std::vector & toRank, std::vector & ranks); static void rankColumns(std::vector & toRank, std::vector & ranks, int nrow); /* static template class definitions added to class definition to prevent solaris error * multiple declaration for utilityLHS */ template static void lhsPrint(int N, int K, T* result, int bTranspose) { if (bTranspose == 0) { for (int row = 0; row < K; row++) { for (int col = 0; col < N; col++) { PRINT_MACRO("%g ", result[row * N + col]); } PRINT_MACRO("\n"); } } else { for (int row = 0; row < N; row++) { for (int col = 0; col < K; col++) { PRINT_MACRO("%d ", result[row * K + col]); } PRINT_MACRO("\n"); } } }; template static double sumInvDistance(T * Tmatrix, int nr, int nc) { T oneDistance = static_cast(0); double totalInvDistance = 0.0; /* iterate the row of the first point from 0 to N-2 */ for (int i = 0; i < nr - 1; i++) { /* iterate the row the second point from i+1 to N-1 */ for (int j = (i + 1); j < nr; j++) { oneDistance = 0; /* iterate through the columns, summing the squared differences */ for (int k = 0; k < nc; k++) { /* calculate the square of the difference in one dimension between the * points */ oneDistance += (Tmatrix[i * nc + k] - Tmatrix[j * nc + k]) * (Tmatrix[i * nc + k] - Tmatrix[j * nc + k]); } /* sum the inverse distances */ totalInvDistance += (1.0 / std::sqrt(static_cast(oneDistance))); } } return(totalInvDistance); }; template static double sumInvDistance(std::vector & Vmatrix, size_t nr, size_t nc) { T oneDistance = static_cast(0); double totalInvDistance = 0.0; /* iterate the row of the first point from 0 to N-2 */ for (size_t i = 0; i < nr - 1; i++) { /* iterate the row the second point from i+1 to N-1 */ for (size_t j = (i + 1); j < nr; j++) { oneDistance = 0; /* iterate through the columns, summing the squared differences */ for (size_t k = 0; k < nc; k++) { /* calculate the square of the difference in one dimension between the * points */ oneDistance += (Vmatrix[i * nc + k] - Vmatrix[j * nc + k]) * (Vmatrix[i * nc + k] - Vmatrix[j * nc + k]); } /* sum the inverse distances */ totalInvDistance += (1.0 / std::sqrt(static_cast(oneDistance))); } } return(totalInvDistance); }; }; // end class utilityLHS #endif lhs/src/optSeededLHS_R.cpp0000644000175100001440000001776212752234771015144 0ustar hornikusers/* * * optSeededLHS_R.cpp: A C++ routine for creating Optimum Latin Hypercube Samples * used in the LHS package * Copyright (C) 2012 Robert Carnell * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * */ #include "defines.h" /* * Arrays are passed into this routine to allow R to allocate and deallocate * memory within the wrapper function. * This code uses ISO C90 comment styles and layout * * "oldHypercube", "newHypercube", and "matrix" are matricies but are treated as one * dimensional arrays to facilitate passing them from R. * Dimensions: oldHypercube N x K * optimalityRecordLength = N choose 2 + 1 * Parameters: * N: The number of points to be sampled * K: The number of dimensions (or variables) needed * maxSweeps: The maximum number of times the exchange algorithm * is applied across the columns. Therefor if * MAXSWEEPS =5 and K = 6 then 30 exchange operations * could be used. * eps: The minimum fraction gained in optimality that is * desired to continue the iterations as a fraction of * the gain from the first interchange * References: Please see the package documentation * */ /* * Return an optimized hypercube according to the criteria given * */ void optSeededLHS_C(int* N, int* K, int* maxSweeps, double* eps, double* oldHypercube, int* optimalityRecordLength, int* bVerbose) { size_t nOptimalityRecordLength = static_cast(*optimalityRecordLength); size_t nsamples = static_cast(*N); size_t nparameters = static_cast(*K); bool isVerbose = (*bVerbose == 0)? false : true; size_t nMaxSweeps = static_cast(*maxSweeps); double eps_change = *eps; int extraColumns = 0; double gOptimalityOld; double optimalityChangeOld = 0.0; double optimalityChange; int test; size_t iter, posit, optimalityRecordIndex; matrix_unsafe oldHypercube_new = matrix_unsafe(nsamples, nparameters, oldHypercube, true); matrix newHypercube = matrix(nsamples, nparameters, true); std::vector optimalityRecord = std::vector(nOptimalityRecordLength); std::vector interchangeRow1 = std::vector(nOptimalityRecordLength); std::vector interchangeRow2 = std::vector(nOptimalityRecordLength); /* find the initial optimality measure */ gOptimalityOld = utilityLHS::sumInvDistance(oldHypercube_new.values, static_cast(nsamples), static_cast(nparameters)); if (isVerbose) PRINT_MACRO("Beginning Optimality Criterion %f \n", gOptimalityOld); #if PRINT_RESULT utilityLHS::lhsPrint(nsamples, nparameters, oldHypercube); #endif test = 0; iter = 0; while (test == 0) { if (iter == nMaxSweeps) break; iter++; /* iterate over the columns */ for (size_t j = 0; j < nparameters; j++) { optimalityRecordIndex = 0; /* iterate over the rows for the first point from 0 to N-2 */ for (size_t i = 0; i < nsamples - 1; i++) { /* iterate over the rows for the second point from i+1 to N-1 */ for (size_t k = i + 1; k < nsamples; k++) { /* put the values from oldHypercube into newHypercube */ for (size_t row = 0; row < nsamples; row++) { for (size_t col = 0; col < nparameters; col++) { newHypercube(row, col) = oldHypercube_new(row, col); } } /* exchange two values (from the ith and kth rows) in the jth column * and place them in the new matrix */ newHypercube(i, j) = oldHypercube_new(k, j); newHypercube(k, j) = oldHypercube_new(i, j); /* store the optimality of the newly created matrix and the rows that * were interchanged */ optimalityRecord[optimalityRecordIndex] = utilityLHS::sumInvDistance(newHypercube.values, nsamples, nparameters); interchangeRow1[optimalityRecordIndex] = i; interchangeRow2[optimalityRecordIndex] = k; optimalityRecordIndex++; } } /* once all combinations of the row interchanges have been completed for * the current column j, store the old optimality measure (the one we are * trying to beat) */ optimalityRecord[optimalityRecordIndex] = gOptimalityOld; interchangeRow1[optimalityRecordIndex] = 0; interchangeRow2[optimalityRecordIndex] = 0; /* Find which optimality measure is the lowest for the current column. * In other words, which two row interchanges made the hypercube better in * this column */ posit = 0; for (size_t k = 0; k < nOptimalityRecordLength; k++) { if (optimalityRecord[k] < optimalityRecord[posit]) posit = k; } /* If the new minimum optimality measure is better than the old measure */ if (optimalityRecord[posit] < gOptimalityOld) { /* put oldHypercube in newHypercube */ for (size_t row = 0; row < nsamples; row++) { for (size_t col = 0; col < nparameters; col++) { newHypercube(row, col) = oldHypercube_new(row, col); } } /* Interchange the rows that were the best for this column */ newHypercube(interchangeRow1[posit], j) = oldHypercube_new(interchangeRow2[posit], j); newHypercube(interchangeRow2[posit], j) = oldHypercube_new(interchangeRow1[posit], j); /* put newHypercube back in oldHypercube for the next iteration */ for (size_t row = 0; row < nsamples; row++) { for (size_t col = 0; col < nparameters; col++) { oldHypercube_new(row, col) = newHypercube(row, col); } } /* if this is not the first column we have used for this sweep */ if (j > 0) { /* check to see how much benefit we gained from this sweep */ optimalityChange = std::fabs(optimalityRecord[posit] - gOptimalityOld); if (optimalityChange < eps_change * optimalityChangeOld) { test = 1; if (isVerbose) PRINT_MACRO("Algorithm stopped when the change in the inverse distance measure was smaller than %f \n", ((eps_change) * optimalityChangeOld)); } } /* if this is first column of the sweep, then store the benefit gained */ else { optimalityChangeOld = std::fabs(optimalityRecord[posit] - gOptimalityOld); } /* replace the old optimality measure with the current one */ gOptimalityOld = optimalityRecord[posit]; } /* if the new and old optimality measures are equal */ else if (optimalityRecord[posit] == gOptimalityOld) { test = 1; if (isVerbose) PRINT_MACRO("Algorithm stopped when changes did not impove design optimality\n"); } /* if the new optimality measure is worse */ else if (optimalityRecord[posit] > gOptimalityOld) { ERROR_MACRO("Unexpected Result: Algorithm produced a less optimal design\n"); test = 1; } /* if there is a reason to exit... */ if (test == 1) break; extraColumns++; } } /* if we made it through all the sweeps */ if (iter == nMaxSweeps) { if (isVerbose) PRINT_MACRO("%d full sweeps completed\n", nMaxSweeps); } /* if we didn't make it through all of them */ else { if (isVerbose) PRINT_MACRO("Algorithm used %d sweep(s) and %d extra column(s)\n", iter-1, extraColumns); } if (isVerbose) PRINT_MACRO("Final Optimality Criterion %f \n", gOptimalityOld); #if PRINT_RESULT utilityLHS::lhsPrint(nsamples, nparameters, oldHypercube_new.values); #endif } lhs/src/utilityLHS_R.cpp0000644000175100001440000000556512752234771014731 0ustar hornikusers/* * * utilityLHS_R.cpp: A C++ routine of utilities used in the LHS package * Copyright (C) 2012 Robert Carnell * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * */ #include "defines.h" #include "utilityLHS_R.h" int utilityLHS::lhsCheck(int N, int K, int * result, int bTranspose) { int total = 0; /* * verify that the result is a latin hypercube. One easy check is to ensure * that the sum of the rows is the sum of the 1st N integers. This check can * be fooled in one unlikely way... * if a column should be 1 2 3 4 6 8 5 7 9 10 * the sum would be 10*11/2 = 55 * the same sum could come from 5 5 5 5 5 5 5 5 5 10 * but this is unlikely */ if (bTranspose == 0) { for (int row = 0; row < K; row++) { total = 0; for (int col = 0; col < N; col++) { total += result[row * N + col]; } if (total != N * (N + 1) / 2) return 0; } } else { for (int col = 0; col < K; col++) { total = 0; for (int row = 0; row < N; row++) { total += result[row * K + col]; } if (total != N * (N + 1) / 2) return 0; } } return 1; } void utilityLHS::rank(std::vector & toRank, std::vector & ranks) { size_t len = toRank.size(); #ifdef _DEBUG if (toRank.size() != ranks.size()) throw new std::exception("illegal call in rank"); #endif for (size_t i = 0; i < len; i++) { ranks[i] = 0; for (size_t j = 0; j < len; j++) { if (toRank[i] < toRank[j]) ranks[i]++; } } } void utilityLHS::rankColumns(std::vector & toRank, std::vector & ranks, int nrow) { size_t n = static_cast(nrow); std::vector column = std::vector(n); size_t len = toRank.size(); int offset; #ifdef _DEBUG if (toRank.size() != ranks.size()) throw new std::exception("illegal call in rank"); #endif for (size_t i = 0; i < len; i+=n) { // copy the first nrow for (size_t j = 0; j < n; j++) { column[j] = toRank[i+j]; } // sort std::sort(column.begin(), column.end(), std::less()); // find the sorted number that is the same as the number to rank for (size_t j = 0; j < n; j++) { offset = static_cast(i); ranks[i+j] = std::find(toRank.begin()+offset, toRank.begin()+offset+nrow, column[j]) - (toRank.begin()+offset); } } } lhs/src/simpleMatrix.h0000644000175100001440000001607512752234771014517 0ustar hornikusers/* * * simpleMatrix.h: A C++ header for a matrix class * used in the LHS package * Copyright (C) 2012 Robert Carnell * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * */ #ifndef SIMPLEMATRIX #define SIMPLEMATRIX #pragma once #ifdef VISUAL_STUDIO // in visual studio debugging, use assert #ifdef _DEBUG #else #ifndef NDEBUG #define NDEBUG #endif #endif #else // in anyother implementation, exclude asserts #ifndef NDEBUG #define NDEBUG #endif #endif #include #include #define ASSERT(x,y) \ assert(x >= 0 && x < nrows); \ assert(y >= 0 && y < ncols); template class matrix { public: size_t nrows; size_t ncols; std::vector values; matrix(); matrix(size_t rows, size_t cols, bool byRow=false); matrix(int rows, int cols, bool byRow=false); matrix(size_t rows, size_t cols, const T* m, bool byRow=false); matrix(int rows, int cols, const T* m, bool byRow=false); matrix(const matrix& mat); ~matrix(); matrix& operator=(const matrix& mat); T & operator()(size_t i, size_t j); T operator()(size_t i, size_t j) const; T & operator()(int i, int j); T operator()(int i, int j) const; void transpose(); private: void matrix_init(size_t rows, size_t cols, bool byRow); void matrix_init(size_t rows, size_t cols, const T* m, bool byRow); bool isByRow; }; template class matrix_unsafe { public: size_t nrows; size_t ncols; T* values; matrix_unsafe(); matrix_unsafe(size_t rows, size_t cols, T* m, bool byRow=false); matrix_unsafe(int rows, int cols, T* m, bool byRow=false); ~matrix_unsafe(); T & operator()(size_t i, size_t j); T operator()(size_t i, size_t j) const; T & operator()(int i, int j); T operator()(int i, int j) const; private: void matrix_unsafe_init(size_t rows, size_t cols, T* m, bool byRow); bool isByRow; }; /***********************************************/ template inline T & matrix::operator()(size_t i, size_t j) { ASSERT(i,j) if (!isByRow) // most often this choice return values[j*nrows + i]; else return values[i*ncols + j]; } template inline T & matrix::operator()(int i, int j) { ASSERT(static_cast(i),static_cast(j)) if (!isByRow) // most often this choice return values[static_cast(j*nrows + i)]; else return values[static_cast(i*ncols + j)]; } template inline T matrix::operator()(size_t i, size_t j) const { ASSERT(i,j) if (!isByRow) return values[j*nrows + i]; else return values[i*ncols + j]; } template inline T matrix::operator()(int i, int j) const { ASSERT(i,j) if (!isByRow) return values[static_cast(j*nrows + i)]; else return values[static_cast(i*ncols + j)]; } template inline matrix& matrix::operator=(const matrix& mat) { nrows = mat.nrows; ncols = mat.ncols; isByRow = mat.isByRow; values.resize(nrows*ncols); for (size_t i = 0; i < values.size(); i++) values[i] = mat.values[i]; return *this; } template void matrix::matrix_init(size_t rows, size_t cols, const T* m, bool byRow) { assert(rows > 0 && cols > 0); nrows = rows; ncols = cols; isByRow = byRow; values = std::vector(rows*cols); for(size_t i = 0; i < rows*cols; i++) values[i] = m[i]; } template matrix::matrix(size_t rows, size_t cols, const T* m, bool byRow) { matrix_init(rows, cols, m, byRow); } template matrix::matrix(int rows, int cols, const T* m, bool byRow) { matrix_init(static_cast(rows), static_cast(cols), m, byRow); } template void matrix::matrix_init(size_t rows, size_t cols, bool byRow) { assert(rows > 0 && cols > 0); nrows = rows; ncols = cols; isByRow = byRow; values = std::vector(rows*cols); } template matrix::matrix(size_t rows, size_t cols, bool byRow) { matrix_init(rows, cols, byRow); } template matrix::matrix(int rows, int cols, bool byRow) { matrix_init(static_cast(rows), static_cast(cols), byRow); } template matrix::matrix(const matrix & mat) { nrows = mat.nrows; ncols = mat.ncols; isByRow = mat.isByRow; values = std::vector(nrows*ncols); for (size_t i = 0; i < nrows; i++) { for (size_t j = 0; j < ncols; j++) { if (!isByRow) // default option values[j*nrows + i] = mat(i, j); else values[i*ncols + j] = mat(i, j); } } } template matrix::matrix() { nrows = 0; ncols = 0; isByRow = false; values = std::vector(); } template void matrix::transpose() { std::vector temp = std::vector(nrows*ncols); size_t newrows = ncols; size_t newcols = nrows; for (size_t i = 0; i < nrows; i++) { for (size_t j = 0; j < ncols; j++) { if (!isByRow) // most likely temp[i*ncols + j] = values[j*nrows + i]; else temp[j*nrows + i] = values[i*ncols + j]; } } ncols = newcols; nrows = newrows; values = temp; } template matrix::~matrix() { } /***************************************************/ template inline T & matrix_unsafe::operator()(int i, int j) { ASSERT(static_cast(i),static_cast(j)) if (!isByRow) return values[j*nrows + i]; else return values[i*ncols + j]; } template inline T matrix_unsafe::operator()(int i, int j) const { ASSERT(i,j) if (!isByRow) return values[j*nrows + i]; else return values[i*ncols + j]; } template inline T & matrix_unsafe::operator()(size_t i, size_t j) { ASSERT(i,j) if (!isByRow) return values[j*nrows + i]; else return values[i*ncols + j]; } template inline T matrix_unsafe::operator()(size_t i, size_t j) const { ASSERT(i,j) if (!isByRow) return values[j*nrows + i]; else return values[i*ncols + j]; } template void matrix_unsafe::matrix_unsafe_init(size_t rows, size_t cols, T* m, bool byRow) { assert(rows > 0 && cols > 0); nrows = rows; ncols = cols; isByRow = byRow; values = m; } template matrix_unsafe::matrix_unsafe(int rows, int cols, T* m, bool byRow) { matrix_unsafe_init(static_cast(rows), static_cast(cols), m, byRow); } template matrix_unsafe::matrix_unsafe(size_t rows, size_t cols, T* m, bool byRow) { matrix_unsafe_init(rows, cols, m, byRow); } template matrix_unsafe::matrix_unsafe() { nrows = 0; ncols = 0; isByRow = false; values = 0; } template matrix_unsafe::~matrix_unsafe() { // release the pointer, but do not delete values = 0; } #endif lhs/src/maximinLHS_R.cpp0000644000175100001440000001436612752234771014667 0ustar hornikusers/* * * maximinLHS_R.cpp: A C routine for creating Maximin Latin Hypercube Samples * used in the LHS package * Copyright (C) 2012 Robert Carnell * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * */ #include "defines.h" /* * Arrays are passed into this routine to allow R to allocate and deallocate * memory within the wrapper function. * The R internal random numer generator is used that R can set.seed for * testing the functions. * Dimensions: result K x N * Parameters: * N: The number of points to be sampled * K: The number of dimensions (or variables) needed * dup: The duplication factor which affects the number of points * that the optimization algorithm has to choose from * References: Please see the package documentation * */ void maximinLHS_C(int* N, int* K, int* dup, int* result) { size_t nsamples = static_cast(*N); size_t nparameters = static_cast(*K); size_t duplication = static_cast(*dup); matrix_unsafe m_result = matrix_unsafe(nparameters, nsamples, result); /* the length of the point1 columns and the list1 vector */ size_t len = duplication * (nsamples - 1); /* create memory space for computations */ matrix avail = matrix(nparameters, nsamples); matrix point1 = matrix(nparameters, len); std::vector list1 = std::vector(len); std::vector vec = std::vector(nparameters); /* squared distance between corner (1,1,1,..) and (N,N,N,...) */ double squaredDistanceBtwnCorners = static_cast(nparameters * (nsamples - 1) * (nsamples - 1)); /* index of the current candidate point */ size_t point_index; /* index of the optimum point */ size_t best; /* the squared distance between points */ unsigned int distSquared; /* the minimum squared distance between points */ double minSquaredDistBtwnPts; /* The minumum candidate squared difference between points */ unsigned int minCandidateSquaredDistBtwnPts; /* initialize the avail matrix */ for (size_t row = 0; row < nparameters; row++) { for (size_t col = 0; col < nsamples; col++) { avail(row, col) = static_cast(col + 1); } } /* * come up with an array of K integers from 1 to N randomly * and put them in the last column of result */ #ifndef VISUAL_STUDIO GetRNGstate(); #endif for (size_t row = 0; row < nparameters; row++) { m_result(row, nsamples-1) = static_cast(std::floor(unif_rand() * static_cast(nsamples) + 1.0)); } /* * use the random integers from the last column of result to place an N value * randomly through the avail matrix */ for (size_t row = 0; row < nparameters; row++) { avail(row, static_cast(m_result(row, nsamples - 1) - 1)) = static_cast(nsamples); } /* move backwards through the result matrix columns */ for (size_t count = nsamples - 1; count > 0; count--) { for (size_t row = 0; row < nparameters; row++) { for (size_t col = 0; col < duplication; col++) { /* create the list1 vector */ for (size_t j = 0; j < count; j++) { list1[j + count*col] = avail(row, j); } } /* create a set of points to choose from */ for (size_t col = count * duplication; col > 0; col--) { point_index = static_cast(std::floor(unif_rand() * static_cast(col))); point1(row, col-1) = list1[point_index]; list1[point_index] = list1[col - 1]; } } minSquaredDistBtwnPts = DBL_MIN; best = 0; for (size_t col = 0; col < duplication * count - 1; col++) { /* set min candidate equal to the maximum distance to start */ minCandidateSquaredDistBtwnPts = static_cast(std::ceil(squaredDistanceBtwnCorners)); for (size_t j = count; j < nsamples; j++) { distSquared = 0; /* * find the distance between candidate points and the points already * in the sample */ for (size_t k = 0; k < nparameters; k++) { vec[k] = point1(k, col) - m_result(k, j); distSquared += vec[k] * vec[k]; } /* * if the distance squared value is the smallest so far, place it in the * min candidate */ if (minCandidateSquaredDistBtwnPts > distSquared) minCandidateSquaredDistBtwnPts = distSquared; } /* * if the candidate point is the largest minimum distance between points so * far, then keep that point as the best. */ if (static_cast(minCandidateSquaredDistBtwnPts) > minSquaredDistBtwnPts) { minSquaredDistBtwnPts = static_cast(minCandidateSquaredDistBtwnPts); best = col; } } /* take the best point out of point1 and place it in the result */ for (size_t row = 0; row < nparameters; row++) { m_result(row, count-1) = point1(row, best); } /* update the numbers that are available for the future points */ for (size_t row = 0; row < nparameters; row++) { for (size_t col = 0; col < nsamples; col++) { if (avail(row, col) == m_result(row, count-1)) { avail(row, col) = avail(row, count-1); } } } } /* * once all but the last points of result are filled in, there is only * one choice left */ for (size_t row = 0; row < nparameters; row++) { m_result(row, 0u) = avail(row, 0u); } #ifdef _DEBUG int test = utilityLHS::lhsCheck(static_cast(nsamples), static_cast(nparameters), result, 1); if (test == 0) { /* the error function should send an error message through R */ ERROR_MACRO("Invalid Hypercube\n"); } #endif #if PRINT_RESULT utilityLHS::lhsPrint(N, K, m_result.values, 0); #endif #ifndef VISUAL_STUDIO /* Give the state of the random number generator back to R */ PutRNGstate(); #endif } lhs/NAMESPACE0000644000175100001440000000031512752234762012306 0ustar hornikusersuseDynLib(lhs) export(improvedLHS, maximinLHS, randomLHS, optimumLHS, augmentLHS, geneticLHS, optAugmentLHS, optSeededLHS) importFrom("stats", dist, na.exclude, na.fail, na.omit, runif) lhs/R/0000755000175100001440000000000012752234762011271 5ustar hornikuserslhs/R/optSeededLHS.R0000644000175100001440000000754412752234762013711 0ustar hornikusers################################################################################ # # Function: optSeededLHS.R # Purpose: To create a nearly optimal latin hypercube design with respect to # the S optimality criterion using the Columnwise-pairwise (CP) # Algorithm using input seed design # Author: Rob Carnell # Created: 26 May 05 # # Variables: # seed is the input Seed design. The input seed must have the correct number # of variables and must be on the interval [0,1] # m is the number of addtional points to augment the design with # (default=1, must be a positive integer) # maxSweeps is the maximum number of times the CP algorithm is applied to all # the columns. # eps is the optimal stopping criterion (explained later) # # Reference: # This code was motivated by the work of Rafal Stocki # "A method to improve design reliability using optimal Latin hypercube # sampling" Institute of Fundamental Technological Research, Polish # Academy of Sciences, ul. Swietokrzyska 21, 00-049 Warsaw, Poland # # Required functions: ranperm.R, augmentlhd.R # # Explanation: # S optimality seeks to maximize the inverse of the sum of the distances # from each point in the design to all other points # Algorithm: generate a random latin hypercube design by augmenting the seed # design. # within each column of that matrix, interchange two numbers. # At each step, calculate the inverse of the sum of the distances between all # points, and pick modification which minimizes the distances. # Continue to move from column to column until the stopping criterion is # reached. Either the maximum number of sweeps through the matrix is reached, # or the interchanges in a given row have no benefit to the S optimality, or # the decrease in the inverse of the sum of the distances is small compared to # the first decrease due to the interchange in the first column (ratio set by # eps) # # Run Time and computer resources: Stocki asserts that processing time # increases proportional to k^5 for constant n and n^5 for constant k # # The dist function calculates the distance between each row of a matrix # and places the answer in a k*k half diagonal matrix # # 6/30/2012 # Changed the C function call. Added the verbose argument. # ################################################################################ optSeededLHS <- function(seed, m=1, maxSweeps=2, eps=.1, verbose=FALSE) { if(is.matrix(seed)==FALSE) stop("Input seed Design must be in the Matrix class\n") if(length(m)!=1 | length(maxSweeps)!=1 |length(eps)!=1) stop("m, eps, and maxSweeps may not be vectors") if(any(is.na(c(m,maxSweeps,eps)))) stop("m, eps, and maxSweeps may not be NA or NaN") if(any(is.infinite(c(m,eps,maxSweeps)))) stop("m, eps, and maxSweeps may not be infinite") if(eps>=1 | eps<=0) stop("eps must fall in the interval (0,1)\n") if(floor(maxSweeps)!=maxSweeps | maxSweeps<1) stop("maxSweeps must be a positive integer\n") if(floor(m)!=m | m<1) stop("m must be a positive integer\n") if(try(is.function(augmentLHS), silent=TRUE)!=TRUE) stop("The augmentLHS.R function must be sourced\n") if(any(is.na(seed)==TRUE)) stop("Input Design cannot contain any NA entries\n") if(max(seed)>1 | min(seed)<0) stop("The seed design must be uniformly distributed on [0,1]\n") k <- ncol(seed) N <- m + nrow(seed) Pold <- augmentLHS(seed, m) if(m==1) return(Pold) Pold <- c(t(Pold)) # changes to an N*k length vector jLen <- choose(N, 2) + 1 resultList <- .C("optSeededLHS_C", as.integer(N), as.integer(k), as.integer(maxSweeps), as.double(eps), as.double(Pold), as.integer(jLen), as.integer(verbose)) result <- resultList[[5]] return(matrix(result, nrow=N, ncol=k, byrow=TRUE)) } lhs/R/geneticLHS.R0000644000175100001440000001077112752234762013407 0ustar hornikusers################################################################################ # # Function: geneticLHS.R # Purpose: To create a nearly optimal latin hypercube design with respect to # the S optimality criterion using a Genetic Algorithm # Author: Rob Carnell # Created: 26 May 05 # # Variables: # n is the number of partitions (simulations or design points) # k is the number of replication (variables) # pop is the number of designs in the initial population # gen is the number of generations over which the algorithm is applied # pMut is the probability with wich a mutation occurs in a column of the # progeny # # Reference: # This code was motivated by the work of Rafal Stocki # "A method to improve design reliability using optimal Latin hypercube # sampling" Institute of Fundamental Technological Research, Polish # Academy of Sciences, ul. Swietokrzyska 21, 00-049 Warsaw, Poland # # Explanation: # S optimality seeks to maximize the inverse of the sum of the inverse # distances from each point in the design to all other points # Algorithm: # 1. Generate pop random latin hypercube designs of size n by k # 2. Calculate the S optimality of each design # 3. Keep the best design in the first position and throw away half of the # rest of the population # 4. Take a random column out of the best matrix and place it in a # random column of each of the other matricies, and take a random column # out of each of the other matricies and put it in copy of the best # matrix thereby causing the progeny # 5. For each of the progeny, cause a genetic mutation pMut percent of the # time by swtching two elements in each column # # The dist function calculates the distance between each row of a matrix # and places the answer in a k*k half diagonal matrix # # 6/30/2012 # Added verbose argument # ################################################################################ geneticLHS <- function(n=10, k=2, pop=100, gen=4, pMut=.1, criterium="S", verbose=FALSE) { if(length(n)!=1 |length(k)!=1 | length(pop)!=1 |length(gen)!=1 | length(pMut)!=1) stop("no parameters may be vectors") if(any(is.na(c(n,k,pop,gen,pMut)))) stop("no paramters may be NA or NaN") if(any(is.infinite(c(n,k,pop,gen,pMut)))) stop("no parameters may be infinite") if(floor(n)!=n | n<1) stop("n must be a positive integer\n") if(floor(k)!=k | k<1) stop("k must be a positive integer\n") if(floor(pop)!=pop | pop<1 | pop%%2!=0) stop("pop must be an even positive integer\n") if(floor(gen)!=gen | gen<1) stop("gen must be a positive integer\n") if(pMut<=0 | pMut>=1) stop("pMut must be on the interval (0,1)") if(n==1) { if (verbose) message("Design is already optimal\n") return(rep(1,k)) } A <- array(0, dim=c(n, k, pop), dimnames=list(points=1:n, variables=1:k, hypercubes=1:pop)) for(i in 1:pop) { for(j in 1:k) { A[ , j, i] <- order(runif(n)) } } for(v in 1:gen) { B <- numeric(pop) for(i in 1:pop) { if (criterium=="S") { B[i] <- 1/sum(1/dist(A[, , i])) } else if (criterium == "Maximin") { B[i] <- min(dist(A[, , i])) } else stop("Criterium not recognized") } H <- order(B, decreasing=TRUE) posit <- which.max(B) J <- array(NA, dim=c(n, k, pop), dimnames=list(points=1:n, variables=1:k, hypercubes=1:pop)) J[ , , 1:(pop/2)] <- A[ , , posit] if((pop/2)==1) break for(i in 1:(pop/2)) { J[ , , (i+pop/2)] <- A[ , , H[i]] } J <- na.fail(J) for(i in 2:(pop/2)) { J[ , runifint(1, 1, k), i] <- J[ , runifint(1, 1, k), (i + pop/2)] } for(i in (pop/2+1):pop) { J[ , runifint(1, 1, k), i] <- A[ , runifint(1, 1, k), posit] } for(i in 2:pop) { y <- runif(k) for(j in 1:k) { if(y[j] <= pMut) { z <- runifint(2, 1, n) a <- J[z[1], j, i] b <- J[z[2], j, i] J[z[1], j, i] <- b J[z[2], j, i] <- a } } } A <- J if(v!=gen && verbose) message(paste("Generation ", v, " completed",sep="")) } if (verbose) message("Last generation completed") P <- as.matrix(J[ , , 1]) test <- apply(P, 2, sum) if(all(test!=(n*(n+1)/2))) stop("Unexpected Result: A Latin Hypercube was not created\n") eps <- matrix(runif(n*k), nrow=n, ncol=k) P <- P - 1 + eps return(P/n) } lhs/R/augmentLHS.R0000644000175100001440000000561512752234762013432 0ustar hornikusers################################################################################ # # Function: augmentLHS.R # Purpose: To add an additional m points to an existing latin hypercube # design in lhs while maintaining marginal distribution uniformity # Author: Rob Carnell # Created: 26 May 05 # # Variables: lhs contains an existing latin hypercube design with a number # of rows equal to the points in the design (simulations) # and a number of columns equal to the number of variables # (parameters). The values of each cell must be between 0 and 1 # and uniformly distributed # m is the number of additional points to augment the design with # (default=1, must be a positive integer) # # Explanation: # First, create a matrix B to hold the candidate points after the design has # been re-partitioned into (N+m)^2 cells # We want to randomly sweep through each column (1 to K) in the repartitioned # design to see where the missing cells lie. # For each column (variable), randomly search for an empty row, generate a # random value that fits in that row, record the value in B # B can contain more filled cells than m unless m = 2N, in which case B will # contain exactly m filled cells # Finally, keep only the first m rows of B. It is guaranteed to have m full # rows in B. The deleted rows are partially full. The candidate # points are selected randomly due to the random search for empty cells # # 10/21/06 # augmentLHS functions where one row was added had an error - fixed # 8/8/2016 # Fixed a bug returning NA values # ################################################################################ augmentLHS <- function(lhs, m=1) { if (!is.matrix(lhs)) stop("Input Latin Hypercube Design must be in the Matrix class\n") if (length(m) != 1) stop("m may not be a vector") if (is.na(m) | is.infinite(m)) stop("m may not be infinite, NA, or NaN") if (m != floor(m) | m < 1) stop("m must be a positive integer\n") if (any(is.na(lhs))) stop("Input Design cannot contain any NA entries\n") if (any(lhs < 0 | lhs > 1)) stop(paste("Input Latin Hypercube Design must have entries on the ", "interval [0,1] which are uniformly distributed\n", sep="")) K <- ncol(lhs) N <- nrow(lhs) colvec <- order(runif(K)) rowvec <- order(runif(N + m)) B <- matrix(nrow=(N + m), ncol=K) for (j in colvec) { newrow <- 0 for (i in rowvec) { if (!(any((i-1)/(N + m) <= lhs[ ,j] & lhs[ ,j] < i/(N + m)))) { newrow <- newrow + 1 B[newrow, j] <- runif(1, (i-1)/(N + m), i/(N + m)) } } } if (is.matrix(B[1:m,])) { E <- rbind(lhs, B[1:m, ]) } else { E <- rbind(lhs, matrix(B[1:m,], nrow=m, ncol=K)) } row.names(E) <- NULL return(E) } lhs/R/improvedLHS.r0000644000175100001440000000637112752234762013657 0ustar hornikusers################################################################################ # # Function: improvedLHS.R # Purpose: To implement the Improved distributed Hypercube Sampling Algorithm # Author: This program is based on the MATLAB program written by # John Burkardt and modified 16 Feb 2005 # http://www.csit.fsu.edu/~burkardt/m_src/ihs/ # ihs.m # R and C code Author: Rob Carnell # Created: May 05 # # Required C function: improvedLHS_R.c # # Discussion: # N Points in an K dimensional Latin hypercube are to be selected. # This algorithm tries to pick a solution which has the property that the # points are "spread out" as evenly as possible. # It does this by determining an optimal even spacing given by OPT # It uses the DUPLICATION factor to limit the number of points available # to choose from at each step. # # Reference: # Brian Beachkofski, Ramana Grandhi, # Improved Distributed Hypercube Sampling, # American Institute of Aeronautics and Astronautics Paper 2002-1274. # # Parameters: # k= positive integer, the spatial dimension. # n= positive integer, the number of points to be generated. # dup= positive integer, the DUPLICATION factor. # (default=1, a value of 5 is reasonable according to Burkardt # # Returns: # A Latin Hypercube sample with N rows and K columns where each entry # is on the interval [0,1] # # Steps # 1. Calculate the optimum spacing interval # 2. Select a random starting point and place it in the matrix X # 3. Populate the matrix AVAIL with the integers from 1 to N # 4. Replace the values in AVAIL which have already been used by the # the first point in X with the value N # 5. Generate the valid points for each row in a random manner by using # the numbers in the rows of AVAIL # 6. For each cadidate point, calculate the distance to the points already # used in X. Select the candidate point with the distance value # closest to the value of OPT and place it in X # 7. Having chosen the new point for X, update AVAIL to replace those # numbers in each row that have been used. The first few columns in # AVAIL are valid points. # 8. There is only one choice for the last point # # 6/30/2012 # Changed the C function call # ################################################################################ improvedLHS <- function(n, k, dup=1){ if(length(n)!=1 |length(k)!=1 | length(dup)!=1) stop("n, k, and dup may not be vectors") if(any(is.na(c(n,k,dup)))) stop("n, k, and dup may not be NA or NaN") if(any(is.infinite(c(n,k,dup)))) stop("n, k, and dup may not be infinite") if(n!=floor(n) | n<1) stop("n must be a positive integer\n") if(k!=floor(k) | k<1) stop("k must be a positive integer\n") if(dup!=floor(dup) | dup<1) stop("The DUPLICATION (dup) factor must be a positive integer\n") result <- numeric(k*n) result2 <- .C("improvedLHS_C", as.integer(n), as.integer(k), as.integer(dup), as.integer(result))[[4]] eps <- runif(n*k) result2 <- (result2 - 1 + eps) / n #return(t(matrix(result2, nrow=k, ncol=n, byrow=TRUE))) return(matrix(result2, nrow=n, ncol=k, byrow=TRUE)) } lhs/R/randomLHS.r0000644000175100001440000000436312752234762013311 0ustar hornikusers################################################################################ # # Function: randomLHS.R # Purpose: This function creates a random latin hypercube design # Author: Doug Mooney # Modified: Rob Carnell # Date: May 05 # # Variables: # N is the number of partitions (simulations or design points) # K is the number of replication (variables) # preserveDraw = TRUE ensures that two subsequent draws with the same # N, but one with k and one with m variables (k randomlhd(4, 3) # [,1] [,2] [,3] # [1,] 0.1379328 0.8588952 0.1370420 # [2,] 0.5323584 0.2725897 0.6963334 # [3,] 0.4522889 0.5765811 0.9899364 # [4,] 0.8484975 0.1562488 0.4050679 # ######################################################################### randomLHS <- function(n, k, preserveDraw=FALSE) { if(length(n)!=1 |length(k)!=1) stop("n and k may not be vectors") if(any(is.na(c(n,k)))) stop("n and k may not be NA or NaN") if(any(is.infinite(c(n,k)))) stop("n and k may not be infinite") if(floor(n)!=n | n<1) stop("n must be a positive integer\n") if(floor(k)!=k | k<1) stop("k must be a positive integer\n") if(!(preserveDraw %in% c(TRUE, FALSE))) stop("preserveDraw must be TRUE/FALSE") if (preserveDraw) { f <- function(X, N) order(runif(N)) - 1 + runif(N) P <- sapply(1:k, f, N=n) } else { ranperm <- function(X, N) order(runif(N)) P <- matrix(nrow=n, ncol=k) P <- apply(P, 2, ranperm, N=n) P <- P - 1 + matrix(runif(n*k), nrow=n, ncol=k) } return(P/n) } lhs/R/runifint.r0000644000175100001440000000116312752234762013313 0ustar hornikusers################################################################################ # # Function: runifint.R # Purpose: To create a random uniform sample of integers. Not exported. # Author: Rob Carnell # Created: 26 May 05 # # Variables: # n is the number of samples # min_int the lower bounds (inclusive) # max_int the upper bounds (inclusive) # ################################################################################ runifint <- function(n=1, min_int=0, max_int=1) { r <- runif(n, min=0, max=1) int <- min_int + floor(r * (max_int + 1 - min_int)) int <- pmin(int, max_int) return(int) }lhs/R/optimumLHS.R0000644000175100001440000000654112752234762013463 0ustar hornikusers################################################################################ # # Function: optimumlhd.R # Purpose: To create a nearly optimal latin hypercube design with respect to # the S optimality criterion using the Columnwise-pairwise (CP) # Algorithm # Author: Rob Carnell # Created: 26 May 05 # # Variables: # n is the number of partitions (simulations or design points) # k is the number of replication (variables) # maxSweeps is the maximum number of times the CP algorithm is applied to all # the columns. # eps is the optimal stopping criterion (explained later) # # Reference: # This code was motivated by the work of Rafal Stocki # "A method to improve design reliability using optimal Latin hypercube # sampling" Institute of Fundamental Technological Research, Polish # Academy of Sciences, ul. Swietokrzyska 21, 00-049 Warsaw, Poland # # Explanation: # S optimality seeks to maximize the inverse of the sum of the distances # from each point in the design to all other points # Algorithm: generate a random latin hypercube design of size n by k # within each column of that matrix, interchange two numbers. # At each step, calculate the inverse of the sum of the distances between all # points, and pick modification which minimizes the distances. # Continue to move from column to column until the stopping criterion is # reached. Either the maximum number of sweeps through the matrix is reached, # or the interchanges in a given row have no benefit to the S optimality, or # the decrease in the inverse of the sum of the distances is small compared to # the first decrease due to the interchange in the first column (ratio set by # eps) # # Run Time and computer resources: Stocki asserts that processing time # increases proportional to K^5 for constant N and N^5 for constant K # # 6/30/2012 # Changed C function call. Added verbose parameter. # ################################################################################ optimumLHS <- function(n=10, k=2, maxSweeps=2, eps=.1, verbose=FALSE) { if(length(n)!=1 |length(k)!=1 | length(maxSweeps)!=1 |length(eps)!=1) stop("n, k, eps, and maxSweeps may not be vectors") if(any(is.na(c(n,k,maxSweeps,eps)))) stop("n, k, eps, and maxSweeps may not be NA or NaN") if(any(is.infinite(c(n,k,eps,maxSweeps)))) stop("n, k, eps, and maxSweeps may not be infinite") if(eps>=1 | eps<=0) stop("eps must fall in the interval (0,1)\n") if(floor(maxSweeps)!=maxSweeps | maxSweeps<1) stop("maxSweeps must be a positive integer\n") if(floor(n)!=n | n<1) stop("n must be a positive integer\n") if(floor(k)!=k | k<1) stop("k must be a positive integer\n") Pold <- matrix(0, nrow=n, ncol=k) for(j in 1:k) { Pold[ ,j] <- order(runif(n)) } Pold <- c(t(Pold)) # changes to an k*n length vector if(n==1) { message("Design is already optimal\n") return(matrix(Pold, nrow=n, ncol=k, byrow=TRUE)) } jLen <- choose(n, 2) + 1 resultList <- .C("optimumLHS_C", as.integer(n), as.integer(k), as.integer(maxSweeps), as.double(eps), as.integer(Pold), as.integer(jLen), as.integer(verbose)) result <- resultList[[5]] z <- runif(n*k) result <- (result - 1 + z) / n return(matrix(result, nrow=n, ncol=k, byrow=TRUE)) } lhs/R/maximinLHS.R0000644000175100001440000000552512752234762013434 0ustar hornikusers################################################################################ # # Function: maximinLHS.R # Purpose: To create an optimum Latin Hypercube Sampling algorithm that is # implements the maximin criteria. The maximin critera attemps to # maximize the minimum distance between points # Author: Rob Carnell # This program is motivated by the MATLAB program written by # John Burkardt # Created: May 05 # # Discussion: # n Points in an k dimensional Latin hypercube are to be selected. # This algorithm tries to pick a solution which has the property that the # points are S optimal. # It uses the dup (DUPLICATION) factor to limit the number of points available # to choose from at each step. # # Parameters: # k= positive integer, the spatial dimension. # n= positive integer, the number of points to be generated. # dup= positive integer, the DUPLICATION factor. # (default=1, a value of 5 is reasonable) # # Steps # 1. Select a random starting point and place it in the matrix X # 2. Populate the matrix AVAIL with the integers from 1 to n # 3. Replace the values in AVAIL which have already been used by the # the first point in X with the value N # 4. Generate the valid points for each row in a random manner by using # the numbers in the rows of AVAIL # 5. For each cadidate point, calculate the distance to the points already # used in X. Select the candidate point with the maximum minimum distance # value and place it in X (actually squared distance is used to eliminate # the square root processing step) # 7. Having chosen the new point for X, update AVAIL to replace those # numbers in each row that have been used. The first "count" columns in # AVAIL are valid points. # 8. There is only one choice for the last point # # 6/30/2012 # Changed the C function call # ################################################################################ maximinLHS <- function(n, k, dup=1) { if(length(n)!=1 |length(k)!=1 | length(dup)!=1) stop("n, k, and dup may not be vectors") if(any(is.na(c(n,k,dup)))) stop("n, k, and dup may not be NA or NaN") if(any(is.infinite(c(n,k,dup)))) stop("n, k, and dup may not be infinite") if(n!=floor(n) | n<1) stop("n must be a positive integer\n") if(k!=floor(k) | k<1) stop("k must be a positive integer\n") if(dup!=floor(dup) | dup<1) stop("The dup factor must be a positive integer\n") result <- numeric(k*n) result2 <- .C("maximinLHS_C", as.integer(n), as.integer(k), as.integer(dup), as.integer(result))[[4]] eps <- runif(n*k) result2 <- (result2 - 1 + eps) / n #return(t(matrix(result2, nrow=k, ncol=n, byrow=TRUE))) return(matrix(result2, nrow=n, ncol=k, byrow=TRUE)) } lhs/R/optAugmentLHS.R0000644000175100001440000001024712752234762014112 0ustar hornikusers################################################################################ # # Function: optAugmentLHS.R # Purpose: To add an additional m points to an existing latin hypercube # design in lhs while maintaining marginal distribution uniformity # and while attempting to maximize S optimality # Author: Rob Carnell # Created: 26 May 05 # # Variables: # lhs contains an existing latin hypercube design with a number # of rows equal to the points in the design (simulations) # and a number of columns equal to the number of variables # (parameters). The values of each cell must be between 0 and 1 and not # contain any NA entries. This algorithm also assumes that the # design is uniformly distributed # m = the number of addtional points to augment the design with # (default=1, must be a positive integer) # mult = a multiple. m*mult random candidate points will be created. # (default=2, and it is suggested for large values of m) # # Explanation: # 1. Test for undesirable conditions. # 2. Create a matrix B to hold the candidate points after the design has # been re-partitioned into (N+m)^2 cells # 3. Randomly sweep through each column (1 to K) in the repartitioned # design to see where the missing cells lie. # 4. For each column (variable), randomly search for an empty cell, generate a # random value that fits in that cell, record the value in B # B can contain more filled cells than m unles m = 2N, in which case B will # contain exactly m filled cells # 5. Create a matrix P which contains random integers selecting # the cells of B # 6. Replace the cells of P with the corresponding cells of B # There is no guarantee that all the possible points will be available in P # 7. Find the distance from each point in P to the current design # 8. Select the point which maximizes the distance # 9. Update B by eliminating the cells in each column of B which correspond # to the point that was just used to augment the design # 10. Repeat until all m points are filled # ################################################################################ optAugmentLHS <- function(lhs, m=1, mult=2) { if(is.matrix(lhs)==FALSE) stop("Input Design must be in the Matrix class\n") if(length(m)!=1 | length(mult)!=1) stop("m and mult may not be vectors") if(is.na(m) | is.infinite(m)) stop("m may not be infinite, NA, or NaN") if(is.na(mult) | is.infinite(mult)) stop("mult may not be infinite, NA, or NaN") if(m!=floor(m) | m<1) stop("m must be a positive integer\n") if(any(is.na(lhs)==TRUE)) stop("Input Design cannot contain any NA entries\n") if(any(lhs<0 | lhs>1)) stop("Input Design must have entries on the interval [0,1]\n") K <- ncol(lhs) N <- nrow(lhs) colvec <- order(runif(K)) rowvec <- order(runif(N + m)) B <- matrix(nrow=(N + m), ncol=K) for(j in colvec) { newrow <- 0 for(i in rowvec) { if((any((i-1)/(N + m) <= lhs[ ,j] & lhs[ ,j] <= i/(N + m)))==FALSE) { newrow <- newrow + 1 B[newrow, j] <- runif(1, (i-1)/(N + m), i/(N + m)) } } } lhs <- rbind(lhs, matrix(nrow=m, ncol=K)) for(k in 1:m) { P <- matrix(nrow=m*mult, ncol=K) for(i in 1:K) { P[,i] <- runifint(m*mult, 1, length(na.exclude(B[,i]))) } for(i in 1:K) { for(j in 1:(m*mult)) { P[j, i] <- B[P[j, i], i] } } vec <- numeric(K) dist1 <- 0 maxdist <- .Machine$double.xmin for(i in 1:(m*mult-k+1)) { dist1 <- numeric(N+k-1) for(j in 1:(N+k-1)) { vec <- P[i,] - lhs[j,] dist1[j] <- vec%*%vec } if(sum(dist1) > maxdist) { maxdist <- sum(dist1) maxrow <- i } } lhs[N+k,] <- P[maxrow,] for(i in 1:K) { for(j in 1:length(na.omit(B[,i]))) { if(P[maxrow,i]==B[j,i]) B[j,i] <- NA } } for(i in 1:K) { if(length(na.omit(B[,i]))==0) next u <- length(na.omit(B[,i])) B[1:u,i] <- na.omit(B[,i]) B[(u+1):m,i] <- NA } } return(lhs) } lhs/vignettes/0000755000175100001440000000000012752234771013100 5ustar hornikuserslhs/vignettes/augmentLHS_Example.Rtex0000644000175100001440000001576612752234762017445 0ustar hornikusers\documentclass[a4paper]{article} \usepackage{Sweave} % to allow for Sweave \usepackage{fullpage} % for fullpage layout \usepackage{graphicx} % for figure inclusion \usepackage{amsmath} % for equation writing and subequations \usepackage{subfigure} % for subfigure numbering \title{An Example of Augmenting a Latin Hypercube} \author{Rob Carnell} \date{22 November 2007} \begin{document} \maketitle % Comment required to put the vignette into the package index %\VignetteIndexEntry{An Example of Augmenting a Latin Hypercube} %\VignetteKeyword{lhs} %\VignetteKeyword{latin hypercube} % --------------------------- Functions ---------------------------------------- \begin{Scode}{echo=FALSE} require(lhs) graph2DaugmentLHS1 <- function(sims, extras) { A <- randomLHS(sims, 2) B <- augmentLHS(A, extras) plot.default(A[,1], A[,2], type="n", ylim=c(0,1), xlim=c(0,1), xlab="x1", ylab="x2", xaxs="i", yaxs="i", main="" ) for(i in 1:length(A[,1])) { rect(floor(A[i,1]*sims)/sims, floor(A[i,2]*sims)/sims, ceiling(A[i,1]*sims)/sims, ceiling(A[i,2]*sims)/sims, col="grey") } points(A[,1], A[,2], pch=19, col="red") abline(v=(0:sims)/sims, h=(0:sims)/sims) return(list(A=A,B=B,sims=sims,extras=extras)) } graph2DaugmentLHS2 <- function(X) { A <- X$A B <- X$B sims <- X$sims extras <- X$extras plot.default(A[,1], A[,2], type="n", ylim=c(0,1), xlim=c(0,1), xlab="x1", ylab="x2", xaxs="i", yaxs="i", main="" ) N <- sims + extras for(i in 1:length(B[,1])) { rect(floor(B[i,1]*N)/N, floor(B[i,2]*N)/N, ceiling(B[i,1]*N)/N, ceiling(B[i,2]*N)/N, col="grey") } points(A[,1], A[,2], pch=19, col="red") points(B[((sims+1):(sims+extras)),1], B[((sims+1):(sims+extras)),2], pch=19, col="blue") abline(v=(0:N)/N, h=(0:N)/N) } #X <- graph2DaugmentLHS1(5,5) #graph2DaugmentLHS2(X) \end{Scode} % --------------------------- Text ------------------------------------------ Suppose that a computer simulation study is being designed that requires expensive runs. A Latin hypercube design is desired for this simulation so that the expectation of the simulation output can be estimated efficiently given the distributions of the input variables. Latin hypercubes are most often used in highly dimensional problems, but the example shown is of small dimension. Suppose further that the total extent of funding is uncertain. Enough money is available for 5 runs, and there is a chance that there will be enough for 5 more. However, if the money for the additional 5 runs does not materialize, then the first 5 runs must be a Latin hypercube alone. A design for this situation can be created using the \texttt{lhs} package.\\ First create a random Latin hypercube using the \texttt{randomLHS(n, k)} command: \begin{Scode} A <- randomLHS(5,2) \end{Scode} An example of this hypercube is shown in Figure \ref{fig:original5}. Note that the $Latin$ property of the hypercube requires that each of the 5 equal probability intervals be filled (i.e. each row and each column is filled with one point). Also notice that the exact location of the design point is randomly sampled from within that cell using a uniform distribution for each marginal variable.\\ \begin{figure}[p] \begin{center} \begin{Scode}{fig=TRUE,echo=FALSE} set.seed(10) X <- graph2DaugmentLHS1(5, 5) \end{Scode} \caption{A randomly produced Latin Hypercube with uniform marginal distributions for 2 parameters with 5 simulations.} \label{fig:original5} \end{center} \end{figure} Next, in order to augment the design with more points use \texttt{augmentLHS(lhs, m)}. The following will add 5 more points to the design: \begin{Scode} B <- augmentLHS(A, 5) \end{Scode} The \texttt{augmentLHS} function works by re-dividing the original design into $n+m$ intervals (e.g. 5+5=10) keeping the original design points exactly in the same position. It then randomly fills the empty row-column sets. The results are shown in Figure \ref{fig:augmented10}.\\ \begin{figure}[p] \begin{center} \begin{Scode}{fig=TRUE,echo=FALSE} graph2DaugmentLHS2(X) \end{Scode} \caption{A randomly produced Latin Hypercube of 5 points (red) with 5 augmented points (blue). Each parameter has a uniform marginal distribution.} \label{fig:augmented10} \end{center} \end{figure} The \texttt{augmentLHS} function uses the following algorithm (see the documentation for \texttt{augmentLHS}): \begin{itemize} \item Create a new $(n+m)$ by $k$ matrix to hold the candidate points after the design has been re-partitioned into $(n+m)^{2}$ cells, where $n$ is number of points in the original $lhs$ matrix.\\ \item Then randomly sweep through each column (1\ldots$k$) in the repartitioned design to find the missing cells.\\ \item For each column (variable), randomly search for an empty row, generate a random value that fits in that row, record the value in the new matrix. The new matrix can contain more than $m$ points unless $m = 2n$, in which case the new matrix will contain exactly $m$ filled rows.\\ \item Finally, keep only the first $m$ rows of the new matrix. It is guaranteed that there will be $m$ full rows (points) in the new matrix. The deleted rows are partially full. The additional candidate points are selected randomly because of the random search used to find empty cells.\\ \end{itemize} Also notice that because the original points are randomly placed within the cells, depending on how you bin the marginal distributions, a histogram (of x1 for example) will not necessarily be exactly uniform.\\ Now, the augmenting points do not necessarily form a Latin Hypercube themselves. The original design and augmenting points may form a Latin Hypercube, or there may be more than one point per row in the augmented design. If the augmented points are equal to the number of original points, then a strictly uniform Latin hypercube is guaranteed. An example of an augmented design which is not uniform in the marginal distributions is given in Figure \ref{fig:badAugment}. The commands were: \begin{Scode} A <- randomLHS(7, 2) B <- augmentLHS(A, 3) \end{Scode}\\ \begin{figure}[p] \centering \subfigure[Original design with 7 points.]{ \label{fig:badAugment:a} %% label for first subfigure \begin{Scode}{fig=TRUE,echo=FALSE} set.seed(12) X <- graph2DaugmentLHS1(7, 3) \end{Scode} } \hspace{0.5in} \subfigure[Augmented design with 3 additional points. Note that row 9 has 2 points and row 3 has none.]{ \label{fig:badAugment:b} %% label for second subfigure \begin{Scode}{fig=TRUE,echo=FALSE} graph2DaugmentLHS2(X) \end{Scode} } \caption{Augmented Latin hypercube design with a non-uniform marginal distribution.} \label{fig:badAugment} %% label for entire figure \end{figure} \end{document} lhs/MD50000644000175100001440000000463012752322544011377 0ustar hornikusersfc1e3999033f0552f3a9c5dffffa63ce *ChangeLog 39342ae7e43df71cebf8b7ed5cdf637a *DESCRIPTION 49b9628e9f383098e1758805daf5f40e *NAMESPACE 8fe4c844ce4c5640d48c90a0708fba96 *R/augmentLHS.R f10c1c4def0a680956843e50bf90a8dd *R/geneticLHS.R 6d0df3bec427a1741073f6047a75a698 *R/improvedLHS.r 6188e4c91d562f4b35f34c612d020f00 *R/maximinLHS.R bf01931e2d447da961544bd667c06c48 *R/optAugmentLHS.R 0f676497654a3c9d9a1c5ac7c03de44b *R/optSeededLHS.R 23b676cb6ad3dce7b25aa16e6ae838c5 *R/optimumLHS.R c0b4bd27ae5771fd74f8ffedb1a1ce2a *R/randomLHS.r 1827548f7dd29f6eea192097719311e1 *R/runifint.r b919e5c316b810f1a6aa3e357a5e6127 *build/vignette.rds 027456f4e65b84661e1f56f310850c6a *inst/doc/augmentLHS_Example.R c62d438d9d8e479af8541bbf6b6cad13 *inst/doc/augmentLHS_Example.Rtex d74096381d97cbdca2853260a54e7c59 *inst/doc/augmentLHS_Example.pdf 32d6e970d691cb524fbddce97962f111 *inst/unitTests/runit_augmentLHS.r 3bb0d524572432ba467990376eaa0558 *inst/unitTests/runit_geneticLHS.r 1082c1a44014bd449f0d76fc277b919c *inst/unitTests/runit_improvedLHS.r d40aa7457e7523852c501e2a26054f02 *inst/unitTests/runit_maximinLHS.r 76c59f95f8343fd1fff99261fd71cb4b *inst/unitTests/runit_optAugmentLHS.r 79ce836c7da5f7094d109dad706d9dd8 *inst/unitTests/runit_optSeededLHS.r 26b0c8babdebe2850e6449001a9ba089 *inst/unitTests/runit_optimumLHS.r c2baaf2a0c816b8b1138dbc7db64aa0e *inst/unitTests/runit_randomLHS.r bf9e1aa5d1da45cdcb3b8cefe0d567d6 *man/augmentLHS.Rd b1f6d9fcb06efa6e8eea90aca5beb794 *man/geneticLHS.Rd 6d00dfb44335d1deed01473e13ad3465 *man/improvedLHS.Rd e69533940acd0fb854248d7519db6180 *man/lhs-internal.Rd 92ef0aa75f8bd8ab77f616f7c898376f *man/lhs-package.rd 9d36383709b86300337e5267148fe2ba *man/maximinLHS.Rd 88d089b249a4e3df03c7c83c22cb8f29 *man/optAugmentLHS.Rd 921de5038e7b99803389af443f1fb331 *man/optSeededLHS.Rd a1d59435279af17bb744f313cfd93778 *man/optimumLHS.Rd ab0e26f96c6ba3e0e2493a9ef76be3d7 *man/randomLHS.Rd b06b70be6ce252121955d004c4dd4e5b *src/defines.h 8606b25ca7497b9020c965472a7587ab *src/improvedLHS_R.cpp c1d06b3029822f6aba388ffc63c584ae *src/maximinLHS_R.cpp 4adcbce55b034267fa156a8e58a79d6b *src/optSeededLHS_R.cpp d7efc3fd518977718190b57a50626658 *src/optimumLHS_R.cpp 9e7265538f6919bc1cb688b2b5e31445 *src/simpleMatrix.h d7655241cb7ae08089d6b5a56ba7fa3a *src/utilityLHS_R.cpp 84b4bf8f980adc9f0f5df8716f395697 *src/utilityLHS_R.h 0623d0fe09df5fbb9c23e1c427383921 *tests/runTests.R c62d438d9d8e479af8541bbf6b6cad13 *vignettes/augmentLHS_Example.Rtex lhs/build/0000755000175100001440000000000012752234771012167 5ustar hornikuserslhs/build/vignette.rds0000644000175100001440000000037712752234771014535 0ustar hornikusersmPn0 u4$&vy $8La7Q*i7B4'y~O\KA!sj|9ܫ8 3WH-PȬSERV_d^M4N^0W,-Ͻc5 "&Ỿhk/+8gu]UY0 FJ"*n=ЙqO:leί|+[8;XiQU(?̈_lhs/DESCRIPTION0000644000175100001440000000114212752322544012570 0ustar hornikusersPackage: lhs Version: 0.14 Date: 2016-08-08 Title: Latin Hypercube Samples Authors@R: c(person("Rob", "Carnell", role=c("aut","cre"), email="bertcarnell@gmail.com")) Author: Rob Carnell [aut, cre] Maintainer: Rob Carnell Depends: R (>= 2.14.2) Suggests: RUnit Description: Provides a number of methods for creating and augmenting Latin Hypercube Samples. License: GPL (>= 2) URL: http://lhs.r-forge.r-project.org BugReports: http://r-forge.r-project.org/projects/lhs/ NeedsCompilation: yes Packaged: 2016-08-09 02:03:37 UTC; Rob Repository: CRAN Date/Publication: 2016-08-09 11:41:56 lhs/ChangeLog0000644000175100001440000000373212752234762012647 0ustar hornikusersVersion 0.1 Version 0.2 Bug suggested by Bjarne Hansen fixed 7/20/06. Bug involved augmenting lhs samples with one parameter. Example a <- randomLHS(4, 1); augmentLHS(a, 2). RUnit test added to check this bug. All RUnit tests satisfactory. Version 0.3 Another bug reported by Bjarne Hansen on 7/23/06, and fixed on 10/21/06. The bug involved augmenting a hypercube with one point. RUnit test added to check this bug. All RUnit tests satisfactory. Also added documentation consisting of an augmentation example. Added a lhs package help page. Version 0.4 Changed the license to GPL >= 2 according to a Kurt Hornik email Version 0.5 Change output filenames to be portable Version 0.6 Added a new option to randomLHS to allow for similar lhs's when the seed is set and columns are added Version 0.7 Removed test directories to fix them for the proper package structure. Version 0.8 Refactored the underlying C code into C++ to add range checks for internal arrays. Corrected a bug suggested by XXXX on DATE. Corrected the bug suggested by Prof Ripley on DATE with the range checking. Version 0.9 Removed non-portable code introduced in Version 0.8 Version 0.10 Changed static template method definitions to be included in the definition of the utilityLHS class, instead of in the header below the class. Version 0.11 Fixed a bug in the geneticLHS code and added Maximin to the optimization criteria. Fixed a bug caused by a change in R2.3.3 that requires a matrix dimnames to be a list. Added an importFrom to the namespace. Version 0.12 Fixed a bug in the Description file. Version 0.13 Numerical accuracy checks on the Solaris 10 systems was failing. Unable to reproduce this error easily, but it is limited to the numerical accuracy tests. Eliminated the numerical tests for Solaris/Sun/Sparc. Version 0.14 Fixed a bug suggested by Roland Lowe on 8/4/2016. lhs/man/0000755000175100001440000000000012752234762011643 5ustar hornikuserslhs/man/optimumLHS.Rd0000644000175100001440000000560612752234762014202 0ustar hornikusers\name{optimumLHS} \alias{optimumLHS} \title{Optimum Latin Hypercube Sample} \description{ Draws a Latin Hypercube Sample from a set of uniform distributions for use in creating a Latin Hypercube Design. This function uses the Columnwise Pairwise (\acronym{CP}) algorithm to generate an optimal design with respect to the S optimality criterion. } \usage{optimumLHS(n=10, k=2, maxSweeps=2, eps=.1, verbose=FALSE)} \arguments{ \item{n}{The number of partitions (simulations or design points)} \item{k}{The number of replications (variables)} \item{maxSweeps}{The maximum number of times the CP algorithm is applied to all the columns.} \item{eps}{The optimal stopping criterion} \item{verbose}{Print informational messages} } \details{ Latin hypercube sampling (LHS) was developed to generate a distribution of collections of parameter values from a multidimensional distribution. A square grid containing possible sample points is a Latin square iff there is only one sample in each row and each column. A Latin hypercube is the generalisation of this concept to an arbitrary number of dimensions. When sampling a function of \code{k} variables, the range of each variable is divided into \code{n} equally probable intervals. \code{n} sample points are then drawn such that a Latin Hypercube is created. Latin Hypercube sampling generates more efficient estimates of desired parameters than simple Monte Carlo sampling. This program generates a Latin Hypercube Sample by creating random permutations of the first \code{n} integers in each of \code{k} columns and then transforming those integers into n sections of a standard uniform distribution. Random values are then sampled from within each of the n sections. Once the sample is generated, the uniform sample from a column can be transformed to any distribution by using the quantile functions, e.g. qnorm(). Different columns can have different distributions. S-optimality seeks to maximize the mean distance from each design point to all the other points in the design, so the points are as spread out as possible. This function uses the \acronym{CP} algorithm to generate an optimal design with respect to the S optimality criterion. } \value{ An \code{n} by \code{k} Latin Hypercube Sample matrix with values uniformly distributed on [0,1] } \references{ Stocki, R. (2005) A method to improve design reliability using optimal Latin hypercube sampling \emph{Computer Assisted Mechanics and Engineering Sciences} \bold{12}, 87--105. } \author{Rob Carnell} \seealso{ \code{\link{randomLHS}}, \code{\link{geneticLHS}}, \code{\link{improvedLHS}} and \code{\link{maximinLHS}} to generate Latin Hypercube Samples. \code{\link{optAugmentLHS}}, \code{\link{optSeededLHS}}, and \code{\link{augmentLHS}} to modify and augment existing designs. } \examples{ optimumLHS(4, 3, 5, .05) } \keyword{design} lhs/man/optAugmentLHS.Rd0000644000175100001440000000322212752234762014623 0ustar hornikusers\name{optAugmentLHS} \alias{optAugmentLHS} \title{Optimal Augmented Latin Hypercube Sample} \description{ Augments an existing Latin Hypercube Sample, adding points to the design, while maintaining the \emph{latin} properties of the design. This function attempts to add the points to the design in an optimal way. } \usage{optAugmentLHS(lhs, m=1, mult=2)} \arguments{ \item{lhs}{The Latin Hypercube Design to which points are to be added} \item{m}{The number of additional points to add to matrix \code{lhs}} \item{mult}{\code{m*mult} random candidate points will be created.} } \details{ Augments an existing Latin Hypercube Sample, adding points to the design, while maintaining the \emph{latin} properties of the design. This function attempts to add the points to the design in a way that maximizes S optimality. S-optimality seeks to maximize the mean distance from each design point to all the other points in the design, so the points are as spread out as possible. } \value{ An \code{n} by \code{k} Latin Hypercube Sample matrix with values uniformly distributed on [0,1] } \references{ Stein, M. (1987) Large Sample Properties of Simulations Using Latin Hypercube Sampling. \emph{Technometrics}. \bold{29}, 143--151. } \author{Rob Carnell} \seealso{ \code{\link{randomLHS}}, \code{\link{geneticLHS}}, \code{\link{improvedLHS}}, \code{\link{maximinLHS}}, and \code{\link{optimumLHS}} to generate Latin Hypercube Samples. \code{\link{optSeededLHS}} and \code{\link{augmentLHS}} to modify and augment existing designs. } \examples{ a <- randomLHS(4,3) a optAugmentLHS(a, 2, 3) } \keyword{design} lhs/man/maximinLHS.Rd0000644000175100001440000000540112752234762014143 0ustar hornikusers\name{maximinLHS} \alias{maximinLHS} \title{Maximin Latin Hypercube Sample} \description{ Draws a Latin Hypercube Sample from a set of uniform distributions for use in creating a Latin Hypercube Design. This function attempts to optimize the sample by maximizing the minium distance between design points (maximin criteria). } \usage{maximinLHS(n, k, dup=1)} \arguments{ \item{n}{The number of partitions (simulations or design points)} \item{k}{The number of replications (variables)} \item{dup}{A factor that determines the number of candidate points used in the search. A multiple of the number of remaining points than can be added.} } \details{ Latin hypercube sampling (LHS) was developed to generate a distribution of collections of parameter values from a multidimensional distribution. A square grid containing possible sample points is a Latin square iff there is only one sample in each row and each column. A Latin hypercube is the generalisation of this concept to an arbitrary number of dimensions. When sampling a function of \code{k} variables, the range of each variable is divided into \code{n} equally probable intervals. \code{n} sample points are then drawn such that a Latin Hypercube is created. Latin Hypercube sampling generates more efficient estimates of desired parameters than simple Monte Carlo sampling. This program generates a Latin Hypercube Sample by creating random permutations of the first \code{n} integers in each of \code{k} columns and then transforming those integers into n sections of a standard uniform distribution. Random values are then sampled from within each of the n sections. Once the sample is generated, the uniform sample from a column can be transformed to any distribution by using the quantile functions, e.g. qnorm(). Different columns can have different distributions. Here, values are added to the design one by one such that the maximin criteria is satisfied. } \value{ An \code{n} by \code{k} Latin Hypercube Sample matrix with values uniformly distributed on [0,1] } \references{ Stein, M. (1987) Large Sample Properties of Simulations Using Latin Hypercube Sampling. \emph{Technometrics}. \bold{29}, 143--151. This function is motivated by the MATLAB program written by John Burkardt and modified 16 Feb 2005 \url{http://www.csit.fsu.edu/~burkardt/m_src/ihs/ihs.m} } \author{Rob Carnell} \seealso{ \code{\link{randomLHS}}, \code{\link{geneticLHS}}, \code{\link{improvedLHS}} and \code{\link{optimumLHS}} to generate Latin Hypercube Samples. \code{\link{optAugmentLHS}}, \code{\link{optSeededLHS}}, and \code{\link{augmentLHS}} to modify and augment existing designs. } \examples{ maximinLHS(4, 3, 2) } \keyword{design} lhs/man/improvedLHS.Rd0000644000175100001440000000557712752234762014344 0ustar hornikusers\name{improvedLHS} \alias{improvedLHS} \title{Improved Latin Hypercube Sample} \description{ Draws a Latin Hypercube Sample from a set of uniform distributions for use in creating a Latin Hypercube Design. This function attempts to optimize the sample with respect to an optimum euclidean distance between design points. } \usage{improvedLHS(n, k, dup=1)} \arguments{ \item{n}{The number of partitions (simulations or design points)} \item{k}{The number of replications (variables)} \item{dup}{A factor that determines the number of candidate points used in the search. A multiple of the number of remaining points than can be added.} } \details{ Latin hypercube sampling (LHS) was developed to generate a distribution of collections of parameter values from a multidimensional distribution. A square grid containing possible sample points is a Latin square iff there is only one sample in each row and each column. A Latin hypercube is the generalisation of this concept to an arbitrary number of dimensions. When sampling a function of \code{k} variables, the range of each variable is divided into \code{n} equally probable intervals. \code{n} sample points are then drawn such that a Latin Hypercube is created. Latin Hypercube sampling generates more efficient estimates of desired parameters than simple Monte Carlo sampling. This program generates a Latin Hypercube Sample by creating random permutations of the first \code{n} integers in each of \code{k} columns and then transforming those integers into n sections of a standard uniform distribution. Random values are then sampled from within each of the n sections. Once the sample is generated, the uniform sample from a column can be transformed to any distribution by using the quantile functions, e.g. qnorm(). Different columns can have different distributions. This function attempts to optimize the sample with respect to an optimum euclidean distance between design points. \deqn{Optimum distance = frac{n}{n^{\frac{1.0}{k}}}}{Optimum distance = n/n^(1.0/k)} } \value{ An \code{n} by \code{k} Latin Hypercube Sample matrix with values uniformly distributed on [0,1] } \references{ Beachkofski, B., Grandhi, R. (2002) Improved Distributed Hypercube Sampling \emph{American Institute of Aeronautics and Astronautics Paper} \bold{1274}. This function is based on the MATLAB program written by John Burkardt and modified 16 Feb 2005 \url{http://www.csit.fsu.edu/~burkardt/m_src/ihs/ihs.m} } \author{Rob Carnell} \seealso{ \code{\link{randomLHS}}, \code{\link{geneticLHS}}, \code{\link{maximinLHS}}, and \code{\link{optimumLHS}} to generate Latin Hypercube Samples. \code{\link{optAugmentLHS}}, \code{\link{optSeededLHS}}, and \code{\link{augmentLHS}} to modify and augment existing designs. } \examples{ improvedLHS(4, 3, 2) } \keyword{design} lhs/man/optSeededLHS.Rd0000644000175100001440000000336112752234762014420 0ustar hornikusers\name{optSeededLHS} \alias{optSeededLHS} \title{Optimum Seeded Latin Hypercube Sample} \description{ Augments an existing Latin Hypercube Sample, adding points to the design, while maintaining the \emph{latin} properties of the design. This function then uses the columnwise pairwise (\acronym{CP}) algoritm to optimize the design. The original design is not necessarily maintained. } \usage{optSeededLHS(seed, m=1, maxSweeps=2, eps=.1, verbose=FALSE)} \arguments{ \item{seed}{The number of partitions (simulations or design points)} \item{m}{The number of additional points to add to matrix \code{seed}} \item{maxSweeps}{The maximum number of times the CP algorithm is applied to all the columns.} \item{eps}{The optimal stopping criterion} \item{verbose}{Print informational messages} } \details{ Augments an existing Latin Hypercube Sample, adding points to the design, while maintaining the \emph{latin} properties of the design. This function then uses the \acronym{CP} algoritm to optimize the design. The original design is not necessarily maintained. } \value{ An \code{n} by \code{k} Latin Hypercube Sample matrix with values uniformly distributed on [0,1] } \references{ Stein, M. (1987) Large Sample Properties of Simulations Using Latin Hypercube Sampling. \emph{Technometrics}. \bold{29}, 143--151. } \author{Rob Carnell} \seealso{ \code{\link{randomLHS}}, \code{\link{geneticLHS}}, \code{\link{improvedLHS}}, \code{\link{maximinLHS}}, and \code{\link{optimumLHS}} to generate Latin Hypercube Samples. \code{\link{optAugmentLHS}} and \code{\link{augmentLHS}} to modify and augment existing designs. } \examples{ a <- randomLHS(4,3) a optSeededLHS(a, 2, 2, .1) } \keyword{design} lhs/man/lhs-internal.Rd0000644000175100001440000000075212752234762014536 0ustar hornikusers\name{lhs-internal} \alias{utility} \alias{runifint} \title{ Internal lhs Functions } \description{ Internal functions for package lhs } \details{ These are not to be called by the user but are used internally in the lhs package. } \usage{ runifint(n=1, min_int=0, max_int=1) } \arguments{ \item{n}{The number of samples} \item{min_int}{The lower bound of the distribution (inclusive)} \item{max_int}{The upper bound of the distribution (inclusive)} } \keyword{ internal } lhs/man/augmentLHS.Rd0000644000175100001440000000427412752234762014150 0ustar hornikusers\name{augmentLHS} \alias{augmentLHS} \title{Augment a Latin Hypercube Design} \description{ Augments an existing Latin Hypercube Sample, adding points to the design, while maintaining the \emph{latin} properties of the design. } \usage{augmentLHS(lhs, m=1)} \arguments{ \item{lhs}{The Latin Hypercube Design to which points are to be added} \item{m}{The number of additional points to add to matrix \code{lhs}} } \details{ Augments an existing Latin Hypercube Sample, adding points to the design, while maintaining the \emph{latin} properties of the design. Augmentation is perfomed in a random manner. The algorithm used by this function has the following steps. First, create a new matrix to hold the candidate points after the design has been re-partitioned into \eqn{(n+m)^{2}}{(n+m)^2} cells, where n is number of points in the original \code{lhs} matrix. Then randomly sweep through each column (1\ldots\code{k}) in the repartitioned design to find the missing cells. For each column (variable), randomly search for an empty row, generate a random value that fits in that row, record the value in the new matrix. The new matrix can contain more filled cells than \code{m} unles \eqn{m = 2n}, in which case the new matrix will contain exactly \code{m} filled cells. Finally, keep only the first m rows of the new matrix. It is guaranteed to have \code{m} full rows in the new matrix. The deleted rows are partially full. The additional candidate points are selected randomly due to the random search for empty cells. } \value{ An \code{n} by \code{k} Latin Hypercube Sample matrix with values uniformly distributed on [0,1] } \references{ Stein, M. (1987) Large Sample Properties of Simulations Using Latin Hypercube Sampling. \emph{Technometrics}. \bold{29}, 143--151. } \author{Rob Carnell} \seealso{ \code{\link{randomLHS}}, \code{\link{geneticLHS}}, \code{\link{improvedLHS}}, \code{\link{maximinLHS}}, and \code{\link{optimumLHS}} to generate Latin Hypercube Samples. \code{\link{optAugmentLHS}} and \code{\link{optSeededLHS}} to modify and augment existing designs. } \examples{ a <- randomLHS(4,3) a augmentLHS(a, 2) } \keyword{design} lhs/man/lhs-package.rd0000644000175100001440000000124212752234762014350 0ustar hornikusers\name{lhs-package} \alias{lhs-package} \alias{lhs} \docType{package} \title{ The Latin Hypercube Sample (lhs) Package } \description{ This package provides a number of methods for creating and augmenting Latin Hypercube Samples For a complete list of functions, use library(help="lhs"). } \author{ Rob Carnell } \keyword{design} \seealso{ \code{\link{randomLHS}}, \code{\link{geneticLHS}}, \code{\link{improvedLHS}}, \code{\link{maximinLHS}}, and \code{\link{optimumLHS}} to generate Latin Hypercube Samples. \code{\link{optAugmentLHS}}, \code{\link{optSeededLHS}}, and \code{\link{augmentLHS}} to modify and augment existing designs. } lhs/man/geneticLHS.Rd0000644000175100001440000000755212752234762014130 0ustar hornikusers\name{geneticLHS} \alias{geneticLHS} \title{Latin Hypercube Sampling with a Genetic Algorithm} \description{ Draws a Latin Hypercube Sample from a set of uniform distributions for use in creating a Latin Hypercube Design. This function attempts to optimize the sample with respect to the S optimality criterion through a genetic type algorithm. } \usage{geneticLHS(n=10, k=2, pop=100, gen=4, pMut=.1, criterium="S", verbose=FALSE)} \arguments{ \item{n}{The number of partitions (simulations or design points)} \item{k}{The number of replications (variables)} \item{pop}{The number of designs in the initial population} \item{gen}{The number of generations over which the algorithm is applied} \item{pMut}{The probability with which a mutation occurs in a column of the progeny} \item{criterium}{The optimality criterium of the algorithm. Default is \code{S}. \code{Maximin} is also supported} \item{verbose}{Print informational messages. Default is \code{FALSE}} } \details{ Latin hypercube sampling (LHS) was developed to generate a distribution of collections of parameter values from a multidimensional distribution. A square grid containing possible sample points is a Latin square iff there is only one sample in each row and each column. A Latin hypercube is the generalisation of this concept to an arbitrary number of dimensions. When sampling a function of \code{k} variables, the range of each variable is divided into \code{n} equally probable intervals. \code{n} sample points are then drawn such that a Latin Hypercube is created. Latin Hypercube sampling generates more efficient estimates of desired parameters than simple Monte Carlo sampling. This program generates a Latin Hypercube Sample by creating random permutations of the first \code{n} integers in each of \code{k} columns and then transforming those integers into n sections of a standard uniform distribution. Random values are then sampled from within each of the n sections. Once the sample is generated, the uniform sample from a column can be transformed to any distribution by using the quantile functions, e.g. qnorm(). Different columns can have different distributions. S-optimality seeks to maximize the mean distance from each design point to all the other points in the design, so the points are as spread out as possible. Genetic Algorithm: \enumerate{ \item Generate \code{pop} random latin hypercube designs of size \code{n} by \code{k} \item Calculate the S optimality measure of each design \item Keep the best design in the first position and throw away half of the rest of the population \item Take a random column out of the best matrix and place it in a random column of each of the other matricies, and take a random column out of each of the other matricies and put it in copies of the best matrix thereby causing the progeny \item For each of the progeny, cause a genetic mutation \code{pMut} percent of the time. The mutation is accomplished by swtching two elements in a column } } \value{ An \code{n} by \code{k} Latin Hypercube Sample matrix with values uniformly distributed on [0,1] } \references{ Stocki, R. (2005) A method to improve design reliability using optimal Latin hypercube sampling \emph{Computer Assisted Mechanics and Engineering Sciences} \bold{12}, 87--105. Stein, M. (1987) Large Sample Properties of Simulations Using Latin Hypercube Sampling. \emph{Technometrics}. \bold{29}, 143--151. } \author{Rob Carnell} \seealso{ \code{\link{randomLHS}}, \code{\link{improvedLHS}}, \code{\link{maximinLHS}}, and \code{\link{optimumLHS}} to generate Latin Hypercube Samples. \code{\link{optAugmentLHS}}, \code{\link{optSeededLHS}}, and \code{\link{augmentLHS}} to modify and augment existing designs. } \examples{ geneticLHS(4, 3, 50, 5, .25) } \keyword{design} lhs/man/randomLHS.Rd0000644000175100001440000000567412752234762013775 0ustar hornikusers\name{randomLHS} \alias{randomLHS} \alias{latin hypercube} \title{Random Latin Hypercube} \description{ Draws a Latin Hypercube Sample from a set of uniform distributions for use in creating a Latin Hypercube Design. This sample is taken in a random manner without regard to optimization. } \usage{randomLHS(n, k, preserveDraw)} \arguments{ \item{n}{The number of partitions (simulations or design points)} \item{k}{The number of replications (variables)} \item{preserveDraw}{Default:FALSE. Ensures that two subsequent draws with the same \code{n}, but one with \code{k} and one with \code{m} variables \code{(k