aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

88
Task/Atomic-updates/PicoLisp/atomic-updates.l
View file

@ -1,72 +1,68 @@
(de *Buckets . 15) # Number of buckets
(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
# Start with an empty DB
(call 'rm "-f" "buckets.db") # Remove old DB (if any)
(pool "buckets.db") # Create new DB file
(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)) )
# Create process
(de process (QuadFunction)
(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
(QuadFunction B1 V1 B2 V2) )
(commit 'upd) ) ) ) ) ) # Close transaction
# First process
(process
(quote (B1 V1 B2 V2)
(cond
((> V1 V2)
(dec> B1 'val) # Make them closer to equal
(inc> B2 'val) )
((> V2 V1)
(dec> B2 'val)
(inc> B1 'val) ) ) ) )
(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
(process
(quote (B1 V1 B2 V2)
(cond
((> V1 V2 0)
(inc> B1 'val) # Redistribute them
(dec> B2 'val) )
((> V2 V1 0)
(inc> B2 'val)
(dec> B1 'val) ) ) ) )
(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
(dbSync) # Atomic DB operation
(let Lst (collect 'key '+Bucket) # Get all buckets
(for This Lst # Print current values
(let Lst (collect 'key '+Bucket) # Get all buckets
(for This Lst # Print current values
(printsp (: val)) )
(prinl # and total sum
(prinl # and total sum
"-- Total: "
(sum '((This) (: val)) Lst) ) )
(rollback)
(wait 2000) ) ) # Sleep two seconds
(wait 2000) ) ) # Sleep two seconds
(wait)