Recent

Author Topic: [SOLVED]Dining philosophers  (Read 3611 times)

avk

  • Sr. Member
  • ****
  • Posts: 273
    • my self-education project
[SOLVED]Dining philosophers
« on: March 03, 2019, 01:36:22 pm »
Greetings to all.
I recently discovered that there is no implementation in Pascal on the appropriate Rosettacode page.
(see https://rosettacode.org/wiki/Dining_philosophers)
I decided to improve the situation, but the code is quite long:
Code: Pascal  [Select][+][-]
  1. program dining_philosophers;
  2.  
  3. {$mode objfpc}{$modeswitch advancedrecords}
  4.  
  5. uses
  6.   {$IFDEF UNIX}
  7.   cthreads,
  8.   {$ENDIF}
  9.   Classes, SysUtils, DateUtils;
  10.  
  11. const
  12.   PHIL_COUNT = 5;
  13.   PHIL_NAMES: array[1..PHIL_COUNT] of string = ('Aristotle', 'Kant', 'Spinoza', 'Marx', 'Russell');
  14.   DELAY_RANGE = 10;
  15.   DELAY_SCALE = 100;
  16. var
  17.   StillDining: Integer = PHIL_COUNT;
  18.  
  19. type
  20.   TFork = record
  21.   strict private
  22.     FState: DWord;
  23.   public
  24.     procedure Take; inline;
  25.     procedure PutDown; inline;
  26.   end;
  27.   PFork = ^TFork;
  28.   TForks = array[1..PHIL_COUNT] of TFork;
  29.  
  30.   TPhilosopher = class(TThread)
  31.   private
  32.     FName: string;
  33.     FLeftFork,
  34.     FRightFork: PFork;
  35.     FLifeSpan: Integer;
  36.     FAwait: PRtlEvent;
  37.   protected
  38.     procedure Execute; override;
  39.     procedure Delay(aInterval: DWord);
  40.   public
  41.     constructor Create(const aName: string; aLeftFork, aRightFork: PFork; aLifeSpan: Integer);
  42.     destructor Destroy; override;
  43.   end;
  44.  
  45. procedure TFork.Take;
  46. begin
  47.   while Boolean(InterlockedExchange(FState, 1)) do
  48.     ThreadSwitch;
  49. end;
  50.  
  51. procedure TFork.PutDown;
  52. begin
  53.   InterlockedExchange(FState, 0);
  54. end;
  55.  
  56. function RandomInterval: Integer; forward;
  57.  
  58. procedure TPhilosopher.Execute;
  59. var
  60.   StartTime: TTime;
  61. begin
  62.   WriteLn(FName, ' sits down at the table');
  63.   while FLifeSpan > 0 do
  64.     begin
  65.       WriteLn(FName, ' thinking about the eternal');
  66.       StartTime := Time;
  67.       Delay(RandomInterval);
  68.       WriteLn(FName, ' thought for ', MillisecondsBetween(Time, StartTime), ' ms');
  69.       WriteLn(FName, ' is hungry');
  70.       FLeftFork^.Take;
  71.       FRightFork^.Take;
  72.       WriteLn(FName, ' eating');
  73.       StartTime := Time;
  74.       Delay(RandomInterval);
  75.       WriteLn(FName, ' ate for ', MillisecondsBetween(Time, StartTime), ' ms');
  76.       WriteLn(FName, ' is full');
  77.       FRightFork^.PutDown;
  78.       FLeftFork^.PutDown;
  79.       Dec(FLifeSpan);
  80.     end;
  81.   WriteLn(FName, ' leaves the table');
  82.   InterlockedDecrement(StillDining);
  83.   Terminate;
  84. end;
  85.  
  86. procedure TPhilosopher.Delay(aInterval: DWord);
  87. begin
  88.   RTLEventWaitFor(FAwait, aInterval);
  89.   RTLEventResetEvent(FAwait);
  90. end;
  91.  
  92. constructor TPhilosopher.Create(const aName: string; aLeftFork, aRightFork: PFork; aLifeSpan: Integer);
  93. begin
  94.   inherited Create(True);
  95.   FName := aName;
  96.   FLeftFork := aLeftFork;
  97.   FRightFork := aRightFork;
  98.   FLifeSpan := aLifeSpan;
  99.   FreeOnTerminate := True;
  100.   FAwait := RtlEventCreate;
  101. end;
  102.  
  103. destructor TPhilosopher.Destroy;
  104. begin
  105.   RTLEventDestroy(FAwait);
  106.   inherited;
  107. end;
  108.  
  109. var
  110.   Philosophers: array[1..PHIL_COUNT] of TPhilosopher;
  111.   Forks: TForks;
  112.   LifeSpan: Integer = 3;
  113.   RandLock: DWord = 0;
  114.  
  115. function RandomInterval: Integer;
  116. begin
  117.   while Boolean(InterlockedExchange(RandLock, 1)) do;
  118.   try
  119.     Result := Succ(Random(DELAY_RANGE)) * DELAY_SCALE;
  120.   finally
  121.     InterlockedExchange(RandLock, 0);
  122.   end;
  123. end;
  124.  
  125. procedure AskLifeSpan;
  126. var
  127.   s: string;
  128.   tmp: Integer;
  129. begin
  130.   Write('You may set life span[default 3]: ');
  131.   ReadLn(s);
  132.   tmp := StrToIntDef(s, 0);
  133.   if (Tmp > 0) and (Tmp <> LifeSpan) then
  134.     begin
  135.       LifeSpan := Tmp;
  136.       WriteLn('Ok, life span is ', LifeSpan);
  137.     end
  138.   else
  139.     WriteLn('Life span remains ', LifeSpan);
  140.   WriteLn('Now let''s begin');
  141. end;
  142.  
  143. procedure StartDinner;
  144. var
  145.   I: Integer = 1;
  146. begin
  147.   Randomize;
  148.   Forks := Default(TForks);
  149.   WriteLn(LineEnding, 'table is empty', LineEnding);
  150.   repeat
  151.     Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], @Forks[I], @Forks[Succ(I)], LifeSpan);
  152.     Inc(I);
  153.   until I = PHIL_COUNT;
  154.   Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], @Forks[1], @Forks[I], LifeSpan);
  155.   for I := 1 to PHIL_COUNT do
  156.     Philosophers[I].Start;
  157. end;
  158.  
  159. procedure WaitForEnd;
  160. begin
  161.   while StillDining > 0 do
  162.     ThreadSwitch;
  163.   WriteLn(LineEnding, 'table is empty', LineEnding);
  164. end;
  165.  
  166. begin
  167.   AskLifeSpan;
  168.   StartDinner;
  169.   WaitForEnd;
  170.   Write('Done, press any key to exit...');
  171.   ReadLn;
  172. end.
  173.  
And what do you think about it?
« Last Edit: March 13, 2019, 09:54:10 am by avk »

Thaddy

  • Hero Member
  • *****
  • Posts: 10276
Re: Dining philosophers
« Reply #1 on: March 03, 2019, 04:10:37 pm »
I should still have some TP code for that.... If it is not lost on a really floppy floppy... I will have a look. I actually attended some classes from Edsger Dijkstra and.. of course my major is in Political science, actually political philosophy, hence I like that particular problem very much (I have a B.Sc in computer science too, but no M.Sc). Will have a look..
« Last Edit: March 03, 2019, 04:20:09 pm by Thaddy »
I am more like donkey than shrek

avk

  • Sr. Member
  • ****
  • Posts: 273
    • my self-education project
Re: Dining philosophers
« Reply #2 on: March 04, 2019, 08:13:52 am »
I actually attended some classes from Edsger Dijkstra
Really? It's great, you are lucky!

Since the random delays are quite large, it turns out that homemade spinlocks heavily load the processor. Replaced them with normal critical sections.
Code: Pascal  [Select][+][-]
  1. program dining_philosophers;
  2. {$mode objfpc}
  3. uses
  4.   {$IFDEF UNIX}
  5.   cthreads,
  6.   {$ENDIF}
  7.   Classes, SysUtils, SyncObjs;
  8. const
  9.   PHIL_COUNT   = 5;
  10.   DEFAULT_SPAN = 3;
  11.   DELAY_RANGE  = 950;
  12.   DELAY_LOW    = 50;
  13.   PHIL_NAMES: array[1..PHIL_COUNT] of string = ('Aristotle', 'Kant', 'Spinoza', 'Marx', 'Russell');
  14. var
  15.   LifeSpan: Integer = DEFAULT_SPAN;
  16.   RandLock: DWord = 0;
  17.   StillDining: Integer = PHIL_COUNT;
  18.   DinnerOver: PRtlEvent = nil;
  19. type
  20.   TFork = TCriticalSection;
  21.   TPhilosopher = class(TThread)
  22.   private
  23.     FName: string;
  24.     FLeftFork, FRightFork: TFork;
  25.     FLifeSpan: Integer;
  26.     FAwait: PRtlEvent;
  27.   protected
  28.     procedure Execute; override;
  29.     procedure Delay(aInterval: DWord);
  30.   public
  31.     constructor Create(const aName: string; aLeftFork, aRightFork: TFork; aLifeSpan: Integer);
  32.     destructor Destroy; override;
  33.   end;
  34.  
  35. function RandomInterval: Integer;
  36. begin
  37.   while Boolean(InterlockedExchange(RandLock, 1)) do;
  38.   try
  39.     Result := Random(DELAY_RANGE) + DELAY_LOW;
  40.   finally InterlockedExchange(RandLock, 0) end;
  41. end;
  42.  
  43. procedure TPhilosopher.Execute;
  44. begin
  45.   WriteLn(FName, ' sits down at the table');
  46.   while FLifeSpan > 0 do
  47.     begin
  48.       WriteLn(FName, ' thinking about the eternal');
  49.       Delay(RandomInterval);
  50.       WriteLn(FName, ' is hungry');
  51.       FLeftFork.Acquire;
  52.       FRightFork.Acquire;
  53.       WriteLn(FName, ' eating');
  54.       Delay(RandomInterval);
  55.       FRightFork.Release;
  56.       FLeftFork.Release;
  57.       Dec(FLifeSpan);
  58.     end;
  59.   WriteLn(FName, ' leaves the table');
  60.   if InterlockedDecrement(StillDining) = 0 then
  61.     RtlEventSetEvent(DinnerOver);
  62.   Terminate;
  63. end;
  64.  
  65. procedure TPhilosopher.Delay(aInterval: DWord);
  66. begin
  67.   RTLEventWaitFor(FAwait, aInterval);
  68.   RTLEventResetEvent(FAwait);
  69. end;
  70.  
  71. constructor TPhilosopher.Create(const aName: string; aLeftFork, aRightFork: TFork; aLifeSpan: Integer);
  72. begin
  73.   inherited Create(True);
  74.   FName := aName;
  75.   FLeftFork := aLeftFork;
  76.   FRightFork := aRightFork;
  77.   FLifeSpan := aLifeSpan;
  78.   FreeOnTerminate := True;
  79.   FAwait := RtlEventCreate;
  80. end;
  81.  
  82. destructor TPhilosopher.Destroy;
  83. begin
  84.   RTLEventDestroy(FAwait);
  85.   inherited;
  86. end;
  87.  
  88. procedure AskLifeSpan;
  89. var
  90.   s: string;
  91.   tmp: Integer;
  92. begin
  93.   Write('You can set the lifespan[default 3]: ');
  94.   ReadLn(s);
  95.   tmp := StrToIntDef(s, 0);
  96.   if (Tmp > 0) and (Tmp <> LifeSpan) then
  97.     begin
  98.       LifeSpan := Tmp;
  99.       WriteLn('Ok, lifespan is ', LifeSpan);
  100.     end
  101.   else
  102.     WriteLn('Lifespan remains ', LifeSpan);
  103.   WriteLn('Now let''s begin');
  104. end;
  105.  
  106. var
  107.   Philosophers: array[1..PHIL_COUNT] of TPhilosopher;
  108.   Forks: array[1..PHIL_COUNT] of TFork;
  109.  
  110. procedure StartDinner;
  111. var
  112.   I: Integer;
  113.   Phil: TPhilosopher;
  114. begin
  115.   WriteLn(LineEnding, 'table is empty', LineEnding);
  116.   Randomize;
  117.   DinnerOver := RTlEventCreate;
  118.   for I := 1 to PHIL_COUNT do
  119.     Forks[I] := TFork.Create;
  120.   for I := 1 to Pred(PHIL_COUNT) do
  121.     Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], Forks[I], Forks[Succ(I)], LifeSpan);
  122.   Philosophers[PHIL_COUNT] := TPhilosopher.Create(PHIL_NAMES[PHIL_COUNT], Forks[1], Forks[PHIL_COUNT], LifeSpan);
  123.   for Phil in Philosophers do
  124.     Phil.Start;
  125. end;
  126.  
  127. procedure WaitForDinnerOver;
  128. var
  129.   Fork: TFork;
  130. begin
  131.   RtlEventWaitFor(DinnerOver);
  132.   RtlEventDestroy(DinnerOver);
  133.   for Fork in Forks do
  134.     Fork.Free;
  135.   WriteLn(LineEnding, 'table is empty', LineEnding);
  136. end;
  137.  
  138. begin
  139.   AskLifeSpan;
  140.   StartDinner;
  141.   WaitForDinnerOver;
  142.   Write('Done, press any key to exit...');
  143.   ReadLn;
  144. end.
  145.  

Thaddy

  • Hero Member
  • *****
  • Posts: 10276
Re: Dining philosophers
« Reply #3 on: March 04, 2019, 09:51:16 am »
I actually attended some classes from Edsger Dijkstra
Really? It's great, you are lucky!
Depends: he had the pen and paper (or blackboard) approach to computing and is famous for rarely touching one... Better payed attention... Difficult and funny at the same time.
I felt that he expected all of his audience to have compute powers like he had in their brains. In my case: not! not at that point in time (90's).

I hope that what I picked up about elegance and "simplicity" ,<yeah, right...> still shows in my little examples on this forum: that definitely had an impact.
Note I did not study at Austin, but he gave lectures and was a visiting professor to the Netherlands all of his life.
There must be more - either Dutch or American - forum members here that attended some of his lectures. I wonder what their opinion is. Must be close....

Now playing "one of these days...."  I invent a Semaphore.... 8-)
« Last Edit: March 04, 2019, 10:18:36 am by Thaddy »
I am more like donkey than shrek

avk

  • Sr. Member
  • ****
  • Posts: 273
    • my self-education project
Re: Dining philosophers
« Reply #4 on: March 05, 2019, 01:54:20 pm »
... elegance and "simplicity" ... Hmm ... :-[

Well, in the third submission there seems nothing more to simplify:
Code: Pascal  [Select][+][-]
  1. program dining_philosophers;
  2. {$mode objfpc}
  3. uses
  4.   {$IFDEF UNIX}
  5.   cthreads,
  6.   {$ENDIF}
  7.   Classes, SysUtils, SyncObjs;
  8. const
  9.   PHIL_COUNT   = 5;
  10.   DELAY_RANGE  = 950;
  11.   DELAY_LOW    = 50;
  12.   PHIL_NAMES: array[1..PHIL_COUNT] of string = ('Aristotle', 'Kant', 'Spinoza', 'Marx', 'Russell');
  13. type
  14.   TFork        = TCriticalSection;
  15.   TPhilosopher = class(TThread)
  16.   private
  17.     FName: string;
  18.     FLeftFork, FRightFork: TFork;
  19.     FLifeSpan: Integer;
  20.   protected
  21.     procedure Execute; override;
  22.   public
  23.     constructor Create(const aName: string; aLeftFork, aRightFork: TFork; aLifeSpan: Integer);
  24.   end;
  25.  
  26. procedure Delay(aInterval: DWord); forward;
  27.  
  28. procedure TPhilosopher.Execute;
  29. begin
  30.   WriteLn(FName, ' sits down at the table');
  31.   while FLifeSpan > 0 do
  32.     begin
  33.       WriteLn(FName, ' thinking');
  34.       Delay(Random(DELAY_RANGE) + DELAY_LOW);
  35.       WriteLn(FName, ' is hungry');
  36.       FLeftFork.Acquire;
  37.       FRightFork.Acquire;
  38.       WriteLn(FName, ' eating');
  39.       Delay(Random(DELAY_RANGE) + DELAY_LOW);
  40.       FRightFork.Release;
  41.       FLeftFork.Release;
  42.       WriteLn(FName, ' is full');
  43.       Dec(FLifeSpan);
  44.     end;
  45.   WriteLn(FName, ' leaves the table');
  46. end;
  47.  
  48. constructor TPhilosopher.Create(const aName: string; aLeftFork, aRightFork: TFork; aLifeSpan: Integer);
  49. begin
  50.   inherited Create(True);
  51.   FName := aName;
  52.   FLeftFork := aLeftFork;
  53.   FRightFork := aRightFork;
  54.   FLifeSpan := aLifeSpan;
  55. end;
  56.  
  57. var
  58.   Philosophers: array[1..PHIL_COUNT] of TPhilosopher;
  59.   Forks: array[1..PHIL_COUNT] of TFork;
  60.   LifeSpan: Integer = 5;
  61.   DelayAwait: PRtlEvent;
  62.  
  63. procedure DinnerBegin;
  64. var
  65.   I: Integer;
  66.   Phil: TPhilosopher;
  67. begin
  68.   DelayAwait := RtlEventCreate;
  69.   for I := 1 to PHIL_COUNT do
  70.     Forks[I] := TFork.Create;
  71.   for I := 1 to Pred(PHIL_COUNT) do
  72.     Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], Forks[I], Forks[Succ(I)], LifeSpan);
  73.   Philosophers[PHIL_COUNT] := TPhilosopher.Create(PHIL_NAMES[PHIL_COUNT], Forks[1], Forks[PHIL_COUNT], LifeSpan);
  74.   for Phil in Philosophers do
  75.     Phil.Start;
  76. end;
  77.  
  78. procedure WaitForDinnerOver;
  79. var
  80.   Phil: TPhilosopher;
  81.   Fork: TFork;
  82. begin
  83.   for Phil in Philosophers do
  84.     begin
  85.       Phil.WaitFor;
  86.       Phil.Free;
  87.     end;
  88.   for Fork in Forks do
  89.     Fork.Free;
  90.   RtlEventDestroy(DelayAwait);
  91. end;
  92.  
  93. procedure Delay(aInterval: DWord);
  94. begin
  95.   RTLEventWaitFor(DelayAwait, aInterval);
  96. end;
  97.  
  98. begin
  99.   Randomize;
  100.   WriteLn(LineEnding, 'table is empty', LineEnding);
  101.   DinnerBegin;
  102.   WaitForDinnerOver;
  103.   WriteLn(LineEnding, 'table is empty', LineEnding);
  104. end.  
  105.  
« Last Edit: March 05, 2019, 04:08:12 pm by avk »

Ñuño_Martínez

  • Hero Member
  • *****
  • Posts: 1028
    • Burdjia
Re: Dining philosophers
« Reply #5 on: March 06, 2019, 01:41:39 pm »
I would add some comments, including some to separate CLASS implementation from procedures and such.
Are you interested in game programming? Join the Pascal Game Development community!
Also visit the Game Development Portal

engkin

  • Hero Member
  • *****
  • Posts: 2513
Re: Dining philosophers
« Reply #6 on: March 06, 2019, 02:32:43 pm »
... elegance and "simplicity" ... Hmm ... :-[

Well, in the third submission there seems nothing more to simplify:
Code: Pascal  [Select][+][-]
  1.   TPhilosopher.Create(PHIL_NAMES[PHIL_COUNT], Forks[1], Forks[PHIL_COUNT], LifeSpan);

Don't these forks need to be swapped?



Deleted!



Instead of:
Code: Pascal  [Select][+][-]
  1.   Forks: array[1..PHIL_COUNT] of TFork;
  2.  
  3. procedure DinnerBegin;
  4. var
  5.   I: Integer;
  6.   Phil: TPhilosopher;
  7. begin
  8.   DelayAwait := RtlEventCreate;
  9.   for I := 1 to PHIL_COUNT do
  10.     Forks[I] := TFork.Create;
  11.   for I := 1 to Pred(PHIL_COUNT) do
  12.     Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], Forks[I], Forks[Succ(I)], LifeSpan);
  13.   Philosophers[PHIL_COUNT] := TPhilosopher.Create(PHIL_NAMES[PHIL_COUNT], Forks[1], Forks[PHIL_COUNT], LifeSpan);
  14.   for Phil in Philosophers do
  15.     Phil.Start;
  16. end;

I somehow prefer to have an additional fork instead of creating the last TPhilosopher outside the loop:
Code: Pascal  [Select][+][-]
  1.   Forks: array[1..PHIL_COUNT+1] of TFork;
  2.  
  3. procedure DinnerBegin;
  4. var
  5.   I: Integer;
  6.   Phil: TPhilosopher;
  7. begin
  8.   DelayAwait := RtlEventCreate;
  9.   for I := 1 to PHIL_COUNT do
  10.     Forks[I] := TFork.Create;
  11.   Forks[PHIL_COUNT+1] := Forks[1];
  12.   for I := 1 to PHIL_COUNT do
  13.     Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], Forks[I], Forks[Succ(I)], LifeSpan);
  14.   for Phil in Philosophers do
  15.     Phil.Start;
  16. end;
« Last Edit: March 06, 2019, 02:59:17 pm by engkin »

avk

  • Sr. Member
  • ****
  • Posts: 273
    • my self-education project
Re: Dining philosophers
« Reply #7 on: March 06, 2019, 03:11:00 pm »
Unfortunately, by the condition of the problem there are only five forks.

For the aforementioned line, I have a rather long comment:
 "In fact, to the left of Russell is the fork number 5.
  But we, taking advantage of the fact that philosophers are usually absent-minded people,
  are trying to convince him that to the left lies the fork number 1.
  If he does not believe us, then a deadlock may occur."  :)
   
And yes, the code can be even simpler:
Code: Pascal  [Select][+][-]
  1. program dining_philosophers;
  2. {$mode objfpc}{$H+}
  3. uses
  4.   {$IFDEF UNIX}
  5.   cthreads,
  6.   {$ENDIF}
  7.   Classes, SysUtils, SyncObjs;
  8. const
  9.   PHIL_COUNT   = 5;
  10.   LIFESPAN     = 7;
  11.   DELAY_RANGE  = 950;
  12.   DELAY_LOW    = 50;
  13.   TABLE_EMPTY  = LineEnding + 'table is empty' + LineEnding;
  14.   PHIL_NAMES: array[1..PHIL_COUNT] of string = ('Aristotle', 'Kant', 'Spinoza', 'Marx', 'Russell');
  15. type
  16.   TFork        = TCriticalSection;
  17.   TPhilosopher = class(TThread)
  18.   private
  19.     FName: string;
  20.     FLeftFork, FRightFork: TFork;
  21.   protected
  22.     procedure Execute; override;
  23.   public
  24.     constructor Create(const aName: string; aLeftFork, aRightFork: TFork);
  25.   end;
  26.  
  27. procedure TPhilosopher.Execute;
  28. var
  29.   LfSpan: Integer = LIFESPAN;
  30. begin
  31.   WriteLn(FName, ' sits down at the table');
  32.   while LfSpan > 0 do
  33.     begin
  34.       WriteLn(FName, ' thinking');
  35.       Sleep(Random(DELAY_RANGE) + DELAY_LOW);
  36.       WriteLn(FName, ' is hungry');
  37.       FLeftFork.Acquire;
  38.       FRightFork.Acquire;
  39.       WriteLn(FName, ' eating');
  40.       Sleep(Random(DELAY_RANGE) + DELAY_LOW);
  41.       FRightFork.Release;
  42.       FLeftFork.Release;
  43.       WriteLn(FName, ' is full');
  44.       Dec(LfSpan);
  45.     end;
  46.   WriteLn(FName, ' leaves the table');
  47. end;
  48.  
  49. constructor TPhilosopher.Create(const aName: string; aLeftFork, aRightFork: TFork);
  50. begin
  51.   inherited Create(False);
  52.   FName := aName;
  53.   FLeftFork := aLeftFork;
  54.   FRightFork := aRightFork;
  55. end;
  56.  
  57. var
  58.   Forks: array[1..PHIL_COUNT] of TFork;
  59.   Philosophers: array[1..PHIL_COUNT] of TPhilosopher;
  60.  
  61. procedure DinnerBegin;
  62. var
  63.   I: Integer;
  64. begin
  65.   for I := 1 to PHIL_COUNT do
  66.     Forks[I] := TFork.Create;
  67.   for I := 1 to Pred(PHIL_COUNT) do
  68.     Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], Forks[I], Forks[Succ(I)]);
  69.   Philosophers[PHIL_COUNT] := TPhilosopher.Create(PHIL_NAMES[PHIL_COUNT], Forks[1], Forks[PHIL_COUNT]);
  70. end;
  71.  
  72. procedure WaitForDinnerOver;
  73. var
  74.   Phil: TPhilosopher;
  75.   Fork: TFork;
  76. begin
  77.   for Phil in Philosophers do
  78.     begin
  79.       Phil.WaitFor;
  80.       Phil.Free;
  81.     end;
  82.   for Fork in Forks do
  83.     Fork.Free;
  84. end;
  85.  
  86. begin
  87.   Randomize;
  88.   WriteLn(TABLE_EMPTY);
  89.   DinnerBegin;
  90.   WaitForDinnerOver;
  91.   WriteLn(TABLE_EMPTY);
  92. end.
  93.  
« Last Edit: March 06, 2019, 04:03:38 pm by avk »

engkin

  • Hero Member
  • *****
  • Posts: 2513
Re: Dining philosophers
« Reply #8 on: March 06, 2019, 05:01:48 pm »
Unfortunately, by the condition of the problem there are only five forks.

Five forks, Fork[6] := Fork[1]

Code: Text  [Select][+][-]
  1. Fork[1] Aristotle Fork[2]
  2. Fork[2] Kant     Fork[3]
  3. Fork[3] Spinoza  Fork[4]
  4. Fork[4] Marx     Fork[5]
  5. Fork[5] Russell  Fork[6] same as Fork[1]

Your arrangement makes Russell giving his back to the table, and he would not be able to eat.

avk

  • Sr. Member
  • ****
  • Posts: 273
    • my self-education project
Re: Dining philosophers
« Reply #9 on: March 06, 2019, 06:40:03 pm »
 Ah, you mean that Russell has seeing double? :)
 But fork number 1 is indeed to the right of Russell(round table), and that’s the problem.
 That is, you could write:
Code: Pascal  [Select][+][-]
  1.   for I := 1 to PHIL_COUNT do
  2.     Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], Forks[I], Forks[Succ(I mod PHIL_COUNT)], LifeSpan);
  3.  
But what happens if they all get hungry at the same time? 
« Last Edit: March 07, 2019, 07:32:12 am by avk »

avk

  • Sr. Member
  • ****
  • Posts: 273
    • my self-education project
Re: Dining philosophers
« Reply #10 on: March 09, 2019, 09:30:44 am »
Thanks for the tips, the page is updated.

Thaddy

  • Hero Member
  • *****
  • Posts: 10276
Re: Dining philosophers
« Reply #11 on: March 09, 2019, 09:46:55 am »
Remember the above problem can be also solved by making one of them left-handed!
I am more like donkey than shrek

avk

  • Sr. Member
  • ****
  • Posts: 273
    • my self-education project
Re: Dining philosophers
« Reply #12 on: March 09, 2019, 10:29:51 am »
Yes, of course, done.

lainz

  • Hero Member
  • *****
  • Posts: 3635
    • Lainz
Re: [SOLVED]Dining philosophers
« Reply #13 on: April 30, 2019, 03:24:20 am »
Thanks for sharing.

I guess this can be used to make a single connection to local SQLite database and use different threads to access and write data into it with no major problems?

Edit: found this https://forum.lazarus.freepascal.org/index.php/topic,42212.0.html
« Last Edit: April 30, 2019, 04:08:25 am by Lainz »
https://lainz.github.io - My Website
https://lazpaint.github.io/ - LazPaint Downloads

 

TinyPortal © 2005-2018