kick-last-place grid search

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
dafhi
Posts: 1706
Joined: Jun 04, 2005 9:51

kick-last-place grid search

Post by dafhi »

a unique concept for evading local optima

[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
Post Reply