Sorting and Searching Demonstration
As promised earlier in the tutorial, we have a program to demonstrate sorting and searching methods working with arrays of records. It includes bubble sort, insertion sort, quicksort, linear search and binary search. Program SortSearchDemo needs Progs.txt, which you may have used already with programs ListDemo and LinkedListDemo in our Lists, Stacks and Queues tutorial. It is available for download here.
program SortSearchDemo; {$APPTYPE CONSOLE} uses SysUtils, StrUtils; type TProg = record ProgramID : integer; ProgName : string[15]; ProgrammerID : integer; Dummy : integer; //to make this compatible with LinkedListDemo end; const FILENAME = 'Progs.txt'; MAX = 20; var LastRecord, FoundRecord, Choice, SelectedID : integer; Programs : array[1 .. MAX] of TProg; procedure InsertRecord(InsertID : integer); var Inserted : Boolean; TempRecord : TProg; CurrentRecord : integer; begin Inserted := False; TempRecord.ProgramID := InsertID; write('Program Name? '); readln(TempRecord.ProgName); write('Programmer ID? '); readln(TempRecord.ProgrammerID); if LastRecord = 0 then begin Programs[1] := TempRecord; LastRecord := 1; writeln('Record added. No others in list.'); end else begin CurrentRecord := LastRecord; inc(LastRecord); while (CurrentRecord > 0) and not Inserted do begin if TempRecord.ProgramID > Programs[CurrentRecord].ProgramID then begin Programs[CurrentRecord + 1] := TempRecord; //No shift needed Inserted := True; writeln('Record inserted at position ', CurrentRecord + 1); end else begin //Shift record one place Programs[CurrentRecord + 1] := Programs[CurrentRecord]; dec(CurrentRecord); end; end; if not Inserted then begin Programs[1] := TempRecord; writeln('Record inserted at position 1'); end; end; end; procedure DisplayRecord(RecNo : integer); begin writeln(' Program ID: ', Programs[RecNo].ProgramID, ' Name: ', Programs[RecNo].ProgName, DupeString(' ', 14 - Length(Programs[RecNo].ProgName)), 'Programmer ID: ', Programs[RecNo].ProgrammerID); end; procedure DisplayRecords; var Count : integer; begin if LastRecord = 0 then writeln('No records to display') else begin for Count := 1 to LastRecord do DisplayRecord(Count); end; end; procedure Find(ProgID: integer; var FoundRecord : integer); var CurrentRecord : integer; Found : Boolean; begin Found := False; if LastRecord = 0 then writeln('No records to search') else begin CurrentRecord := 1; repeat if Programs[CurrentRecord].ProgramID = ProgID then begin Found := True; FoundRecord := CurrentRecord; DisplayRecord(FoundRecord); end else inc(CurrentRecord); until Found or (CurrentRecord = LastRecord + 1); if not Found then begin FoundRecord := 0; writeln('Not found'); end; end; end; procedure BinarySearch(SearchNum, First, Last : integer); var MidPoint: integer; begin if First > Last then writeln('Search Failed') else begin writeln('Searching for ', SearchNum, ' between index ',First ,' and index ', Last); Midpoint := (First + Last) DIV 2; if Programs[MidPoint].ProgramID = SearchNum then writeln('Found at position ', MidPoint) else if Programs[MidPoint].ProgramID < SearchNum then BinarySearch(SearchNum, MidPoint + 1, Last) else BinarySearch(SearchNum, First, MidPoint - 1); end; end; procedure Delete(DeleteID : integer); var Count : integer; begin Find(DeleteID, FoundRecord); if FoundRecord <> 0 then begin dec(LastRecord); for Count := FoundRecord to LastRecord do Programs[Count] := Programs[Count + 1]; writeln('Deleted'); end; end; procedure Edit(EditID : integer); var Response : char; begin Find(EditID, FoundRecord); if FoundRecord <> 0 then begin write('Would you like to change the name y/n? '); readln(Response); if Response in ['Y', 'y'] then begin writeln('What should the name be? '); readln(Programs[FoundRecord].ProgName); writeln('New name entered'); end; write('Would you like to change the programmer ID y/n? '); readln(Response); if Response in ['Y', 'y'] then begin writeln('What should the ID be? '); readln(Programs[FoundRecord].ProgrammerID); writeln('New ID entered'); end; end; end; procedure BubbleSort(ChosenField : integer); var NoSwaps, SwapNeeded : Boolean; Count, LastCompare : integer; TempRecord : TProg; begin if LastRecord = 0 then begin writeln('No records to sort'); end else begin if LastRecord = 1 then begin writeln('Cannot sort 1 record.') end else begin NoSwaps := False; LastCompare := LastRecord; while NoSwaps = False do begin //start of loop comparing pairs of names NoSwaps := True; Count := 1; while (Count < LastCompare) do begin case ChosenField of 1: SwapNeeded := Programs[Count].ProgName > Programs[Count + 1].ProgName; 2: SwapNeeded := Programs[Count].ProgramID > Programs[Count + 1].ProgramID; end; if SwapNeeded then begin NoSwaps := False; TempRecord := Programs[Count + 1]; Programs[Count + 1] := Programs[Count]; Programs[Count] := TempRecord; writeln('Swapping ', Count,' with ', Count + 1); end else //No swap begin inc(Count); end; end;//while dec(LastCompare); end; //while NoSwaps = False; end; end; end; procedure InsertionSort; var Inserted : Boolean; Current, Insert : integer; ProgTemp : TProg; begin DisplayRecords; if LastRecord < 2 then begin writeln('No sorting possible'); end else begin for Insert := 2 to LastRecord do begin Inserted := False; Current := Insert; ProgTemp := Programs[Insert]; while not inserted do begin if ProgTemp.ProgramID > Programs[Current - 1].ProgramID then begin Inserted := True; //Position found; Programs[Current] := ProgTemp; writeln('Record inserted at position ', Current); DisplayRecords; end else begin //Shift up record one place Programs[Current] := Programs[Current - 1]; dec(Current); if Current = 1 then begin Programs[1] := ProgTemp; writeln('Inserted at position 1'); Inserted := True; DisplayRecords; end; end; end; end;//for end; end; procedure Quicksort(Left, Right: integer); var ptrLeft, ptrRight : integer; Temp, Pivot : TProg; begin //writeln('Quicksort procedure for index ', Left, ' to ', Right); ptrLeft := Left; ptrRight := Right; Pivot := Programs[(Left + Right) div 2]; repeat {Increment left pointer while it has not reached upper index of array segment and ProgramID of record pointed to by left pointer remains less than pivot ProgramID.} while (ptrLeft < Right) and (Programs[ptrLeft].ProgramID < Pivot.ProgramID) do inc(ptrLeft); {Decrement left pointer while it has not reached lower index of array segment and ProgramID of record pointed to by right pointer remains greater than pivot ProgramID.} while (ptrRight > Left) and (Programs[ptrRight].ProgramID > Pivot.ProgramID) do dec(ptrRight); if ptrLeft <= ptrRight then //if left pointer and right pointer have not crossed begin //Swap records at left and right pointers if pointers are not equal if ptrLeft < ptrRight then begin //writeln('Swapping ', Programs[ptrLeft].ProgramID, ' with ',Programs[ptrRight].ProgramID); Temp := Programs[ptrLeft]; Programs[ptrLeft] := Programs[ptrRight]; Programs[ptrRight] := Temp; //DisplayRecords; end; //Move pointers one place (left pointer moves right and right pointer moves left). inc(ptrLeft); dec(ptrRight); end; until ptrLeft > ptrRight; //Until pointers have crossed //Sort the left segment of the partition if there is more than one item in it. if ptrRight > Left then Quicksort(Left, ptrRight); //Sort the right segment of the partition if there is more than one item in it. if ptrLeft < Right then Quicksort(ptrLeft, Right); end; procedure Init; begin LastRecord := 0; end; procedure SaveRecords; var ProgFile : file of TProg; Count : integer; begin if LastRecord = 0 then writeln('No records to save') else begin assignFile(ProgFile, Filename); rewrite(ProgFile); for Count := 1 to LastRecord do write(ProgFile, Programs[Count]); closeFile(ProgFile); end; end; procedure LoadRecords; var ProgFile : file of TProg; begin assignFile(ProgFile, FILENAME); reset(ProgFile); LastRecord := 0; while not eof(Progfile) do begin inc(LastRecord); read(ProgFile, Programs[LastRecord]); end; closeFile(ProgFile); end; begin Init; repeat writeln(#13#10'Please type the number of your choice.'); writeln('1 - Insert a record'); writeln('2 - Save records'); writeln('3 - Load records (requires Progs.txt)'); writeln('4 - Display records'); writeln('5 - Bubble sort on program ID'); writeln('6 - Bubble sort on program name'); writeln('7 - Insertion Sort on program ID'); writeln('8 - Quicksort on program ID'); writeln('9 - Find a record by linear/sequential search using Program ID'); writeln(' (You need to sort the file using option 5, 7 or 8 first).'); writeln('10 - Find a record by binary search on Program ID'); writeln('11 - Edit a record'); writeln('12 - Delete a record'); writeln('13 - Quit'); readln(Choice); case choice of 1 : begin write('Which program ID would you like to insert? '); readln(SelectedID); InsertRecord(SelectedID); end; 2 : begin writeln('Saving records'); SaveRecords; end; 3 : begin writeln('Loading records'); LoadRecords; end; 4 : DisplayRecords; 5 : begin writeln('Bubble sort on program ID'); BubbleSort(1); end; 6 : begin writeln('Bubble sort on program Name'); BubbleSort(2); end; 7 : begin writeln('Insertion sort on program ID'); InsertionSort; end; 8 : begin writeln('Quicksort on program ID'); QuickSort(1, LastRecord); end; 9 : begin write('What is the ID of the record to find? '); readln(SelectedID); Find (SelectedID, FoundRecord ); end; 10 : begin write('What is the ID of the record to find? '); readln(SelectedID); BinarySearch (SelectedID, 1, LastRecord); end; 11 : begin write('What is the ID of the record to edit? '); readln(SelectedID); Edit(SelectedID); end; 12 : begin write('What is the ID of the record to delete? '); readln(SelectedID); Delete(SelectedID); end; end;//case until Choice = 13; end.