Results 1 to 7 of 7

Thread: rearrange an array

  1. #1
    Join Date
    Nov 2006
    Posts
    1,103
    Mentioned
    0 Post(s)
    Quoted
    6 Post(s)

    Default rearrange an array

    i need to rearrange an array of array on the length of the arrays, how would i do that?(has to be both from smallest to biggest length)


    thanks in advance
    Infractions, reputation, reflection, the dark side of scripting, they are.

  2. #2
    Join Date
    Sep 2006
    Posts
    6,089
    Mentioned
    77 Post(s)
    Quoted
    43 Post(s)

    Default

    SCAR Code:
    function ReArrangeArrayLength(TheArray: Array of Array of Integer; SmallFirst: Boolean): Array of Array of Integer;
    var
      Done: Boolean;
      ttp: Array of Integer;
      tmpTPA: Array of Array of Integer;
      c: integer;
    begin
      SetLength(tmpTPA, Length(TheArray));
      tmpTPA:= TheArray;
      if SmallFirst then
      begin
        repeat
          done := true;
          for c := 0 to (GetArrayLength(TheArray) - 2) do
            if Length(tmpTPA[c]) > Length([c + 1]) then
            begin
              ttp := tmpTPA[c];
              tmpTPA[c] := tmpTPA[c + 1];
              tmpTPA[c + 1] := ttp;
              done := false;
            end;
        until(done);
        SetArrayLength(Result, GetArrayLength(tmpTPA));
        Result := tmpTPA;
        Exit;
      end else
      begin
        repeat
          done := true;
          for c := 0 to (GetArrayLength(TheArray) - 2) do
            if Length(tmpTPA[c]) < Length([c + 1]) then
            begin
              ttp := tmpTPA[c];
              tmpTPA[c] := tmpTPA[c + 1];
              tmpTPA[c + 1] := ttp;
              done := false;
            end;
        until(done);
        SetArrayLength(Result, GetArrayLength(tmpTPA));
        Result := tmpTPA;
        Exit;
      end
    end;

    I think this will do, haven't tested it though
    Hup Holland Hup!

  3. #3
    Join Date
    Nov 2006
    Location
    NSW, Australia
    Posts
    3,487
    Mentioned
    1 Post(s)
    Quoted
    0 Post(s)

    Default

    Good Lord...it's by Nielsie anyway.

    No need to test.
    [CENTER][img]http://signatures.mylivesignature.com/54486/113/4539C8FAAF3EAB109A3CC1811EF0941B.png[/img][/CENTER]
    [CENTER][BANANA]TSN ~ Vacation! ~ says :I Love Santy[/BANANA][/CENTER]

    [CENTER][BANANA]Raymond - Oh rilie? says :Your smart[/BANANA][/CENTER]

  4. #4
    Join Date
    Feb 2006
    Location
    Amsterdam
    Posts
    13,692
    Mentioned
    146 Post(s)
    Quoted
    130 Post(s)

    Default

    the code

    SCAR Code:
    Procedure RearrangeArrayByLength(var a: Array Of TPointArray; Small: Boolean);

    Var
       B: Boolean;
       L, I: Integer;

    Begin
      B := True;
      L := GetArrayLength(a);
      While B Do
      Begin
        B := False;
        For I := 0 To L - 2 Do
          If Small Then
          Begin
          If GetArrayLength(a[i]) > GetArrayLength(a[i+1]) then
            Begin
              SwapA(a[i], a[i + 1]);
              B := True;
            End
          End
          Else
          Begin
            If GetArrayLength(a[i]) < GetArrayLength(a[i+1]) then
            Begin
              SwapA(a[i], a[i + 1]);
              B := True;
            End
          End;
      End;
    End;

    test code
    SCAR Code:
    program New;

    Procedure SwapA(var a, b :TPointArray);

    Var
       c: TPointArray;
    Begin
      c := a;
      a := b;
      b := c;
    End;

    Procedure RearrangeArrayByLength(var a: Array Of TPointArray; Small: Boolean);

    Var
       B: Boolean;
       L, I: Integer;

    Begin
      B := True;
      L := GetArrayLength(a);
      While B Do
      Begin
        B := False;
        For I := 0 To L - 2 Do
          If Small Then
          Begin
          If GetArrayLength(a[i]) > GetArrayLength(a[i+1]) then
            Begin
              SwapA(a[i], a[i + 1]);
              B := True;
            End
          End
          Else
          Begin
            If GetArrayLength(a[i]) < GetArrayLength(a[i+1]) then
            Begin
              SwapA(a[i], a[i + 1]);
              B := True;
            End
          End;
      End;
    End;

    var
       a: array of tpointarray;
       i: integer;

    begin
      setarraylength(a, 8);
      setarraylength(a[0], 0);
      setarraylength(a[1], 7);
      setarraylength(a[2], 5);
      setarraylength(a[3], 4);
      setarraylength(a[4], 0);
      setarraylength(a[5], 2);
      setarraylength(a[6], 25);
      setarraylength(a[7], 6);
      RearrangeArrayByLength(a, True);
      for i := 0 to getarraylength(a) - 1 do
        writeln(inttostr(getarraylength(a[i])));
    end.

  5. #5
    Join Date
    Sep 2006
    Posts
    5,219
    Mentioned
    4 Post(s)
    Quoted
    1 Post(s)

    Default

    I guess you didn't see the pastebin link I gave you on msn last night for this ...

    SCAR Code:
    {*******************************************************************************
    function RearrangeAOTPAByLength (TheAOTPA:array of array of tpoint; Increasing:boolean):array of array of tpoint;
    By: Boreas
    Description: Sorts an array of array of tpoint by length of arrays. Increasing=true
    makes Result[0] have the smallest array length. Does not touch the tpoints within the arrays.
    *******************************************************************************}

    function RearrangeAOTPAByLength (TheAOTPA:array of array of tpoint; Increasing:boolean):array of array of tpoint;
    var done:boolean;
    AL,parray:integer;
    ttpa:array of tpoint;
    begin
      result:=TheAOTPA;
      AL:=getarraylength(result);
      if Increasing then
      begin
        repeat
          done := True;
          for pArray := 0 to (AL - 2) do
          begin
            if (getarraylength(result[pArray]) > getarraylength(result[pArray + 1])) then
            begin
              ttpa := result[pArray];
              result[pArray] := result[pArray + 1];
              result[pArray + 1] := ttpa;
              done := False;
            end;
          end;
        until (done);
      end;
      if not Increasing then
      begin
        repeat
          done := True;
          for pArray := 0 to (AL - 2) do
          begin
            if (getarraylength(result[pArray]) < getarraylength(result[pArray + 1])) then
            begin
              ttpa := result[pArray];
              result[pArray] := result[pArray + 1];
              result[pArray + 1] := ttpa;
              done := False;
            end;
          end;
        until (done);
      end;
    end;

  6. #6
    Join Date
    Nov 2006
    Posts
    1,103
    Mentioned
    0 Post(s)
    Quoted
    6 Post(s)

    Default

    nope i didnt... sorry then lol wizzups code is easier to understand though(because swap is a different procedure)
    Infractions, reputation, reflection, the dark side of scripting, they are.

  7. #7
    Join Date
    Sep 2006
    Posts
    5,219
    Mentioned
    4 Post(s)
    Quoted
    1 Post(s)

    Default

    Plus it's faster.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Array in an array...
    By Lorax in forum OSR Advanced Scripting Tutorials
    Replies: 20
    Last Post: 01-16-2010, 09:10 PM
  2. ItemColors: Array of Array of Integer
    By n3ss3s in forum Research & Development Lounge
    Replies: 5
    Last Post: 10-30-2007, 06:04 PM
  3. Array Help. ... . . .. !
    By kooldude in forum OSR Help
    Replies: 2
    Last Post: 06-19-2007, 06:16 PM
  4. Array of Tbox - And TPoint array helps.
    By R0b0t1 in forum OSR Help
    Replies: 4
    Last Post: 06-10-2007, 06:43 PM
  5. array help please
    By omgh4x0rz in forum OSR Help
    Replies: 4
    Last Post: 02-18-2007, 05:30 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •