type hcUnit
as ubyte best(any)
as double er_best
as long ub, c
declare sub mutate
declare sub source_data(p as ubyte ptr, ub as long = -1)
private:
declare function get_err(i as long) as single
as double er_temp
as ubyte ptr psrc
end type
sub hcUnit.source_data(_p as ubyte ptr, _ub as long)
psrc=_p: ub=_ub: c=ub+1: redim best(ub)
er_best = 0
for i as long = 0 to ub
er_best += get_err(i)
next
end sub
sub hcUnit.mutate
'typically, a solver adjusts inputs.
'here i'm manipulating the actual bitmap (output)
var elem = int(rnd*c)
var err0 = get_err(elem)
var sav_best = best(elem)
best(elem) = int(rnd*256)
var err1 = get_err(elem)
if err1 < err0 then
er_best += err1 - err0
else
best(elem) = sav_best
endif
end sub
function hcUnit.get_err(i as long) as single
return abs(best(i) - psrc[i])
end function
dim as ubyte source(9)
for i as long = 0 to ubound(source)
source(i) = int(rnd*256)
next
dim as hcUnit hc
hc.source_data @source(0), ubound(source)
for i as long = 1 to 1000
hc.mutate
next
sub printout(p as ubyte ptr, ub as long = -1)
for i as long = 0 to ub
? p[i];
next
end sub
? "desired error: "; 0
? "obtained error: "; hc.er_best
?
? "original: ";: printout @source(0), hc.ub: ?
? "result: ";: printout @hc.best(0), hc.ub
sleep
Last edited by dafhi on Sep 05, 2017 3:49, edited 49 times in total.
hi owen .. i haven't 'forgotten' about your query. i lost interest in my demo after failed optimization attempts.
The wind is back in my sail and I nailed the optimization. Since then i've been conceptualizing a more general approach.
if you're talking about splines, something like this:
overview
3 splines: 1 reference and 2 temporary
A. udt.reference (spline)
[secondary goal: reduce sampling size]
for each udt.reference pixel, pixloc(i) = location 1d
B. sub compare()
1. udt.temp (spline) = udt.best (spline)
2. mutate udt.temp (spline)
3. erase udt.best (spline)
4. draw udt.temp (spline)
5. error function
a. err_temp = 0: loop: err_temp += reference(pixloc(i)) - temp(pixloc(i))
C. udt.best (spline): initialize as being offscreen. call compare(). error will be maximum first run
D. while err_best > threshold:
1. compare()
2. if err_temp < err_best then
err_best = err_temp
udt.best = udt.temp
else
erase udt.temp
draw udt.best
endif
sub Main
dim as single etime = 30
var fidelity = 0.02 / (11/3) '11 bytes per circle
dim as single mip = 1 'these 2 values also found via hill climb,
dim as single mipi = 1 'producing good speed
dim as imagevars buf: buf.screen_init 320,240
dim as tRenderer ren
ren.bmp_load filename
var w = ren.imv.w
var h = ren.imv.h + 16
w/=2: w*=2
h/=2: h*=2
buf.screen_init w, h
dim as double t = timer, tnext = t, t0 = t, update_interval = .15
dim as string kstr, s
etime /= int((1-mip)/mipi+.5) + 1
with ren
while .er_best > .001
ren.mip mip
var circles_ub = int( mip*fidelity*(ren.imv.ub+1) + .5)
for i as integer = .ubv+1 to circles_ub
.new_circle
for k as long = 1 to 4 / (mip + .1)
.mutate .ubv
next
Next
dim as single report_compression = (.ubi+1)/(.ubv+1)*(3/11)
dim as double hours, t1=timer
do
.frame
t = timer
hours = (t-t0)/3600
var er = .er_best*999
s = "error: " & round(er) & " hours: " & round(hours)
if t >= tnext then
.show
tnext = t+update_interval
windowtitle s
draw string (0,ren.h+1), str(circles_ub+1) + " circles" '& " compression: " & round(report_compression)
endif
kstr = inkey
if kstr <> "" then exit while
loop until (t-t1)>etime
mip += mipi
if mip >= 1.01 then exit while
if kstr <> "" then exit while
wend
t = timer - t0
var er = .er_best*999
s = "error: " & round(er) & " mip: " & round(mip-mipi) & " score: " & round(1/er)
windowtitle s
draw string (0,ren.h+9), " time: " & round(t)
end with
sleep
end sub
Main
ok. so then, if you could give another example doing something with your algo other then what you use it for now, it will help me see your algo more clearly.
type hcUnit
as single val1=rnd, val2=rnd, val3=rnd
declare function get_err as single
end type
function hcUnit.get_err as single
'1. error function is the creative part
'here i'm just making something up
return abs(val1-val2) + abs(val1-val3) + abs(val2-val3)
end function
dim as hcUnit temp, best
dim as single er_best = best.get_err
for i as long = 1 to 1000
var er_temp = temp.get_err
if er_temp < er_best then best = temp: er_best = er_temp
temp = best '2. best result as new platform
var s = rnd '3. randomize a parameter
if s < .33 then
temp.val1 = rnd
elseif s < .67 then
temp.val2 = rnd
else
temp.val3 = rnd
endif
next
? "desired error: "; 0
? "obtained error: "; er_best
?
? "values: "; best.val1; best.val2; best.val3
sleep
actually very interesting.
i am finding things i did not know. for example:
function declarations in a type
colon after if then is part of the if statement without using an if then block
from what I can gather so far, over all, you're picking a lesser value.
Dim As Integer a,i,r
r=Int(Rnd*100)
Print "r=";r
Print
for i = 1 to 3
a=Int(Rnd*100)
Print i,"a=";a
If a<r then r=a
Print i,"r=";r
Print
next
print "r=";r
Sleep
End
