Code: Select all
namespace EvoRnd
dim as long ffile
sub init()
if ffile<>0 then return
ffile=freefile()
Open "/dev/urandom" For Input As #ffile
end sub
sub finish()
close #ffile
ffile=0
end sub
function rand() as ulongint
dim as ulongint k
get #ffile,,k
return k
end function
end namespace
namespace RndAdapt
' returns a scale free mutation between (-1,1). The precision defines the minimum magnitude and scaling range.
function mutateSingleSym naked (k as ulongint,precision as ulong) as single
asm
mov eax,edi
bswapq rdi
imul rax,rsi
mov esi,126
and edi,0x807fffff
shr rax,32
xorps xmm0,xmm0
sub esi,eax
jc endms
sal esi,23
or edi,esi
movd xmm0,edi
endms:
ret
end asm
end function
function mutateSym(precision as ulong) as single
return mutateSingleSym(EvoRnd.rand(),precision)
end function
function mutate(precision as ulong) as single
var r=mutateSingleSym(EvoRnd.rand(),precision)
return iif(r<0!,-r,r)
end function
'random uniform between 0 and 1 excludes 1
function uniform() as single
return EvoRnd.rand()*5.4210107E-20!
end function
'converts a random ulong k to a long between [min,max]. Includes min and max
function rndInt(k as ulong,min as longint,max as longint) as long
dim as ulongint r=k*(max-min+1)
return (r shr 32)+min
end function
sub permutate(x() as ulong,m as ulong)
for i as ulong=0 to m
var r=rndInt(EvoRnd.rand(),i,ubound(x))
swap x(i),x(r)
next
end sub
end namespace
namespace xfile
function openfile(filename as string) as long
var ff=freefile()
open filename for binary as #ff
seek #ff,1
return ff
end function
sub closefile(free_file as long)
close #free_file
end sub
end namespace
#define fnType function(x() as single) as single
type EvoSF
dimM as ulong
dimPrm(any) as ulong
precision1 as ulong
precision2 as ulong
parentIter as ulong
childIter as ulong
grandparentCost as single
grandparent(any) as single
parent(any) as single
child(any) as single
declare constructor(fnDim as ulong,precision1 as ulong,precision2 as ulong,parentIter as ulong,childIter as ulong)
declare destructor()
declare sub initMemory()
declare sub mutateVec(mutated() as single,in() as single)
declare sub optimise(fn as fnType)
declare function getResult(x() as single) as single
declare sub copyVec(x() as single,y() as single)
declare function load(free_file as long) as boolean
declare function save(free_file as long) as boolean
end type
constructor EvoSF(fnDim as ulong,precision1 as ulong,precision2 as ulong,parentIter as ulong,childIter as ulong)
this.precision1=precision1
this.precision2=precision2
this.parentIter=parentIter
this.childIter=childIter
this.dimM=fnDim-1
initMemory()
EvoRnd.init()
grandparentCost=1!/0!
for i as ulong=0 to dimM
grandparent(i)=RndAdapt.uniform()
next
end constructor
destructor EvoSF()
erase grandparent,parent,child,dimPrm
EvoRnd.finish()
end destructor
sub EvoSF.initMemory()
redim grandparent(dimM)
redim parent(dimM)
redim child(dimM)
redim dimPrm(dimM)
for i as ulong=0 to dimM
dimPrm(i)=i
next
end sub
function EvoSF.save(free_file as long) as boolean
var e=put(#free_file,,precision1)
e or=put(#free_file,,precision2)
e or=put(#free_file,,parentIter)
e or=put(#free_file,,childIter)
e or=put(#free_file,,dimM)
e or=put(#free_file,,grandparentcost)
e or=put(#free_file,,grandparent())
return e=0
end function
function EvoSF.load(free_file as long) as boolean
var e=get(#free_file,,precision1)
e or=get(#free_file,,precision2)
e or=get(#free_file,,parentIter)
e or=get(#free_file,,childIter)
e or=get(#free_file,,dimM)
e or=get(#free_file,,grandparentcost)
initMemory()
e or=get(#free_file,,grandparent())
return e=0
end function
sub EvoSF.mutateVec(mutated() as single,in() as single)
copyVec(mutated(),in())
var m=int(dimM*RndAdapt.mutate(precision2))
RndAdapt.permutate(dimPrm(),m)
for i as ulong=0 to m
var idx=dimPrm(i)
var r=in(idx)+RndAdapt.mutateSym(precision1)
if r>1! or r<0! then r=in(idx)
mutated(idx)=r
next
end sub
sub EvoSF.copyVec(x() as single,y() as single)
for i as ulong=0 to dimM
x(i)=y(i)
next
end sub
function EvoSF.getResult(x() as single) as single
copyVec(x(),grandparent())
return grandparentcost
end function
sub EvoSF.optimise(fn as fnType)
for i as ulong=0 to parentIter-1
mutateVec(parent(),grandparent())
var parentcost=fn(parent())
for j as ulong=0 to childIter-1
mutateVec(child(),parent())
var childcost=fn(child())
if childcost<parentcost then
parentcost=childcost
copyVec(parent(),child())
end if
next
if parentcost<grandparentcost then
grandparentcost=parentcost
copyVec(grandparent(),parent())
end if
next
end sub
/'f(-0.54719,-1.54719)=-1.9133
function test(u() as single) as single
var x=u(0)*5.5!-1.5!
var y=u(1)*7!-3!
return sin(x+y)+(x-y)*(x-y)-1.5*x+2.5*y+1
end function '/
' -391.16599
function test(u() as single) as single
dim as single res
for i as ulong=0 to ubound(u)
var x=u(i)*10!-5!
res+=0.5!*(x*x*x*x-16*x*x+5*x)
next
return res
end function
dim as EvoSF e=EvoSF(10,40,40,100,1000)
e.optimise(@test)
print e.grandparentcost
getkey