Compacting arrays

[Arbiter]

Awight people!

Right, I have the worlds biggest stinker of an array that certain elements will become redundant over time. These elements will have a flag saying they're no good, but I want to compact the array to remove the elements.

Does anyone have any decent / fast methods of doing this?

[DaoK]

i can make you a Function, give me 30 minutes ok, but in few word you have to do a loop to check if the array have the value if not add it on the tempo... if the array is big it will take few second...

[plenderj]

Move all the elements that are bad to the back of the array, then use ReDim

[Arbiter]

Whoa, Daok - I can do that.

The only thing is the array is a UDT with a bog load of properties that I didn't want to have to set manually....

Attached is the UDT...

Type unitTemp
        XC As Integer
        YC As Integer
        weapon(4) As Byte
        ammo(4) As ammotemp
        AutoModel As Byte
        Speed As Single
        CurrShields As Single
        CurrArmour As Single
        MaxArmour As Single
        torso As Integer
        reactor As Byte
        Standingcharge As Single
        MaxEnergyDrain As Integer
        EnergyUsed As Single
        Weight As Single
        Status As Boolean
        Chip(3) As Byte
        ChassisType As Byte
        SheildGenerator As Byte
        ArmourType As Byte
        Name As String
        DestXC As Integer
        DestYC As Integer
        TurnComplete As Boolean
        SpeedRemaining As Single
        EnergyUsedPerMove As Single
        WeaponFireState(4) As firestatetemp
        ViewRadius As Byte
        options As String
        ProcCost As Single
        GraphicID As Long
        Autopilot As Boolean
        Maturity As Integer
        MatStage As Byte
        HomeX As Integer
        HomeY As Integer
        ChanceOfSettleDown As Byte
        MonsterType As Byte
        Read(7) As Boolean
        Might As Single
    End Type

[Arbiter]

As you can see there are quite a few individual wotsits that I have to move for each unit.

Can I move an arrays element without transferring the data items individually?

If so, could you point me in the right direction?

[plenderj]

How's this

Option Explicit
 
Private myArray() As argType
Private Type argType
    a As Long
    b As String
    c As Integer
    d As Currency
    exists As Boolean
End Type
 
 
Private Sub Form_Load()
    Dim i As Long
    ReDim myArray(9999)
    For i = 0 To 9999
        myArray(i).exists = Not ((i Mod 100) = 0)
    Next
    ReDim Preserve myArray(UBound(myArray) - putNonExistantElementsToBack(myArray))
End Sub
 
Private Function putNonExistantElementsToBack(ByRef myArr() As argType) As Long
    Dim i As Long, j As Long, tempArr() As argType: ReDim tempArr(UBound(myArr))
    For i = 0 To UBound(myArr)
        If Not myArr(i).exists Then
            tempArr(UBound(myArr) - j) = myArr(i)
            j = j + 1
        Else
            tempArr(i) = myArr(i)
        End If
    Next
    myArr = tempArr
    putNonExistantElementsToBack = j
End Function

[Arbiter]

Ummm, what about all the array elements?

[plenderj]

All bad array elements are put to the back of the array.
Then you call ReDim to cut the bad part off.
Ya folly ?

[Arbiter]

Ahhhh, the function takes the input as the type of the wotsit.

I didn't know you could do that.

Hehehehe, aren't I thick!

I understood the principle but wasn't sure how it would transfer all the variables in the type.

That's cool - cheers Plend!

[plenderj]

No probs. Though there is an easier approach.
Make a dynamic array. Loop through the first array.
For each index that does exist/is good, redim preserve the other array 1 bigger and put that index into it.

That'd be much easier though slower. But it'd be much easy to debug and what not...

[Arbiter]

I think that's what Daok was suggesting.

Well, as long as this method of yours works then I'll have no call to firebomb your house...

[plenderj]

I had better test it so

[Arbiter]

Hang about.

Isn't this code of your flawed?

I notice that it's putting the bad ones at the back moving them progressively forward, but it's putting the good ones back in the same position.

Or am I wrong?

[plenderj]

You're wrong. i <> j

Anyway, use this instead ;

Option Explicit
 
Private myArray() As argType
Private Type argType
    a As Long
    b As String
    c As Integer
    d As Currency
    exists As Boolean
End Type
 
 
Private Sub Form_Load()
    Dim i As Long
    ReDim myArray(9999)
    For i = 0 To 9999
        myArray(i).exists = Not ((i Mod 100) = 0)
    Next
    
    Dim tempArr() As argType
    ReDim tempArr(0)
    For i = 0 To UBound(myArray)
        If myArray(i).exists Then
            tempArr(UBound(tempArr)) = myArray(i)
            ReDim Preserve tempArr(UBound(tempArr) + 1)
        End If
    Next
    
    ReDim pyarray(UBound(tempArr))
    myArray = tempArr
End Sub

[Arbiter]

I know I<>J and I don't think I'm wrong.

The if doesn't exist bit is right, but the does exist bit is wrong.

Run through it on paper with an array of 10 items if you don't believe me.

Anyways, now I know you can pass UDT arrays to functions, I'm laughing anyway - I can write it myself now, I just didn't know you could do that.

Ta muchly Plend!

[plenderj]

Bah I just wrote the thing in about 2 minutes while eating a bigmac
The basic idea for the first algorithm is sound... oh yeah I see. I should add in another counter, k, and count the number of good items. Good items go into tempArr(k) and bad items into tempArr(UBound(myArr) - j)

Pffft. Pretty damn close with no testing I'd say though
I'd stick with the second example I posted anyway. That seems to me to be the easiest way of doing it ... oh and I tested it too

[Arbiter]

Yep, you needed another counter.

I'd already amended the code before I told you, but your second code seems a bit neater.

How was the BigMac? And only one? You need at least two and some fried for a proper snack!

[plenderj]

Yeah just the one. I didn't want to seem greedy

[chrisa_uk]

why not use a collection? then the collection resizes automatically and gets rid of them when you want?

[plenderj]

Arrays are easier (and faster) to work with

[Arbiter]

Definately so, and speed is an issue here.

Also Sentience is now over 28500 lines of code - I will show my arse if I'm going to chance something so fundamental at this stage....

PS - Plend, when do we next get one of those super furry bug lists off you....

[plenderj]

Whenever you ask

[Arbiter]

Plend,

Please can we have one of those super furry bug lists off you?

[plenderj]

Of course
I'll do one up tonight when I get home

[Arbiter]

Awwww, what a hero!!!

A tip for you - on the main game screen (when you can see units and buildings) press "p".

[plenderj]

I've a small list already. Will post in g&g forum

[jim mcnamara]

Have you considered using sparse arrays? Sparse arrays are virtual arrays that are huge, but many of the elements don't exist in physical memory. The elements may come and go dynamically

Sample .CLS file attached.


From:
http://www.softcircuits.com/sw_vbsrc.htm

[jim mcnamara]

The idea is that you read thru the array and delete the element.
You don't have to copy or move elements around.

[beachbum]

We all know that Jamie is a bit of a half ass hack at programming and his method sux lol

Arbiter, redim preserve is slow and so should be used as little as possible. Modify the Irish git's form load code (the second half) for something like this..

lCounter = -1
    ReDim tempArr(UBound(myArray))
    For i = 0 To UBound(myArray)
        If myArray(i).exists Then
            lCounter = lCounter + 1
            tempArr(lCounter) = myArray(i)
        End If
    Next
    ReDim Preserve tempArr(lCounter)
    ReDim myArray(lCounter)
    myArray = tempArr

Good to have you and ur barnyard animals back Jamie

[plenderj]

Fack awf

'aint nutin wrong with Redim Preserve when being used to simply chop off the end of an array. I stand by my code

[beachbum]

Originally posted by plenderj
'aint nutin wrong with Redim Preserve when being used to simply chop off the end of an array. I stand by my code

yep sure anything u say!
with 99999 array items running on my Vic 20 the results were...

Irish Git 1400
Me 818
Irish Git 1315
Me 869
Irish Git 1331
Me 828
Irish Git 1379
Me 854
Irish Git 1459
Me 830
Irish Git 1438
Me 793

[plenderj]

You just hang on a minute there .... *mutter*mutter*

[plenderj]

Ok. Average times taken after 10 iterations of each ;

jamie; 459
stuart; 348


But did you test yours yet ?
ie. does it do the job ?

Option Explicit
 
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Private myArray() As argType
Private Type argType
    a As Long
    b As String
    c As Integer
    d As Currency
    exists As Boolean
End Type
 
 
Private Function jamie() As Long
    Dim tempTime As Long, elapsed As Long, n As Long, i As Long
    Dim tempArr() As argType
    For n = 0 To 9
        tempTime = GetTickCount
        ReDim myArray(99999)
        For i = 0 To 99999
            myArray(i).exists = Not ((i Mod 100) = 0)
        Next
        ReDim tempArr(0)
        For i = 0 To UBound(myArray)
            If myArray(i).exists Then
                tempArr(UBound(tempArr)) = myArray(i)
                ReDim Preserve tempArr(UBound(tempArr) + 1)
            End If
        Next
        ReDim pyarray(UBound(tempArr))
        myArray = tempArr
        tempTime = GetTickCount - tempTime
        elapsed = elapsed + tempTime
    Next
    jamie = (elapsed / 10)
End Function
 
Private Function stuart() As Long
    Dim tempTime As Long, elapsed As Long, n As Long, i As Long
    Dim tempArr() As argType, lCounter As Long
    For n = 0 To 9
        tempTime = GetTickCount
        ReDim myArray(99999)
        For i = 0 To 99999
            myArray(i).exists = Not ((i Mod 100) = 0)
        Next
        lCounter = -1
        ReDim tempArr(UBound(myArray))
        For i = 0 To UBound(myArray)
            If myArray(i).exists Then
                lCounter = lCounter + 1
                tempArr(lCounter) = myArray(i)
            End If
        Next
        ReDim Preserve tempArr(lCounter)
        ReDim myArray(lCounter)
        myArray = tempArr
        tempTime = GetTickCount - tempTime
        elapsed = elapsed + tempTime
    Next
    stuart = (elapsed / 10)
End Function
 
Private Sub Form_Load()
    MsgBox "Times taken : " & vbCrLf & vbCrLf & _
            "Jamie's Method  : " & jamie & vbCrLf & _
            "Stuart's Method : " & stuart, vbInformation
End Sub

[beachbum]

Test? what's that word mean?
yeah it should work.. concept is just this...

A | 0 | 0 | 1 | 0 | 1 | 0 | 'original array 6 with 2 to remove

B | X | X | X | X | X | X | 'new array set to same size

B | 0 | 0 | 0 | 0 | X | X | 'copy correct entries to new array

'keeping count of correct entries resize the new array
B | 0 | 0 | 0 | 0 | 
A | X | X | X | X | 'then resize original array

and copy across
A | 0 | 0 | 0 | 0 |

regards
Stuart

[plenderj]

"should work" ... "concept" .... bah stuart
I bet your code doesnt even work. I'll test it hang on.

[beachbum]

Geesh it was only ur code rearranged.. cant see how ur rock solid code can go wrong with such a minor adjustment

[plenderj]

Pfft.
Your code works

Option Explicit
 
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Private Type argType
    a As Long
    b As String
    c As Integer
    d As Currency
    exists As Boolean
End Type
 
Private Sub form_load()
 
    Dim i As Long
    Dim tempArr1() As argType, myArray1() As argType
    Dim tempArr2() As argType, myArray2() As argType
        
    ReDim myArray1(99999)
    For i = 0 To 99999
        myArray1(i).exists = Not ((i Mod 100) = 0)
        myArray1(i).a = i
    Next
    ReDim tempArr1(0)
    For i = 0 To UBound(myArray1)
        If myArray1(i).exists Then
            tempArr1(UBound(tempArr1)) = myArray1(i)
            ReDim Preserve tempArr1(UBound(tempArr1) + 1)
        End If
    Next
    ReDim myArray1(UBound(tempArr1))
    myArray1 = tempArr1
        
    Dim lCounter As Long
    ReDim myArray2(99999)
    For i = 0 To 99999
        myArray2(i).exists = Not ((i Mod 100) = 0)
        myArray2(i).a = i
    Next
    lCounter = -1
    ReDim tempArr2(UBound(myArray2))
    For i = 0 To UBound(myArray2)
        If myArray2(i).exists Then
            lCounter = lCounter + 1
            tempArr2(lCounter) = myArray2(i)
        End If
    Next
    ReDim Preserve tempArr2(lCounter)
    ReDim myArray2(lCounter)
    myArray2 = tempArr2
    
    MsgBox "Ubound of both arrays : " & UBound(myArray1) & "," & UBound(myArray2)
    For i = 0 To UBound(myArray1)
        If Not (myArray1(i).a = myArray2(i).a) Then
            MsgBox "Ack!"
        End If
    Next
End Sub

[Arbiter]

Children, children, play nice.

Oh never mind.

I wrote my own anyway using Plends as a base.

I must say, it did come out looking more like Stuarts though - I dimmed the temp array to the same size as the and then chopped it down at the end rather than increasing its size by one every time.

Not that it matters really, as long as it works...

[plenderj]

Yeah 'tis a bit stupid to redim all the way through