LinkedListDemo
Throughout the code of program LinkedListDemo, PtrFirst, PtrCurrent, PtrPred, and PtrSucc are the pointers of the first record, the current record, its predecessor and its successor, respectively. The program structure is very similar to that of program ListDemo so that you can compare corresponding procedures. You can use our test file, (Progs.dat), available for download here.
The following notes should help you to understand the code for some key procedures.
In the complicated procedure InsertRecord, the instruction new(PtrNew)creates a pointer to a new record together with a new record of type TProg. The record is then populated. The caret after the pointer name in the instruction PtrNew^.ProgramID := InsertID dereferences the pointer, allowing a value to be assigned to the ProgramID field of the record. The instruction PtrNew^.Next := nil; initialises the Next field to nil, the value it should have when it is not pointing to another record. We do not need change this value if the record is last in the list.
- the only record (PtrFirst);
- the first (PtrFirst and PtrFirst.Next);
- between the first and last (PtrPred.Next and PtrNew.Next);
- the last (PtrPred.Next).
if PtrCurrent^.ProgramID > PtrNew^.ProgramID then ...If the correct position is found before the end, the insertion is achieved by assigning values to the Next pointers of the new record and of its predecessor:
PtrNew^.Next := PtrCurrent; PtrPred^.Next := PtrNew;
Procedure Find employs the same navigation code as procedure Insert and is more straightforward. We use its variable parameters to change the values of the global variables PtrFound and PtrPred.
Procedure Delete calls procedure Find and uses simple code to remove a record from the list. The assignments PtrFirst := PtrFound^.Next and PtrPred^.Next := PtrFound^.Next delete the first record and any other record, respectively.
Please refer to our notes on program BubbleSortDemo in the following section for the explanation of the complex procedure BubbleSort.
The code follows. Many thanks to Jussi Salmela for both spotting deficiencies in the original version and for providing this corrected solution.
program LinkedListDemo; {$APPTYPE CONSOLE} {$mode objfpc}{$H+} uses {$IFDEF UNIX} {$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} Classes, SysUtils, StrUtils; type PtrProg = ^TProg; //PtrProg is a type of pointer to the record of type Tprog. TProg = record ProgramID: integer; ProgName: string[15]; ProgrammerID: integer; Next: PtrProg; end; const FILENAME = 'Progs.dat'; var PtrFirst, PtrFound, PtrPred: PtrProg; Choice, SelectedID: integer; procedure InsertRecord(InsertID: integer); var PtrNew, PtrCurrent: PtrProg; Inserted: boolean; begin Inserted := False; PtrPred := nil; new(PtrNew); PtrNew^.ProgramID := InsertID; Write('Program Name? '); readln(PtrNew^.ProgName); Write('Programmer ID? '); readln(PtrNew^.ProgrammerID); PtrNew^.Next := nil; if PtrFirst = nil then begin PtrFirst := PtrNew; writeln(' Record added. No others in list.'); end else begin if PtrFirst^.ProgramID > PtrNew^.ProgramID then begin PtrNew^.Next := PtrFirst; PtrFirst := PtrNew; writeln(' Inserted as first record'); Inserted := True; end else begin PtrPred := PtrFirst; PtrCurrent := PtrFirst^.Next; while (Inserted = False) and (PtrCurrent <> nil) do if PtrCurrent^.ProgramID > PtrNew^.ProgramID then begin PtrNew^.Next := PtrCurrent; PtrPred^.Next := PtrNew; Inserted := True; end else begin PtrPred := PtrCurrent; PtrCurrent := PtrCurrent^.Next; end; if Inserted = True then begin writeln(' New record inserted'); end else begin PtrPred^.Next := PtrNew; writeln(' New record appended'); end; end; //if PtrFirst^.ProgramID > PtrNew^.ProgramID end;//if PtrFirst = nil end; procedure DisplayRecord(RecPtr: PtrProg); begin writeln(' Program ID: ', RecPtr^.ProgramID, ' Name: ', RecPtr^.ProgName, DupeString(' ', 14 - Length(RecPtr^.ProgName)), 'Programmer ID: ', RecPtr^.ProgrammerID); end; procedure DisplayRecords; var PtrCurrent: PtrProg; begin if PtrFirst = nil then writeln(' No records to display') else begin PtrCurrent := PtrFirst; repeat DisplayRecord(PtrCurrent); PtrCurrent := PtrCurrent^.Next; until PtrCurrent = nil; end; end; procedure Find(ProgID: integer; var PtrPred, PtrFound: PtrProg); var PtrCurrent: PtrProg; begin PtrFound := nil; if PtrFirst <> nil then begin PtrPred := nil; PtrCurrent := PtrFirst; repeat if PtrCurrent^.ProgramID = ProgID then begin PtrFound := PtrCurrent; end else begin PtrPred := PtrCurrent; PtrCurrent := PtrCurrent^.Next; end; until (PtrFound <> nil) or (PtrCurrent = nil); end; end; procedure Delete(DeleteID: integer); begin Find(DeleteID, PtrPred, PtrFound); if PtrFound <> nil then begin DisplayRecord(PtrFound); writeln(' Deleting'); if PtrPred = nil then PtrFirst := PtrFound^.Next else PtrPred^.Next := PtrFound^.Next; dispose(ptrFound); end else writeln(' Record with ID ', DeleteID, ' can''t be found'); end; procedure Edit(EditID: integer); var Response: char; begin Find(EditID, PtrPred, PtrFound); if PtrFound <> nil then begin DisplayRecord(PtrFound); 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(PtrFound^.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(PtrFound^.ProgrammerID); writeln(' New ID entered'); end; end else writeln(' Record with ID ', EditID, ' can''t be found'); end; procedure BubbleSort; var PtrCurrent, PtrPred, PtrSucc, PtrEnd, PtrTemp: PtrProg; NoSwaps: boolean; begin if PtrFirst = nil then begin writeln(' No records to sort'); end else begin if PtrFirst^.Next = nil then begin writeln(' Cannot sort 1 record.'); end else begin PtrEnd := nil; NoSwaps := False; while NoSwaps = False do begin //start of loop comparing pairs of RecordIDs NoSwaps := True; PtrSucc := PtrFirst^.Next; PtrCurrent := PtrFirst; PtrPred := nil; while (PtrSucc <> PtrEnd) do begin if PtrCurrent^.ProgramID > PtrSucc^.ProgramID then begin Noswaps := False; PtrTemp := PtrSucc^.Next; //Save pointer PtrSucc^.Next := PtrCurrent; if PtrPred = nil then //Swap first two records and prepare for next swap begin //New first will be old second. Its .Next has been set already PtrFirst := PtrSucc; end else begin PtrPred^.Next := PtrSucc; end; PtrPred := PtrSucc; //New Pred. Its .Next must point to new current //New Succ will be successor of old Succ. Its pointer is OK PtrSucc := PtrTemp; PtrCurrent^.Next := PtrSucc; PtrPred^.Next := PtrCurrent; end else //No swap begin //Prepare for new comparison PtrPred := PtrCurrent; PtrCurrent := PtrSucc; PtrSucc := PtrSucc^.Next; end; end;//while PtrEnd := PtrCurrent; end; //while NoSwaps = False; end; end; end; procedure Init; begin PtrFirst := nil; // empty list ==> no first PtrPred := nil; // empty list ==> no predecessor end; procedure SaveRecords; var ProgFile: file of TProg; PtrCurrent: PtrProg; begin if PtrFirst = nil then writeln(' No records to save') else begin assignFile(ProgFile, Filename); rewrite(ProgFile); PtrCurrent := PtrFirst; repeat Write(ProgFile, PtrCurrent^); PtrCurrent := PtrCurrent^.Next; until PtrCurrent = nil; closeFile(ProgFile); end; end; procedure LoadRecords; var ProgFile: file of TProg; PtrNew, PtrPred: PtrProg; begin if FileExists(FILENAME) then begin writeln(' Loading records'); assignFile(ProgFile, FILENAME); reset(ProgFile); new(PtrNew); PtrFirst := PtrNew; Read(ProgFile, PtrNew^); while not EOF(Progfile) do begin PtrPred := PtrNew; new(PtrNew); PtrPred^.Next := PtrNew; Read(ProgFile, PtrNew^); end; closeFile(ProgFile); end else writeln(' File ', FILENAME, ' does not exist'); 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.dat)'); writeln('4 - Display records'); writeln('5 - Find a record'); writeln('6 - Edit a record'); writeln('7 - Delete a record'); writeln('8 - Sort by Program ID'); writeln('9 - Quit'); readln(Choice); case choice of 1: begin Write('Which program ID would you like to insert? '); readln(SelectedID); Find(SelectedID, PtrPred, PtrFound); if PtrFound <> nil then begin writeln(' Record with ID ', SelectedID, ' is already inserted:'); DisplayRecord(PtrFound); end else InsertRecord(SelectedID); end; 2: begin writeln(' Saving records'); SaveRecords; end; 3: begin LoadRecords; end; 4: DisplayRecords; 5: begin Write('What is the ID of the record to find? '); readln(SelectedID); Find(SelectedID, PtrPred, PtrFound); if PtrFound <> nil then DisplayRecord(PtrFound) else writeln(' Record with ID ', SelectedID, ' can''t be found'); end; 6: begin Write('What is the ID of the record to edit? '); readln(SelectedID); Edit(SelectedID); end; 7: begin Write('What is the ID of the record to delete? '); readln(SelectedID); Delete(SelectedID); end; 8: begin writeln(' Sorting records'); BubbleSort; end; end;//case until Choice = 9; end.
The bubble sort is tricky to code with pointers and the program in the next section demonstrates its use.