[update: auto range find]

Code: Select all

```
/' -- "kick last place" grid search - 2024 Aug 30 by dafhi
proving grounds i pulled from a different project:
hash offline surface scenario.b() till it closely resembles .a()
update:
auto range adjust finds GREAT sets quickly
'/
' -- boilerplate
#define min( a, b) iif( (a)<(b), (a), (b) )
#define max( a, b) iif( (a)>(b), (a), (b) )
function clamp( in as double, hi as double = 1, lo as double = 0) as double
return min( max(in, lo), hi ) '' 2023 June 12
End Function
function round(in as double, places as ubyte = 3) as string ' 2024 Aug 4
dim as integer mul = 10 ^ places
dim as string ret = str( int(in * mul + .5) / mul )
return left( ret, places + instr( ret, ".") )
End Function
function u32_2_float(byval value as ulong) as single
'' https://www.freebasic.net/forum/viewtopic.php?t=32758
dim as ulong u32 = &H3F800000 or (value and &H3FFFFFFF)
dim as single f32 = *cptr(single ptr, @u32)
return f32 - 1.0f
end function
type dual_range
' chunk + pad bytes range outliner
as longint L1 ' chunk range in bytes
declare property B as longint ' pad range
as longint B1
declare property len as long
end type
property dual_range.B as longint
return L1 + 1
end property
property dual_range.len as long
return B1 + 1
end property
sub set_dualrange( byref t as dual_range, j as ulongint, chunk_size as ulong, byte_oob as longint, elem_size as long = 4 )
dim as long j1E = j + chunk_size ' 1 Extra (above ubound)
dim as long clip = j1E - byte_oob
chunk_size -= max( 0, clip )
dim as long c_big = chunk_size \ elem_size
t.L1 = elem_size * c_big - 1
t.B1 = chunk_size - 1
end sub
sub _cpy( des as any ptr, src as any ptr, byref dr as dual_range )
for j as long = 0 to dr.L1 step 4
*cast( ulong ptr, des + j ) = *cast( ulong ptr, src + j )
next
for j as long = dr.B to dr.B1
*cast( ubyte ptr, des + j ) = *cast( ubyte ptr, src + j )
next
end sub
function sbin(p as any ptr, cBytes as long = 1) as string
' binary print
var s = "": static as ubyte ptr pb
pb = p + cbytes - 1 ' "most-significant" first
for j as long = 1 to cBytes
for i as long = 7 to 0 step -1
s += str((*pb shr i) and 1)
next: pb -= 1
next
return s
end function
function popcount( n as longint) as ubyte ' https://nimrod.blog/posts/algorithms-behind-popcount/
n = n - ((n shr 1) and &h5555555555555555)
n = (n and &h3333333333333333) + ((n shr 2) and &h3333333333333333)
n = (n + (n shr 4)) and &hF0F0F0F0F0F0F0F
return (n * &h101010101010101) shr 56
end function
'' process bit lengths from 1 to 57 (1 bit from byte 0 offset 7, plus 7 remaining bytes)
''
namespace ba57 ' bit aligned R/W - 2024 Aug 24 - by dafhi
/'
* code example *
ba57.pdata = @mydata(0)
ba57.wri( some_val, bitpos, cbits_up_to_57 )
dim as ulongint k = ba57.rea( bitpos, cbits_up_to_57 )
'/
' support
dim as any ptr pdata, pa
dim as longint pos_oob, clip, b_offs, mask ' 2024 Aug 24 - changed to signed
sub params( p as any ptr, cbytes as long )
pdata = p
pos_oob = cbytes * 8
end sub
sub _rw_common( bpos as longint, byref c as byte ) ' 2024 Aug 24 - changed to signed
'c = min(c,57) ' (optional - experienced user won't go past 57)
clip = max( 0, bpos + c - pos_oob ) ' clip if oob
pa = pdata + bpos \ 8 ' any ptr. integer divide
b_offs = bpos - (bpos \ 8) * 8 ' bit offset within a byte
mask = ( ( 2^(c - clip) )-1 ) shl b_offs ' finally
end sub
function rea( bitpos as longint, cbits as byte = 1 ) as ulongint
if bitpos >= pos_oob then return 0
_rw_common bitpos, cbits
return (*cast(ulongint ptr, pa) and mask) shr b_offs
end function
dim as ulongint ptr p_li
sub wri( valu as ulongint, bitpos as longint, cbits as byte = 1 )
if bitpos >= pos_oob then exit sub
_rw_common bitpos, cbits
p_li = pa ' longint
*p_li xor= *p_li and mask ' destination all zeros
*p_li or= (valu shl b_offs)and mask ' new bits
end sub
end namespace ' -------- ba57
function ror64( in as ulongint, r as ubyte = 1 ) as ulongint
return (in shl (64 - r)) or (in shr r)
end function
namespace rng
const as ulongint xorA = &b0101010101010101010101010101010101010101010101010101010101010101
const as ulongint xorC = &b0000000010000000001000000001000000010000001000001000010001001011
dim as ulongint a, b
function v( seed as ulongint = 0 ) as ulongint
a = (a xor seed) * xorC + 442695040888963407 ' Knuth LCG
return ror64(a, a shr 58)
end function
end namespace
' ------------ boilerplate
' --------- support
'
type t_RangeRandom ' 2024 Aug 27
as single f ' result
as single a ' soft limit
as single b ' soft limit
as string desc ' user description
end type
type t_HyperParam extends t_RangeRandom ' 2024 Aug 29
declare operator cast as const single
declare operator cast as string
declare constructor( as single = 1, as single = 0, as string = "")
declare operator let( as single )
declare sub filtered_rand( as ubyte = 0, range_scalar as single = 1 ) ' future concept: scalar from parameter set
as single lim_a ' hard limit
as single lim_b
end type
operator t_HyperParam.cast as string ' 2024 Aug 16
return round(f,4) + ": " + desc + " "
end operator
operator t_HyperParam.cast as const single
return f
end operator
constructor t_HyperParam( _lim_a as single, _lim_b as single, _desc as string)
lim_a = _lim_a : a = _lim_a
lim_b = _lim_b : b = _lim_b
desc = _desc
f = (b + a) / 2
end constructor
operator t_HyperParam.let( in as single ) ' range check if file input or something
f = clamp( in, max( a, b ), min( a, b ) )
end operator
sub _potential_range_bump( byref h as t_HyperParam, range_scalar as single )
' potentially out of bounds, which is allowed but at reduced strength
h.f += range_scalar * (h.b - h.a) * (rnd - .5)
' prep for less/greater than (lo,hi) of (a,b)
dim as single ptr lo = iif( h.a < h.b, @h.a, @h.b )
dim as single ptr hi = iif( @h.a = lo, @h.b, @h.a )
dim as single near = iif( abs(h.f - h.a) < abs(h.f - h.b), h.a, h.b )
dim as single clip = .33 * iif( h.f < *lo or h.f > *hi, h.f - near, 0 )
dim as single lim_lo = min( h.lim_a, h.lim_b )
dim as single lim_hi = max( h.lim_a, h.lim_b )
*lo = max( *lo + clip, lim_lo )
*hi = min( *hi + clip, lim_hi )
h.f = clamp( h.f, *hi, *lo )
end sub
sub t_HyperParam.filtered_rand( u_params as ubyte, range_scalar as single )
static as single lo, hi, variance
dim as single acceptance = (1 / (u_params+1)) ^ .66
if rnd > acceptance then exit sub
if rnd < .7 then
_potential_range_bump this, range_scalar
else
f = a + (b - a) * rnd
endif
end sub
' --------------------------
/' now we're getting somewhere
so here's a scenario
'/
namespace scenario ' fill 2 offline surfaces differently and see how quickly one can be xor'd to match the other.
type parameter_set
' match loop ends to parameter set
#define t_rr_loop(q) for p as t_HyperParam ptr = @(q)->val_0 to @(q)->chunk_cbits
dim as t_HyperParam val_0 = type( .1, 2, "val 0" ) ' 1. semi-clueless manual settings
dim as t_HyperParam decay = type( .01, .999, "decay" ) ' 2. automatic range adjustment finds great parameter sets
dim as t_HyperParam expon = type( .01, .999, "expon" ) ' 3. after noting trends you can adjust
dim as t_HyperParam k_mul = type( 1, 10, "k mul" ) ' small = cheat
dim as t_HyperParam adapt_le = type( .01, .99, "adaptive less than one" )
dim as t_HyperParam adapt_ge = type( 1.01, 1.99, "adaptive greater than one" )
dim as t_HyperParam adapt_impr_case0 = type( .001, .5, "adaptive improvement rate case 0" )
dim as t_HyperParam adapt_impr_case1 = type( .001, .5, "adaptive improvement rate case 1" )
dim as t_HyperParam chunk_cbits = type( 46, 52, "chunk size (in bits)" ) ' small = cheat
as single adaptive_range_scalar = 1
declare sub print_info
end type
' more support
'
sub print_param( t_rr as t_HyperParam )
print str( t_rr )
end sub
sub parameter_set.print_info
t_rr_loop( @this )
print_param *p
next
end sub
sub filtered_rand( byref bvs as parameter_set )
dim as long n_params = len(parameter_set) / len(t_HyperParam)
t_rr_loop( @bvs )
p->filtered_rand( n_params )
next
end sub
#undef rr_loop
dim as long run_idx
enum en_fill_type
black
gray
white
randoms
end enum
sub fill( a() as ubyte, fill_type as en_fill_type = black )
dim as long c = 127.5 * fill_type
for i as long = 0 to ubound(a)
a(i) = iif( fill_type = randoms, rnd * cubyte(-1), c )
next
end sub
dim as ubyte a(), b()
sub resize_a_and_b( size as long )
if size < 1 then exit sub
if size <> (ubound(a) + 1) then
redim a(size - 1)
redim b(size - 1)
endif
end sub
dim as parameter_set ptr hypers
dim as long iteration
/' -- adaptive k suggested by 3.5-Sonnet.
Enhanced error reduction over my original reduce-k-over-time.
General enough i might use for other projects
'/
dim as single adaptive_k = 1.0
function f_hamming_weight_over_time as single
' my original curve
dim as single base_k = hypers->k_mul * (1 - hypers->val_0 * hypers->decay ^ (iteration ^ hypers->expon))
return base_k * adaptive_k ' a simple multiplier on the return
end function
sub update_adaptive_k( improvement as long = 0, reset as long = false ) ' 3.5-Sonnet
' bit equality between 2 surfaces passed down from f_bitAligned_blockimprovement()
static as long last_improvement: if reset then last_improvement = 0: exit sub
dim as single improvement_rate = (improvement - last_improvement) / (last_improvement + 1) ' Avoid division by zero
#if 1
if improvement_rate > hypers->adapt_impr_case0 then
adaptive_k *= hypers->adapt_ge
elseif improvement_rate < hypers->adapt_impr_case1 then
adaptive_k *= hypers->adapt_le
end if
#else ' original
if improvement_rate > 0.1 then
adaptive_k *= 1.05 ' Smaller increase (huge perf boost over 1.1
elseif improvement_rate < 0.01 then
adaptive_k *= 0.9 ' Same decrease
end if
#endif
adaptive_k = clamp(adaptive_k, 10.0, 0.1) ' Keep adaptive_k within reasonable bounds
last_improvement = improvement
end sub
dim as ubyte surface_b_restore()
sub _if_resize_backup( chunk_cbits as long )
dim as long ubytes = (chunk_cbits + 7) \ 8 - 1
if ubound(surface_b_restore) < ubytes then redim surface_b_restore( ubytes )
end sub
' bit count after surface1 xor surface2. dual_range holds bytes location
function xord_surfaces_popcnt( byref t as dual_range, i_byte as long ) as long
dim as any ptr pa = @a(i_byte)
dim as any ptr pb = @b(i_byte)
dim as long c
for j as long = 0 to t.L1 step 4
c += popcount( *cast( ulong ptr, pa + j ) xor *cast( ulong ptr, pb + j ) )
next
for j as long = t.B to t.B1
c += popcount( *cast( ubyte ptr, pa + j ) xor *cast( ubyte ptr, pb + j ) )
next
return c
end function
function f_byte_oob as long
return ubound(a) + 1
end function
dim as single k
function f_hash( pow2 as ubyte ) as ulongint
return int( u32_2_float(rng.v) ^ k * 2^pow2 )
end function
sub xor_chunk( i_bit as ulongint, chunk_cbits as long, byref t as dual_range )
for i as longint = i_bit to i_bit + chunk_cbits - 1 step chunk_cbits
var hash = f_hash( chunk_cbits )
var v = ba57.rea( i, chunk_cbits ) xor hash
ba57.wri v, i, chunk_cbits
next
end sub
function f_bitAligned_blockimprovement( i_bit as ulongint, chunk_cbits as long ) as long
static as dual_range dr
dim as long chunk_size = (chunk_cbits+7)\8
dim as long byte_idx = i_bit \ 8
set_dualrange dr, byte_idx, chunk_size, f_byte_oob
_cpy @surface_b_restore(0), @b(byte_idx), dr
dim as long c = xord_surfaces_popcnt( dr, byte_idx )
xor_chunk i_bit, chunk_cbits, dr
dim as long c2 = xord_surfaces_popcnt( dr, byte_idx )
dim as long improvement = c - c2
if improvement < 0 then
_cpy @b(byte_idx), @surface_b_restore(0), dr
improvement = 0
endif
return improvement
end function
function f_frame_improvement( _iteration as long ) as longint
iteration = _iteration
_if_resize_backup hypers->chunk_cbits
dim as longint c
ba57.params @b(0), f_byte_oob
dim as ulongint cbits = f_byte_oob * 8
dim as long i_step = max(1, hypers->chunk_cbits.f)
k = f_hamming_weight_over_time
for i as longint = 0 to cbits - 1 step i_step
c += f_bitaligned_blockimprovement( i, hypers->chunk_cbits )
next
update_adaptive_k( c )
return c
end function
end namespace
namespace ns_grid_process
using scenario
type tile
as parameter_set params
as double er = 1
declare property score as single
declare sub print_info
end type
property tile.score as single
return (1 - er)
end property
sub tile.print_info
params.print_info
print " error: "; er
end sub
/' larger grid (slow convergence) for more accurate hypothesis testing
'/
dim as tile grid(19), tile_backup
function f_lastPlace as long
dim as double er = grid(0).er
dim as long ret
for i as long = 1 to ubound(grid)
if grid(i).er > er then er = grid(i).er : ret = i
next
return ret
end function
dim as long also_1337
function f_1337 as long
dim as single score = grid(0).score
dim as long ret
for i as long = 1 to ubound(grid)
if grid(i).score > score then score = grid(i).score : also_1337 = ret: ret = i
next
return ret
end function
function perfect_score( popcount as longint ) as boolean
return popcount = 0
end function
dim as long lastPlace_tile
sub do_it( iters as long = 6 ) ' smallish count gives little room for doubt
var c_bytes = 900
resize_a_and_b c_bytes ' from .scenario
fill a(), black
fill b(), white
' grid concept
lastPlace_tile = f_lastPlace
if grid( lastPlace_tile ).er = 0 then exit sub
tile_backup = grid( lastPlace_tile )
hypers = @grid( lastPlace_tile ).params
filtered_rand *hypers ' kick last place
static as dual_range dr
dim as long chunk_size = f_byte_oob
set_dualrange dr, 0, chunk_size, f_byte_oob
dim as longint popcnt = xord_surfaces_popcnt( dr, 0 )
dim as long reset = true
update_adaptive_k , reset
for i as long = 1 to iters
dim as long c = f_frame_improvement( i )
popcnt -= c
if i mod 51 = 0 then sleep 1
next
dim as double er = popcnt / (f_byte_oob * 8)
if er < tile_backup.er then
grid( lastPlace_tile).er = er
grid( lastPlace_tile).params.adaptive_range_scalar *= .94
locate 2,1
print
print " last place error "; round(er,4); " (after param adjust) "
else
grid( lastPlace_tile) = tile_backup
endif
end sub
end namespace
randomize
using ns_grid_process
dim as long runs = 600 * (1+ubound(grid)) ^ .75
for i as long = 1 to runs
locate 1,1
if (i mod 20) = 0 then print "run "; str(i) ; " of " ; str(runs)
scenario.run_idx = i
do_it
var kstr = inkey
if kstr <> "" then exit for
next
locate 5,1
dim as long _1337 = f_1337
print "elite hyperparam set(s)"
print
if also_1337 <> _1337 then
grid( f_1337 ).print_info
print
grid( also_1337 ).print_info
else
grid( f_1337 ).print_info
endif
sleep
```