SRL Archive - OSR Help

Bubble sort

Awkwardsaw

2013-07-23 19:56:17

I'm looking for a way to sort out a TExtendedArray. Through google I found this:
Procedure BubbleSort(var a:TExtendedArray; size:integer);
var
  i,j : integer;
  temp : extended;
begin
   for i:=1 to size-1 do
    for j:=1 to size do
     if a[i]>a[j] then
        begin
         temp:=a[i];
         a[i]:=a[j];
         a[j]:=temp;
        end;
end;

And all the other sources that i've seen match this algorithm. The problem is, it doesn't work :\

When I tried doing this:
program new;

var
  colors : TExtendedArray;
Procedure BubbleSort(var a:TExtendedArray; size:integer);
var
  i,j : integer;
  temp : extended;
begin
   for i:=1 to size-1 do
    for j:=1 to size do
     if a[i]>a[j] then
        begin
         temp:=a[i];
         a[i]:=a[j];
         a[j]:=temp;
        end;
end;
begin

Colors := [0.1, 0.5, 0.77, 0.6, 0.07];
BubbleSort(Colors, 4);
BubbleSort(Colors, 4);
BubbleSort(Colors, 4);// I decided to try sorting out multiple times, but it really doesnt do anything
BubbleSort(Colors, 4);
BubbleSort(Colors, 4);
writeln(Colors);
end.

I return with: 

[ 1.0000000000000000E-0001,  8.0000000000000000E-0001,  7.7000000000000000E-0001,  7.0000000000000000E-0002,  5.0000000000000000E-0001]

Help? :) I've never played with any sorting algos, so I really don't know what I'm doing :p

Sin

2013-07-23 20:54:36

EDIT: @Awkwardsaw
Im not too sure why this is happening. I rewrote the entire Bubble Sort proc, and this is what happens:

program new;

var
  colors : TExtendedArray;
  var
  x:Integer;
Procedure BubbleSort(var a:TExtendedArray; size:integer);
var
  i,j : integer;
  temp : extended;
  flag:boolean;
begin
  while (flag) do
  begin
    flag := false;
    for j := 0 to Length(a)-1 do
    begin
      if (a[j] < a[j+1]) then
      begin
        temp := a[j];
        a[j] := a[j+1];
        a[j+1] := temp;
        flag := true;
      end;
    end;
  end;
end;
begin
  setlength(Colors,5);
  Colors := [0.1, 0.5, 0.77, 0.6, 0.07];
  BubbleSort(Colors, 4);

  for x := 0 to Length(Colors)-1 do
  begin
    writeLn('Colors: ' + ToStr(x) + ' at ' + ToStr(Colors[x]));
  end;
end.


Compiled successfully in 15 ms.
Colors: 0 at 0.1
Colors: 1 at 0.5
Colors: 2 at 0.77
Colors: 3 at 0.6
Colors: 4 at 0.07
Successfully executed.



Well then..

Nvm, im terrible:


program new;

var
  colors : TExtendedArray;
  var
  x:Integer;
Procedure BubbleSort(var a:TExtendedArray; size:integer);
var
  i,j : integer;
  temp : extended;
  flag:boolean;
begin
  writeln('hi');
  flag := true;
  while (flag) do
  begin
    flag := false;

    for j := 0 to Length(a)-2 do
    begin

      writeln('trying to see if swap');
      if (a[j] < a[j+1]) then
      begin
      writeln('swapping');
        temp := a[j];
        a[j] := a[j+1];
        a[j+1] := temp;
        flag := true;
      end;
    end;
  end;
end;
begin
  setlength(Colors,5);
  Colors := [0.1, 0.5, 0.77, 0.6, 0.07];
  BubbleSort(Colors, 4);

  for x := 0 to Length(Colors)-1 do
  begin
    writeLn('Colors: ' + ToStr(x) + ' at ' + ToStr(Colors[x]));
  end;
end.

Remove the writelns, and you're good to go.

Compiled successfully in 15 ms.
hi
trying to see if swap
swapping
trying to see if swap
swapping
trying to see if swap
swapping
trying to see if swap
trying to see if swap
Error: Out Of Range at line 23
[Hint] C:\Simba\Scripts\bubblesort.simba(10:3): Variable 'I' never used at line 9
Compiled successfully in 16 ms.
hi
trying to see if swap
swapping
trying to see if swap
swapping
trying to see if swap
swapping
trying to see if swap
trying to see if swap
swapping
trying to see if swap
swapping
trying to see if swap
trying to see if swap
trying to see if swap
trying to see if swap
trying to see if swap
trying to see if swap
Colors: 0 at 0.77
Colors: 1 at 0.6
Colors: 2 at 0.5
Colors: 3 at 0.1
Colors: 4 at 0.07

Le Jingle

2013-07-23 21:17:18

Janilabo has libraries for this, but I think a better (perhaps not best depending..) approach may be in some case,

program LJ_Sort_MachCode;

procedure QuickSortTEA(var arr: TExtendedArray; left, right: Integer);
var
  pivot: Extended;
  l, r: Integer;
begin
  pivot := arr[(left + right) / 2];
  l := left;
  r := right;
  while (l <= r) do
  begin
    while (arr[l] < pivot) do
      Inc(l);
    while (arr[r] > pivot) do
      Dec(r);
    if (l <= r) then
    begin
      Swap(arr[l], arr[r]);
      Inc(l);
      Dec(r);
    end;
  end;
  if (left < r) then
    QuickSortTEA(arr, left, r);
  if (l < right) then
    QuickSortTEA(arr, l, right);
end;

var i: Integer;
var s: string;
var someArr: TExtendedArray;

begin
  s := '';
  someArr := [5.0, 10.0, 1.0, 0.5];
  QuickSortTEA(someArr, 0, high(someArr));
  for i := 0 to high(someArr) do
  begin
    if (i <> 0) then
      s := s + ', ';
    s := s + IntToStr(Round(someArr[i]));
  end;
  WriteLn(s);
end.

-Lj

Kasi

2013-07-23 22:14:11

Quicksort is better then bubblesort. Bubblesort has the maximum number of compares.


program new;

var
  Colors : TExtendedArray;

Procedure BubbleSort(var A :TExtendedArray);
var
  I, II : integer;
  Temp : Extended;
begin
  for I := 0 to High(A) do
    for II := 0 to (High(A) - 1) do
      if A[I] < A[II] then
      begin
        Temp := A[I];
        A[I] := A[II];
        A[II] := Temp;
      end;
end;

begin
  Setlength(Colors,5);
  Colors := [0.1, 0.5, 0.77, 0.6, 0.07];
  Writeln(Colors);
  BubbleSort(Colors);
  Writeln(Colors);
end.

Janilabo

2013-07-24 03:48:03

Seems like ToStr() goes crazy with TExtendedArrays.

Run this and you'll see what you mean:

function TEAToStr(TEA: TExtendedArray): string;
var
  h, i: Integer;
begin
  h := High(TEA);
  Result := '[';
  if (h > -1) then
  begin
    for i := 0 to (h - 1) do
      Result := (Result + FloatToStr(TEA[i]) + ', ');
    Result := (Result + FloatToStr(TEA[i]));
  end;
  Result := (Result + ']');
end;

var
  TEA: TExtendedArray;

begin
  TEA := [0.1, 0.55, 2.59, 55454.223];
  WriteLn(TEA);
  WriteLn('ToStr(TEA): ' + ToStr(TEA));
  WriteLn('TEAToStr(TEA): ' + TEAToStr(TEA));
end.

Awkwardsaw

2013-07-24 07:04:18

Thanks a ton for the help guys :)