Sync

Task/Atomic-updates/Haskell/atomic-updates-1.hs

@@ -0,0 +1,69 @@
+module AtomicUpdates (main) where
+
+import Control.Concurrent (forkIO, threadDelay)
+import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_)
+import Control.Monad (forever, forM_)
+import Data.IntMap (IntMap, (!), toAscList, fromList, adjust)
+import System.Random (randomRIO)
+import Text.Printf (printf)
+
+-------------------------------------------------------------------------------
+
+type Index = Int
+type Value = Integer
+data Buckets = Buckets Index (MVar (IntMap Value))
+
+makeBuckets   :: Int -> IO Buckets
+size          :: Buckets -> Index
+currentValue  :: Buckets -> Index -> IO Value
+currentValues :: Buckets          -> IO (IntMap Value)
+transfer      :: Buckets -> Index -> Index -> Value -> IO ()
+
+-------------------------------------------------------------------------------
+
+makeBuckets n = do v <- newMVar (fromList [(i, 100) | i <- [1..n]])
+                   return (Buckets n v)
+
+size (Buckets n _) = n
+
+currentValue (Buckets _ v) i = fmap (! i) (readMVar v)
+currentValues (Buckets _ v) = readMVar v
+
+transfer b@(Buckets n v) i j amt | amt < 0        = transfer b j i (-amt)
+                                 | otherwise      = do
+  modifyMVar_ v $ \map -> let amt' = min amt (map ! i)
+                            in return $ adjust (subtract amt') i
+                                      $ adjust (+        amt') j
+                                      $ map
+
+-------------------------------------------------------------------------------
+
+roughen, smooth, display :: Buckets -> IO ()
+
+pick buckets = randomRIO (1, size buckets)
+
+roughen buckets = forever loop where
+  loop = do i <- pick buckets
+            j <- pick buckets
+            iv <- currentValue buckets i
+            transfer buckets i j (iv `div` 3)
+
+smooth buckets = forever loop where
+  loop = do i <- pick buckets
+            j <- pick buckets
+            iv <- currentValue buckets i
+            jv <- currentValue buckets j
+            transfer buckets i j ((iv - jv) `div` 4)
+
+display buckets = forever loop where
+  loop = do threadDelay 1000000
+            bmap <- currentValues buckets
+            putStrLn (report $ map snd $ toAscList bmap)
+  report list = "\nTotal: " ++ show (sum list) ++ "\n" ++ bars
+    where bars = concatMap row $ map (*40) $ reverse [1..5]
+          row lim = printf "%3d " lim ++ [if x >= lim then '*' else ' ' | x <- list] ++ "\n"
+
+main = do buckets <- makeBuckets 100
+          forkIO (roughen buckets)
+          forkIO (smooth buckets)
+          display buckets

Task/Atomic-updates/Haskell/atomic-updates-2.hs

@@ -0,0 +1,33 @@
+global mtx
+
+procedure main(A)
+    nBuckets := integer(A[1]) | 10
+    nShows := integer(A[2]) | 4
+    showBuckets := A[3]
+    mtx := mutex()
+    every !(buckets := list(nBuckets)) := ?100
+
+    thread repeat {
+        every (b1|b2) := ?nBuckets   # OK if same!
+        critical mtx: xfer((buckets[b1] - buckets[b2])/2, b1, b2)
+        }
+    thread repeat {
+        every (b1|b2) := ?nBuckets   # OK if same!
+        critical mtx: xfer(integer(?buckets[b1]), b1, b2)
+        }
+    wait(thread repeat {
+        delay(500)
+        critical mtx: {
+            every (sum := 0) +:= !buckets
+            writes("Sum: ",sum)
+            if \showBuckets then every writes(" -> "|right(!buckets, 4))
+            }
+        write()
+        if (nShows -:= 1) <= 0 then break
+        })
+end
+
+procedure xfer(x,b1,b2)
+    buckets[b1] -:= x
+    buckets[b2] +:= x
+end

Task/Atomic-updates/Java/atomic-updates-1.java

@@ -0,0 +1,119 @@
+import java.util.Arrays;
+import java.util.Random;
+
+public class AtomicUpdates
+{
+  public static class Buckets
+  {
+    private final int[] data;
+
+    public Buckets(int[] data)
+    {
+      this.data = data.clone();
+    }
+
+    public int getBucket(int index)
+    {
+      synchronized (data)
+      {  return data[index];  }
+    }
+
+    public int transfer(int srcBucketIndex, int destBucketIndex, int amount)
+    {
+      if (amount == 0)
+        return 0;
+      // Negative transfers will happen in the opposite direction
+      if (amount < 0)
+      {
+        int tempIndex = srcBucketIndex;
+        srcBucketIndex = destBucketIndex;
+        destBucketIndex = tempIndex;
+        amount = -amount;
+      }
+      synchronized (data)
+      {
+        if (amount > data[srcBucketIndex])
+          amount = data[srcBucketIndex];
+        if (amount <= 0)
+          return 0;
+        data[srcBucketIndex] -= amount;
+        data[destBucketIndex] += amount;
+        return amount;
+      }
+    }
+
+    public int[] getBuckets()
+    {
+      synchronized (data)
+      {  return data.clone();  }
+    }
+  }
+
+  public static int getTotal(int[] values)
+  {
+    int totalValue = 0;
+    for (int i = values.length - 1; i >= 0; i--)
+      totalValue += values[i];
+    return totalValue;
+  }
+
+  public static void main(String[] args)
+  {
+    final int NUM_BUCKETS = 10;
+    Random rnd = new Random();
+    final int[] values = new int[NUM_BUCKETS];
+    for (int i = 0; i < values.length; i++)
+      values[i] = rnd.nextInt(10);
+    System.out.println("Initial Array: " + getTotal(values) + " " + Arrays.toString(values));
+    final Buckets buckets = new Buckets(values);
+
+    new Thread(new Runnable() {
+        public void run()
+        {
+          Random r = new Random();
+          while (true)
+          {
+            int srcBucketIndex = r.nextInt(NUM_BUCKETS);
+            int destBucketIndex = r.nextInt(NUM_BUCKETS);
+            int amount = (buckets.getBucket(srcBucketIndex) - buckets.getBucket(destBucketIndex)) >> 1;
+            if (amount != 0)
+              buckets.transfer(srcBucketIndex, destBucketIndex, amount);
+          }
+        }
+      }
+    ).start();
+
+    new Thread(new Runnable() {
+        public void run()
+        {
+          Random r = new Random();
+          while (true)
+          {
+            int srcBucketIndex = r.nextInt(NUM_BUCKETS);
+            int destBucketIndex = r.nextInt(NUM_BUCKETS);
+            int srcBucketAmount = buckets.getBucket(srcBucketIndex);
+            int destBucketAmount = buckets.getBucket(destBucketIndex);
+            int amount = r.nextInt(srcBucketAmount + destBucketAmount + 1) - destBucketAmount;
+            if (amount != 0)
+              buckets.transfer(srcBucketIndex, destBucketIndex, amount);
+          }
+        }
+      }
+    ).start();
+
+    while (true)
+    {
+      long nextPrintTime = System.currentTimeMillis() + 3000;
+      long curTime;
+      while ((curTime = System.currentTimeMillis()) < nextPrintTime)
+      {
+        try
+        {  Thread.sleep(nextPrintTime - curTime);  }
+        catch (InterruptedException e)
+        {  }
+      }
+      int[] bucketValues = buckets.getBuckets();
+      System.out.println("Current values: " + getTotal(bucketValues) + " " + Arrays.toString(bucketValues));
+    }
+  }
+}

Task/Atomic-updates/Java/atomic-updates-2.java

@@ -0,0 +1,186 @@
+import java.util.Arrays;
+import java.util.Optional;
+import java.util.Random;
+import java.util.function.Consumer;
+import java.util.function.Function;
+import java.util.stream.IntStream;
+import java.util.stream.Stream;
+
+public interface Buckets {
+  public static Buckets new_(int[] data) {
+    return $.new_(data);
+  }
+  public static void main(String... arguments) {
+    $.main(arguments);
+  }
+  public int[] getBuckets();
+
+  public int getBucket(int index);
+
+  public int transfer(int srcBucketIndex, int destBucketIndex, int amount);
+
+  public enum $ {
+    $$;
+
+    private static Buckets new_(int[] data) {
+      return (FunctionalBuckets) function -> {
+        synchronized (data) {
+          return Optional.of(data)
+            .map(function)
+            .filter(output -> output != data)
+            .orElseGet(() -> data.clone())
+          ;
+        }
+      };
+    }
+
+    private static void main(String... arguments) {
+      Stream.of(new Random())
+        .parallel()
+        .map(r -> r.ints($.NUM_BUCKETS, 0, NUM_BUCKETS))
+        .map(IntStream::toArray)
+        .peek(bucketValues -> Stream.of(bucketValues)
+          .map(values -> "Initial values: " + getTotal(values) + " " + Arrays.toString(values))
+          .forEach(System.out::println)
+        )
+        .map(Buckets::new_)
+        .forEach(
+          Stream.<Consumer<Buckets>>of(
+            $::processBuckets,
+            $::displayBuckets
+          ).reduce($ -> {}, Consumer::andThen)
+        )
+      ;
+    }
+
+    @FunctionalInterface
+    private static interface FunctionalBuckets extends Buckets {
+      public Object untypedUseData(Function<int[], Object> function);
+
+      @SuppressWarnings("unchecked")
+      public default <OUTPUT> OUTPUT useData(Function<int[], OUTPUT> function) {
+        return (OUTPUT) untypedUseData(function::apply);
+      }
+
+      @Override
+      public default int[] getBuckets() {
+        return useData(Function.<int[]>identity());
+      }
+
+      @Override
+      public default int getBucket(int index) {
+        return useData(data -> data[index]);
+      }
+
+      @Override
+      public default int transfer(int originalSrcBucketIndex, int originalDestBucketIndex, int originalAmount) {
+        return useData(data -> {
+          int srcBucketIndex = originalSrcBucketIndex;
+          int destBucketIndex = originalDestBucketIndex;
+          int amount = originalAmount;
+          if (amount == 0) {
+            return 0;
+          }
+          // Negative transfers will happen in the opposite direction
+          if (amount < 0) {
+            int tempIndex = srcBucketIndex;
+            srcBucketIndex = destBucketIndex;
+            destBucketIndex = tempIndex;
+            amount = -amount;
+          }
+          if (amount > data[srcBucketIndex]) {
+            amount = data[srcBucketIndex];
+          }
+          if (amount <= 0) {
+            return 0;
+          }
+          data[srcBucketIndex] -= amount;
+          data[destBucketIndex] += amount;
+          return amount;
+        });
+      }
+    }
+
+    private static final int NUM_BUCKETS = 10;
+    private static final int PRINT_DELAY = 3_000;
+
+    private static int getTotal(int[] values) {
+      return Arrays.stream(values)
+        .parallel()
+        .sum()
+      ;
+    }
+
+    private static void equalizeBuckets(Buckets buckets) {
+      Random r = new Random();
+      while (true) {
+        int srcBucketIndex = r.nextInt($.NUM_BUCKETS);
+        int destBucketIndex = r.nextInt($.NUM_BUCKETS);
+        Stream.of(srcBucketIndex, destBucketIndex)
+          .map(buckets::getBucket)
+          .reduce((srcBucketAmount, destBucketAmount) ->
+            srcBucketAmount - destBucketAmount
+          )
+          .map(amount -> amount >> 1)
+          .filter(amount -> amount != 0)
+          .ifPresent(amount ->
+            buckets.transfer(srcBucketIndex, destBucketIndex, amount)
+          )
+        ;
+      }
+    }
+
+    private static void randomizeBuckets (Buckets buckets) {
+      Random r = new Random();
+      while (true) {
+        int srcBucketIndex = r.nextInt($.NUM_BUCKETS);
+        int destBucketIndex = r.nextInt($.NUM_BUCKETS);
+        Stream.of(srcBucketIndex, destBucketIndex)
+          .map(buckets::getBucket)
+          .reduce((srcBucketAmount, destBucketAmount) ->
+            r.nextInt(srcBucketAmount + destBucketAmount + 1) - destBucketAmount
+          )
+          .filter(amount -> amount != 0)
+          .ifPresent(amount ->
+            buckets.transfer(srcBucketIndex, destBucketIndex, amount)
+          )
+        ;
+      }
+    }
+
+    private static Runnable run(Runnable runnable) {
+      return runnable;
+    }
+
+    private static void processBuckets(Buckets buckets) {
+      Stream.<Consumer<Buckets>>of(
+        $::equalizeBuckets,
+        $::randomizeBuckets
+      )
+        .parallel()
+        .map(consumer -> run(() -> consumer.accept(buckets)))
+        .map(Thread::new)
+        .forEach(Thread::start)
+      ;
+    }
+
+    private static void displayBuckets(Buckets buckets) {
+      while (true) {
+        long nextPrintTime = System.currentTimeMillis() + PRINT_DELAY;
+        long curTime;
+        while ((curTime = System.currentTimeMillis()) < nextPrintTime) {
+          try {
+            Thread.sleep(nextPrintTime - curTime);
+          }
+          catch (InterruptedException e) {}
+        }
+        Stream.of(buckets)
+          .parallel()
+          .map(Buckets::getBuckets)
+          .map(values -> "Current values: " + getTotal(values) + " " + Arrays.toString(values))
+          .forEach(System.out::println)
+        ;
+      }
+    }
+  }
+}

Task/Atomic-updates/Logtalk/atomic-updates-1.logtalk

@@ -0,0 +1,107 @@
+:- object(buckets).
+
+    :- threaded.
+
+    :- public([start/0, start/4]).
+
+    % bucket representation
+    :- private(bucket_/2).
+    :- dynamic(bucket_/2).
+
+    % use the same mutex for all the predicates that access the buckets
+    :- private([bucket/2, buckets/1, transfer/3]).
+    :- synchronized([bucket/2, buckets/1, transfer/3]).
+
+    start :-
+        % by default, create ten buckets with initial random integer values
+        % in the interval [0, 10[ and print their contents ten times
+        start(10, 0, 10, 10).
+
+    start(N, Min, Max, Samples) :-
+        % create the buckets with random values in the
+        % interval [Min, Max[ and return their sum
+        create_buckets(N, Min, Max, Sum),
+        write('Sum of all bucket values: '), write(Sum), nl, nl,
+        % use competitive or-parallelism for the three loops such that
+        % the computations terminate when the display loop terminates
+        threaded((
+                display_loop(Samples)
+            ;   match_loop(N)
+            ;   redistribute_loop(N)
+        )).
+
+    create_buckets(N, Min, Max, Sum) :-
+        % remove all exisiting buckets
+        retractall(bucket_(_,_)),
+        % create the new buckets
+        create_buckets(N, Min, Max, 0, Sum).
+
+    create_buckets(0, _, _, Sum, Sum) :-
+        !.
+    create_buckets(N, Min, Max, Sum0, Sum) :-
+        random::random(Min, Max, Value),
+        asserta(bucket_(N,Value)),
+        M is N - 1,
+        Sum1 is Sum0 + Value,
+        create_buckets(M, Min, Max, Sum1, Sum).
+
+    bucket(Bucket, Value) :-
+        bucket_(Bucket, Value).
+
+    buckets(Values) :-
+        findall(Value, bucket_(_, Value), Values).
+
+    transfer(Origin, _, Origin) :-
+        !.
+    transfer(Origin, Delta, Destin) :-
+        retract(bucket_(Origin, OriginValue)),
+        retract(bucket_(Destin, DestinValue)),
+        % the buckets may have changed between the access to its
+        % values and the calling of this transfer predicate; thus,
+        % we must ensure that we're transfering a legal amount
+        Amount is min(Delta, OriginValue),
+        NewOriginValue is OriginValue - Amount,
+        NewDestinValue is DestinValue + Amount,
+        assertz(bucket_(Origin, NewOriginValue)),
+        assertz(bucket_(Destin, NewDestinValue)).
+
+    match_loop(N) :-
+        % randomly select two buckets
+        M is N + 1,
+        random::random(1, M, Bucket1),
+        random::random(1, M, Bucket2),
+        % access their contents
+        bucket(Bucket1, Value1),
+        bucket(Bucket2, Value2),
+        % make their new values approximately equal
+        Delta is truncate(abs(Value1 - Value2)/2),
+        (   Value1 > Value2 ->
+            transfer(Bucket1, Delta, Bucket2)
+        ;   Value1 < Value2 ->
+            transfer(Bucket2, Delta, Bucket1)
+        ;   true
+        ),
+        match_loop(N).
+
+    redistribute_loop(N) :-
+        % randomly select two buckets
+        M is N + 1,
+        random::random(1, M, FromBucket),
+        random::random(1, M, ToBucket),
+        % access bucket from where we transfer
+        bucket(FromBucket, Current),
+        Limit is Current + 1,
+        random::random(0, Limit, Delta),
+        transfer(FromBucket, Delta, ToBucket),
+        redistribute_loop(N).
+
+    display_loop(0) :-
+        !.
+    display_loop(N) :-
+        buckets(Values),
+        write(Values), nl,
+        thread_sleep(2),
+        M is N - 1,
+        display_loop(M).
+
+:- end_object.

Task/Atomic-updates/Logtalk/atomic-updates-2.logtalk

@@ -0,0 +1,14 @@
+?- buckets::start.
+Sum of all bucket values: 52
+
+[4,6,9,5,3,5,9,7,4,0]
+[5,3,6,3,9,5,5,6,2,8]
+[2,2,3,13,5,5,2,8,6,6]
+[7,4,7,1,1,1,5,11,8,7]
+[8,5,8,4,4,3,4,1,3,12]
+[2,4,8,6,11,6,6,7,1,1]
+[2,12,3,2,6,5,0,9,7,6]
+[2,6,3,3,16,3,2,3,7,7]
+[6,0,4,0,23,1,1,4,2,11]
+[11,6,10,4,0,4,5,5,4,3]
+true.

Task/Atomic-updates/Racket/atomic-updates.rkt

@@ -0,0 +1,101 @@
+#lang racket
+
+(struct bucket (value [lock #:auto])
+  #:auto-value #f
+  #:mutable
+  #:transparent)
+
+(define *buckets* (build-vector 10 (λ (i) (bucket 100))))
+
+(define (show-buckets)
+  (let* ([values (for/list ([b *buckets*]) (bucket-value b))]
+         [total (apply + values)])
+    (append values (list '- total))))
+
+(define *equalizations* 0)
+(define *randomizations* 0)
+(define *blocks* 0)
+
+(define (show-stats)
+  (let ([n (length *log*)]
+        [log (reverse *log*)])
+    (printf "Equalizations ~a, Randomizations ~a, Transfers: ~a, Blocks ~a\n"
+              *equalizations* *randomizations* n *blocks*)
+    (for ([i (in-range 10)])
+      (define j (min (floor (* i (/ n 9))) (sub1 n)))
+      (printf "~a (~a). " (add1 i) (add1 j))
+      (displayln (list-ref log j)))))
+
+(define *log* (list (show-buckets)))
+
+(define-syntax-rule (inc! x) (set! x (add1 x)))
+
+(define (get-bucket i) (vector-ref *buckets* i))
+
+(define (get-value i) (bucket-value (get-bucket i)))
+(define (set-value! i v) (set-bucket-value! (get-bucket i) v))
+
+(define (locked? i) (bucket-lock (vector-ref *buckets* i)))
+(define (lock! i v) (set-bucket-lock! (get-bucket i) v))
+(define (unlock! i) (lock! i #f))
+
+(define *clamp-lock* #f)
+
+(define (clamp i j)
+  (cond [*clamp-lock* (inc! *blocks*)
+                      #f]
+        [else (set! *clamp-lock* #t)
+              (let ([result #f]
+                    [g (gensym)])
+                (unless (locked? i)
+                  (lock! i g)
+                  (cond [(locked? j) (unlock! i)]
+                        [else (lock! j g)
+                              (set! result #t)]))
+                (unless result (inc! *blocks*))
+                (set! *clamp-lock* #f)
+                result)]))
+
+(define (unclamp i j)
+  (unlock! i)
+  (unlock! j))
+
+(define (transfer i j amount)
+  (let* ([lock1 (locked? i)]
+         [lock2 (locked? j)]
+         [a (get-value i)]
+         [b (get-value j)]
+         [c (- a amount)]
+         [d (+ b amount)])
+    (cond [(< c 0) (error 'transfer "Removing too much.")]
+          [(< d 0) (error 'transfer "Stealing too much.")]
+          [(and lock1 (equal? lock1 lock2)) (set-value! i c)
+                                            (set-value! j d)
+                                            (set! *log*
+                                                  (cons (show-buckets) *log*))]
+          [else (error 'transfer "Lock problem")])))
+
+(define (equalize i j)
+  (when (clamp i j)
+    (let ([a (get-value i)]
+          [b (get-value j)])
+      (unless (= a b)
+        (transfer i j (if (> a b)
+                          (floor (/ (- a b) 2))
+                          (- (floor (/ (- b a) 2)))))
+        (inc! *equalizations*)))
+        (unclamp i j)))
+
+(define (randomize i j)
+  (when (clamp i j)
+    (let* ([a (get-value i)]
+           [b (get-value j)]
+           [t (+ a b)]
+           [r (if (= t 0) 0 (random t))])
+      (unless (= r 0)
+        (transfer i j (- a r))
+        (inc! *randomizations*)))
+    (unclamp i j)))
+
+(thread (λ () (for ([_ (in-range 500000)]) (equalize (random 10) (random 10)))))
+(thread (λ () (for ([_ (in-range 500000)]) (randomize (random 10) (random 10)))))