Pascal Bubble Sort - pascal

I have a project where the program must accept 10 words and display the words in descending order (alphabetical order from Z-A)
using bubble sorting.
Here's what I know so far:
Program sample;
uses crt;
TYPE
no._list=ARRAY(1...10)OF REAL;
CONST
no.:no._list=(20.00,50.50.35.70....);
VAR
x:INTEGER;
small:REAL;
BEGIN clrscr:
small:=no.(1);
FOR x:=2 TO 10 DO
IF small>number(x);
writeln('Smallest value in the array of no.s is',small:7:2);
END
I really don't know how to do this though and could use some help.

Here's a video by Alister Christie on Bubble sort describing the principle :
http://codegearguru.com/index.php?option=com_content&task=view&id=64&Itemid=1
The algorithm in Pascal can be found # http://delphi.wikia.com/wiki/Bubble_sort

function BubbleSort( list: TStringList ): TStringList;
var
i, j: Integer;
temp: string;
begin
// bubble sort
for i := 0 to list.Count - 1 do begin
for j := 0 to ( list.Count - 1 ) - i do begin
// Condition to handle i=0 & j = 9. j+1 tries to access x[10] which
// is not there in zero based array
if ( j + 1 = list.Count ) then
continue;
if ( list.Strings[j] > list.Strings[j+1] ) then begin
temp := list.Strings[j];
list.Strings[j] := list.Strings[j+1];
list.Strings[j+1] := temp;
end; // endif
end; // endwhile
end; // endwhile
Result := list;
end;

Related

Insertion Sort - TStringList Delphi

i'm trying to sort TStringList of integers from a text file with Insertion and Selection Sort .Selection Sort works ok , but the Insertion Sort doesnt work with my code . Can someone tell me where i'm wrong ? My 'numbers.txt' has 5000 lines of numbers. Thanks in advance
UPDATE : I have edited my code a bit , it works now with Insertion-Sort but it sorts just 4 indexes of integer as on the image
var
i, Position, n: integer;
Value: string;
begin
n := Items.Count;
for i := 1 to n - 1 do
begin
Value := Items[i];
Position := i-1;
while (Position >0) and (Items[Position]>Value) do
begin
Items[Position+1]:= Items[Position] ;
Position := Position -1 ;
end;
Items[Position+1] := Value;
end;
end;
Your data in the image is sorting exactly as it should, because you're sorting on string values, and based on the comparison you're making the order is perfect. "1143" falls exactly between the string values "11413" and "11443", because the comparison is made character by character out to the length of the shortest of the values. "1141" < "1143" < "1144", based on the first four characters of each string.
If you want an actual integer sort, then you need to convert the two values to integer before comparing them. Something like this should work (note I did not test your overall sort logic - I just used values that demonstrate the concept):
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Classes;
var
i, Position, n: integer;
Value: integer;
Items: TStringList;
begin
Items := TStringList.Create;
try
Items.DelimitedText := '1116,11170,11178,11206,1122,11221,11228';
n := Items.Count;
for i := 1 to n - 1 do
begin
Value := StrToInt(Items[i]);
Position := i - 1;
while (Position > 0) and (StrToInt(Items[Position]) > Value) do
begin
Items[Position + 1]:= Items[Position];
Position := Position - 1 ;
end;
Items[Position+1] := IntToStr(Value);
end;
for i := 0 to Items.Count - 1 do
WriteLn(Items[i]);
finally
Items.Free;
end;
ReadLn;
end.
The output I got from the code above in a console window:
1116
1122
11170
11178
11206
11221
11228

Delphi - descending sort of string grid rows, sorting by 1 column

I've run into a bit of a wall with my sorting, I managed to sort the rows of my string grid from smallest to largest but now I'm not sure how to sort it in descending order. I've tried using the code I used from the other sort and I only changed the 2nd last loop in the code to see if I can read from the bottom of the TStringList, but it hasn't worked and only takes one row from the list and duplicates it into the rest of the rows. Is there perhaps a way to reverse read a TStringList after sorting?
Code I used for the other sort I have and tried to implement for this sort (only changed the 2nd last loop):
procedure TfrmPuntehou.SortLTSGrid(var grid: TStringGrid; columntotal: Integer);
const
separator = ',';
var
iCount,i,j,k,iPos:integer;
TheList:TStringList;
sString,sTempString:string;
m: Integer;
o: Integer;
begin
//procedure to sort from large to small values
//get row amount
iCount:=grid.RowCount-1;
//create list
TheList:=TStringList.Create;
TheList.Sorted:=False;
//start of try..finally block
try
begin
//fill the list
for i := 1 to (iCount - 1) do
begin
TheList.Add(grid.Rows[i].Strings[columntotal]+separator+grid.Rows[i].Text);
end;
//sort the list
TheList.Sort;
for k := 1 to TheList.Count do
begin
//take the line of the list and put it in a string var
sString:= TheList.Strings[(k-1)];
//get separator pos in that string
iPos:=AnsiPos(separator,sString);
sTempString:='';
//remove separator and the column text at the front of the string
sTempString:=Copy(sString,(iPos+1),Length(sString));
TheList.Strings[(k-1)]:= '';
TheList.Strings[(k-1)]:= sTempString;
end;
//fill the grid
for j:= (iCount - 1) downto 1 do
begin
for o := 1 to (iCount - 1) do
begin
grid.Rows[j].Text := TheList.Strings[(o-1)] ;
end;
end;
//fill the row numbers
for m := 1 to iCount do
begin
grid.Cells[0,m]:= IntToStr(m);
end;
end;
finally
TheList.Free;
end;
//end of try..finally block
end;
Thanks in advance for the help!Kind RegardsPrimeBeat
Use TStringList.CustomSort to sort the list using a specific method for comparison.
The specification for the comparer is given here.
Example:
function Compare1( // Normal alphanum sort
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
begin
if List[Index1] = List[Index2] then
Result := 0
else if List[Index1] < List[Index2] then
Result := -1
else
Result := 1;
end;
function Compare2( // Reverse alphanum sort
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
begin
if List[Index1] = List[Index2] then
Result := 0
else if List[Index1] < List[Index2] then
Result := 1
else
Result := -1;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SList : TStringList;
S : String;
begin
SList := TStringList.Create;
try
SList.Add('Pierre');
SList.Add('Albert');
SList.Add('Paul');
SList.Add('Jean');
SList.Add('Simon');
Memo1.Lines.Add('=== Compare1 ===');
SList.CustomSort(Compare1);
for S in SList do
Memo1.Lines.Add(S);
Memo1.Lines.Add('=== Compare2 ===');
SList.CustomSort(Compare2);
for S in SList do
Memo1.Lines.Add(S);
finally
SList.Free;
end;
end;

Read integers from a string

I'm learning algorithms and I'm trying to make an algorithm that extracts numbers lets say n in [1..100] from a string. Hopefully I get an easier algorithm.
I tried the following :
procedure ReadQuery(var t : tab); // t is an array of Integer.
var
x,v,e : Integer;
inputs : String;
begin
//readln(inputs);
inputs:='1 2 3';
j:= 1;
// make sure that there is one space between two integers
repeat
x:= pos(' ', inputs); // position of the space
delete(inputs, x, 1)
until (x = 0);
x:= pos(' ', inputs); // position of the space
while x <> 0 do
begin
x:= pos(' ', inputs); //(1) '1_2_3' (2) '2_3'
val(copy(inputs, 1, x-1), v, e); // v = value | e = error pos
t[j]:=v;
delete(inputs, 1, x); //(1) '2_3' (2) '3'
j:=j+1; //(1) j = 2 (2) j = 3
//writeln(v);
end;
//j:=j+1; // <--- The mistake were simply here.
val(inputs, v, e);
t[j]:=v;
//writeln(v);
end;
I get this result ( resolved ) :
1
2
0
3
expected :
1
2
3
PS : I'm not very advanced, so excuse me for reducing you to basics.
Thanks for everyone who is trying to share knowledge.
Your code is rather inefficient and it also doesn't work for strings containing numbers in general.
A standard and performant approach would be like this:
type
TIntArr = array of Integer;
function GetNumbers(const S: string): TIntArr;
const
AllocStep = 1024;
Digits = ['0'..'9'];
var
i: Integer;
InNumber: Boolean;
NumStartPos: Integer;
NumCount: Integer;
procedure Add(Value: Integer);
begin
if NumCount = Length(Result) then
SetLength(Result, Length(Result) + AllocStep);
Result[NumCount] := Value;
Inc(NumCount);
end;
begin
InNumber := False;
NumCount := 0;
for i := 1 to S.Length do
if not InNumber then
begin
if S[i] in Digits then
begin
NumStartPos := i;
InNumber := True;
end;
end
else
begin
if not (S[i] in Digits) then
begin
Add(StrToInt(Copy(S, NumStartPos, i - NumStartPos)));
InNumber := False;
end;
end;
if InNumber then
Add(StrToInt(Copy(S, NumStartPos)));
SetLength(Result, NumCount);
end;
This code is intentionally written in a somewhat old-fashioned Pascal way. If you are using a modern version of Delphi, you wouldn't write it like this. (Instead, you'd use a TList<Integer> and make a few other adjustments.)
Try with the following inputs:
521 cats, 432 dogs, and 1487 rabbits
1 2 3 4 5000 star 6000
alpha1beta2gamma3delta
a1024b2048cdef32
a1b2c3
32h50s
5020
012 123!
horses
(empty string)
Make sure you fully understand the algorithm! Run it on paper a few times, line by line.

Insert values ordered from least to greatest in an Array

I need to create an array within a register that is a sequence of natural numbers, these are inserted by the user and cannot be repeated. My problem is sorting the array values as they are inserted in ascending order. I have tried this code without success. Thank you.
const
MAX = 10;
type
Natural = 0..MAXINT;
Secuencia = RECORD
valores : ARRAY [1..MAX] OF Natural;
tope : 0..MAX;
END;
TipoResultado = (Fallo, Creado, Agregado);
Resultado = RECORD
CASE quePaso : TipoResultado OF
Fallo: ();
Creado: ();
Agregado: (posicion: Natural);
END;
//Non-repeating value search function in array
Function BLineal(valor: Natural; sec: Secuencia ): boolean;
var i : integer;
begin
i := 1;
while (i <= sec.tope) and (sec.valores[i] <> valor) do
i := i + 1;
BLineal := i <= sec.tope
end;
Procedure to order values within the arrangement from smallest to largest by insertion.
//Procedure ORDER
Procedure OrdIns (var sec: Secuencia);
var
i,j: integer;
aux: Natural;
begin
for i := 2 to sec.tope do begin
j := i;
while (j >= 2) and ((sec.valores[j]) < (sec.valores[j-1])) do
begin
aux:=sec.valores[j-1];
sec.valores[j-1]:=sec.valores[j];
sec.valores[j]:=aux;
j := j - 1
end
end;
end;
Do the problem in two steps. First, create a binary tree and insert values as entered. Then when no more values are found simply walk the tree and create the array.

How to convert a tree recursive function ( or algorithm ) to a loop one?

I have written a recursive Tree Function in pascal ( or delphi ) but i had an 'Out of Memory' message when I ran it.
I need to turn the Calculate recursive function in this code to non-recursive function, can you tell me how please :
program testing(input, output);
type
ptr = ^tr;
tr = record
age: byte;
left, right: ptr;
end;
var
topper: ptr;
total, day: longint;
procedure mycreate(var t: ptr);
var
temp:ptr;
begin
new(temp);
temp^.age := 1;
temp^.left := nil;
temp^.right := nil;
t := temp;
end;
procedure gooneday(var t: ptr);
begin
if t^.age <> 5 then
begin
if t^.age = 2 then
mycreate(t^.left)
else if t^.age = 3 then
mycreate(t^.right);
t^.age := t^.age + 1;
total := total + 1;
end;
end;
procedure calculate(var crnt: ptr);
begin
if crnt <> nil then
begin
gooneday(crnt);
calculate(crnt^.left);
calculate(crnt^.right);
end;
end;
begin
total := 0;
mycreate(topper);
day := 0;
while total < 1000000000000 do
begin
total := 0;
day := day + 1;
calculate(topper);
end;
writeln(day);
writeln(total);
end.
Recursive functions use a stack to keep the state of the recursion.
When converting to a loop, you must actually create an explicit stack. You must push and pop elements off the stack within the loop.

Resources