MODULE DiningPhilosophers EXPORTS Main;

IMPORT IO, Random, Thread;

CONST

  PartySize = 5; (* modify for more/fewer philosophers *)

TYPE

  Closure = Thread.Closure OBJECT
  (* thread information *)
    which: [1..PartySize]; (* identifies the thread *)
  OVERRIDES
    apply := Live; (* procedure to execute *)
  END;

VAR

  (* how long to eat/think *)
  random: Random.T;

  (* controls access to resources *)
  test := NEW(MUTEX);
  forks := NEW(Thread.Condition); (* condition variable, used for signaling *)
  forkAvailable := ARRAY[1..PartySize] OF BOOLEAN {
    TRUE, TRUE, TRUE, TRUE, TRUE
  };
  (* the philosophers/tasks *)
  thread: ARRAY[1..PartySize] OF Thread.T;
  name := ARRAY[1..PartySize] OF TEXT {
    "Aristotle", "Kant", "Spinoza", "Marx", "Russell"
  };

PROCEDURE PlaceAvailable(): CARDINAL =
(*
  Determines whether a place is available at the table.
  If so, returns the place number. Otherwise, returns 0.
  We consider a place available if and only if *both* forks are free.
*)
BEGIN
  FOR i := 1 TO PartySize DO
    IF forkAvailable[i] AND forkAvailable[((i+1) MOD PartySize) + 1] THEN
      RETURN i;
    END;
  END;
  RETURN 0;
END PlaceAvailable;

PROCEDURE Live(philosopher: Closure): REFANY =
(* philosophers eat, sleep, ... and that's about it *)
VAR
  place: CARDINAL;
BEGIN
  WITH which = philosopher.which DO
    WHILE TRUE DO
      (* first make sure a place is available: both forks must be free! *)
      LOCK test DO
        place := PlaceAvailable();
        (* if not, release mutex and use condition variable to wait for one *)
        WHILE place = 0 DO
          IO.Put(name[which]); IO.Put(" starving!\n");
          Thread.Wait(test, forks);
          (* in Modula-3 we arrive here only if we have the lock again *)
          place := PlaceAvailable();
        END;
        (* a place has come available! seize the forks while mutex is locked *)
        forkAvailable[place] := FALSE;
        forkAvailable[(place MOD PartySize) + 1] := FALSE;
        IO.Put(name[which]); IO.Put(" eating at place "); IO.PutInt(place);
        IO.PutChar('\n');
      END;
      Thread.Pause(FLOAT(random.integer(1,3), LONGREAL));
      (* put down the forks *)
      forkAvailable[place]  := TRUE;
      forkAvailable[(place MOD PartySize) + 1] := TRUE;
      Thread.Signal(forks); (* signal the condition variable *)
      LOCK test DO
        IO.Put(name[which]); IO.Put(" thinking\n");
      END;
      Thread.Pause(FLOAT(random.integer(1,3), LONGREAL));
    END; (* WHILE *)
  END; (* WITH *)
  RETURN NIL;
END Live;

BEGIN
  random := NEW(Random.Default).init();
  (* bring philosophers to life *)
  FOR i := 1 TO PartySize DO
    thread[i] := Thread.Fork(NEW(Closure, apply := Live, which := i));
  END;
  (*
    We need to wait, otherwise the program will terminate,
    and the philosophers with it. Technically we could wait
    for just one philosopher, but in the interest of symmetry...
  *)
  FOR i := 1 TO PartySize DO
    EVAL Thread.Join(thread[i]);
  END;
END DiningPhilosophers.


using System;
using static System.Linq.Enumerable;

public class Program
{
    static void Main()
    {
        SqueezeAndPrint("", ' ');
        SqueezeAndPrint("\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ", '-');
        SqueezeAndPrint("..1111111111111111111111111111111111111111111111111111111111111117777888", '7');
        SqueezeAndPrint("I never give 'em hell, I just tell the truth, and they think it's hell. ", '.');
        string s = "                                                    --- Harry S Truman  ";
        SqueezeAndPrint(s, ' ');
        SqueezeAndPrint(s, '-');
        SqueezeAndPrint(s, 'r');
    }

    static void SqueezeAndPrint(string s, char c) {
        Console.WriteLine($"squeeze: '{c}'");
        Console.WriteLine($"old: {s.Length} «««{s}»»»");
        s = Squeeze(s, c);
        Console.WriteLine($"new: {s.Length} «««{s}»»»");
    }

    static string Squeeze(string s, char c) => string.IsNullOrEmpty(s) ? "" :
        s[0] + new string(Range(1, s.Length - 1).Where(i => s[i] != c || s[i] != s[i - 1]).Select(i => s[i]).ToArray());
}


#include <algorithm>
#include <string>
#include <iostream>

template<typename char_type>
std::basic_string<char_type> squeeze(std::basic_string<char_type> str, char_type ch) {
    auto i = std::unique(str.begin(), str.end(),
        [ch](char_type a, char_type b) { return a == ch && b == ch; });
    str.erase(i, str.end());
    return str;
}

void test(const std::string& str, char ch) {
    std::cout << "character: '" << ch << "'\n";
    std::cout << "original: <<<" << str << ">>>, length: " << str.length() << '\n';
    std::string squeezed(squeeze(str, ch));
    std::cout << "result: <<<" << squeezed << ">>>, length: " << squeezed.length() << '\n';
    std::cout << '\n';
}

int main(int argc, char** argv) {
    test("", ' ');
    test("\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ", '-');
    test("..1111111111111111111111111111111111111111111111111111111111111117777888", '7');
    test("I never give 'em hell, I just tell the truth, and they think it's hell. ", '.');
    std::string truman("                                                    --- Harry S Truman  ");
    test(truman, ' ');
    test(truman, '-');
    test(truman, 'r');
    return 0;
}


import threadpool, locks, math, os, random
# to call randomize() as a seed, need to import random module
randomize()

type Philosopher = ref object
  name: string
  food: string
  forkLeft, forkRight: int

const
  n = 5
  names = ["Aristotle", "Kant", "Spinoza", "Marx", "Russell"]
  foods = [" rat poison", " cockroaches", " dog food", " lemon-curd toast", " baked worms"]

var
  forks: array[n, Lock]
  phils: array[n, Philosopher]
  threads: array[n, Thread[Philosopher]]

proc run(p: Philosopher) {.thread.} =
  # random deprecated, use rand(x .. y)
  sleep rand(1..10) * 500
  echo p.name, " is hungry."

  acquire forks[min(p.forkLeft, p.forkRight)]
  sleep rand(1..5) * 500
  acquire forks[max(p.forkLeft, p.forkRight)]

  echo p.name, " starts eating", p.food, "."
  sleep rand(1..10) * 500

  echo p.name, " finishes eating", p.food, " and leaves to think."

  release forks[p.forkLeft]
  release forks[p.forkRight]

for i in 0..<n:
  initLock forks[i]
  phils[i] = Philosopher(
    name: names[i],
    food: foods[rand(0 .. n) mod n],
    forkLeft: i,
    forkRight: (i + 1) mod n
  )
  createThread(threads[i], run, phils[i])

joinThreads(threads)


'=========================
class RoundTableWith5Seats
'=========================

  % hungry    0
  % beingUsed 1
  % putDown   0
  % empty     0

  sys fork[5], plate[5],chair[5],philosopher[5]
  sys first

  method AddPasta() as sys
    function rand() as sys
      static seed=0x12345678
      mov eax,seed
      rol eax,7
      mul seed
      xor eax,0x5335ABD9
      mov seed,eax
      return seed
    end function
    return 4+(rand() and 15)
  end method

  method dine()
  first++ 'PRIORITY DINER
  if first>5 then first-=5
  for i=1 to 5
    kl=first+i-1
    kr=first+i
    if kl>5 then kl-=5
    if kr>5 then kr-=5
    if philosopher(kl) = hungry then
      if not fork(kl) or fork(kr) = beingUsed then
        plate(kl) = AddPasta()
        fork(kl)=beingUsed
        fork(kr)=beingUsed
      end if
    end if
    '
  next
  '
  for kl=1 to 5
    kr=kl+1 : if kr>5 then kr-=5
    if plate(kl)
      philosopher(kl)+=1 'PHILOSOPHER DINING
      --plate(kl)
      if plate(kl)=empty
        fork(kl)=PutDown
        fork(kr)=PutDown
      end if
    else
      if philosopher(kl)>0
        --philosopher(kl) 'PHILOSOPHER THINKING
      end if
    end if
  next
  '
  end method

  method show() as string
  cr=chr(13)+chr(10) : tab=chr(9)
  pr="philos" tab "activity" tab "plate" tab "fork L" tab "fork R" cr cr
  for i=1 to 5
  j=i+1 : if j>5 then j-=5
  if plate(i)=0 then
    if philosopher(i)=0 then
      act="waiting"
    else
      act="thinks"
    end if
  else
    act="dining"
  end if
  '
  pr+=i tab act tab plate(i) tab fork(i) tab fork(j) cr
  next
  return pr
  end method

end class

'TEST
'====

RoundTableWith5Seats Sopho
for i=1 to 100
  Sopho.dine
next

print Sopho.show
'putfile "s.txt",Sopho.show

'philos	action	plate	fork L	fork R
'
'1	waiting	0	0	1
'2	dining	8	1	1
'3	thinks	0	1	1
'4	dining	8	1	1
'5	thinks	0	1	0


(defn squeeze [s c]
  (let [spans (partition-by #(= c %) s)
        span-out (fn [span]
                   (if (= c (first span))
                     (str c)
                     (apply str span)))]
    (apply str (map span-out spans))))

(defn test-squeeze [s c]
  (let [out (squeeze s c)]
    (println (format "Input:   <<<%s>>> (len %d)\n" s (count s))
             (format "becomes: <<<%s>>> (len %d)" out (count out)))))


include "cowgol.coh";
include "strings.coh";

sub squeeze(ch: uint8, str: [uint8], buf: [uint8]): (r: [uint8]) is
    r := buf;
    var prev: uint8 := 0;
    while [str] != 0 loop
        if prev != ch or [str] != ch then
            prev := [str];
            [buf] := prev;
            buf := @next buf;
        end if;
        str := @next str;
    end loop;
    [buf] := 0;
end sub;

sub squeezeAndPrint(ch: uint8, str: [uint8]) is
    sub bracketLength(str: [uint8]) is
        print_i32(StrLen(str) as uint32);
        print(" <<<");
        print(str);
        print(">>>\n");
    end sub;

    var buf: uint8[256];
    bracketLength(str);
    bracketLength(squeeze(ch, str, &buf[0]));
    print_nl();
end sub;

var strs: [uint8][] := {
"",
"\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ",
"..1111111111111111111111111111111111111111111111111111111111111117777888",
"I never give 'em hell, I just tell the truth, and they think it's hell. ",
"                                                    --- Harry S Truman  "
};

squeezeAndPrint(' ', strs[0]);
squeezeAndPrint('-', strs[1]);
squeezeAndPrint('7', strs[2]);
squeezeAndPrint('.', strs[3]);
squeezeAndPrint(' ', strs[4]);
squeezeAndPrint('-', strs[4]);
squeezeAndPrint('r', strs[4]);


import std.stdio;

void squeezable(string s, char rune) {
    writeln("squeeze: '", rune, "'");
    writeln("old: <<<", s, ">>>, length = ", s.length);

    write("new: <<<");
    char last = '\0';
    int len = 0;
    foreach (c; s) {
        if (c != last || c != rune) {
            write(c);
            len++;
        }
        last = c;
    }
    writeln(">>>, length = ", len);

    writeln;
}

void main() {
    squeezable(``, ' ');
    squeezable(`"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln `, '-');
    squeezable(`..1111111111111111111111111111111111111111111111111111111111111117777888`, '7');
    squeezable(`I never give 'em hell, I just tell the truth, and they think it's hell. `, '.');

    string s = `                                                    --- Harry S Truman  `;
    squeezable(s, ' ');
    squeezable(s, '-');
    squeezable(s, 'r');
}


declare
  Philosophers = [aristotle kant spinoza marx russell]

  proc {Start}
     Forks = {MakeList {Length Philosophers}}
  in
     {ForAll Forks NewFork}
     for
        Name in Philosophers
        LeftFork in Forks
        RightFork in {RightShift Forks}
     do
        thread
           {Philosopher Name LeftFork RightFork}
        end
     end
  end

  proc {Philosopher Name LeftFork RightFork}
     for do
        {ShowInfo Name#" is hungry."}

        {TakeForks [LeftFork RightFork]}
        {ShowInfo Name#" got forks."}
        {WaitRandom}
        {ReleaseFork LeftFork}
        {ReleaseFork RightFork}

        {ShowInfo Name#" is thinking."}
        {WaitRandom}
     end
  end

  proc {WaitRandom}
     {Delay 1000 + {OS.rand} mod 4000} %% 1-5 seconds
  end

  proc {TakeForks Forks}
     {ForAll Forks WaitForFork}
     case {TryAtomically proc {$}
                            {ForAll Forks TakeFork}
                         end}
     of true then
        {ForAll Forks InitForkNotifier}
     [] false then
        {TakeForks Forks}
     end
  end

  %%
  %% Fork type
  %%

  %% A fork is a mutable reference to a pair
  fun {NewFork}
     {NewCell
      unit(taken:_     %% a fork is taken by setting this value to a unique value
           notify:unit %% to wait for a taken fork
	  )}
  end

  proc {TakeFork F}
     (@F).taken = {NewName}
  end

  proc {InitForkNotifier F}
     %% we cannot do this in TakeFork
     %% because side effect are not allowed in subordinate spaces
     New Old
  in
     {Exchange F Old New}
     New = unit(taken:Old.taken notify:_)
  end

  proc {ReleaseFork F}
     New Old
  in
     {Exchange F Old New}
     New = unit(taken:_ notify:unit)
     Old.notify = unit %% notify waiters
  end

  proc {WaitForFork F}
     {Wait (@F).notify}  %% returns immediatly if fork is free, otherwise blocks
  end

  %%
  %% Helpers
  %%

  %% Implements transactions on data flow variables
  %% with computation spaces. Returns success.
  fun {TryAtomically P}
     try
	S = {Space.new
	     proc {$ Sync}
		{P}
		Sync = unit
	     end}
     in
	{Space.askVerbose S} \= failed = true
	{Wait {Space.merge S}}
	true
     catch _ then
	false
     end
  end

  fun {RightShift Xs} %% circular
     case Xs of nil then nil
     else {Append Xs.2 [Xs.1]}
     end
  end

  ShowInfo = System.showInfo
in
  {Start}


program Determine_if_a_string_is_squeezable;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

var
  TestStrings: TArray<string> = ['',
    '''If I were two-faced, would I be wearing this one?'' --- Abraham Lincoln ',
    '..1111111111111111111111111111111111111111111111111111111111111117777888',
    'I never give ''em hell, I just tell the truth, and they think it''s hell. ',
    '                                                    --- Harry S Truman  ',
    '122333444455555666666777777788888888999999999',
    'The better the 4-wheel drive, the further you''ll be from help when ya get stuck!',
    'headmistressship'];
  TestChar: TArray<string> = [' ', '-', '7', '.', ' -r', '5', 'e', 's'];

function squeeze(s: string; include: char): string;
begin
  var sb := TStringBuilder.Create;
  for var i := 1 to s.Length do
  begin
    if (i = 1) or (s[i - 1] <> s[i]) or ((s[i - 1] = s[i]) and (s[i] <> include)) then
      sb.Append(s[i]
  end;
  Result := sb.ToString;
  sb.Free;
end;

begin
  for var testNum := 0 to high(TestStrings) do
  begin
    var s := TestStrings[testNum];
    for var c in TestChar[testNum] do
    begin
      var result: string := squeeze(s, c);
      writeln(format('use: "%s"'#10'old:  %2d <<<%s>>>'#10'new:  %2d <<<%s>>>'#10, [c,
        s.Length, s, result.length, result]));
    end;
  end;
  readln;
end.


// Determine if a string is squeezable. Nigel Galloway: June 9th., 2020
let squeeze n i=if String.length n=0 then None else
                let fN=let mutable g=n.[0] in (fun n->if n=i && n=g then false else g<-n; true)
                let fG=n.[0..0]+System.String(n.[1..].ToCharArray()|>Array.filter fN)
                if fG.Length=n.Length then None else Some fG
let isSqueezable n g=match squeeze n g with
                      Some i->printfn "%A squeezes <<<%s>>> (length %d) to <<<%s>>> (length %d)" g n n.Length i i.Length
                     |_->printfn "%A does not squeeze <<<%s>>> (length %d)" g n n.Length

isSqueezable "" ' '
isSqueezable "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln " '-'
isSqueezable "..1111111111111111111111111111111111111111111111111111111111111117777888" '7'
isSqueezable "I never give 'em hell, I just tell the truth, and they think it's hell. " '.'
let fN=isSqueezable "                                                    --- Harry S Truman  " in fN ' '; fN '-'; fN 'r'


program dining_philosophers;
{$mode objfpc}{$H+}
uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes, SysUtils, SyncObjs;
const
  PHIL_COUNT   = 5;
  LIFESPAN     = 7;
  DELAY_RANGE  = 950;
  DELAY_LOW    = 50;
  PHIL_NAMES: array[1..PHIL_COUNT] of string = ('Aristotle', 'Kant', 'Spinoza', 'Marx', 'Russell');
type
  TFork        = TCriticalSection;
  TPhilosopher = class;
var
  Forks: array[1..PHIL_COUNT] of TFork;
  Philosophers: array[1..PHIL_COUNT] of TPhilosopher;
type
  TPhilosopher = class(TThread)
  private
    FName: string;
    FFirstFork, FSecondFork: TFork;
  protected
    procedure Execute; override;
  public
    constructor Create(const aName: string; aForkIdx1, aForkIdx2: Integer);
  end;

procedure TPhilosopher.Execute;
var
  LfSpan: Integer = LIFESPAN;
begin
  while LfSpan > 0 do
    begin
      Dec(LfSpan);
      WriteLn(FName, ' sits down at the table');
      FFirstFork.Acquire;
      FSecondFork.Acquire;
      WriteLn(FName, ' eating');
      Sleep(Random(DELAY_RANGE) + DELAY_LOW);
      FSecondFork.Release;
      FFirstFork.Release;
      WriteLn(FName, ' is full and leaves the table');
      if LfSpan = 0 then
        continue;
      WriteLn(FName, ' thinking');
      Sleep(Random(DELAY_RANGE) + DELAY_LOW);
      WriteLn(FName, ' is hungry');
    end;
end;

constructor TPhilosopher.Create(const aName: string; aForkIdx1, aForkIdx2: Integer);
begin
  inherited Create(True);
  FName := aName;
  if aForkIdx1 < aForkIdx2 then
    begin
      FFirstFork := Forks[aForkIdx1];
      FSecondFork := Forks[aForkIdx2];
    end
  else
    begin
      FFirstFork := Forks[aForkIdx2];
      FSecondFork := Forks[aForkIdx1];
    end;
end;

procedure DinnerBegin;
var
  I: Integer;
  Phil: TPhilosopher;
begin
  for I := 1 to PHIL_COUNT do
    Forks[I] := TFork.Create;
  for I := 1 to PHIL_COUNT do
    Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], I, Succ(I mod PHIL_COUNT));
  for Phil in Philosophers do
    Phil.Start;
end;

procedure WaitForDinnerOver;
var
  Phil: TPhilosopher;
  Fork: TFork;
begin
  for Phil in Philosophers do
    begin
      Phil.WaitFor;
      Phil.Free;
    end;
  for Fork in Forks do
    Fork.Free;
end;

begin
  Randomize;
  DinnerBegin;
  WaitForDinnerOver;
end.


USING: formatting fry io kernel math sbufs sequences strings ;
IN: rosetta-code.squeeze

: (squeeze) ( str c -- new-str )
    [ unclip-slice 1string >sbuf ] dip
    '[ over last over [ _ = ] both? [ drop ] [ suffix! ] if ]
    reduce >string ;

: squeeze ( str c -- new-str )
    over empty? [ 2drop "" ] [ (squeeze) ] if ;

: .str ( str -- ) dup length "«««%s»»» (length %d)\n" printf ;

: show-squeeze ( str c -- )
    dup "Specified character: '%c'\n" printf
    [ "Before squeeze: " write drop .str ]
    [ "After  squeeze: " write squeeze .str ] 2bi nl ;

: squeeze-demo ( -- )
    {
        ""
        "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln "
        "..1111111111111111111111111111111111111111111111111111111111111117777888"
        "I never give 'em hell, I just tell the truth, and they think it's hell. "
    } "\0-7." [ show-squeeze ] 2each

    "                                                   ---  Harry S Truman  "
    [ CHAR: space ] [ CHAR: - ] [ CHAR: r ] tri
    [ show-squeeze ] [email protected] ;

MAIN: squeeze-demo


program main
implicit none
character(len=:),allocatable :: strings(:)

strings=[ character(len=72) :: &
'', &
'"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln',  &
'..1111111111111111111111111111111111111111111111111111111111111117777888', &
'I never give ''em hell, I just tell the truth, and they think it''s hell.',&
'                                                    --- Harry S Truman'    &
]

   call printme( trim(strings(1)), ' ' )
   call printme( strings(2:4),     ['-','7','.'] )
   call printme( strings(5),       [' ','-','r'] )

contains

impure elemental subroutine printme(str,chr)
character(len=*),intent(in) :: str
character(len=1),intent(in) :: chr
character(len=:),allocatable :: answer
   write(*,'(a)')repeat('=',9)
   write(*,'("IN:   <<<",g0,">>>")')str
   answer=compact(str,chr)
   write(*,'("OUT:  <<<",g0,">>>")')answer
   write(*,'("LENS: ",*(g0,1x))')"from",len(str),"to",len(answer),"for a change of",len(str)-len(answer)
   write(*,'("CHAR: ",g0)')chr
end subroutine printme

elemental function compact(str,charp) result (outstr)

character(len=*),intent(in)  :: str
character(len=1),intent(in)  :: charp
character(len=:),allocatable :: outstr
character(len=1)             :: ch, last_one
integer                      :: i, pio ! position in output

   outstr=repeat(' ',len(str))      ! start with a string big enough to hold any output
   if(len(outstr)==0)return         ! handle edge condition
   last_one=str(1:1)                ! since at least this long start output with first character
   outstr(1:1)=last_one
   pio=1

   do i=2,len(str)
      ch=str(i:i)
      pio=pio+merge(0,1, ch.eq.last_one.and.ch.eq.charp) ! decide whether to advance before saving
      outstr(pio:pio)=ch  ! store new one or overlay the duplcation
      last_one=ch
   enddo

   outstr=outstr(:pio)              ! trim the output string to just what was set
end function compact

end program main
}


use threads;
use threads::shared;
my @names = qw(Aristotle Kant Spinoza Marx Russell);

my @forks = ('On Table') x @names;
share $forks[$_] for 0 .. $#forks;

sub pick_up_forks {
   my $philosopher = shift;
   my ($first, $second) = ($philosopher, $philosopher-1);
   ($first, $second) = ($second, $first) if $philosopher % 2;
   for my $fork ( @forks[ $first, $second ] ) {
      lock $fork;
      cond_wait($fork) while $fork ne 'On Table';
      $fork = 'In Hand';
   }
}

sub drop_forks {
   my $philosopher = shift;
   for my $fork ( @forks[$philosopher, $philosopher-1] ) {
      lock $fork;
      die unless $fork eq 'In Hand';
      $fork = 'On Table';
      cond_signal($fork);
   }
}

sub philosopher {
   my $philosopher = shift;
   my $name = $names[$philosopher];
   for my $meal ( 1..5 ) {
      print $name, " is pondering\n";
      sleep 1 + rand 8;
      print $name, " is hungry\n";
      pick_up_forks( $philosopher );
      print $name, " is eating\n";
      sleep 1 + rand 8;
      drop_forks( $philosopher );
   }
   print $name, " is done\n";
}

my @t = map { threads->new(\&philosopher, $_) } 0 .. $#names;
for my $thread ( @t ) {
   $thread->join;
}

print "Done\n";
__END__


function squeeze(byval s as string,target as string) as string
      dim as string g
      dim as long n
      for n =0 to len(s)-2
            if s[n]=asc(target) then
            if s[n]<>s[n+1]  then g+=chr(s[n])
           else
            g+=chr(s[n])
            end if
      next n
      if len(s) then g+=chr(s[n])
      return g
end function

dim as string z,o
        print "character "" """
        o=""
        print "original ";o;tab(90);"(";len(o);")"
        z=Squeeze("", " ")
        print "squeeze  "; z;tab(90);"(";len(z);")"
        print
        print "character ""-"""
        o= """If I were two-faced, would I be wearing this one?"" --- Abraham Lincoln "
        print "original ";o;tab(90);"(";len(o);")"
        z=Squeeze(o,"-")
        print "squeeze  "; z;tab(90);"(";len(z);")"
        print
        print "character ""7"""
        o="..1111111111111111111111111111111111111111111111111111111111111117777888"
        print "original ";o;tab(90);"(";len(o);")"
        z=Squeeze(o,"7")
        print "squeeze  "; z;tab(90);"(";len(z);")"
        print
        print "character ""."""
        o="I never give 'em hell, I just tell the truth, and they think it's hell. "
        print "original ";o;tab(90);"(";len(o);")"
        z=Squeeze(o,".")
        print "squeeze  ";z ;tab(90);"(";len(z);")"
        print
        dim as string s = "                                                    --- Harry S Truman  "
        print "character "" """
        o="                                                    --- Harry S Truman  "
        print "original ";o;tab(90);"(";len(o);")"
        z=Squeeze(s, " ")
        print "squeeze  ";z ;tab(90);"(";len(z);")"
        print
         print "character ""-"""
        o="                                                    --- Harry S Truman  "
        print "original ";o;tab(90);"(";len(o);")"
        z=Squeeze(s, "-")
        print "squeeze  "; z;tab(90);"(";len(z);")"
        print
          print "character ""r"""
        o="                                                    --- Harry S Truman  "
        print "original ";o;tab(90);"(";len(o);")"
        z=Squeeze(s, "r")
        print "squeeze  "; z;tab(90);"(";len(z);")"
        sleep


without js -- threads
integer fork1 = init_cs(),
        fork2 = init_cs(),
        fork3 = init_cs(),
        fork4 = init_cs(),
        fork5 = init_cs()
integer terminate = 0                   -- control flag

procedure person(sequence name, atom left_fork, atom right_fork)
-- (except Russell, who gets left and right the other way round)
    while terminate=0 do
        enter_cs(left_fork)
        enter_cs(right_fork)
        puts(1, name & " grabs forks.\n")
        for i=1 to rand(10) do
--          if terminate then exit end if
            puts(1, name & " is eating.\n")
--          sleep(1)
        end for
        puts(1, name & " puts forks down and leaves the dinning room.\n")
        leave_cs(left_fork)
        leave_cs(right_fork)
        for i=1 to rand(10) do
--          if terminate then exit end if
            puts(1, name & " is thinking.\n")
--          sleep(1)
        end for
        puts(1, name & " becomes hungry.\n")
    end while
end procedure
constant r_person = routine_id("person")

constant threads = {create_thread(r_person,{"Aristotle",fork1,fork2}),
                    create_thread(r_person,{"Kant",fork2,fork3}),
                    create_thread(r_person,{"Spinoza",fork3,fork4}),
                    create_thread(r_person,{"Marx",fork4,fork5}),
--                  create_thread(r_person,{"Russell",fork5,fork1})}    -- this will deadlock!
                    create_thread(r_person,{"Russell",fork1,fork5})}

constant ESC = #1B
while not find(get_key(),{ESC,'q','Q'}) do
    sleep(1)
end while
terminate = 1
wait_thread(threads)    -- (not strictly necessary)
delete_cs(fork1)        -- ""
delete_cs(fork2)
delete_cs(fork3)
delete_cs(fork4)
delete_cs(fork5)


squeeze[str, ch] :=
{
   println["Use: '$ch'"]
   println["old: " + length[str] + " <<<$str>>>"]
   str =~ subst["($ch)\\1+", "$$1", "g"]
   println["new: " + length[str] + " <<<$str>>>"]
}

lines = [["", [""]],
         [""""If I were two-faced, would I be wearing this one?" --- Abraham Lincoln """, ["-"]],
["..1111111111111111111111111111111111111111111111111111111111111117777888", ["7"]],
["I never give 'em hell, I just tell the truth, and they think it's hell. ", ["."]],
["                                                    --- Harry S Truman  ",[" ", "-", "r"]]]

for [line, chars] = lines
   for char = chars
      println[squeeze[line, char]]


package main

import "fmt"

// Returns squeezed string, original and new lengths in
// unicode code points (not normalized).
func squeeze(s string, c rune) (string, int, int) {
    r := []rune(s)
    le, del := len(r), 0
    for i := le - 2; i >= 0; i-- {
        if r[i] == c && r[i] == r[i+1] {
            copy(r[i:], r[i+1:])
            del++
        }
    }
    if del == 0 {
        return s, le, le
    }
    r = r[:le-del]
    return string(r), le, len(r)
}

func main() {
    strings := []string{
        "",
        `"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln `,
        "..1111111111111111111111111111111111111111111111111111111111111117777888",
        "I never give 'em hell, I just tell the truth, and they think it's hell. ",
        "                                                   ---  Harry S Truman  ",
        "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
        "headmistressship",
        "aardvark",
        "😍😀🙌💃😍😍😍🙌",
    }
    chars := [][]rune{{' '}, {'-'}, {'7'}, {'.'}, {' ', '-', 'r'}, {'e'}, {'s'}, {'a'}, {'😍'}}

    for i, s := range strings {
        for _, c := range chars[i] {
            ss, olen, slen := squeeze(s, c)
            fmt.Printf("specified character = %q\n", c)
            fmt.Printf("original : length = %2d, string = «««%s»»»\n", olen, s)
            fmt.Printf("squeezed : length = %2d, string = «««%s»»»\n\n", slen, ss)
        }
    }
}


(de dining (Name State)
   (loop
      (prinl Name ": " State)
      (state 'State                       # Dispatch according to state
         (thinking 'hungry)               # If thinking, get hungry
         (hungry                          # If hungry, grab random fork
            (if (rand T)
               (and (acquire leftFork) 'leftFork)
               (and (acquire rightFork) 'rightFork) ) )
         (hungry 'hungry                  # Failed, stay hungry for a while
            (wait (rand 1000 3000)) )
         (leftFork                        # If holding left fork, try right one
            (and (acquire rightFork) 'eating)
            (wait 2000) )                 # then eat for 2 seconds
         (rightFork                       # If holding right fork, try left one
            (and (acquire leftFork) 'eating)
            (wait 2000) )                 # then eat for 2 seconds
         ((leftFork rightFork) 'hungry    # Otherwise, go back to hungry,
            (release (val State))         # release left or right fork
            (wait (rand 1000 3000)) )     # and stay hungry
         (eating 'thinking             # After eating, resume thinking
            (release leftFork)
            (release rightFork)
            (wait 6000) ) ) ) )           # for 6 seconds

(setq *Philosophers
   (maplist
      '((Phils Forks)
         (let (leftFork (tmp (car Forks))  rightFork (tmp (cadr Forks)))
            (or
               (fork)  # Parent: Collect child process IDs
               (dining (car Phils) 'hungry) ) ) )  # Initially hungry
      '("Aristotle" "Kant" "Spinoza" "Marx" "Russell")
      '("ForkA" "ForkB" "ForkC" "ForkD" "ForkE" .) ) )

(push '*Bye '(mapc kill *Philosophers))  # Terminate all upon exit


class Philosopher
{
    string name;
    object left;
    object right;

    void create(string _name, object _left, object _right)
    {
        name = _name;
        left = _left;
        right = _right;
    }

    void take_forks()
    {
        if (left->take(this) && right->take(this))
        {
            write("%s is EATING\n", name);
            call_out(drop_forks, random(30));
        }
        else
        {
            write("%s is WAITING\n", name);
            if (random(10) >= 8)
                drop_forks();
            call_out(take_forks, random(10));
        }
    }

    void drop_forks()
    {
        left->drop(this);
        right->drop(this);
        write("%s is THINKING\n", name);
        call_out(take_forks, random(30));
    }
}

class Fork
{
    int number;
    Philosopher user;

    void create(int _number)
    {
        number = _number;
    }

    int take(object new_user)
    {
        if (!user)
        {
            write("%s takes fork %d\n", new_user->name, number);
            user = new_user;
            return 1;
        }
        else if (new_user == user)
        {
            write("%s has fork %d\n", new_user->name, number);
            return 1;
        }
        else
            write("%s tries to take fork %d from %s\n", new_user->name, number, user->name);
    }

    void drop(object old_user)
    {
        if (old_user == user)
        {
            write("%s drops fork %d\n", old_user->name, number);
            user = 0;
        }
    }
}

int main(int argc, array argv)
{

  array forks = ({ Fork(1), Fork(2), Fork(3), Fork(4), Fork(5) });
  array philosophers = ({
                           Philosopher("einstein", forks[0], forks[1]),
                           Philosopher("plato", forks[1], forks[2]),
                           Philosopher("sokrates", forks[2], forks[3]),
                           Philosopher("chomsky", forks[3], forks[4]),
                           Philosopher("archimedes", forks[4], forks[0]),
                        });

  call_out(philosophers[0]->take_forks, random(5));
  call_out(philosophers[1]->take_forks, random(5));
  call_out(philosophers[2]->take_forks, random(5));
  call_out(philosophers[3]->take_forks, random(5));
  call_out(philosophers[4]->take_forks, random(5));
  return -1;
}


class StringSqueezable {
    static void main(String[] args) {
        String[] testStrings = [
                "",
                "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ",
                "..1111111111111111111111111111111111111111111111111111111111111117777888",
                "I never give 'em hell, I just tell the truth, and they think it's hell. ",
                "                                                    --- Harry S Truman  ",
                "122333444455555666666777777788888888999999999",
                "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
                "headmistressship"
        ]

        String[] testChar = [" ", "-", "7", ".", " -r", "5", "e", "s"]
        for (int testNum = 0; testNum < testStrings.length; testNum++) {
            String s = testStrings[testNum]
            for (char c : testChar[testNum].toCharArray()) {
                String result = squeeze(s, c)
                System.out.printf("use: '%c'%nold:  %2d <<<%s>>>%nnew:  %2d <<<%s>>>%n%n", c, s.length(), s, result.length(), result)
            }
        }
    }

    private static String squeeze(String input, char include) {
        StringBuilder sb = new StringBuilder()
        for (int i = 0; i < input.length(); i++) {
            if (i == 0 || input.charAt(i - 1) != input.charAt(i) || (input.charAt(i - 1) == input.charAt(i) && input.charAt(i) != include)) {
                sb.append(input.charAt(i))
            }
        }
        return sb.toString()
    }
}


import Text.Printf (printf)

input :: [(String, Char)]
input = [ ("", ' ')
        , ("The better the 4-wheel drive, the further you'll be from help when ya get stuck!", 'e')
        , ("headmistressship", 's')
        , ("\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ", '-')
        , ("..1111111111111111111111111111111111111111111111111111111111111117777888", '7')
        , ("I never give 'em hell, I just tell the truth, and they think it's hell. ", '.')
        , ("                                                    --- Harry S Truman  ", 'r')
        , ("aardvark", 'a')
        , ("😍😀🙌💃😍😍😍🙌", '😍')
        ]

collapse :: Eq a => [a] -> a -> [a]
collapse s c = go s
  where go [] = []
        go (x:y:xs)
          | x == y && x == c = go (y:xs)
          | otherwise        = x : go (y:xs)
        go xs = xs

main :: IO ()
main =
  mapM_ (\(a, b, c) -> printf "squeeze: '%c'\nold: %3d «««%s»»»\nnew: %3d «««%s»»»\n\n" c (length a) a (length b) b)
  $ (\(s, c) -> (s, collapse s c, c)) <$> input


dining_philosophers :-
	new(D, window('Dining philosophers')),
	new(S, window('Dining philosophers : statistics')),
	send(D, size, new(_, size(800,800))),

	new(E, ellipse(400,400)),
	send(E, center, point(400,400)),
	send(D, display, E),

	new(F1, fork(0)),
	new(F2, fork(1)),
	new(F3, fork(2)),
	new(F4, fork(3)),
	new(F5, fork(4)),

	send_list(D, display, [F1,F2,F3,F4,F5]),

	new(Waiter, waiter(F1, F2, F3, F4, F5)),

	create_plate(P1, 0),
	create_plate(P2, 1),
	create_plate(P3, 2),
	create_plate(P4, 3),
	create_plate(P5, 4),

	create_point(0, Pt1),
	create_point(1, Pt2),
	create_point(2, Pt3),
	create_point(3, Pt4),
	create_point(4, Pt5),

	new(Ph1, philosopher('Aristotle', Waiter, P1, D, S, 0, Pt1, left)),
	new(Ph2, philosopher('Kant', Waiter, P2, D, S, 1, Pt2, left)),
	new(Ph3, philosopher('Spinoza', Waiter, P3, D, S, 2, Pt3, right)),
	new(Ph4, philosopher('Marx', Waiter, P4, D, S, 3, Pt4, right)),
	new(Ph5, philosopher('Russell', Waiter, P5, D, S, 4, Pt5, left)),

	send(Waiter, init_phi, Ph1, Ph2, Ph3, Ph4, Ph5),

	send_list([Ph1, Ph2, Ph3, Ph4, Ph5], start),

	send(D, done_message, and(message(Waiter, free),
				 message(Ph1, free),
				 message(Ph2, free),
				 message(Ph3, free),
				 message(Ph4, free),
				 message(Ph5, free),
				 message(S, open),
				 message(D, destroy))),

	send(D, open).

create_plate(P, N) :-
	new(P, ellipse(80,80)),
	X is 400 + 140 * cos(N * pi / 2.5),
	Y is 400 + 140 * sin(N * pi / 2.5),
	send(P, center, point(X, Y)).

create_point(N, point(X, Y)) :-
	X is 400 + 220 * cos(N * pi / 2.5),
	Y is 400 + 220 * sin(N * pi / 2.5) - 20.

:- pce_begin_class(waiter , object, "gives the forks to the philosophers").
variable(f1, fork, both, "free or used").
variable(f2, fork, both, "free or used").
variable(f3, fork, both, "free or used").
variable(f4, fork, both, "free or used").
variable(f5, fork, both, "free or used").
variable(phi1, philosopher, both, "philosopher").
variable(phi2, philosopher, both, "philosopher").
variable(phi3, philosopher, both, "philosopher").
variable(phi4, philosopher, both, "philosopher").
variable(phi5, philosopher, both, "philosopher").

initialise(P, F1, F2, F3, F4, F5) :->
	send(P, slot, f1, F1),
	send(P, slot, f2, F2),
	send(P, slot, f3, F3),
	send(P, slot, f4, F4),
	send(P, slot, f5, F5).

init_phi(P, Phi1,Phi2, Phi3, Phi4, Phi5) :->
	send(P, slot, phi1, Phi1),
	send(P, slot, phi2, Phi2),
	send(P, slot, phi3, Phi3),
	send(P, slot, phi4, Phi4),
	send(P, slot, phi5, Phi5).

want_forks(P, Phi) :->
	( get(P, slot, phi1, Phi) ,!, check_forks(P, Phi, f5, f1);
	 get(P, slot, phi2, Phi),!, check_forks(P, Phi, f1, f2);
	 get(P, slot, phi3, Phi),!, check_forks(P, Phi, f2, f3);
	 get(P, slot, phi4, Phi),!, check_forks(P, Phi, f3, f4);
	 get(P, slot, phi5, Phi),!, check_forks(P, Phi, f4, f5)).

give_back_forks(P, Phi) :->
	( get(P, slot, phi1, Phi) ,!, release_forks(P, phi1);
	 get(P, slot, phi2, Phi),!, release_forks(P, phi2);
	 get(P, slot, phi3, Phi),!, release_forks(P, phi3);
	 get(P, slot, phi4, Phi),!, release_forks(P, phi4);
	 get(P, slot, phi5, Phi),!, release_forks(P, phi5)),

	get(P, slot, phi1, Phi1),
	check_forks(P, Phi1, f5, f1),
	get(P, slot, phi2, Phi2),
	check_forks(P, Phi2, f1, f2),
	get(P, slot, phi3, Phi3),
	check_forks(P, Phi3, f2, f3),
	get(P, slot, phi4, Phi4),
	check_forks(P, Phi4, f3, f4),
	get(P, slot, phi5, Phi5),
	check_forks(P, Phi5, f4, f5).

release_forks(P, phi1) :-
	get(P, slot, f5, F5),
	send(F5, free),
	get(P, slot, f1, F1),
	send(F1, free).

release_forks(P, phi2) :-
	get(P, slot, f1, F1),
	send(F1, free),
	get(P, slot, f2, F2),
	send(F2, free).

release_forks(P, phi3) :-
	get(P, slot, f2, F2),
	send(F2, free),
	get(P, slot, f3, F3),
	send(F3, free).

release_forks(P, phi4) :-
	get(P, slot, f3, F3),
	send(F3, free),
	get(P, slot, f4, F4),
	send(F4, free).

release_forks(P, phi5) :-
	get(P, slot, f4, F4),
	send(F4, free),
	get(P, slot, f5, F5),
	send(F5, free).

check_forks(P, Phi, F1, F2) :-
	get(P, slot, F1, FF1),
	get(P, slot, F2, FF2),
	(   (get(Phi, slot, status, waiting),
	     get(FF1, slot, status, free),
	     get(FF2, slot, status, free))
	->
	     send(Phi, receive_forks),
	     send(FF1, used, right),
	     send(FF2, used, left)
	;
	     true).

:- pce_end_class.

:- pce_begin_class(philosopher , object, "eat, think or wait !").
variable(name, string, both).
variable(window, object, both).
variable(status, object, both, "eating/thinking/waiting").
variable(waiter, object, both).
variable(plate,  object, both).
variable(mytimer, timer, both).
variable(pos, point, both).
variable(side, object, both).
variable(old_text, object, both).
variable(window_stat, object, both).
variable(line_stat, number, both).
variable(stat_wait, my_stat, both).
variable(stat_eat, my_stat, both).
variable(stat_think, my_stat, both).

% méthode appelée lors de la destruction de l'objet
% On arrête d'abord le timer pour poursuivre ensuite
% sans problème (appel par le timer de ressources libérées)
unlink(P) :->
	send(P?mytimer, stop),

	get(P, status, Sta),
	stop_timer(P, Sta),
	get(P, slot, window_stat, WS),
	get(P, slot, line_stat, LS),
	get(LS, value, VLS),
	get(P, slot, name, Name),
	get(Name, value, V),
	sformat(A, 'Statistics of philosopher : ~w', [V]),
	new(Text, text(A)),
	send(Text, font, font(times, bold, 16)),
	Y is VLS * 30,
	send(WS, display, Text, point(30, Y)),

	VLS1 is VLS+1,
	get(P, slot, stat_think, ST),
	send(ST, statistics, WS, VLS1),

	VLS2 is VLS+2,
	get(P, slot, stat_eat, SE),
	send(SE, statistics, WS, VLS2),

	VLS3 is VLS+3,
	get(P, slot, stat_wait, SW),
	send(SW, statistics, WS, VLS3),

	send(P, send_super, unlink).

initialise(P, Name, Waiter, Plate, Window, Window_stat, Line_stat, Point, Side) :->
	% gtrace,
	send(P, slot, name, Name),
	send(P, slot, window, Window),
	send(P, slot, window_stat, Window_stat),
	Line is Line_stat * 5,
	send(P, slot, line_stat, Line),
	send(P, slot, waiter,Waiter),
	send(P, slot, plate,Plate),
	send(P, slot, status, thinking),
	send(P, slot, pos, Point),
	send(P, slot, side, Side),
	send(Window, display, Plate),
	send(P, slot, old_text, new(_, text(' '))),
	send(P, display_status),
	send(P, slot, stat_wait, new(_, my_stat('Waiting'))),
	send(P, slot, stat_eat, new(_, my_stat('Eating'))),
	send(P, slot, stat_think, new(_, my_stat('Thinking'))).

stop_timer(P, eating) :-
	get(P, slot, stat_eat, SE),
	send(SE, stop).

stop_timer(P, waiting) :-
	get(P, slot, stat_wait, SW),
	send(SW, stop).

stop_timer(P, thinking) :-
	get(P, slot, stat_think, ST),
	send(ST, stop).

% internal message send by the timer
my_message(P) :->
	% gtrace,
	get(P, slot, status, Status),
	next_status(P, Status).

% philosopher eating ==> thinking
next_status(P, eating) :-
	get(P, slot, waiter, Waiter),
	get(P, slot, stat_eat, SE),
	send(SE, stop),
	get(P, slot, stat_think, ST),
	send(ST, start),
	send(Waiter, give_back_forks, P),
	send(P, slot, status, thinking),
	send(P, display_status),
	get(P, plate, Plate),
	send(Plate, fill_pattern, colour(white)),
	I is random(20)+ 10,
	get(P, slot, mytimer, Timer),
	send(Timer, interval, I),
	send(Timer, start, once).

next_status(P, thinking) :-
	get(P, slot, waiter, Waiter),
	send(P, slot, status, waiting),
	send(P, display_status),
	get(P, slot, stat_think, ST),
	send(ST, stop),
	get(P, slot, stat_wait, SW),
	send(SW, start),
	send(Waiter, want_forks, P).

% send by the waiter
% philosopher can eat !
receive_forks(P) :->
	get(P, slot, stat_wait, SW),
	send(SW, stop),
	get(P, slot, stat_eat, SE),
	send(SE, start),
	send(P, slot, status, eating),
	send(P, display_status),
	get(P, plate, Plate),
	send(Plate, fill_pattern, colour(black)),
	I is random(20)+ 5,
	get(P, slot, mytimer, Timer),
	send(Timer, interval, I),
	send(Timer, start, once).

display_status(P) :->
	get(P, old_text, OT),
	free(OT),
	get(P, name, Name),
	get(Name, value, V),
	get(P, status, Status),
	choose_color(Status, Colour),
	sformat(A, '~w ~w', [V, Status]),
	get(P, window, W),
	get(P, pos, point(X, Y)),
	new(Text, text(A)),
	send(Text, font, font(times, bold, 16)),
	send(Text, colour, Colour),
	get(Text, string, Str),
	get(font(times, bold, 16), width(Str), M),
	(get(P, side, right) -> X1 is X - M; X1 = X),
	send(W, display, Text, point(X1, Y)),
	send(P, old_text, Text).

start(P) :->
	I is random(10)+ 2,
	get(P, slot, stat_think, ST),
	send(ST, start),
	send(P, mytimer, new(_, timer(I,message(P, my_message)))),
	send(P?mytimer, start, once).

choose_color(eating, colour(blue)).
choose_color(thinking, colour(green)).
choose_color(waiting, colour(red)).

:- pce_end_class.

:- pce_begin_class(disk, ellipse, "disk with color ").

initialise(P, C, R, Col) :->
        send(P, send_super, initialise, R, R),
	send(P, center, C),
	send(P, pen, 0),
	send(P, fill_pattern, Col).

change_color(P, Col) :->
	send(P, fill_pattern, Col).

:- pce_end_class.

:- pce_begin_class(my_stat , object, "statistics").
variable(name, string, both).
variable(nb, number, both).
variable(duration, real, both).
variable(start, real, both).

initialise(P, Name) :->
	send(P, name, Name),
	send(P, nb, 0),
	send(P, duration, 0.0).

start(P) :->
	get_time(T),
	send(P, slot, start, T).

stop(P) :->
	get_time(Fin),

	get(P, slot, nb, N),
	send(N, plus,1),
	send(P, slot, nb, N),

	get(P, slot, duration, D),
	get(P, slot, start, Deb),

	get(D, value, VD),
	get(Deb, value, VDeb),
	X is VD + Fin - VDeb,

	send(P, slot, duration, X).

statistics(P, W, L) :->
	get(P, nb, N),
	get(N, value, VN),
	get(P, duration, D),
	get(D, value, VD),
	get(P, name, Name),
	get(Name, value, V),
	sformat(A, '~w~tnb :~13| ~t~w~17| duration : ~t~1f~35|', [V, VN, VD]),
	new(Text, text(A)),
	send(Text, font, font(screen, roman, 14)),
	Y is L * 30,
	send(W, display, Text, point(40, Y)).

:-pce_end_class.

% forks changes of place
:- pce_begin_class(fork, line, "to help philosopphers to eat").
variable(value, number, both, "0 => 4").
variable(side, object, both), "left / right".
variable(status, object, both, "free / used").

initialise(P, Val) :->
	send_super(P, initialise),
	send(P, slot, value, Val),
	send(P, slot, status, free),
	compute(Val, free, _, PS, PE),
	send(P, start, PS),
	send(P, end, PE).

free(P) :->
	send(P, status, free),
	send(P, position).

used(P, Side) :->
	send(P, status, used),
	send(P, side, Side),
	send(P, position).

position(P) :->
	get(P, value, V),
	get(V, value, N),
	get(P, status, St),
	get(P, side, Side),
	compute(N, St, Side, PS, PE),
	send(P, start, PS),
	send(P, end, PE).

compute(N, free, _Side, point(XS,YS), point(XE,YE)) :-
	A is N * pi / 2.5 + pi / 5,
	XS is 400 + 100 * cos(A),
	YS is 400 + 100 * sin(A),
	XE is 400 + 180 * cos(A),
	YE is 400 + 180 * sin(A).

compute(N, used, left, point(XS,YS), point(XE,YE)) :-
	A is N * pi / 2.5 + pi / 5 - 2 * pi / 15,
	XS is 400 + 100 * cos(A),
	YS is 400 + 100 * sin(A),
	XE is 400 + 180 * cos(A),
	YE is 400 + 180 * sin(A).

compute(N, used, right, point(XS,YS), point(XE,YE)) :-
	A is N * pi / 2.5 + pi / 5 +  2 * pi / 15,
	XS is 400 + 100 * cos(A),
	YS is 400 + 100 * sin(A),
	XE is 400 + 180 * cos(A),
	YE is 400 + 180 * sin(A).

:- pce_end_class.


//  Title:  Determine if a string is squeezable

public class StringSqueezable {

    public static void main(String[] args) {
        String[] testStrings = new String[] {
                "",
                "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ",
                "..1111111111111111111111111111111111111111111111111111111111111117777888",
                "I never give 'em hell, I just tell the truth, and they think it's hell. ",
                "                                                    --- Harry S Truman  ",
                "122333444455555666666777777788888888999999999",
                "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
                "headmistressship"};

        String[] testChar = new String[] {
                " ",
                "-",
                "7",
                ".",
                " -r",
                "5",
                "e",
                "s"};
        for ( int testNum = 0 ; testNum < testStrings.length ; testNum++ ) {
            String s = testStrings[testNum];
            for ( char c : testChar[testNum].toCharArray() ) {
                String result = squeeze(s, c);
                System.out.printf("use: '%c'%nold:  %2d <<<%s>>>%nnew:  %2d <<<%s>>>%n%n", c, s.length(), s, result.length(), result);
            }
        }
    }

    private static String squeeze(String in, char include) {
        StringBuilder sb = new StringBuilder();
        for ( int i = 0 ; i < in.length() ; i++ ) {
            if ( i == 0 || in.charAt(i-1) != in.charAt(i) || (in.charAt(i-1) == in.charAt(i) && in.charAt(i) != include)) {
                sb.append(in.charAt(i));
            }
        }
        return sb.toString();
    }

}


Macro Tell(Mutex, Message) ; Make a macro to easy send info back to main thread
  LockMutex(Mutex)
    LastElement(Queue())
    AddElement(Queue())
    Queue() = Message
    SignalSemaphore(Semaphore)
  UnlockMutex(Mutex)
EndMacro

;Set up a data structure to pass needed info into the threads
Structure Thread_Parameters
  Name.s
  fork1.i
  fork2.i
EndStructure

; Declare function to be used
Declare.i TryFork(n)
Declare   PutDownFork(n)
Declare   Invite(Namn.s, Fork1, Fork2)
Declare   _philosophers(*arg.Thread_Parameters)

Global Semaphore = CreateSemaphore()
Global Mutex1     = CreateMutex() ; Eg. fork 1
Global Mutex2     = CreateMutex() ; Eg. fork 2
Global Mutex3     = CreateMutex() ; Eg. fork 3
Global Mutex4     = CreateMutex() ; Eg. fork 4
Global Mutex5     = CreateMutex() ; Eg. fork 5
Global Mutex_main = CreateMutex() ; locking communication with the main thread which do all output.
Global NewList Queue.s()

If OpenConsole()
  Invite("Aristotle",1,2)  ; Get all Philosophers activated
  Invite("Kant",     2,3)
  Invite("Spinoza",  3,4)
  Invite("Marx",     4,5)
  Invite("Russell",  5,1)
  CompilerIf #PB_Compiler_OS=#PB_OS_Windows
    SetConsoleTitle_("Dining philosophers, by Jofur")   ; Using a Windows-API here, so checking before
  CompilerEndIf
  ; Wait and see if any Philosophers want to tell me anything
  Repeat
    WaitSemaphore(Semaphore)
    LockMutex(Mutex_main)
      ForEach Queue()
        PrintN( Queue() )  ; Print what the Philosopher(s) told me
        i-1
      Next Queue()
      ClearList(Queue())
    UnlockMutex(Mutex_main)
  ForEver
EndIf

Procedure TryFork(n)  ; Se is fork #n is free and if so pick it up
  Select n
    Case 1: ProcedureReturn TryLockMutex(Mutex1)
    Case 2: ProcedureReturn TryLockMutex(Mutex2)
    Case 3: ProcedureReturn TryLockMutex(Mutex3)
    Case 4: ProcedureReturn TryLockMutex(Mutex4)
    Default:ProcedureReturn TryLockMutex(Mutex5)
  EndSelect
EndProcedure

Procedure PutDownFork(n) ; put down fork #n and free it to be used by neighbors.
  Select n
    Case 1: UnlockMutex(Mutex1)
    Case 2: UnlockMutex(Mutex2)
    Case 3: UnlockMutex(Mutex3)
    Case 4: UnlockMutex(Mutex4)
    Default:UnlockMutex(Mutex5)
  EndSelect
EndProcedure

Procedure Invite(Namn.s, Fork1, Fork2)
  Protected *arg.Thread_Parameters ;create the structure containing the parameters
  Protected Thread
  *arg = AllocateMemory(SizeOf(Thread_Parameters))
  *arg\Name = Namn
  *arg\fork1 = Fork1
  *arg\fork2 = Fork2
  Thread=CreateThread(@_philosophers(), *arg) ;send the thread a pointer to our structure
  ProcedureReturn Thread
EndProcedure

Procedure _philosophers(*arg.Thread_Parameters)
  Protected Iam.s=*arg\Name, j=*arg\fork1, k=*arg\fork2
  Protected f1, f2
  ClearStructure(*arg, Thread_Parameters)
  FreeMemory(*arg)
  ;
  Repeat
    Tell(Mutex_main,Iam+": Going to the table")
    Repeat          ;Trying to get my two forks
      f1=TryFork(j)
      If f1
        f2=TryFork(k)
        If Not f2   ; I got only one fork
          PutDownFork(j)
          f1=0
        EndIf
      EndIf
      If Not f2
        Delay(Random(100))  ; Take a short breath, then try the forks in the other order
        Swap j,k
      EndIf
    Until f1 And f2
    Tell(Mutex_main,Iam+": I have fork #"+Str(j)+" & #"+Str(k)+" and I'm eating now")
    Delay(Random(1500)+15)
    Tell(Mutex_main,Iam+": release fork #"+Str(j)+" & #"+Str(k)+"")
    Delay(Random(45)+15)
    PutDownFork(j)
    PutDownFork(k)
    f1=0:f2=0
    Tell(Mutex_main,Iam+": Thinking about the nature of the universe...")
    Delay(Random(2500)+25)
  ForEver
EndProcedure


# Assume $c is specified as a single character correctly
def squeeze($c): gsub("[\($c)]+"; $c);

def Guillemets: "«««\(.)»»»";

def Squeeze(s; $c):
  "Squeeze character: \($c)",
   (s | "Original: \(Guillemets) has length \(length)",
        (squeeze($c) | "result is \(Guillemets) with length \(length)")),
   "";


NB. Note |.!.1 here instead of the APL version's 1 , }. to more elegantly handle the null case in J
sq =: ] #~ ~: +. _1 |.!.1 ] ~: 1 |. ]


const teststringpairs = [
    ("", ' '),
    (""""If I were two-faced, would I be wearing this one?" --- Abraham Lincoln """, '-'),
    ("..1111111111111111111111111111111111111111111111111111111111111117777888", '7'),
    ("""I never give 'em hell, I just tell the truth, and they think it's hell. """, '.'),
    ("                                                    --- Harry S Truman  ", ' '),
    ("                                                    --- Harry S Truman  ", '-'),
    ("                                                    --- Harry S Truman  ", 'r')]

function squeezed(s, c)
    t = isempty(s) ? "" : s[1:1]
    for x in s[2:end]
        if x != t[end] || x != c
            t *= x
        end
    end
    t
end

for (s, c) in teststringpairs
    n, t = length(s), squeezed(s, c)
    println("«««$s»»» (length $n)\n",
        s == t ? "is not squeezed, so remains" : "squeezes to",
        ":\n«««$t»»» (length $(length(t))).\n")
end


fun main() {
    val testStrings = arrayOf(
        "",
        "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ",
        "..1111111111111111111111111111111111111111111111111111111111111117777888",
        "I never give 'em hell, I just tell the truth, and they think it's hell. ",
        "                                                    --- Harry S Truman  ",
        "122333444455555666666777777788888888999999999",
        "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
        "headmistressship")
    val testChar = arrayOf(
        " ",
        "-",
        "7",
        ".",
        " -r",
        "5",
        "e",
        "s")
    for (testNum in testStrings.indices) {
        val s = testStrings[testNum]
        for (c in testChar[testNum].toCharArray()) {
            val result = squeeze(s, c)
            System.out.printf("use: '%c'%nold:  %2d >>>%s<<<%nnew:  %2d >>>%s<<<%n%n", c, s.length, s, result.length, result)
        }
    }
}

private fun squeeze(input: String, include: Char): String {
    val sb = StringBuilder()
    for (i in input.indices) {
        if (i == 0 || input[i - 1] != input[i] || input[i - 1] == input[i] && input[i] != include) {
            sb.append(input[i])
        }
    }
    return sb.toString()
}


import threading
import random
import time

# Dining philosophers, 5 Phillies with 5 forks. Must have two forks to eat.
#
# Deadlock is avoided by never waiting for a fork while holding a fork (locked)
# Procedure is to do block while waiting to get first fork, and a nonblocking
# acquire of second fork.  If failed to get second fork, release first fork,
# swap which fork is first and which is second and retry until getting both.
#
# See discussion page note about 'live lock'.

class Philosopher(threading.Thread):

    running = True

    def __init__(self, xname, forkOnLeft, forkOnRight):
        threading.Thread.__init__(self)
        self.name = xname
        self.forkOnLeft = forkOnLeft
        self.forkOnRight = forkOnRight

    def run(self):
        while(self.running):
            #  Philosopher is thinking (but really is sleeping).
            time.sleep( random.uniform(3,13))
            print '%s is hungry.' % self.name
            self.dine()

    def dine(self):
        fork1, fork2 = self.forkOnLeft, self.forkOnRight

        while self.running:
            fork1.acquire(True)
            locked = fork2.acquire(False)
            if locked: break
            fork1.release()
            print '%s swaps forks' % self.name
            fork1, fork2 = fork2, fork1
        else:
            return

        self.dining()
        fork2.release()
        fork1.release()

    def dining(self):
        print '%s starts eating '% self.name
        time.sleep(random.uniform(1,10))
        print '%s finishes eating and leaves to think.' % self.name

def DiningPhilosophers():
    forks = [threading.Lock() for n in range(5)]
    philosopherNames = ('Aristotle','Kant','Spinoza','Marx', 'Russel')

    philosophers= [Philosopher(philosopherNames[i], forks[i%5], forks[(i+1)%5]) \
            for i in range(5)]

    random.seed(507129)
    Philosopher.running = True
    for p in philosophers: p.start()
    time.sleep(100)
    Philosopher.running = False
    print ("Now we're finishing.")

DiningPhilosophers()


function squeezable(s, rune)
    print("squeeze: `" .. rune .. "`")
    print("old: <<<" .. s .. ">>>, length = " .. string.len(s))

    local last = nil
    local le = 0
    io.write("new: <<<")
    for c in s:gmatch"." do
        if c ~= last or c ~= rune then
            io.write(c)
            le = le + 1
        end
        last = c
    end
    print(">>>, length = " .. le)

    print()
end

function main()
    squeezable("", ' ');
    squeezable("\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ", '-')
    squeezable("..1111111111111111111111111111111111111111111111111111111111111117777888", '7')
    squeezable("I never give 'em hell, I just tell the truth, and they think it's hell. ", '.')

    local s = "                                                    --- Harry S Truman  "
    squeezable(s, ' ')
    squeezable(s, '-')
    squeezable(s, 'r')
end

main()


ClearAll[Squeeze]
Squeeze[s_String,sq_String]:=StringReplace[s,x:(sq..):>sq]
s={
  "",
  "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln",
  "..1111111111111111111111111111111111111111111111111111111111111117777888",
  "I never give 'em hell, I just tell the truth, and they think it's hell. ",
  "                                                    --- Harry S Truman  "
};
Squeeze[s[[1]],""]
Squeeze[s[[2]],"-"]
Squeeze[s[[3]],"7"]
Squeeze[s[[4]],"."]
Squeeze[s[[5]]," "]
Squeeze[s[[5]],"-"]
Squeeze[s[[5]],"r"]


function r = squeezee(s,c)
  ix = [];
  c  = unique(c);
  for k=1:length(c)
    ix=[ix; find((s(1:end-1)==s(2:end)) & (s(1:end-1)==c(k)))+1];
  end
  r=s;
  r(ix)=[];

  fprintf(1,'Character to be squeezed: "%s"\n',c);
  fprintf(1,'Input:  <<<%s>>>  length: %d\n',s,length(s));
  fprintf(1,'Output: <<<%s>>>  length: %d\n',r,length(r));
  fprintf(1,'Character to be squeezed: "%s"\n',c);

end

squeezee('', ' ')
squeezee('║╚═══════════════════════════════════════════════════════════════════════╗', '-')
squeezee('║"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ║', '7')
squeezee('║..1111111111111111111111111111111111111111111111111111111111111117777888║', '.')
squeezee('║I never give ''em hell, I just tell the truth, and they think it''s hell. ║', '.')
squeezee('║                                                    --- Harry S Truman  ║', '.')
squeezee('║                                                    --- Harry S Truman  ║', '-')
squeezee('║                                                    --- Harry S Truman  ║', 'r')


#lang racket

;; Racket has traditional semaphores in addition to several higher level
;; synchronization tools.  (Note that these semaphores are used for Racket's
;; green-threads, there are also "future semaphores" which are used for OS
;; threads, with a similar interface.)

;; ----------------------------------------------------------------------------
;; First, a bunch of code to run the experiments below

;; Only two philosophers to make it deadlock very fast
(define philosophers '(Aristotle Kant #|Spinoza Marx Russell|#))

(define (run-philosopher name fork1 fork2)
  (define (show what) (displayln (~a name " " what)))
  (define (loop)
    (show "thinks") (sleep (* 2 (random))) (show "is hungry")
    (grab-forks fork1 fork2 (λ() (show "eats") (sleep (random))))
    (loop))
  (thread loop))

(define (run:simple)
  (define forks (for/list ([i philosophers]) (make-semaphore 1)))
  (for ([i philosophers] [fork1 forks] [fork2 (cons (last forks) forks)])
    (run-philosopher i fork1 fork2))
  (sleep (* 60 60 24 365)))

;; ----------------------------------------------------------------------------
;; This is the naive implementation, which can be used to try getting a
;; deadlock.

(define (grab:naive fork1 fork2 eat!)
  (semaphore-wait fork1)
  (sleep (random)) ; to make deadlocks probable
  (semaphore-wait fork2)
  (eat!)
  (semaphore-post fork1)
  (semaphore-post fork2))

;; ----------------------------------------------------------------------------
;; One way to solve it is to release the first fork if the second is busy and
;; wait for a while.

(define (grab:release+wait fork1 fork2 eat!)
  (semaphore-wait fork1)
  (if (not (semaphore-try-wait? fork2))
    ;; couldn't grab the second fork, so release the first and wait
    (begin (semaphore-post fork1)
           (sleep (random))
           (grab-forks fork1 fork2)) ; can swap them to improve chances
    ;; we have both forks
    (begin (eat!)
           (semaphore-post fork1)
           (semaphore-post fork2))))

;; ----------------------------------------------------------------------------
;; Another solution is to label the forks and lock the lowest-id one first,
;; which makes the naive solution work.

(define (run:labeled-forks)
  (define forks (for/list ([i philosophers]) (make-semaphore 1)))
  ;; the simple run used forks as (1 2 3 4) (4 1 2 3) -- so to implement this,
  ;; we can swap the two first ones: (4 2 3 4) (1 1 2 3)
  (for ([i philosophers]
        [fork1 (cons (last forks) (cdr forks))]
        [fork2 (cons (first forks) forks)])
    (run-philosopher i fork1 fork2))
  (sleep (* 60 60 24 365)))

;; ----------------------------------------------------------------------------
;; Homework: implement the centralized waiter solution

;; ...

;; ----------------------------------------------------------------------------
;; Uncomment one of the following pairs to try it

;; (define grab-forks grab:naive)
;; (define run run:simple)

;; (define grab-forks grab:release+wait)
;; (define run run:simple)

;; (define grab-forks grab:naive)
;; (define run run:labeled-forks)

(run)


class Fork {
    has $!lock = Lock.new;
    method grab($who, $which) {
	say "$who grabbing $which fork";
	$!lock.lock;
    }
    method drop($who, $which) {
	say "$who dropping $which fork";
	$!lock.unlock;
    }
}

class Lollipop {
    has $!channel = Channel.new;
    method mine($who) { $!channel.send($who) }
    method yours { $!channel.receive }
}

sub dally($sec) { sleep 0.01 + rand * $sec }

sub MAIN(*@names) {
    @names ||= <Aristotle Kant Spinoza Marx Russell>;

    my @lfork = Fork.new xx @names;
    my @rfork = @lfork.rotate;

    my $lollipop = Lollipop.new;
    start { $lollipop.yours; }

    my @philosophers = do for flat @names Z @lfork Z @rfork -> $n, $l, $r {
	start {
	    sleep 1 + rand*4;
	    loop {
		$l.grab($n,'left');
		dally 1;  # give opportunity for deadlock
		$r.grab($n,'right');
		say "$n eating";
		dally 10;
		$l.drop($n,'left');
		$r.drop($n,'right');

		$lollipop.mine($n);
		sleep 1;  # lick at least once
		say "$n lost lollipop to $lollipop.yours(), now digesting";

		dally 20;
	    }
	}
    }
    sink await @philosophers;
}


to-report split [ string ]
  ;; utility reporter to split a string into a list
  report n-values length string [ [ n ] -> item n string ]
end

to-report squeeze [ character string ]
  ;; reporter that actually does the squeeze function
  ;; remote immeadiately repeating instances of character from string
  ifelse ( string = "" )
  [ report "" ] ;; empty input, report empty output
  [ report
      reduce
        [ [ a b ] ->
          ( word a
            ifelse-value b = character and b = last a
            [ "" ]
            [  b ]
          )
        ]
        split string
  ]
end

to-report bracket [ string ]
  ;; utility reporter to enclose a string in brackets
  report ( word "<<<" string ">>>" )
end

to-report format [ string ]
  ;; utility reporter to format the output as required
  report ( word bracket string " " length string )
end

to demo-squeeze [ character string ]
  ;; procedure to display the required output
  output-print bracket character
  output-print format string
  output-print format squeeze character string
end

to demo
  ;; procedure to perform the test cases
  demo-squeeze " " ""
  demo-squeeze "-" "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln "
  demo-squeeze "7" "..1111111111111111111111111111111111111111111111111111111111111117777888"
  demo-squeeze "." "I never give 'em hell, I just tell the truth, and they think it's hell. "
  demo-squeeze " " "                                                    --- Harry S Truman  "
  demo-squeeze "-" "                                                    --- Harry S Truman  "
  demo-squeeze "r" "                                                    --- Harry S Truman  "
end


import unicode, strformat

proc squeeze(s: string; ch: Rune) =
  echo fmt"Specified character: '{ch}'"
  let original = s.toRunes
  echo fmt"Original: length = {original.len}, string = «««{s}»»»"
  var previous = Rune(0)
  var squeezed: seq[Rune]
  for rune in original:
    if rune != previous:
      squeezed.add(rune)
      previous = rune
    elif rune != ch:
      squeezed.add(rune)
  echo fmt"Squeezed: length = {squeezed.len}, string = «««{squeezed}»»»"
  echo ""

const Strings = ["",
        "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ",
        "..1111111111111111111111111111111111111111111111111111111111111117777888",
        "I never give 'em hell, I just tell the truth, and they think it's hell. ",
        "                                                   ---  Harry S Truman  ",
        "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
        "headmistressship",
        "aardvark",
        "😍😀🙌💃😍😍😍🙌",]

const Chars = [@[Rune(' ')], @[Rune('-')], @[Rune('7')], @[Rune('.')],
               @[Rune(' '), Rune('-'), Rune('r')],
               @[Rune('e')], @[Rune('s')], @[Rune('a')], "😍".toRunes]

for i, s in Strings:
  for ch in Chars[i]:
    s.squeeze(ch)


use strict;
use warnings;
use Unicode::UCD 'charinfo';

for (
  ['', ' '],
  ['"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ', '-'],
  ['..1111111111111111111111111111111111111111111111111111111111111117777888', '7'],
  ["I never give 'em hell, I just tell the truth, and they think it's hell. ", '.'],
  ['                                                    --- Harry S Truman  ', ' '],
  ['                                                    --- Harry S Truman  ', '-'],
  ['                                                    --- Harry S Truman  ', 'r']
) {
    my($phrase,$char) = @$_;
    (my $squeeze = $phrase) =~ s/([$char])\1+/$1/g;
    printf "\nOriginal length: %d <<<%s>>>\nSqueezable on \"%s\": %s\nSqueezed length: %d <<<%s>>>\n",
        length($phrase), $phrase,
        charinfo(ord $char)->{'name'},
        $phrase ne $squeeze ? 'True' : 'False',
        length($squeeze), $squeeze
}


/*REXX program demonstrates a solution in solving the  dining philosophers problem.     */
signal on halt                                   /*branches to  HALT:   (on Ctrl─break).*/
parse arg seed diners                            /*obtain optional arguments from the CL*/
if datatype(seed, 'W')  then call random ,, seed /*this allows for random repeatability.*/
if diners= ''           then diners = 'Aristotle, Kant, Spinoza, Marx, Russell'
  tell= left(seed, 1) \== '+'                    /*Leading + in SEED? Then no statistics*/
diners= space( translate(diners, , ',') )        /*change to an uncommatized diners list*/
     #= words(diners);      @.=   0              /*#: the number of dining philosophers.*/
  eatL= 15;               eatH=  60              /*minimum & maximum minutes for eating.*/
thinkL= 30;             thinkH= 180              /*   "    "    "       "     " thinking*/
forks.=  1                                       /*indicate that all forks are on table.*/
            do tic=1         /*'til halted.*/    /*use  "minutes"  for time advancement.*/
            call grabForks                       /*determine if anybody can grab 2 forks*/
            call passTime                        /*handle philosophers eating|thinking. */
            end   /*tic*/                        /*     ··· and time marches on ···     */
                                                 /* [↓]    this REXX program was halted,*/
halt: say '  ··· REXX program halted!'           /*probably by Ctrl─Break or equivalent.*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fork: parse arg x 1 ox;  x= abs(x) ;  L= x - 1 ;  if L==0  then L= # /*use "round Robin"*/
      if ox<0  then do;  forks.L= 1;  forks.x=1;  return;  end       /*drop the forks.  */
      got2= forks.L  &  forks.x                                      /*get 2 forks │ not*/
      if got2  then do;  forks.L= 0;  forks.x=0;           end       /*obtained 2 forks */
      return got2                                /*return with success  ··· or failure. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
grabForks:   do person=1  for  #                 /*see if any person can grab two forks.*/
             if @.person.state\==0  then iterate /*this diner ain't in a waiting state. */
             if \fork(person)       then iterate /*  "    "   didn't grab two forks.    */
             @.person.state= 'eating'            /*  "    "   is slurping spaghetti.    */
             @.person.dur= random(eatL, eatH)    /*how long will this diner eat pasta ? */
             end   /*person*/                    /* [↑]  process the dining philosophers*/
          return                                 /*all the diners have been examined.   */
/*──────────────────────────────────────────────────────────────────────────────────────*/
passTime: if tell  then say                      /*display a handy blank line separator.*/
            do p=1  for #                        /*handle each of the diner's activity. */
            if tell  then say  right(tic, 9, .)           right( word( diners, p), 20),
                      right(word(@.p.state 'waiting',1+(@.p.state==0)),9) right(@.p.dur,5)
            if @.p.dur==0   then iterate         /*this diner is waiting for two forks. */
            @.p.dur= @.p.dur - 1                 /*indicate single time unit has passed.*/
            if @.p.dur\==0  then iterate         /*Activity done?   No, then keep it up.*/
            if @.p.state=='eating'  then do                      /*now, leave the table.*/
                                         call fork  -p           /*drop the darn forks. */
                                         @.p.state= 'thinking'                 /*status.*/
                                         @.p.dur= random(thinkL, thinkH)       /*length.*/
                                         end     /* [↓]  a diner goes   ──►  the table. */
                                    else if  @.p.state=='thinking'  then @.p.state=0
            end   /*p*/                          /*[↑]  P (person)≡ dining philosophers.*/
          return                                 /*now, have some human beans grab forks*/


macro loadpair,regs,addr
	lda #<\addr
	sta \regs
	lda #>\addr
	sta \regs+1
endm

macro pushY
	tya
	pha
endm

macro popY
	pla
	tay
endm


with javascript_semantics
constant tests = {"",                                                                         " ",
                  `"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln `,"-",
                  "..1111111111111111111111111111111111111111111111111111111111111117777888","7",
                  "I never give 'em hell, I just tell the truth, and they think it's hell. ",".",
                  "                                                    --- Harry S Truman  "," -r"},
         fmt = """
length %2d      input: <<<%s>>>
length %2d squeeze(%c): <<<%s>>>
"""
function squeeze(sequence s, integer ch)
    if length(s)>1 then
        integer outdx = 1
        object prev = s[1]
        for i=2 to length(s) do
            if s[i]!=prev or prev!=ch then
                prev = s[i]
                outdx += 1
                s[outdx] = prev
            end if
        end for
        s = s[1..outdx]
    end if
    return s
end function

for i=1 to length(tests) by 2 do
    string ti = tests[i], chars = tests[i+1]
    for j=1 to length(chars) do
        string si = squeeze(ti,chars[j])
        printf(1,fmt,{length(ti),ti,length(si),chars[j],si})
    end for
end for


require 'mutex_m'

class Philosopher
  def initialize(name, left_fork, right_fork)
    @name = name
    @left_fork = left_fork
    @right_fork = right_fork
    @meals = 0
  end

  def go
    while @meals < 5
      think
      dine
    end
    puts "philosopher #@name is full!"
  end

  def think
    puts "philosopher #@name is thinking..."
    sleep(rand())
    puts "philosopher #@name is hungry..."
  end

  def dine
    fork1, fork2 = @left_fork, @right_fork
    while true
      pickup(fork1, :wait => true)
      puts "philosopher #@name has fork #{fork1.fork_id}..."
      if pickup(fork2, :wait => false)
        break
      end
      puts "philosopher #@name cannot pickup second fork #{fork2.fork_id}..."
      release(fork1)
      fork1, fork2 = fork2, fork1
    end
    puts "philosopher #@name has the second fork #{fork2.fork_id}..."

    puts "philosopher #@name eats..."
    sleep(rand())
    puts "philosopher #@name belches"
    @meals += 1

    release(@left_fork)
    release(@right_fork)
  end

  def pickup(fork, opt)
    puts "philosopher #@name attempts to pickup fork #{fork.fork_id}..."
    opt[:wait] ? fork.mutex.mu_lock : fork.mutex.mu_try_lock
  end

  def release(fork)
    puts "philosopher #@name releases fork #{fork.fork_id}..."
    fork.mutex.unlock
  end
end

n = 5

Fork = Struct.new(:fork_id, :mutex)
forks = Array.new(n) {|i| Fork.new(i, Object.new.extend(Mutex_m))}

philosophers = Array.new(n) do |i|
                 Thread.new(i, forks[i], forks[(i+1)%n]) do |id, f1, f2|
                   ph = Philosopher.new(id, f1, f2).go
                 end
               end

philosophers.each {|thread| thread.join}


/* ARM assembly Raspberry PI  */
/*  program strNumber.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

.equ BUFFERSIZE,          100

/* Initialized data */
.data
szMessNum: .asciz "Enter number : \n"

szMessError:            .asciz "String is not a number !!!\n"
szMessInteger:          .asciz "String is a integer.\n"
szMessFloat:            .asciz "String is a float.\n"
szMessFloatExp:         .asciz "String is a float with exposant.\n"
szCarriageReturn:       .asciz "\n"

/* UnInitialized data */
.bss
sBuffer:              .skip BUFFERSIZE

/*  code section */
.text
.global main
main:

loop:
    ldr x0,qAdrszMessNum
    bl affichageMess
    mov x0,#STDIN                               // Linux input console
    ldr x1,qAdrsBuffer                          // buffer address
    mov x2,#BUFFERSIZE                          // buffer size
    mov x8, #READ                               // request to read datas
    svc 0                                       // call system
    ldr x1,qAdrsBuffer                          // buffer address
    mov x2,#0                                   // end of string
    sub x0,x0,#1                                   // replace character 0xA
    strb w2,[x1,x0]                             // store byte at the end of input string (x0 contains number of characters)
    ldr x0,qAdrsBuffer
    bl controlNumber                            // call routine
    cmp x0,#0
    bne 1f
    ldr x0,qAdrszMessError                      // not a number
    bl affichageMess
    b 5f
1:
    cmp x0,#1
    bne 2f
    ldr x0,qAdrszMessInteger                    // integer
    bl affichageMess
    b 5f
2:
    cmp x0,#2
    bne 3f
    ldr x0,qAdrszMessFloat                      // float
    bl affichageMess
    b 5f
3:
    cmp x0,#3
    bne 5f
    ldr x0,qAdrszMessFloatExp                   // float with exposant
    bl affichageMess
5:
    b loop

100:                                            // standard end of the program
    mov x0, #0                                  // return code
    mov x8, #EXIT                               // request to exit program
    svc 0                                       // perform system call
qAdrszMessNum:            .quad szMessNum
qAdrszMessError:          .quad szMessError
qAdrszMessInteger:        .quad szMessInteger
qAdrszMessFloat:          .quad szMessFloat
qAdrszMessFloatExp:       .quad szMessFloatExp
qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrsBuffer:              .quad sBuffer
/******************************************************************/
/*     control if string is number                          */
/******************************************************************/
/* x0 contains the address of the string */
/* x0 return 0 if not a number       */
/* x0 return 1 if integer   eq 12345 or -12345      */
/* x0 return 2 if float     eq 123.45 or 123,45  or -123,45     */
/* x0 return 3 if float with exposant  eq 123.45E30 or -123,45E-30        */
controlNumber:
    stp x1,lr,[sp,-16]!    // save  registers
    stp x2,x3,[sp,-16]!    // save  registers
    stp x4,x5,[sp,-16]!    // save  registers
    mov x1,#0
    mov x3,#0              // point counter
1:
    ldrb w2,[x0,x1]
    cmp x2,#0              // end string ?
    beq 7f
    cmp x2,#' '            // space ?
    bne 3f
    add x1,x1,#1
    b   1b                 // loop
3:
    cmp x2,#'-'            // negative ?
    bne 4f
    add x1,x1,#1
    b 5f
4:
    cmp x2,#'+'            // positive ?
    bne 5f
    add x1,x1,#1
5:
    ldrb w2,[x0,x1]        // control space
    cmp x2,#0              // end ?
    beq 7f
    cmp x2,#' '            // space ?
    bne 6f
    add x1,x1,#1
    b 5b                   // loop
6:
    ldrb w2,[x0,x1]
    cmp x2,#0              // end ?
    beq 14f
    cmp x2,#'E'            // exposant ?
    beq 9f
    cmp x2,#'e'            // exposant ?
    beq 9f
    cmp x2,#'.'            // point ?
    bne 7f
    add x3,x3,#1           // yes increment counter
    add x1,x1,#1
    b 6b                   // and loop
7:
    cmp x2,#','            // comma ?
    bne 8f
    add x3,x3,#1           // yes increment counter
    add x1,x1,#1
    b 6b                   // and loop
8:
    cmp x2,#'0'            // control digit < 0
    blt 99f
    cmp x2,#'9'            // control digit > 0
    bgt 99f
    add x1,x1,#1           // no error loop digit
    b 6b

9:                         // float with exposant
    add x1,x1,#1
    ldrb w2,[x0,x1]
    cmp x2,#0              // end ?
    beq 99f

    cmp x2,#'-'            // negative exposant ?
    bne 10f
    add x1,x1,#1
10:
    mov x4,#0              // nombre de chiffres
11:
    ldrb w2,[x0,x1]
    cmp x2,#0              // end ?
    beq 13f
    cmp x2,#'0'            // control digit < 0
    blt 99f
    cmp x2,#'9'            // control digit > 9
    bgt 99f
    add x1,x1,#1
    add x4,x4,#1           // counter digit
    b 11b                  // and loop

13:
    cmp x4,#0              // number digit exposant = 0 -> error
    beq 99f                // error
    cmp x4,#2              // number digit exposant > 2 -> error
    bgt 99f                // error

    mov x0,#3              // valid float with exposant
    b 100f
14:
    cmp x3,#0
    bne 15f
    mov x0,#1              // valid integer
    b 100f
15:
    cmp x3,#1             // number of point or comma = 1 ?
    blt 100f
    bgt 99f               // error
    mov x0,#2             // valid float
    b 100f
99:
    mov x0,#0             // error
100:
    ldp x4,x5,[sp],16     // restaur  2 registres
    ldp x2,x3,[sp],16     // restaur  2 registres
    ldp x1,lr,[sp],16     // restaur  2 registres
    ret

/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit

BYTE FUNC AreEqual(CHAR ARRAY a,b)
  BYTE i

  IF a(0)#b(0) THEN
    RETURN (0)
  FI
  FOR i=1 to a(0)
  DO
    IF a(i)#b(i) THEN
      RETURN (0)
    FI
  OD
RETURN (1)

BYTE FUNC IsNumeric(CHAR ARRAY s)
  CHAR ARRAY tmp(20)
  INT i
  CARD c
  REAL r

  i=ValI(s)
  StrI(i,tmp)
  IF AreEqual(s,tmp) THEN
    RETURN (1)
  FI

  c=ValC(s)
  StrC(c,tmp)
  IF AreEqual(s,tmp) THEN
    RETURN (1)
  FI

  ValR(s,r)
  StrR(r,tmp)
  IF AreEqual(s,tmp) THEN
    RETURN (1)
  FI
RETURN (0)

PROC Test(CHAR ARRAY s)
  BYTE res

  res=IsNumeric(s)
  Print(s)
  Print(" is ")
  IF res=0 THEN
    Print("not ")
  FI
  PrintE("a number.")
RETURN

PROC Main()
  Put(125) PutE() ;clear the screen
  Test("56233")
  Test("-315")
  Test("1.36")
  Test("-5.126")
  Test("3.7E-05")
  Test("1.23BC")
  Test("5.6.3")
RETURN


<?php

function squeezeString($string, $squeezeChar) {
    $previousChar = null;
    $squeeze = '';
    $charArray = preg_split('//u', $string, -1, PREG_SPLIT_NO_EMPTY);
    for ($i = 0 ; $i < count($charArray) ; $i++) {
        $currentChar = $charArray[$i];
        if ($previousChar !== $currentChar || $currentChar !== $squeezeChar) {
            $squeeze .= $charArray[$i];
        }
        $previousChar = $currentChar;
    }
    return $squeeze;
}

function isSqueezable($string, $squeezeChar) {
    return ($string !== squeezeString($string, $squeezeChar));
}

$strings = array(
    ['-', '"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln '],
    ['1', '..1111111111111111111111111111111111111111111111111111111111111117777888'],
    ['l', "I never give 'em hell, I just tell the truth, and they think it's hell. "],
    [' ', '                                                    --- Harry S Truman  '],
    ['9', '0112223333444445555556666666777777778888888889999999999'],
    ['e', "The better the 4-wheel drive, the further you'll be from help when ya get stuck!"],
    ['k', "The better the 4-wheel drive, the further you'll be from help when ya get stuck!"],
);
foreach ($strings as $params) {
    list($char, $original) = $params;
    echo 'Original   : <<<', $original, '>>> (len=', mb_strlen($original), ')', PHP_EOL;
    if (isSqueezable($original, $char)) {
        $squeeze = squeezeString($original, $char);
        echo 'Squeeze(', $char, ') : <<<', $squeeze, '>>> (len=', mb_strlen($squeeze), ')', PHP_EOL, PHP_EOL;
    } else {
        echo 'Squeeze(', $char, ') : string is not squeezable (char=', $char, ')...', PHP_EOL, PHP_EOL;
    }
}


use std::thread;
use std::sync::{Mutex, Arc};

struct Philosopher {
    name: String,
    left: usize,
    right: usize,
}

impl Philosopher {
    fn new(name: &str, left: usize, right: usize) -> Philosopher {
        Philosopher {
            name: name.to_string(),
            left: left,
            right: right,
        }
    }

    fn eat(&self, table: &Table) {
        let _left = table.forks[self.left].lock().unwrap();
        let _right = table.forks[self.right].lock().unwrap();

        println!("{} is eating.", self.name);

        thread::sleep_ms(1000);

        println!("{} is done eating.", self.name);
    }
}

struct Table {
    forks: Vec<Mutex<()>>,
}

fn main() {
    let table = Arc::new(Table { forks: vec![
        Mutex::new(()),
        Mutex::new(()),
        Mutex::new(()),
        Mutex::new(()),
        Mutex::new(()),
    ]});

    let philosophers = vec![
        Philosopher::new("Baruch Spinoza", 0, 1),
        Philosopher::new("Gilles Deleuze", 1, 2),
        Philosopher::new("Karl Marx", 2, 3),
        Philosopher::new("Friedrich Nietzsche", 3, 4),
        Philosopher::new("Michel Foucault", 0, 4),
    ];

    let handles: Vec<_> = philosophers.into_iter().map(|p| {
        let table = table.clone();

        thread::spawn(move || {
            p.eat(&table);
        })
    }).collect();

    for h in handles {
        h.join().unwrap();
    }
}


COMMENT
!    DEADLOCK IS PREVENTED BY REVERSING THE ORDER OF TAKING THE CHOPSTICKS FOR THE LAST PHILOSOPHER.
!    THAT MEANS ALL PHILOSOPHERS FIRST TAKE THE LEFT CHOPSTICK, THEN THE RIGHT CHOPSTICK.
!    BUT THE LAST PHILOSOPHER FIRST TAKES THE RIGHT CHOPSTICK, THEN THE LEFT.
!
!    THE DETACH STATEMENT IN CLASS PHILOSOPHER GIVES CONTROL BACK TO THE MAIN BLOCK.
!    THE MAIN BLOCK CALLS/RESUMES ALL THE PHILOSOPHERS USING THE RESUME(PHILOSOPHER) STATEMENT.
!    THIS CONTINUES THE CODE IN THE PHILOSOPHER CLASS AFTER THE LAST DETACH STATEMENT.
!    (ANOTHER NAME FOR THIS FEATURE IS THE CONCEPT OF A COROUTINE)
;
BEGIN
    INTEGER N;
    INTEGER PNR, CNR;
    INTEGER SEED;
    SEED := ININT;
    N := 5;
    BEGIN

        CLASS CHOPSTICK;
        BEGIN
            REF(PHILOSOPHER) OWNER;
            INTEGER ID;
            ID := CNR := CNR + 1;
        END CHOPSTICK;

        CLASS PHILOSOPHER(L,R);
            REF(CHOPSTICK) L,R;
        BEGIN
            INTEGER ID;
            ID := PNR := PNR + 1;
            WHILE TRUE DO
            BEGIN
                DETACH;

                OUTTEXT("PHILOSOPHER(");
                OUTINT(ID, 0);
                OUTTEXT(") THINKING...");
                OUTIMAGE;
                DETACH;

                WHILE RANDINT(0,1,SEED) = 0 DO BEGIN
                    OUTTEXT("PHILOSOPHER(");
                    OUTINT(ID, 0);
                    OUTTEXT(") THINKING DEEPER...");
                    OUTIMAGE;
                    DETACH;
                END;

                WHILE L.OWNER =/= NONE DO BEGIN
                    OUTTEXT("PHILOSOPHER(");
                    OUTINT(ID, 0);
                    OUTTEXT(") WAITING FOR LEFT CHOPSTICK(");
                    OUTINT(L.ID, 0);
                    OUTTEXT(") ...");
                    OUTIMAGE;
                    DETACH;
                END;
                L.OWNER :- THIS PHILOSOPHER;
                OUTTEXT("PHILOSOPHER(");
                OUTINT(ID, 0);
                OUTTEXT(") GRABBED LEFT CHOPSTICK(");
                OUTINT(L.ID, 0);
                OUTTEXT(")");
                OUTIMAGE;

                WHILE R.OWNER =/= NONE DO BEGIN
                    OUTTEXT("PHILOSOPHER(");
                    OUTINT(ID, 0);
                    OUTTEXT(") WAITING FOR RIGHT CHOPSTICK(");
                    OUTINT(R.ID, 0);
                    OUTTEXT(") ...");
                    OUTIMAGE;
                    DETACH;
                END;
                R.OWNER :- THIS PHILOSOPHER;
                OUTTEXT("PHILOSOPHER(");
                OUTINT(ID, 0);
                OUTTEXT(") GRABBED RIGHT CHOPSTICK(");
                OUTINT(R.ID, 0);
                OUTTEXT(")");
                OUTIMAGE;

                OUTTEXT("PHILOSOPHER(");
                OUTINT(ID, 0);
                OUTTEXT(") EATING...");
                OUTIMAGE;
                WHILE RANDINT(0,1,SEED) = 0 DO BEGIN
                    DETACH;
                    OUTTEXT("PHILOSOPHER(");
                    OUTINT(ID, 0);
                    OUTTEXT(") STILL EATING...");
                    OUTIMAGE;
                END;
                L.OWNER :- NONE;
                R.OWNER :- NONE;
                OUTTEXT("PHILOSOPHER(");
                OUTINT(ID, 0);
                OUTTEXT(") RELEASED LEFT CHOPSTICK(");
                OUTINT(L.ID, 0);
                OUTTEXT(")");
                OUTIMAGE;
                OUTTEXT("PHILOSOPHER(");
                OUTINT(ID, 0);
                OUTTEXT(") RELEASED RIGHT CHOPSTICK(");
                OUTINT(R.ID, 0);
                OUTTEXT(")");
                OUTIMAGE;
            END;
        END PHILOSOPHER;

        !---------------------------------------|
        !                                       |
        !                                       |
        !                  (3)                  |
        !             P2         P3             |
        !                                       |
        !        (2)                  (4)       |
        !                                       |
        !                                       |
        !      P1                       P4      |
        !                                       |
        !                                       |
        !         (1)              (5)          |
        !                                       |
        !                  P5                   |  only P5 takes Right first (5), then Left (1)
        !                                       |
        !---------------------------------------|
        !;

        REF(PHILOSOPHER) ARRAY PHILS (1:N);
        REF(CHOPSTICK) L, R;
        INTEGER I, LOOPS;

        R :- NEW CHOPSTICK;
        FOR I := 1 STEP 1 UNTIL N-1 DO
        BEGIN
            L :- NEW CHOPSTICK;
            PHILS(I) :- NEW PHILOSOPHER(L,R);
            R :- L;
        END;
        ! REVERSED ORDER FOR THE LAST PHILOSOPHER ;
        PHILS(N) :- NEW PHILOSOPHER(R,PHILS(1).R);

        FOR I := 1 STEP 1 UNTIL N DO BEGIN
            OUTTEXT("PHILOSOPHER(ID=");
            OUTINT(PHILS(I).ID, 0);
            OUTTEXT(", L=");
            OUTINT(PHILS(I).L.ID, 0);
            OUTTEXT(", R=");
            OUTINT(PHILS(I).R.ID, 0);
            OUTTEXT(")");
            OUTIMAGE;
        END;

        FOR LOOPS := 1 STEP 1 UNTIL 10 DO BEGIN
            FOR I := 1 STEP 1 UNTIL N DO BEGIN
                RESUME(PHILS(I));
            END;
        END;

    END;
END.


public function isNumeric(num:String):Boolean
{
    return !isNaN(parseInt(num));
}


package Numeric_Tests is
   function Is_Numeric (Item : in String) return Boolean;
end Numeric_Tests;


squeeze_( [], _, [] ).
squeeze_( [A], _, [A] ).
squeeze_( [A,A|T], A, R ) :- squeeze_( [A|T], A, R ).
squeeze_( [A,A|T], B, [A|R] ) :- dif( A, B ), squeeze_( [A|T], B, R ).
squeeze_( [A,B|T], S, [A|R] ) :- dif( A, B ), squeeze_( [B|T], S, R ).

squeeze( Str, SqueezeChar, Collapsed ) :-
    string_chars( Str, Chars ),
    squeeze_( Chars, SqueezeChar, Result ),
    string_chars( Collapsed, Result ).


from itertools import groupby

def squeezer(s, txt):
    return ''.join(item if item == s else ''.join(grp)
                   for item, grp in groupby(txt))

if __name__ == '__main__':
    strings = [
            "",
            '"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ',
            "..1111111111111111111111111111111111111111111111111111111111111117777888",
            "I never give 'em hell, I just tell the truth, and they think it's hell. ",
            "                                                   ---  Harry S Truman  ",
            "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
            "headmistressship",
            "aardvark",
            "😍😀🙌💃😍😍😍🙌",
            ]
    squeezers = ' ,-,7,., -r,e,s,a,😍'.split(',')
    for txt, chars in zip(strings, squeezers):
        this = "Original"
        print(f"\n{this:14} Size: {len(txt)} «««{txt}»»»" )
        for ch in chars:
            this = f"Squeezer '{ch}'"
            sqz = squeezer(ch, txt)
            print(f"{this:>14} Size: {len(sqz)} «««{sqz}»»»" )


'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 13 October 2011 at 2:44:42 pm'!
Object subclass: #Philosopher
	instanceVariableNames: 'table random name seat forks running'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'rosettacode'!

!Philosopher methodsFor: 'private'!
createfork
	^ Semaphore forMutualExclusion! !

!Philosopher methodsFor: 'private'!
displayState: aStateName
	Transcript show: name , ' is ' , aStateName;
		 cr! !

!Philosopher methodsFor: 'private'!
pickUpForkAt: relativePosition
	| fork pos |
	pos := self tableIndex: seat + relativePosition.
	(fork := table at: pos)
		ifNotNil: [fork
				critical: [(table at: pos) notNil
						ifTrue: [table at: pos put: nil]
						ifFalse: [fork := nil]]].
	^ (forks at: relativePosition put: fork) notNil! !

!Philosopher methodsFor: 'private'!
putBackForkAt: aRelativePosition
	| fork |
	fork := forks at: aRelativePosition.
	fork
		ifNotNil: [table
				at: (self tableIndex: seat + aRelativePosition)
				put: fork.
			forks at: aRelativePosition put: nil]! !

!Philosopher methodsFor: 'private'!
tableIndex: aNum
	^ aNum - 1 \\ table size + 1! !

!Philosopher methodsFor: 'private'!
waitRandomTime
	(Delay forMilliseconds: (random next * 4000) rounded) wait! !

!Philosopher methodsFor: 'dining'!
eat
	self displayState: 'eating';
		 waitRandomTime;
		 putBackForkAt: -1;
		 putBackForkAt: 1! !

!Philosopher methodsFor: 'dining'!
pickUpForks
	self displayState: 'trying to pick up forks'.
	[(self pickUpForkAt: -1)
		ifTrue: [(self pickUpForkAt: 1)
				ifFalse: [self putBackForkAt: -1]].
	(forks at: 1) notNil]
		whileFalse: [(Delay forMilliseconds: 10) wait]! !

!Philosopher methodsFor: 'dining'!
think
	self displayState: 'thinking';
		 waitRandomTime! !

!Philosopher methodsFor: 'initialize-release'!
beginDining: aName at: aTable
	name := aName.
	table := aTable.
	forks := Dictionary new at: -1 put: nil;
				 at: 1 put: nil;
				 yourself.
	random := Random new seed: name hash.
	seat := table size + 1.
	table add: self;
		 add: self createfork.
	running := true.
	[(Delay forSeconds: 20) wait.
	running := false] fork.
	[[running]
		whileTrue: [self think; pickUpForks; eat].
	nil] fork! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Philosopher class
	instanceVariableNames: ''!

!Philosopher class methodsFor: 'examples'!
diningPhilosophersTest
	| diningTable |
	diningTable := OrderedCollection new.
	#('Aristotle' 'Kant' 'Buddha' 'Marx' 'Russel' )
		do: [:aName | Philosopher new beginDining: aName at: diningTable]! !


integer
is_numeric(text s)
{
    return !trap_q(alpha, s, 0);
}

integer
main(void)
{
    if (!is_numeric("8192&*")) {
        o_text("Not numeric.\n");
    }
    if (is_numeric("8192")) {
        o_text("Numeric.\n");
    }

    return 0;
}


PROC is numeric = (REF STRING string) BOOL: (
  BOOL out := TRUE;
  PROC call back false = (REF FILE f)BOOL: (out:= FALSE; TRUE);

  FILE memory;
  associate(memory, string);
  on value error(memory, call back false);
  on logical file end(memory, call back false);

  UNION (INT, REAL, COMPL) numeric:=0.0;
  # use a FORMAT pattern instead of a regular expression #
  getf(memory, ($gl$, numeric));
  out
);

test:(
   STRING
     s1 := "152",
     s2 := "-3.1415926",
     s3 := "Foo123";
   print((
     s1, " results in ", is numeric(s1), new line,
     s2, " results in ", is numeric(s2), new line,
     s3, " results in ", is numeric(s3), new line
   ))
)


squeeze_string <- function(string, character){

    str_iterable <- strsplit(string, "")[[1]]

    message(paste0("Original String: ", "<<<", string, ">>>\n",
                   "Length: ", length(str_iterable), "\n",
                   "Character: ", character))

    detect <- rep(TRUE, length(str_iterable))

    for(i in 2:length(str_iterable)){

      if(length(str_iterable) == 0) break
      if(str_iterable[i] != character) next

      if(str_iterable[i] == str_iterable[i-1])

        detect[i] <- FALSE
    }

    squeezed_string <- paste(str_iterable[detect], collapse = "")

    message(paste0("squeezed string: ", "<<<",squeezed_string, ">>>\n",
                   "Length: ", length(str_iterable[detect])), "\n")

  }

  squeeze_string("", " ")
  squeeze_string("'If I were two-faced, would I be wearing this one?' --- Abraham Lincoln ", "-")
  squeeze_string("..1111111111111111111111111111111111111111111111111111111111111117777888", "7")
  squeeze_string("I never give 'em hell, I just tell the truth, and they think it's hell. ", ".")
  squeeze_string("                                                    --- Harry S Truman  ", " ")
  squeeze_string("                                                    --- Harry S Truman  ", "-")
  squeeze_string("                                                    --- Harry S Truman  ", "r")
  squeeze_string("  Ciao Mamma, guarda come mi diverto!!!  ", "!")


#lang racket/base

(define (squeeze-string s c)
  (let loop ((cs (string->list s)) (squeezing? #f) (l 0) (acc null))
    (cond [(null? cs) (values l (list->string (reverse acc)))]
          [(and squeezing? (char=? (car cs) c)) (loop (cdr cs) #t l acc)]
          [else (loop (cdr cs) (char=? (car cs) c) (add1 l) (cons (car cs) acc))])))

(define (report-squeeze s c)
  (define-values (l′ s′) (squeeze-string s c))
  (printf "Squeezing ~s in «««~a»»» (length ~a)~%" c s (string-length s))
  (printf "Result: «««~a»»» (length ~a)~%~%" s′ l′))

(define (Determine-if-a-string-is-squeezeable)
  (report-squeeze "" #\space)
  (report-squeeze "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln " #\-)
  (report-squeeze "..1111111111111111111111111111111111111111111111111111111111111117777888" #\7)
  (report-squeeze "I never give 'em hell, I just tell the truth, and they think it's hell. " #\.)
  (define truman-sig "                                                    --- Harry S Truman  ")
  (report-squeeze truman-sig #\space)
  (report-squeeze truman-sig #\-)
  (report-squeeze truman-sig #\r))

(module+ main
  (Determine-if-a-string-is-squeezeable))


map {
    my $squeeze = $^phrase;
    sink $^reg;
    $squeeze ~~ s:g/($reg)$0+/$0/;
    printf "\nOriginal length: %d <<<%s>>>\nSqueezable on \"%s\": %s\nSqueezed length: %d <<<%s>>>\n",
      $phrase.chars, $phrase, $reg.uniname, $phrase ne $squeeze, $squeeze.chars, $squeeze
},
  '', ' ',
  '"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ', '-',
  '..1111111111111111111111111111111111111111111111111111111111111117777888', '7',
  "I never give 'em hell, I just tell the truth, and they think it's hell. ", '.',
  '                                                    --- Harry S Truman  ', ' ',
  '                                                    --- Harry S Truman  ', '-',
  '                                                    --- Harry S Truman  ', 'r'