Hello,
Just wanted to contribute my two cents with this homemade Unit
[attached to
the mail] for working with:
- Simple Linked Lists;
- Double Linked Lists;
- Stacks;
Don't know of any other unit that does this, but think it is of use to
the
day-to-day Pascal developer. Feedback would be a bliss. Thank you.
Note: This is a homemade project. I'm going to develop it further than what I
need to do with it, if developers find it usefull. I welcome advices.
(*
Author : Zamfir Catalin Alexandru, 2006/2007;
Version : 0.1;
Licence : GPLv2/GNU;
Description : Helps manage simple lists, double linked lists and stacks. Features like Tails will be added at a later
time. It supports one info: record that accepts anything the "variant" data type can.
Website : http://www.theg33ks.com/
E-Mail : [EMAIL PROTECTED]; [EMAIL PROTECTED]
Purpose : Ease the life of the Pascal developer when working with lists, double liss and stacks.
*)
unit ListsAndStacks;
interface
uses
crt, dos, variants;
type
refsimplu = ^inr;
inr = record
inf: variant;
urm: refsimplu;
end;
refdublu = ^inreg;
inreg = record
ant: refdublu;
inf: variant;
urm: refdublu;
end;
refstiva = ^inregistrare;
inregistrare = record
inf: variant;
urm: refstiva;
end;
refcoada = ^inregcoada;
inregcoada = record
inf: variant;
ant, urm: refcoada;
end;
var
p, c, u: refsimplu;
p2, c2, u2: refdublu;
pstiva, cstiva, ustiva: refstiva;
ccoada, pcoada, ucoada: refcoada;
i, q: integer;
info, t: variant;
procedure CreateSimpleList (c: refsimplu; n: integer);
procedure ListSimpleList (c: refsimplu);
procedure SortSimpleListByInfoN (c: refsimplu);
function ExistsInSimpleList (c: refsimplu; cauta: variant): boolean;
function SumOfElementsInSimpleList (c: refsimplu): extended;
function MultipleOfElementsInSimpleList (c: refsimplu): extended;
function SumOfNElementsInSimpleList (c: refsimplu; n: integer): extended;
function MultipleOfNElementsInSimpleList (c: refsimplu; n: integer): extended;
function CountElementsInSimpleList (c: refsimplu): integer;
function ArithmeticMediumInSimpleList (c: refsimplu): extended;
function MaximumOfSimpleList (c: refsimplu): extended;
function MinimumOfSimpleList (c: refsimplu): extended;
function ElementOfSimpleList (c: refsimplu; n: integer): variant;
procedure AddBeforeFirstOneInSimpleList (c: refsimplu; info: variant);
procedure AddBeforeLastInSimpleList (c: refsimplu; info: variant);
procedure AddAfterNInSimpleList (c: refsimplu; info: variant; n: integer);
procedure ModifyNElementInSimpleList (c: refsimplu; info: variant; n: integer);
procedure DeleteNElementInSimpleList (c: refsimplu; n: integer);
procedure DeleteLastInSimpleList (c: refsimplu);
procedure DeleteFirstInSimpleList (c: refsimplu);
procedure CreateDoubleList (c2: refdublu; info: variant; n: integer);
procedure ListDoubleListLeftRight (c2: refdublu);
procedure ListDoubleListRightLeft (c2: refdublu);
procedure AddBeforeFirstInDoubleList (c2: refdublu; info: variant);
procedure AddAfterLastInDoubleList (c2: refdublu; info: variant);
procedure AddAfterNElementInDoubleList (c2: refdublu; info: variant; n: integer);
procedure DeleteFirstInDoubleList (c2: refdublu);
procedure DeleteLastInDoubleList (c2: refdublu);
procedure DeleteNElementInDoubleList (c2: refdublu; n: integer);
procedure SortDoubleListByInfoN (c2: refdublu);
function ExistsInDoubleList (c2: refdublu; cauta: variant; n: integer): boolean;
function SumOfElementsInDoubleList (c2: refdublu): extended;
function SumOfNElementsInDoubleList (c2: refdublu; n: integer): extended;
function MultipleOfElementsInDoubleList (c2: refdublu): extended;
function MultipleOfNElementsInDoubleList (c2: refdublu; n: integer): extended;
function CountElementsInDoubleList (c2: refdublu): extended;
function ArithmeticMediumInDoubleList (c2: refdublu): extended;
function MaximumOfDoubleList (c2: refdublu): extended;
function MinimumOfDoubleList (c2: refdublu): extended;
function ElementOfDoubleList (c2: refdublu; n: integer): variant;
procedure ModifyNElementInDoubleList (c2: refdublu; info: variant; n: integer);
procedure CreateStack (var pstiva: refstiva; info: variant);
procedure DeteleOneFromStack (var pstiva: refstiva);
function CountAllInStack (var pstiva: refstiva): integer;
function ElementFromTheStack (cstiva: refstiva; n: integer): variant;
implementation
{ ############## Simple Lists ############## }
procedure CreateSimpleList (c: refsimplu; n: integer);
begin
info := 0; { ### Make it 0 so we can modify each one individually at a later time. ### }
new (c);
c^.inf := info;
c^.urm := nil;
p := c;
u := c;
for i := 2 to n do
begin
new (c);
c^.inf := info;
c^.urm := nil;
u^.urm := c;
u := c;
end;
end;
procedure ListSimpleList (c: refsimplu);
begin
c := p;
while (c <> nil) do
begin
write (c^.inf,' ');
c := c^.urm;
end;
end;
procedure SortSimpleListByInfoN (c: refsimplu);
begin
repeat
q := 1;
c := p;
while (c^.urm <> nil) do
begin
if (c^.inf > c^.urm^.inf) then
begin
t := c^.inf;
c^.inf := c^.urm^.inf;
c^.urm^.inf := t;
q := 0;
end;
c := c^.urm;
end;
until q = 1;
end;
function ExistsInSimpleList (c: refsimplu; cauta: variant): boolean;
begin
c := p;
while (c <> nil) do
begin
if (c^.inf = cauta) then
ExistsInSimpleList := TRUE
else
ExistsInSimpleList := FALSE;
c := c^.urm;
end;
end;
function SumOfElementsInSimpleList (c: refsimplu): extended;
var
s: extended;
begin
s := 0;
c := p;
while (c <> nil) do
begin
if (c^.inf <> 0) then
s := s + c^.inf;
c := c^.urm;
end;
SumOfElementsInSimpleList := s;
end;
function SumOfNElementsInSimpleList (c: refsimplu; n: integer): extended;
var
s: extended;
begin
s := 0;
c := p;
for i := 1 to n do
begin
if (c^.inf <> 0) then
s := s + c^.inf;
c := c^.urm;
end;
SumOfNElementsInSimpleList := s;
end;
function MultipleOfElementsInSimpleList (c: refsimplu): extended;
var
pr: extended;
begin
pr := 1;
c := p;
while (c <> nil) do
begin
if (c^.inf > 0) then
pr := pr * c^.inf;
if (c^.inf < 0) then
pr := pr * c^.inf;
c := c^.urm;
end;
MultipleOfElementsInSimpleList := pr;
end;
function MultipleOfNElementsInSimpleList (c: refsimplu; n: integer): extended;
var
pr: extended;
begin
pr := 1;
c := p;
for i := 1 to n do
begin
if (c^.inf > 0) then
pr := pr * c^.inf;
if (c^.inf < 0) then
pr := pr * c^.inf;
c := c^.urm;
end;
MultipleOfNElementsInSimpleList := pr;
end;
function CountElementsInSimpleList (c: refsimplu): integer;
var
sum: integer;
begin
c := p;
sum := 0;
while (c <> nil) do
begin
sum := sum + 1;
c := c^.urm;
end;
CountElementsInSimpleList := sum;
end;
function ArithmeticMediumInSimpleList (c: refsimplu): extended;
var
media: extended;
s: extended;
num: integer;
begin
s := 0;
num := 0;
c := p;
while (c <> nil) do
begin
if (c^.inf <> 0) then
begin
num := num + 1;
s := S + c^.inf;
end;
c := c^.urm;
end;
if num <> 0 then
begin
media := S/num;
ArithmeticMediumInSimpleList := media;
end;
end;
function MaximumOfSimpleList (c: refsimplu): extended;
var
max: extended;
begin
c := p;
while (c <> nil) and not (c^.inf > 0) do
c := c^.urm;
if (c = nil) then
MaximumOfSimpleList := 0
else
begin
max := c^.inf;
while (c <> nil) do
begin
if (c^.inf > max) and (c^.inf <> 0) then
max := c^.inf;
c := c^.urm;
end;
MaximumOfSimpleList := max;
end;
end;
function MinimumOfSimpleList (c: refsimplu): extended;
var
min: extended;
begin
c := p;
while (c <> nil) and not (c^.inf > 0) do
c := c^.urm;
if (c= nil) then
MinimumOfSimpleList := 0
else
begin
min := c^.inf;
while (c <> nil) do
begin
if (c^.inf < min) and (c^.inf <> 0) then
min := c^.inf;
c := c^.urm;
end;
MinimumOfSimpleList := min;
end;
end;
function ElementOfSimpleList (c: refsimplu; n: integer): variant;
begin
c := p;
for i := 1 to n - 1 do
c := c^.urm;
ElementOfSimpleList := c^.inf;
end;
procedure AddBeforeFirstOneInSimpleList (c: refsimplu; info: variant);
begin
new (c);
c^.inf := info;
c^.urm := p;
p := c;
end;
procedure AddBeforeLastInSimpleList (c: refsimplu; info: variant);
begin
new (c);
c^.inf := info;
c^.urm := nil;
u^.urm := c;
u := c;
end;
procedure AddAfterNInSimpleList (c: refsimplu; info: variant; n: integer);
var
q: refsimplu;
begin
c := p;
for i := 1 to n - 1 do
c := c^.urm;
new (q);
q^.inf := info;
q^.urm := c^.urm;
c^.urm := q;
end;
procedure ModifyNElementInSimpleList (c: refsimplu; info: variant; n: integer);
begin
c := p;
for i:= 1 to n - 1 do
c := c^.urm;
c^.inf := info;
end;
procedure DeleteNElementInSimpleList (c: refsimplu; n: integer);
var
q, t: refsimplu;
begin
c := p;
for i := 1 to n do
begin
t := c;
c := c^.urm;
end;
q := c;
t^.urm := c^.urm;
dispose (q);
end;
procedure DeleteLastInSimpleList (c: refsimplu);
var
q, t: refsimplu;
begin
c := p;
while (c <> u) do
begin
t := c;
c := c^.urm;
end;
q := c;
t^.urm := nil;
u := t;
dispose (q);
end;
procedure DeleteFirstInSimpleList (c: refsimplu);
var
q: refsimplu;
begin
q := p;
p := p^.urm;
dispose (q);
end;
{############## Double Lists ############## }
procedure CreateDoubleList (c2: refdublu; info: variant; n: integer);
begin
new (c2);
c2^.inf := info;
c2^.urm := nil;
c2^.ant := nil;
p2 := c2;
u2 := c2;
for i := 2 to n do
begin
new (c2);
c2^.inf := info;
c2^.urm := nil;
c2^.ant := u2;
u2^.urm := c2;
u2 := c2;
end;
end;
procedure ListDoubleListLeftRight (c2: refdublu);
begin
c2 := p2;
while (c2 <> nil) do
begin
write (c2^.inf, ' ');
c2 := c2^.urm;
end;
end;
procedure ListDoubleListRightLeft (c2: refdublu);
begin
c2 := u2;
while (c2 <> nil) do
begin
write (c2^.inf, ' ');
c2 := c2^.urm;
end;
end;
procedure AddBeforeFirstInDoubleList (c2: refdublu; info: variant);
begin
new (c2);
c2^.inf := info;
c2^.urm := p2;
p2^.ant := c2;
c2^.ant := nil;
p2 := c2;
end;
procedure AddAfterLastInDoubleList (c2: refdublu; info: variant);
begin
new (c2);
c2^.inf := info;
c2^.urm := nil;
c2^.ant := u2;
u2^.urm := c2;
u2 := c2;
end;
procedure AddAfterNElementInDoubleList (c2: refdublu; info: variant; n: integer);
var
q: refdublu;
begin
c2 := p2;
for i := 1 to n - 1 do
c2 := c2^.urm;
new (q);
q^.inf := info;
q^.urm := c2^.urm;
c2^.urm^.ant := q;
q^.ant := c2;
c2^.urm := q;
end;
procedure DeleteFirstInDoubleList (c2: refdublu);
var
q: refdublu;
begin
q := p2;
p2 := p2^.urm;
p2^.ant := nil;
dispose (q);
end;
procedure DeleteLastInDoubleList (c2: refdublu);
var
q: refdublu;
begin
q := c2;
u2 := u2^.ant;
u2^.urm := nil;
dispose(q);
end;
procedure DeleteNElementInDoubleList (c2: refdublu; n: integer);
var
q: refdublu;
begin
c2 := p2;
for i := 1 to n - 1 do
c2 := c2^.urm;
q := c2;
c2^.ant^.urm := c2^.urm;
c2^.urm^.ant := c2^.ant;
dispose (q);
end;
procedure SortDoubleListByInfoN (c2: refdublu);
begin
repeat
q := 1;
c2 := p2;
while (c2^.urm <> nil) do
begin
if (c2^.inf > c2^.urm^.inf) then
begin
t := c2^.inf;
c2^.inf := c2^.urm^.inf;
c2^.urm^.inf := 1;
q := 0;
end;
c2 := c2^.urm;
end;
until q = 1;
end;
function ExistsInDoubleList (c2: refdublu; cauta: variant; n: integer): boolean;
begin
c2 := p2;
while (c2 <> nil) do
begin
if (c2^.inf = cauta) then
ExistsInDoubleList := TRUE
else
ExistsInDoubleList := FALSE;
c2 := c2^.urm;
end;
end;
function SumOfElementsInDoubleList (c2: refdublu): extended;
var
s: extended;
begin
s := 0;
c2 := p2;
while (c2 <> nil) do
begin
if (c2^.inf <> 0) then
s := s + c2^.inf;
c2 := c2^.urm;
end;
SumOfElementsInDoubleList := s;
end;
function SumOfNElementsInDoubleList (c2: refdublu; n: integer): extended;
var
s: extended;
begin
s := 0;
c2 := p2;
for i := 1 to n do
begin
if (c2^.inf <> 0) then
s := s + c2^.inf;
c2 := c2^.urm;
end;
SumOfNElementsInDoubleList := s;
end;
function MultipleOfElementsInDoubleList (c2: refdublu): extended;
var
pr: extended;
begin
pr := 1;
c2 := p2;
while (c2 <> nil) do
begin
if (c2^.inf <> 0) then
pr := pr * c2^.inf
else
pr := 0;
c2 := c2^.urm;
end;
MultipleOfElementsInDoubleList := pr;
end;
function MultipleOfNElementsInDoubleList (c2: refdublu; n: integer): extended;
var
pr: extended;
begin
pr := 1;
c2 := p2;
for i := 1 to n do
begin
if (c2^.inf <> 0) then
pr := pr * c2^.inf
else
pr := 0;
c2 := c2^.urm;
end;
MultipleOfNElementsInDoubleList := pr;
end;
function CountElementsInDoubleList (c2: refdublu): extended;
var
sum: integer;
begin
c := p;
sum := 0;
while (c <> nil) do
begin
sum := sum + 1;
c2 := c2^.urm;
end;
CountElementsInDoubleList := sum;
end;
function ArithmeticMediumInDoubleList (c2: refdublu): extended;
var
media, s: extended;
num: integer;
begin
s := 0;
num := 0;
c2 := p2;
while (c2 <> nil) do
begin
if (c2^.inf <> 0) then
begin
num := num + 1;
s := s + c2^.inf;
end;
c2 := c2^.urm;
end;
if num <> 0 then
begin
media := s/num;
ArithmeticMediumInDoubleList := media;
end;
end;
function MaximumOfDoubleList (c2: refdublu): extended;
var
max: extended;
begin
c2 := p2;
while (c2 <> nil) and not (c2^.inf > 0) do
c2 := c2^.urm;
if (c2 = nil) then
MaximumOfDoubleList := 0
else
begin
max := c2^.inf;
while (c2 <> nil) do
begin
if (c2^.inf > max) and (c2^.inf <> 0) then
max := c2^.inf;
c2 := c2^.urm;
end;
MaximumOfDoubleList := max;
end;
end;
function MinimumOfDoubleList (c2: refdublu): extended;
var
min: extended;
begin
c2 := p2;
while (c2 <> nil) and not (c2^.inf > 0) do
c2 := c2^.urm;
if (c2 = nil) then
MinimumOfDoubleList := 0
else
begin
min := c2^.inf;
while (c2 <> nil) do
begin
if (c2^.inf < min) and (c2^.inf <> 0) then
min := c2^.inf;
c2 := c2^.urm;
end;
MinimumOfDoubleList := min;
end;
end;
function ElementOfDoubleList (c2: refdublu; n: integer): variant;
begin
c2 := p2;
for i := 1 to n - 1 do
c2 := c2^.urm;
ElementOfDoubleList := c2^.inf;
end;
procedure ModifyNElementInDoubleList (c2: refdublu; info: variant; n: integer);
begin
c2 := p2;
for i := 1 to n - 1 do
c2 := c2^.urm;
c2^.inf := info;
end;
{ ############## Stacks ############## }
procedure CreateStack (var pstiva: refstiva; info: variant);
begin
new (cstiva);
cstiva^.inf := info;
cstiva^.urm := pstiva;
pstiva := cstiva;
end;
procedure DeteleOneFromStack (var pstiva: refstiva);
begin
if pstiva = nil then
write ('The stack is empty!')
else
begin
cstiva := pstiva;
pstiva := pstiva^.urm;
dispose (c);
end;
end;
function CountAllInStack (var pstiva: refstiva): integer;
var
sum: integer;
begin
while (pstiva <> nil) do
begin
sum := sum + 1;
pstiva := pstiva^.urm;
end;
CountAllInStack := sum;
end;
function ElementFromTheStack (cstiva: refstiva; n: integer): variant;
begin
for i := 1 to n - 1 do
pstiva := pstiva^.urm;
ElementFromTheStack := pstiva^.inf;
end;
(*
To Do @ Later Time:
- Tails;
- Testing;
- New Stuff, if it's OK to add it.
*)
begin
end.
pgpKO8DUebqJY.pgp
Description: PGP signature
_______________________________________________ fpc-pascal maillist - fpc-pascal@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-pascal
