69 lines
2.3 KiB
Plaintext
69 lines
2.3 KiB
Plaintext
(seed (in "/dev/urandom" (rd 8)))
|
|
|
|
(de *Buckets . 15) # Number of buckets
|
|
|
|
# E/R model
|
|
(class +Bucket +Entity)
|
|
(rel key (+Key +Number)) # Key 1 .. *Buckets
|
|
(rel val (+Number)) # Value 1 .. 999
|
|
|
|
# Create new DB file
|
|
(pool (tmp "buckets.db"))
|
|
|
|
# Create *Buckets buckets with values between 1 and 999
|
|
(for K *Buckets
|
|
(new T '(+Bucket) 'key K 'val (rand 1 999)) )
|
|
(commit)
|
|
|
|
# Pick a random bucket
|
|
(de pickBucket ()
|
|
(db 'key '+Bucket (rand 1 *Buckets)) )
|
|
|
|
# First process
|
|
(unless (fork)
|
|
(seed *Pid) # Ensure local random sequence
|
|
(loop
|
|
(let (B1 (pickBucket) B2 (pickBucket)) # Pick two buckets 'B1' and 'B2'
|
|
(dbSync) # Atomic DB operation
|
|
(let (V1 (; B1 val) V2 (; B2 val)) # Get current values
|
|
(cond
|
|
((> V1 V2)
|
|
(dec> B1 'val) # Make them closer to equal
|
|
(inc> B2 'val) )
|
|
((> V2 V1)
|
|
(dec> B2 'val)
|
|
(inc> B1 'val) ) ) )
|
|
(commit 'upd) # Close transaction
|
|
(wait 1) ) ) )
|
|
|
|
# Second process
|
|
(unless (fork)
|
|
(seed *Pid) # Ensure local random sequence
|
|
(loop
|
|
(let (B1 (pickBucket) B2 (pickBucket)) # Pick two buckets 'B1' and 'B2'
|
|
(unless (== B1 B2) # Found two different ones?
|
|
(dbSync) # Atomic DB operation
|
|
(let (V1 (; B1 val) V2 (; B2 val)) # Get current values
|
|
(cond
|
|
((> V1 V2 0)
|
|
(inc> B1 'val) # Redistribute them
|
|
(dec> B2 'val) )
|
|
((> V2 V1 0)
|
|
(inc> B2 'val)
|
|
(dec> B1 'val) ) ) )
|
|
(commit 'upd) # Close transaction
|
|
(wait 1) ) ) ) )
|
|
|
|
# Third process
|
|
(unless (fork)
|
|
(loop
|
|
(let Lst (collect 'key '+Bucket) # Get all buckets
|
|
(for This Lst # Print current values
|
|
(printsp (: val)) )
|
|
(prinl # and total sum
|
|
"-- Total: "
|
|
(sum '((This) (: val)) Lst) ) )
|
|
(wait 2000) ) ) # Sleep two seconds
|
|
|
|
(wait)
|