Skip to content

Commit

Permalink
Multi-threaded part of computation is terminated by pressing ESC key …
Browse files Browse the repository at this point in the history 
…(provided by Ingo Wulf).

#3
  • Loading branch information
@dvmorozov
dvmorozov committed Dec 3, 2019
1 parent 897065a commit 3ed61f5
Show file tree
Hide file tree
Showing 3 changed files with 134 additions and 76 deletions.
127 changes: 72 additions & 55 deletions examples/TBoundingBoxServerForm/bounding_box_server_demo.lps
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,11 +20,10 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<TopLine Value="727"/>
<CursorPos X="19" Y="749"/>
<TopLine Value="787"/>
<CursorPos Y="810"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit1>
<Unit2>
Expand Down Expand Up @@ -111,8 +110,8 @@
<Unit12>
<Filename Value="..\..\package\RunningThread.pas"/>
<EditorIndex Value="7"/>
<TopLine Value="95"/>
<CursorPos Y="115"/>
<TopLine Value="81"/>
<CursorPos Y="106"/>
<UsageCount Value="138"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
Expand Down Expand Up @@ -209,123 +208,141 @@
</OtherDefines>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="222" Column="14" TopLine="194"/>
<Filename Value="..\..\package\DownhillSimplexAlgorithm.pas"/>
<Caret Line="71" Column="22" TopLine="43"/>
</Position1>
<Position2>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="620" Column="35" TopLine="611"/>
</Position2>
<Position3>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="69" Column="18" TopLine="42"/>
<Caret Line="245" TopLine="225"/>
</Position3>
<Position4>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="85" Column="41" TopLine="58"/>
<Filename Value="..\..\package\RunningThread.pas"/>
<Caret Line="116" TopLine="96"/>
</Position4>
<Position5>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="618" Column="69" TopLine="604"/>
<Filename Value="..\..\package\RunningThread.pas"/>
<Caret Line="117" TopLine="96"/>
</Position5>
<Position6>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="620" Column="35" TopLine="611"/>
<Filename Value="..\..\package\RunningThread.pas"/>
<Caret Line="118" TopLine="96"/>
</Position6>
<Position7>
<Filename Value="downhill_simplex_handler.pas"/>
<Caret Line="81" Column="20" TopLine="65"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="245" TopLine="224"/>
</Position7>
<Position8>
<Filename Value="downhill_simplex_handler.pas"/>
<Caret Line="238" Column="40" TopLine="221"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="768" Column="60" TopLine="761"/>
</Position8>
<Position9>
<Filename Value="..\..\package\DownhillSimplexAlgorithm.pas"/>
<Caret Line="105" Column="31" TopLine="92"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="78" Column="34" TopLine="64"/>
</Position9>
<Position10>
<Filename Value="..\..\package\DownhillSimplexAlgorithm.pas"/>
<Caret Line="160" Column="39" TopLine="140"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="658" Column="54" TopLine="630"/>
</Position10>
<Position11>
<Filename Value="..\..\package\DownhillSimplexAlgorithm.pas"/>
<Caret Line="580" Column="8" TopLine="562"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="767" Column="35" TopLine="740"/>
</Position11>
<Position12>
<Filename Value="..\..\package\DownhillSimplexAlgorithm.pas"/>
<Caret Line="614" Column="36" TopLine="587"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="768" Column="67" TopLine="741"/>
</Position12>
<Position13>
<Filename Value="..\..\package\DownhillSimplexAlgorithm.pas"/>
<Filename Value="bounding_box_server_form.pas"/>
</Position13>
<Position14>
<Filename Value="..\..\package\DownhillSimplexAlgorithm.pas"/>
<Caret Line="45" Column="62" TopLine="17"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="78" Column="39" TopLine="51"/>
</Position14>
<Position15>
<Filename Value="..\..\package\DownhillSimplexAlgorithm.pas"/>
<Caret Line="60" Column="17" TopLine="32"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="658" Column="54" TopLine="654"/>
</Position15>
<Position16>
<Filename Value="..\..\package\DownhillSimplexAlgorithm.pas"/>
<Caret Line="61" Column="17" TopLine="33"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="790" Column="38" TopLine="770"/>
</Position16>
<Position17>
<Filename Value="..\..\package\DownhillSimplexAlgorithm.pas"/>
<Caret Line="64" Column="20" TopLine="36"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="786" Column="47" TopLine="770"/>
</Position17>
<Position18>
<Filename Value="..\..\package\DownhillSimplexAlgorithm.pas"/>
<Caret Line="69" Column="22" TopLine="41"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="17" Column="33"/>
</Position18>
<Position19>
<Filename Value="..\..\package\DownhillSimplexAlgorithm.pas"/>
<Caret Line="71" Column="22" TopLine="43"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="221" Column="48" TopLine="202"/>
</Position19>
<Position20>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="620" Column="35" TopLine="611"/>
</Position20>
<Position21>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="245" TopLine="225"/>
<Caret Line="82" Column="33" TopLine="56"/>
</Position21>
<Position22>
<Filename Value="..\..\package\RunningThread.pas"/>
<Caret Line="116" TopLine="96"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="221" Column="48" TopLine="208"/>
</Position22>
<Position23>
<Filename Value="..\..\package\RunningThread.pas"/>
<Caret Line="117" TopLine="96"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="260" Column="21" TopLine="245"/>
</Position23>
<Position24>
<Filename Value="..\..\package\RunningThread.pas"/>
<Caret Line="118" TopLine="96"/>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="261" Column="53" TopLine="245"/>
</Position24>
<Position25>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="245" TopLine="225"/>
<Caret Line="82" Column="33" TopLine="67"/>
</Position25>
<Position26>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="239" Column="35" TopLine="232"/>
<Caret Line="221" Column="48" TopLine="199"/>
</Position26>
<Position27>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="237" Column="35" TopLine="230"/>
<Caret Line="260" Column="21" TopLine="251"/>
</Position27>
<Position28>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="241" Column="45" TopLine="230"/>
<Filename Value="..\..\package\RunningThread.pas"/>
<Caret Line="103" TopLine="81"/>
</Position28>
<Position29>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="747" Column="26" TopLine="730"/>
<Filename Value="..\..\package\RunningThread.pas"/>
<Caret Line="106" TopLine="81"/>
</Position29>
<Position30>
<Filename Value="bounding_box_server_form.pas"/>
<Caret Line="13" Column="33"/>
<Caret Line="810" Column="16" TopLine="796"/>
</Position30>
</JumpHistory>
</ProjectSession>
<Debugging>
<BreakPoints Count="2">
<Item1>
<Kind Value="bpkSource"/>
<WatchScope Value="wpsLocal"/>
<WatchKind Value="wpkWrite"/>
<Source Value="..\..\package\RunningThread.pas"/>
<Line Value="106"/>
</Item1>
<Item2>
<Kind Value="bpkSource"/>
<WatchScope Value="wpsLocal"/>
<WatchKind Value="wpkWrite"/>
<Source Value="bounding_box_server_form.pas"/>
<Line Value="810"/>
</Item2>
</BreakPoints>
</Debugging>
</CONFIG>
72 changes: 52 additions & 20 deletions examples/TBoundingBoxServerForm/bounding_box_server_form.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -82,8 +82,8 @@ TBoundingBoxServerForm = class(TForm)
procedure OuputMinVolume(Handler: TDownHillSimplexHandler);
{ Creates and returns container instance which should be destroyed by calling method. }
function CreateHandler(iAlpha, iBeta, iGamma: Double;
iDHS_InitParamLength: Double;
iShowDetails: Boolean; RunId: Integer): TDownHillSimplexHandler;
iDHS_InitParamLength: Double; iShowDetails: Boolean;
RunId: Integer): TDownHillSimplexHandler;

procedure LoadObjPointCloud(iFileName: String; iAlpha, iBeta, iGamma: single);
procedure GenerateRandomPointCloud;
Expand Down Expand Up @@ -195,9 +195,9 @@ function TBoundingBoxServerForm.CreateHandler(iAlpha, iBeta, iGamma: Double;
begin
fExitDerivate := 0.5; // default value
end;
Result := TDownHillSimplexHandler.Create(self,
iAlpha, iBeta, iGamma, iDHS_InitParamLength,
fFinalTolerance, fExitDerivate, iShowDetails, RunId);
Result := TDownHillSimplexHandler.Create(self, iAlpha,
iBeta, iGamma, iDHS_InitParamLength, fFinalTolerance,
fExitDerivate, iShowDetails, RunId);
{ Adds to the list for asynchronous operations. }
FHandlers.Add(Result);
end;
Expand Down Expand Up @@ -274,7 +274,8 @@ procedure TBoundingBoxServerForm.BitBtnFindMinimumBoundingBoxClick(Sender: TObje

procedure TBoundingBoxServerForm.PostProcessStatistics;
const
cCriterion01 = 0.001; // criterion for relative deviation pass/fail; e.g. 0.0 1 => 0.1%
cCriterion01 = 0.001;
// criterion for relative deviation pass/fail; e.g. 0.0 1 => 0.1%
cCriterion1 = 0.01; // criterion for relative deviation pass/fail; e.g. 0.01 => 1%

var
Expand Down Expand Up @@ -511,12 +512,7 @@ procedure TBoundingBoxServerForm.ButtonBruteForceClick(Sender: TObject);
SortUp(fDeltaCord[1], fDeltaCord[2], fDeltaCord[3]);
fResult :=
Format(
' %10.2f %10.2f (%6.3f %6.3f %6.3f) -- (%7.2f %7.2f %7.2f) -- (%6.2f %6.2f %6.2f) --- %7.4f -- %4d -- %4d -- %2d',
[fDeltaVolume, BoxVolume, fDeltaCord[1],
fDeltaCord[2], fDeltaCord[3], Alpha,
Beta, Gamma, fAlpha, fBeta, fGamma,
ComputationTime, CycleCount, EvaluationCount,
RestartCount]);
' %10.2f %10.2f (%6.3f %6.3f %6.3f) -- (%7.2f %7.2f %7.2f) -- (%6.2f %6.2f %6.2f) --- %7.4f -- %4d -- %4d -- %2d', [fDeltaVolume, BoxVolume, fDeltaCord[1], fDeltaCord[2], fDeltaCord[3], Alpha, Beta, Gamma, fAlpha, fBeta, fGamma, ComputationTime, CycleCount, EvaluationCount, RestartCount]);
if fDeltaVolume > fMaxDeltaVolume then
begin
fMaxDeltaVolume := fDeltaVolume;
Expand All @@ -539,9 +535,10 @@ procedure TBoundingBoxServerForm.ButtonBruteForceClick(Sender: TObject);
Label2.Caption :=
Format(
'MinDelta Volume: %8.2f (%6.4f %6.4f %6.4f) --- MaxDelta Volume: %8.2f (%6.4f %6.4f %6.4f)',
[fMinDeltaVolume, fMinDeltaCord[1], fMinDeltaCord[2],
fMinDeltaCord[3], fMaxDeltaVolume,
fMaxDeltaCord[1], fMaxDeltaCord[2], fMaxDeltaCord[3]]);
[fMinDeltaVolume, fMinDeltaCord[1],
fMinDeltaCord[2], fMinDeltaCord[3],
fMaxDeltaVolume, fMaxDeltaCord[1],
fMaxDeltaCord[2], fMaxDeltaCord[3]]);
end;
end;
{ Removes and frees inserted container. }
Expand Down Expand Up @@ -727,14 +724,19 @@ procedure TBoundingBoxServerForm.FindGlobalMinVolume;
(45, 45, -45)
);
var
i: integer;
i, j: integer;
fRuns: integer;
fStartAngle: TDoubleVector3;
Handler: TDownHillSimplexHandler;
Runners: TComponentList;
Runner: TRunner;
fPerformanceFrequency, fStartTime, fEndTime: Int64;
FComputationTime: single;
fMustContinue: Boolean;
fWaitResult: DWord;
fHandle: THandle;
fKeyState: Byte;
fMsg: TMsg;
begin
fRuns := 3;
if PointCloud.Count < 100000 then
Expand Down Expand Up @@ -780,15 +782,45 @@ procedure TBoundingBoxServerForm.FindGlobalMinVolume;
{ Waits until all runners finish computing. }
for i := 0 to Runners.Count - 1 do
begin
Runner := TRunner(Runners[i]);
Runner.Wait;
fHandle := Runner.Handle;
fMustContinue := True;
while fMustContinue do
begin
{ Waits for thread finishing or any input event. }
fWaitResult := MsgWaitForMultipleObjects(1, fHandle, False,
INFINITE, QS_ALLINPUT);
if (fWaitResult = WAIT_OBJECT_0) then
{ Thread was finished, break the loop and wait for next. }
fMustContinue := False;
if fWaitResult = WAIT_OBJECT_0 + 1 then
begin
{ Reads the ESC key's status. }
fKeyState := GetAsyncKeyState(27);
Application.ProcessMessages;
if (fKeyState > 0) then
begin
{ ESC was pressed. }
Application.Restore;
while PeekMessage(fMsg, 0, WM_KEYFIRST, WM_KEYLAST,
PM_REMOVE or PM_NOYIELD) do ;
GetAsyncKeyState(27);
{ Stops calculation of other threads. }
for j := 0 to FHandlers.Count - 1 do
TDownHillSimplexHandler(FHandlers[j]).Stop;
end;
end;
if fWaitResult = WAIT_FAILED then
fMustContinue := False;
end;
end;
{ It is not necessarily to free separately all runners,
because the list owns them and removes them itself. }
Runners.Free;

QueryPerformanceCounter(fEndTime);
FComputationTime:= 0;
FComputationTime := 0;
if fPerformanceFrequency <> 0 then
FComputationTime := (fEndTime - fStartTime) / fPerformanceFrequency;
FComputationTime := (fEndTime - fStartTime) / fPerformanceFrequency;
FOptiResultBoxVolume := FBoxVolume;
FOptiResultBoxMaxCoords := FMaxCoords;
FOptiResultBoxMinCoords := FMinCoords;
Expand Down
11 changes: 10 additions & 1 deletion package/RunningThread.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,11 +16,12 @@

interface

uses Classes, Tools,
{$IFNDEF Lazarus}
uses Classes, Tools;
//TODO: set up proper module name for Delhpi build.
//DesignIntf;
{$ELSE}
uses Classes, Tools,
PropEdits;
{$ENDIF}

Expand All @@ -47,6 +48,7 @@ TRunner = class(TComponent)
FOutput: TOutputProcedure;
FCreate: TCreatingProcedure;
FRunningThread: TRunningThread;
function GetHandle: THandle;

public
{ Waits for finishing execution and terminates the thread. }
Expand All @@ -67,6 +69,7 @@ TRunner = class(TComponent)
read FOutput write FOutput;
property OnCreate: TCreatingProcedure
read FCreate write FCreate;
property Handle: THandle read GetHandle;
end;

procedure Register;
Expand Down Expand Up @@ -126,6 +129,12 @@ procedure TRunner.Wait;
FRunningThread := nil;
end;
end;

function TRunner.GetHandle: THandle;
begin
Result:= FRunningThread.Handle;
end;

{$warnings on}

end.

0 comments on commit 3ed61f5

Please sign in to comment.