unit SearchF;
//*******************************************************
// Example program demonstrating list searching.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus;

const
    NUM_ALGS = 5;

type
  TLongArray = array [1..10000000] of Longint;
  PLongArray = ^TLongArray;

  PCell = ^TCell;
  TCell = record
      Value    : Longint;
      NextCell : PCell;
      PrevCell : PCell;
  end;

  TSearchForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    mnuExit: TMenuItem;
    Help1: TMenuItem;
    mnuAbout: TMenuItem;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    NumItemsText: TEdit;
    CmdCreateList: TButton;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    RepetitionsText: TEdit;
    TargetText: TEdit;
    CmdSearch: TButton;
    AlgCheck1: TCheckBox;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    LocationLabel1: TLabel;
    SearchesLabel1: TLabel;
    TimeLabel1: TLabel;
    AlgCheck2: TCheckBox;
    AlgCheck3: TCheckBox;
    AlgCheck4: TCheckBox;
    AlgCheck5: TCheckBox;
    LocationLabel2: TLabel;
    SearchesLabel2: TLabel;
    TimeLabel2: TLabel;
    LocationLabel3: TLabel;
    SearchesLabel3: TLabel;
    TimeLabel3: TLabel;
    LocationLabel4: TLabel;
    SearchesLabel4: TLabel;
    TimeLabel4: TLabel;
    LocationLabel5: TLabel;
    SearchesLabel5: TLabel;
    TimeLabel5: TLabel;
    MaxValueLabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure CmdCreateListClick(Sender: TObject);
    procedure FreeMemory;
    procedure CmdSearchClick(Sender: TObject);
    procedure DoLinearSearch(target, num_reps : Longint);
    function LinearSearch(target : Longint; List : PLongArray; min, max : Longint; var searches : Longint) : Longint;
    procedure DoBinarySearch(target, num_reps : Longint);
    function BinarySearch(target : Longint; List : PLongArray; min, max : Longint; var searches : Longint) : Longint;
    procedure DoInterpolationSearch(target, num_reps : Longint);
    function InterpolationSearch(target : Longint; List : PLongArray; min, max : Longint; var searches : Longint) : Longint;
    procedure DoLListSearch(target, num_reps : Longint);
    function LListSearch(target : Longint; top : PCell; var searches : Longint) : PCell;
    procedure DoSentinelSearch(target, num_reps : Longint);
    function SentinelSearch(target : Longint; top : PCell; var searches : Longint) : PCell;
  private
    { Private declarations }
    LocationLabel : array [1..NUM_ALGS] of TLabel;
    SearchesLabel : array [1..NUM_ALGS] of TLabel;
    TimeLabel     : array [1..NUM_ALGS] of TLabel;

    List          : PLongArray;
    NumItems      : Longint;
    TopSentinel   : PCell;
    BottomCell    : PCell;
  public
    { Public declarations }
  end;

var
  SearchForm: TSearchForm;

implementation

{$R *.DFM}

procedure TSearchForm.FormCreate(Sender: TObject);
begin
    Randomize;

    LocationLabel[1] := LocationLabel1;
    LocationLabel[2] := LocationLabel2;
    LocationLabel[3] := LocationLabel3;
    LocationLabel[4] := LocationLabel4;
    LocationLabel[5] := LocationLabel5;
    SearchesLabel[1] := SearchesLabel1;
    SearchesLabel[2] := SearchesLabel2;
    SearchesLabel[3] := SearchesLabel3;
    SearchesLabel[4] := SearchesLabel4;
    SearchesLabel[5] := SearchesLabel5;
    TimeLabel[1] := TimeLabel1;
    TimeLabel[2] := TimeLabel2;
    TimeLabel[3] := TimeLabel3;
    TimeLabel[4] := TimeLabel4;
    TimeLabel[5] := TimeLabel5;
end;

procedure TSearchForm.FormDestroy(Sender: TObject);
begin
    if (NumItems > 0) then FreeMemory;
end;

procedure TSearchForm.mnuExitClick(Sender: TObject);
begin
    Close;
end;

procedure TSearchForm.mnuAboutClick(Sender: TObject);
const
    CRCR = #13#10#13#10;
begin
    MessageDlg(
        'This program demonstrates various list searching algorithms.' + CRCR +
        'Enter list parameters and click the Create List button to build a random list. Each item is between 1 and 5 greater than the previous item.' + CRCR +
        'Then enter a target value and click the Search button to make the program locate the target using the algorithms you select.'
        , mtInformation, [mbOK], 0);
end;

// Create the lists to sort.
procedure TSearchForm.CmdCreateListClick(Sender: TObject);
var
    i, value : Longint;
begin
    Screen.Cursor := crHourGlass;
    Refresh;

    if (NumItems > 0) then FreeMemory;
    NumItems := StrToInt(NumItemsText.Text);
    GetMem(List, NumItems * SizeOf(Longint));
    New(TopSentinel);
    BottomCell := TopSentinel;

    value := 0;
    for i := 1 to NumItems do
    begin
        value := value + 1 + Trunc(Random(5));
        List^[i] := value;
        New(BottomCell^.NextCell);
        BottomCell^.NextCell^.PrevCell := BottomCell;
        BottomCell := BottomCell^.NextCell;
        BottomCell^.Value := value;
    end;
    BottomCell^.NextCell := nil;

    MaxValueLabel.Caption := IntToStr(value);        
    CmdSearch.Enabled := True;
    Screen.Cursor := crDefault;
end;

// Free dynamically allocated memory.
procedure TSearchForm.FreeMemory;
var
    cell : PCell;
begin
    FreeMem(List);

    while (TopSentinel <> nil) do
    begin
        cell := TopSentinel^.NextCell;
        Dispose(TopSentinel);
        TopSentinel := cell;
    end;
end;

// Search using the selected algorithms.
procedure TSearchForm.CmdSearchClick(Sender: TObject);
var
    i, target, num_reps : Longint;
begin
    Screen.Cursor := crHourGlass;

    for i := 1 to NUM_ALGS do
    begin
        LocationLabel[i].Caption := '';
        SearchesLabel[i].Caption := '';
        TimeLabel[i].Caption := '';
    end;
    Refresh;

    target := StrToInt(TargetText.Text);
    num_reps := StrToInt(RepetitionsText.Text);

    if (AlgCheck1.Checked) then DoLinearSearch(target, num_reps);
    if (AlgCheck2.Checked) then DoBinarySearch(target, num_reps);
    if (AlgCheck3.Checked) then DoInterpolationSearch(target, num_reps);
    if (AlgCheck4.Checked) then DoLListSearch(target, num_reps);
    if (AlgCheck5.Checked) then DoSentinelSearch(target, num_reps);

    Screen.Cursor := crDefault;
end;

// Search using linear search.
procedure TSearchForm.DoLinearSearch(target, num_reps : Longint);
var
    time1                : TDateTime;
    h, m, s, ms          : Word;
    rep, index, searches : Longint;
begin
    index := 0;
    searches := 0;
    time1 := Time;
    for rep := 1 to num_reps do
    begin
        index := LinearSearch(target, List, 1, NumItems, searches);
    end;
    time1 := Time - time1;

    LocationLabel1.Caption := IntToStr(index);
    SearchesLabel1.Caption := IntToStr(searches);
    DecodeTime(time1, h, m, s, ms);
    TimeLabel1.Caption := Format('%.2f',
        [ms / 1000.0 + s + 60 * (m + h * 60)]);
end;
function TSearchForm.LinearSearch(target : Longint; List : PLongArray; min, max : Longint; var searches : Longint) : Longint;
var
    i : Longint;
begin
    searches := 0;
    for i := min to max do
    begin
        searches := searches + 1;
        if (list^[i] >= target) then break;
    end;

    if (i > max) then
        Result := 0
    else if (list^[i] = target) then
        Result := i
    else
        Result := 0;
end;

// Search using binary search.
procedure TSearchForm.DoBinarySearch(target, num_reps : Longint);
var
    time1                : TDateTime;
    h, m, s, ms          : Word;
    rep, index, searches : Longint;
begin
    index := 0;
    searches := 0;
    time1 := Time;
    for rep := 1 to num_reps do
    begin
        index := BinarySearch(target, List, 1, NumItems, searches);
    end;
    time1 := Time - time1;

    LocationLabel2.Caption := IntToStr(index);
    SearchesLabel2.Caption := IntToStr(searches);
    DecodeTime(time1, h, m, s, ms);
    TimeLabel2.Caption := Format('%.2f',
        [ms / 1000.0 + s + 60 * (m + h * 60)]);
end;
function TSearchForm.BinarySearch(target : Longint; List : PLongArray; min, max : Longint; var searches : Longint) : Longint;
var
    middle : Longint;
begin
    searches := 0;

    // During the search the target's index will be between
    // min and max: min <= target index <= max
    while (min <= max) do
    begin
        searches := searches + 1;

        middle := Round((max + min) / 2);
        if (target = list^[middle]) then // We found it.
        begin
            Result := middle;
            exit;
        end else if target < List[middle] then
            // Search the left half.
            max := middle - 1
        else
            // Search the right half.
            min := middle + 1;
    end;

    // If we get here the target is not in the list.
    Result := 0;
end;

// Search using interpolation search.
procedure TSearchForm.DoInterpolationSearch(target, num_reps : Longint);
var
    time1                : TDateTime;
    h, m, s, ms          : Word;
    rep, index, searches : Longint;
begin
    index := 0;
    searches := 0;
    time1 := Time;
    for rep := 1 to num_reps do
    begin
        index := InterpolationSearch(target, List, 1, NumItems, searches);
    end;
    time1 := Time - time1;

    LocationLabel3.Caption := IntToStr(index);
    SearchesLabel3.Caption := IntToStr(searches);
    DecodeTime(time1, h, m, s, ms);
    TimeLabel3.Caption := Format('%.2f',
        [ms / 1000.0 + s + 60 * (m + h * 60)]);
end;
function TSearchForm.InterpolationSearch(target : Longint; List : PLongArray; min, max : Longint; var searches : Longint) : Longint;
var
    middle : Longint;
begin
    searches := 0;

    while (min <= max) do
    begin
        // Prevent division by zero.
        if (list^[min] = list^[max]) then
        begin
            // This must be the item (if it's in the list).
            if List[min] = target then
                Result := min
            else
                Result := 0;
            exit;
        end;

        // Compute the dividing point.
        middle := Round(min + ((target - list^[min]) *
            ((max - min) / (list^[max] - list^[min]))));

        // Make sure we stay in bounds.
        if ((middle < min) or (middle > max)) then
        begin
            // It's not in the list.
            Result := 0;
            exit;
        end;

        searches := searches + 1;
        if target = List[middle] then // We found it.
        begin
            Result := middle;
            exit;
        end else if target < List[middle] then
            // Search the left half.
            max := middle - 1
        else
            // Search the right half.
            min := middle + 1;
    end; // End while (min <= max) do...

    // If we got to this point, the item is not in the list.
    Result := 0;
end;

// Search using linked list search.
procedure TSearchForm.DoLListSearch(target, num_reps : Longint);
var
    time1         : TDateTime;
    h, m, s, ms   : Word;
    rep, searches : Longint;
    cell          : PCell;
begin
    searches := 0;
    cell := nil;
    time1 := Time;
    for rep := 1 to num_reps do
        cell := LListSearch(target, TopSentinel, searches);
    time1 := Time - time1;

    if (cell = nil) then
        LocationLabel4.Caption := '0'
    else
        LocationLabel4.Caption := IntToStr(searches);
    SearchesLabel4.Caption := IntToStr(searches);
    DecodeTime(time1, h, m, s, ms);
    TimeLabel4.Caption := Format('%.2f',
        [ms / 1000.0 + s + 60 * (m + h * 60)]);
end;
function TSearchForm.LListSearch(target : Longint; top : PCell; var searches : Longint) : PCell;
begin
    searches := 0;
    top := top^.NextCell;
    while (top <> nil) do
    begin
        searches := searches + 1;
        if (top^.Value >= target) then break;
        top := top^.NextCell;
    end;
    if (top = nil) then
        Result := nil
    else if (top^.Value = target) then
        Result := top
    else
        Result := nil;
end;

// Search using linked list with sentinel search.
procedure TSearchForm.DoSentinelSearch(target, num_reps : Longint);
var
    time1         : TDateTime;
    h, m, s, ms   : Word;
    rep, searches : Longint;
    cell          : PCell;
begin
    searches := 0;
    cell:= nil;
    time1 := Time;
    for rep := 1 to num_reps do
    begin
        cell := SentinelSearch(target, TopSentinel, searches);
    end;
    time1 := Time - time1;

    if (cell = nil) then
        LocationLabel5.Caption := '0'
    else
        LocationLabel5.Caption := IntToStr(searches);
    SearchesLabel5.Caption := IntToStr(searches);
    DecodeTime(time1, h, m, s, ms);
    TimeLabel5.Caption := Format('%.2f',
        [ms / 1000.0 + s + 60 * (m + h * 60)]);
end;
function TSearchForm.SentinelSearch(target : Longint; top : PCell; var searches : Longint) : PCell;
var
    bottom_sentinel : TCell;
begin
    // Add the sentinel.
    BottomCell^.NextCell := @bottom_sentinel;
    bottom_sentinel.Value := target;

    searches := 1;
    top := top^.NextCell;
    while (top^.Value < target) do
    begin
        searches := searches + 1;
        top := top^.NextCell;
    end;
    if ((top^.Value <> target) or
        (top = @bottom_sentinel))
    then
        Result := nil
    else
        Result := top;

    // Remove the sentinel.
    BottomCell^.NextCell := nil;
end;

end.
