Array optimization - String or Integer?

[Ellis Dee]

Yeah, that looks pretty tight.

[Krass]

Well, that was an overall EXCELLENT optimization, I'd say. Your tricks did help a lot.

On a 14 seconds test, I think about 10 or 12 are wasted manipulating an image in a picturebox using .pset and .point. I can't wait to have Milk's DIB Section solution up and running..

I was skeptic at first, knowing I'd end up with a million records to browse but this is veeery quick, even tho that test was done with only 36,000 records, not a million.

...My code is to be executed at a precise time/date, and must end within about 40 hours of execution. I think that'll work perfectly. I will always be able to setup more than 1 machine to do the task anyway.

Thanks again, optimization masters.

[Milk]

If I understand this problem correctly there is a way to improve this enormously, not that there is anything wrong with the above routines, just that as far as I can tell you are comparing an array of particular pixels to many arrays of particular pixels.

A much better approach would be to have an array of all the pixels in the target image which you compare to the coordinates... i.e.

If ImageData2D(HugeType(i).Coords(xHuge).x, HugeType(i).Coords(xHuge).y) = tgtColour Then
   MatchCount = MatchCount + 1
End If

'or simpler

If ImageData2D(.x, .y) = tgtColour Then MatchCount = MatchCount + 1

even better convert your two X and Y integer coords into a single Long index

If ImageData1D(HugeType(i).Index(ii)) = tgtColour Then MatchCount = MatchCount + 1

ATM I'm not sure what XAdd and YAdd are for? Are your search coordinates from a smaller image than the database coordinates, or are you searching all over the image?

[Krass]

Hi Milk..

Your approach seems pretty good. I should have thought about such a simple method, even tho I'll have to think further more if this can be adapted to suit my needs. It might be better than looping my arrays to find matches.

My huge array is filled with tons of sub-arrays. Those tons sub-arrays will always (or almost always?) contains more pixels than the target image it's been compared to.

The target image has been modified/played with (by code) before comparing it to my tons of sub-arrays. While doing those pre-checkup modifications, the whole image might move some pixels in any direction.. (example: in some cases, the top of the image will be deleted, and it'll be 'cropped/moved' to be at the top-left of the picturebox)... That is the main reason why I am using xAdd and yAdd.......:

The image has moved a couple of pixels, so the sub-arrays won't contain the same exact X and Ys. So, for each target image that I'll compare to many sub-arrays, it'll actually do a loop for xAdd = -5 to 5 (same for Y), as an offset.

Some of my tests shows a > 90% pixel match at offset 0, -1, while some at 3, 2.. and so on.

You'll be asking why not just remembering how many pixels you moved it left, top or else.. well, before modifying the image by code, I couldn't know where it actually really starts on the left or at the top. My code modifying the image is sometimes taking off the image important parts of its content, but this I have to deal with. A big-enough part is remaining so I can use it to see in which sub-arrays it "fits" best. Reason of the checking method with an offset.

Makes a lot more demanding process - but so far, tests have shown pretty good results, based on both accuracy and speed. Your method might be a considerable help.. Will have to think about that.

My present method advances in the arrays until X and Y are the same. I believe I could just use your method but that'll make me look for match on every X,Y contained in the sub-arrays. Might still be quicker than dealing movements in both arrays.

Thanks!

[Krass]

Milk, I've played with your DIb Sections functions and it sure looks sweet.

I, for now, will focus only on black pixels. I got rid of the SearchPalette and ended up with that code:

Public Function retByteData(PictureObject As Object)
    Dim i As Long, ii As Long, lngImageData() As Long, bytImageData() As Byte
    
    lngImageData = RetDIBDataLong(PictureObject)
    i = UBound(lngImageData)
    ReDim bytImageData(i)
    
    'Checking only black pixels (Case 0) (avoiding SearchPalette)
    For i = 0 To i
        If lngImageData(i) = 0 Then bytImageData(i) = 1
    Next i
    
    retByteData = bytImageData
End Function

...if the color in lngImageDate(i) = black, then I write 1 in the byte array, ... but later on, how will I know the X&Ys if I only have "1" and "0" in the byte array? Unless "i" = X and Y converted to long. That'd be clever. But then what to do with my xAdd and yAdd? I'd have to reconvert "i" to different X and Y coords, add xAdd and yAdd and reconvert it to "i"?

I'm not quite sure I understand the way it works.

In your previous post, you suggested the following:

If ImageData1D(HugeType(i).Index(ii)) = tgtColour Then MatchCount = MatchCount + 1

In this example, I believe ImageData1D = lngImageData used in your previous code?

..you suggested to "convert your two X and Y integer coords into a single Long index". If I got it right, the hugetype will contain a Index array, let's say of ~700 records, some having "1" and some having "0", right? (considering I get rid of all colors BUT black).

Exemple: HugeType(52).Index(523) = 142525. "142525" would be my X and my Y, mixed together and saved as long? Sounds good to me if that works well. To do that, I'd need to know how to invert my Ys, and how to transfer my X,Y coord to long correctly.

[Milk]

<snip>...if the color in lngImageDate(i) = black, then I write 1 in the byte array, ... but later on, how will I know the X&Ys if I only have "1" and "0" in the byte array? Unless "i" = X and Y converted to long. That'd be clever. But then what to do with my xAdd and yAdd? I'd have to reconvert "i" to different X and Y coords, add xAdd and yAdd and reconvert it to "i"?

Actually this is why I asked what they were for, I think because your doing lots different searches with different xAdd and yAdd values using a 2D array will be easier.

The retByteData can be easily adapted to a return 2D array.

Public Function retByteData2D(PictureObject As Object, SearchColour As Long) As Byte()
Dim x As Long, y As Long, uby As Long, lngImageData() As Long, bytImageData() As Byte
'The PictureObject must be an object with both a HDC and Image property
'such as a PictureBox, UserControl or Form

  lngImageData = RetDIBDataLong(PictureObject, True)
  x = UBound(lngImageData, 1)
  uby = UBound(lngImageData, 2)
  ReDim bytImageData(x, uby)
  
  For x = 0 To x
    For y = 0 To uby
      If lngImageData(x, y) = SearchColour Then
        bytImageData(x, y) = 1
      End If
    Next y
  Next x
  
  retByteData2D = bytImageData
End Function

Regarding two Integer coordinates as one Long...

There are two main ways to do this, consider a small image, width 4, height 3.

2D Dib indexes would look like
0,2 1,2 2,2 3,2 <-- 11 Mod Width, 11 \ Width <--edited
0,1 1,1 2,1 3,1
0,0 1,0 2,0 3,0

1D Dib indexes would look like
08 09 10 11 <-- 3 + 2 * Width
04 05 06 07
00 01 02 03

You could also convert the above 2D coordinates to longs like this
131072 131073 131074 131075 <-- 3 + 2 * 65536
065536 065537 065538 065539
000000 000001 000002 000003

Does that make sense? Basically if you need to use many different yAdd and Xadd values I would stick to 2D.

Edit: I made a mistake in the code in post #26

#
Public Function retByteData(PictureObject As Object, SearchPalette() As Long) as byte()

[Krass]

Ok, I will stick with 2d arrays.

I may be stupid but I don't understand those 2:

2D Dib indexes would look like
0,2 1,2 2,2 3,2 <--11 \ Width + 11 Mod Width
0,1 1,1 2,1 3,1
0,0 1,0 2,0 3,0

131072 131073 131074 131075 <-- 3 + 2 * 65536
065536 065537 065538 065539
000000 000001 000002 000003

In the first example, where does 11 comes from? And the * 65536 on the 2and example?..... I'm totally lost

If you have some spare time, would you take me by the hand?...

[Milk]

oops 11 \ Width + 11 Mod Width should be 11 Mod Width, 11 \ Width The 11 is the 1D index as shown in the next example.

I = X + Y * Width
X = I Mod Width
Y = I \ Width

And the other one...

An Integer has the range -32768 to 32767 and a Long, -2147483648 to 2147483647

-32768 * 65536 = -2147483648
32767 * 65536 = 2147483647

P = X + Y * 65536
X = P Mod 65536
Y = P \ 65536

[Krass]

Hi Milk,

Thanks for clarifying.

After such modification, the Command1_Click would require some modifications. I tried something like that:

    
Dim PicData() As Byte, i As Long, y As Long, W As Long
    
    PicData = retByteData2D(Picture1, 0)
    
    'This next bit is slow, it is just to show the data we have just gained visualy
    With Picture1
      W = Picture1.ScaleX(.ScaleWidth, .ScaleMode, vbPixels)
    End With

    Picture2.Cls
    For i = 0 To UBound(PicData, 1)
        For y = 0 To UBound(PicData, 2)
            If PicData(i, y) Then SetPixelV Picture2.hDC, i Mod W, i \ W, QBColor(PicData(i))
        Next y
    Next i

... but that still gives me a "subscript out of range" at the SetPixelV line. I don't feel very comfortable with this, maybe would it be easy for you to edit your first posted procedure so it can now work with a 2D array?

Thank you Milk for you time and dealing with a newbie...

[Krass]

Nevermind the last post, Milk... after scratching my head quite a couple of times I ended up with that code. Please correct me if it is incorrect in any way, but I'd doubt it since it does show your "Felix the cat", upside down, just like your original code.

Private Sub Command1_Click()
    Dim PicData() As Byte, i As Long, y As Long, W As Long
    
    PicData = retByteData2D(Picture1, 0)
    
    'This next bit is slow, it is just to show the data we have just gained visualy
    With Picture1
      W = Picture1.ScaleX(.ScaleWidth, .ScaleMode, vbPixels)
    End With

    Picture2.Cls
    For i = 0 To UBound(PicData, 1)
        For y = 0 To UBound(PicData, 2)
            If PicData(i, y) Then SetPixelV Picture2.hDC, i, y, 0
        Next y
    Next i
End Sub

...notice how I've changed the SetPixelV call.

Now my PicData() is filled with 0's and 1's. All 1's are black pixels and that's all I'm interested into. That array upper bounds will always be approx 280,78 (can't quite remember - but I think that's not important). Let's just take the top left 9 x 9.. it would look like this:

1 0 0 0 0 0 0 0 1 [ 0 to 280 ...]
0 1 0 0 0 0 0 1 0
0 0 1 0 0 0 1 0 0
0 0 0 1 0 1 0 0 0
0 0 0 0 1 0 0 0 0
0 0 0 1 0 1 0 0 0
0 0 1 0 0 0 1 0 0
0 1 0 0 0 0 0 1 0
1 0 0 0 0 0 0 0 1
[ 0 to 78 ...]

So, as an example, the top-left part of my picture actually looks like a "X" sign. We will agree that the very most top-left pixel is a black pixel at 0,0 (yes, on a picture box, 0,0 is top-left, and not bottom-left). After using dib sections, as you mentionned, the Y gets inverted so that this 0,0 pixel is now located at 0,77.

Since I am now using a 2d array, do I still need to convert my database X,Y coords to long? If so, how would I now compare that "long data" to the PicData array? To me it sounds like I could only convert the Y part of my database coord?.. and then compare it to the PicData array. But maybe that was some processing time you were trying to help me avoid. In clear, it's the following line of code that I'd like to run succesfully:

If PicData(.x, .y) = 1 Then MatchCount = MatchCount + 1

...where .x and .y are coords from my database.

So, instead of inverting the Y in my database on every loop instance, shouldn't it be easier to flip the array and end up with good original coords? My 0,77 black pixels would get back to 0,0 and I'd be on my way..

Any tip VERY welcome.

Edit:

I just thought that "flipping" the array back in good order would make life easier for me.. My current code, which modifies the target images in various ways, would still be applicable without much modifications... I'll still wait for your input. Thanks.

[Milk]

Either flip the Y axis as you extract it (like below) or flip the Y axis in your database and re-save the database.

  For x = 0 To x
    For y = 0 To uby
      If lngImageData(x, y) = SearchColour Then
        bytImageData(x, uby - y) = 1
      End If
    Next y
  Next x

As to converting to Longs, don't! Get it working with 2D Integer coordinates then later maybe try a Long version. The Long version would work very well if your database coords and the extraction image coords were taken from images with the same width, which I'm not sure they are.

If PicData(.Coords(xHuge).x, .Coords(xHuge).y) = 1 Then MatchCount = MatchCount + 1

'or perhaps...

If PicData(.Coords(xHuge).x, .Coords(xHuge).y) <> 1 Then MissCount = MissCount + 1
If MissCount > 100 then Exit For

[Krass]

All those techniques have been applied and tested. Works like a charm.

I removed the following code from Command1_Click which became useless (so it seems):

'This next bit is slow, it is just to show the data we have just gained visualy
With Picture1
  W = pic1.ScaleX(.ScaleWidth, .ScaleMode, vbPixels)
End With

I will also get rid of the Command2, as this was just for demonstration purpose.

I will need your expertise (again) to achieve a little task. My PicData is now perfectly filled with black pixels AFTER all my picture modifications were applied. My last step was to move the content TOP-LEFT in the picturebox (getting rid of completely whited-out lines or columns).

I was using such code:

pic1.PaintPicture pic1.Picture, 0, -10

I believe this technique is yet another 'slow' picturebox technique. Let's say I know there are 6 vertical lines (on the left) and 10 horizontal lines (on the top) to get rid off, would there be a way to apply this straight to my PicData array? I believe there will be some ReDim tricks to be done here.

Also, I have brought final modification to the retByteArray2D function:

Public Function retByteData2D(PictureObject As Object) As Byte() ', SearchColour As Long) As Byte()
    Dim x As Long, y As Long, uby As Long, lngImageData() As Long, bytImageData() As Byte
    Dim lngColor As Long, intRed As Integer, intGreen As Integer, intBlue As Integer

    lngImageData = RetDIBDataLong(PictureObject, True)
    x = UBound(lngImageData, 1)
    uby = UBound(lngImageData, 2)
    ReDim bytImageData(x, uby)
   
    For x = 0 To x
        For y = 0 To uby
            lngColor = lngImageData(x, y)
            intRed = lngColor And 255
            intGreen = lngColor \ 256 And 255
            intBlue = lngColor \ 65536 And 255

            If (intRed + intGreen + intBlue) / 3 > 30 Then
                'Pixel NOT black enough - do nothing
            Else
                'Pixel black or almost black - save pixel to bytImageData
                bytImageData(x, uby - y) = 1
            End If
        Next y
    Next x
    
    retByteData2D = bytImageData
End Function

...Yes, I won't just check for black pixels, after second thought. As you can see in the above code, I'll keep any pixels that is actually black or ALMOST black. I don't think the SearchPalette shown earlier would have helped here, right? If you have any speed-concern about my code, feel free to correct me!

Thanks!.. My app is taking form and I am happy.

[si_the_geek]

Your IF statement is far from ideal in terms of speed.

Division is particularly slow (especially with / rather than \ ), and it is faster to multiply instead - so it would be quicker to multiply the opposite side of the comparison:

            If (intRed + intGreen + intBlue) > 30 * 3 Then

..however, as that is a constant value, just change the constant instead:

            If (intRed + intGreen + intBlue) > 90 Then

I don't think PaintPicture is particularly slow in comparison to the alternative methods, but it may be extra work that you don't need - it sounds as if you could just start your loops in a different place instead (eg: rather than start your X loop at 0, start at 6 to ignore the first 6 columns)

[Krass]

Si_the_geek... Modification has been made. Thanks.

Starting the loop at 6 instead of 0 would be a good way to ignore first 6 columns.... but I'm wondering if it'd still be better to move my picture at the beginning of the huge loop... else the code will end up something like that:

If PicData(.Coords(xHuge).x + xAdd + intAvoidedCols, .Coords(xHuge).y + yAdd + intAvoidedRows) = 1 Then MatchCount = MatchCount + 1

...see, that adds an operator to my huge loop, which will of course be the more ressource/time demanding (the huge loop).

What do you think?

Moreover, I lied. I wasn't using that line of code:

pic1.PaintPicture pic1.Picture, 0, -10

'...but THAT one!
for i = 0 to 10
     pic1.PaintPicture pic1.Picture, 0, -1
next i

For some odd reasons, doing -10 at a time was keeping the old result in place, duplicating the picture.. (maybe was there some pic1.Picture = pic1.image missing here and there)....

[Milk]

You can alter RetDIBDataLong to return the RGBQUAD type like this. Remember to alter all the variable names throughout the function.

Public Function RetDIBDataRGBA(PictureObject As Object, Optional Return2DArray As Boolean) As RGBQUAD()
Dim BM As BITMAP, bmi As BITMAPINFO, RGBAImageData() As RGBQUAD

Then you don't have to extract the bytes out of the long....

Public Function retByteData2D(PictureObject As Object) As Byte() 
    Dim x As Long, y As Long, uby As Long, RGBAImageData() As RGBQUAD, bytImageData() As Byte
    
    RGBAImageData = RetDIBDataRGBA(PictureObject, True)
    x = UBound(RGBAImageData, 1)
    uby = UBound(RGBAImageData, 2)
    ReDim bytImageData(x, uby)
   
    For x = 0 To x
        For y = 0 To uby
            with RGBAImageData(x,y)
              if clng(.Red) + .Green + .Blue < 90 then bytImageData(x, uby - y) = 1
            end with
        Next y
    Next x

    retByteData2D = bytImageData
End Function

Away from IDE, Untested warning!

[si_the_geek]

There's no need for using intAvoidedCols/intAvoidedRows inside the loop - as you could simply modify the xAdd/yAdd values before the loop instead.

[Krass]

Milk, your code using RGBQUAD was good. Good work.

I've been able to test my application again, now using dib sections. My main huge loop is executing the following on each target image:

For i = 0 To intHugeUBound
    For xAdd = -5 To 5
        intOffsetX = xAdd + intModifOffsetX
        For yAdd = -5 To 5
            MatchCount = 0
            xHuge = 0
            intOffsetY = yAdd + intModifOffsetY
            '289,79
            'HugeType(i).Length
            
            Do While xHuge < HugeType(i).Length
                If HugeType(i).Coords(xHuge).x + intOffsetX < 290 And HugeType(i).Coords(xHuge).y + intOffsetY < 80 Then
                    If HugeType(i).Coords(xHuge).x + intOffsetX > -1 And HugeType(i).Coords(xHuge).y + intOffsetY > -1 Then
                        If PicData(HugeType(i).Coords(xHuge).x + intOffsetX, HugeType(i).Coords(xHuge).y + intOffsetY) = 1 Then
                            MatchCount = MatchCount + 1
                            'Picture2.PSet (.Coords(xHuge).x + intOffsetX, .Coords(xHuge).y + intOffsetY), vbBlue
                            DoEvents
                        End If
                    End If
                End If
                xHuge = xHuge + 1
            Loop
        Next yAdd
    Next xAdd
    'MsgBox MatchCount
    
    'Debug.Print "hello"
    
    'If (MatchCount / intSmallUBound) * 100 > 80 Then
    '    MsgBox HugeType(i).Info
    'End If
    
Next i

Sure, those both "double-if" lines (< 290 and > -1) are probably slowing things down a bit. Also, that example is not using any "with". I am getting horrible results compared to my old technique and it wouldn't be MUCH better by fixing it by using a with or optimizing those "double-if" lines.

The part of modifying my target image, using dib sections instead of .pset and .point, is unbelievably quicker than my previous technique. And that was the part slowing down my old technique too much. It's the "comparing pixels" that's now taking forever.

Why is it slow: I think it's because EVERY pixels from my huge coords array (from the DB) are checked against the target image array. And that huge array will ALWAYS have much more coords than actually needed (in many cases). Using my old technique, I was browsing both arrays until we have a match, and quitting the process when the huge arrays coords are bigger than the biggest coord from the target image, hence skipping a lot of useless processing. That old technique was from post 29 from Si the geek...

Yes I am going to use a "intMissCount" after the work is done to speed up the process even more, but results are too slow right now to even think of optimizing the actual technique.

What I'm thinking of doing is keep the following DIB sections routines, but instead of keeping that array filled with 0s and 1s, I'll make a loop to find 1's and build back an array like I did before, and I'll test my old technique. I should get the exact same 'good' results I had, but better since it's now using dib sections.

Also, it is true that moving ('cropping') my target image was useless. The matching-pixel counts are the same good results and it works pretty good that way.

Sorry for making such a long post - I'm trying to make sure things are clear. When all of this is finished, my app will run much more quickly than I would have thought - and that's because of you guys.. *thanks*

Edit:

Btw, for your information, the old technique was clocking at 12 seconds (compiled), while my actual new technique is clocking at ~30 seconds, which is comparable to my initial technique without using the dib sections.

[Krass]

Edit:

Never mind the following post, I am now using this method:

If intMissCount = 60 Then
MatchCount = 0
Exit Do
End If

I might end up chanding "60" for a pre-calculated % of the total number of pixels in the target image.

Right after my last (long) post, I've started to work to modify my code, exactly as I mentionned it. The results are very satisfying and I've never had my application running that fast.

Si_the_geek, I was able to witness how awful "/" is compared to "\". That's good knowledge, thank you.

Here is a routine I am using right now. This code is at the bottom-most of my loop and is executed quadrillions of times...

If (xSmall * 20) > intSmallUBound Then
    If ((MatchCount \ (intSmallUBound \ 20)) * 100) < 80 Then
        MatchCount = 0
        Exit Do
    End If
End If

'First line used to be:
If xSmall > (intSmallUBound \ 20) Then
'...but thanks to your advice, I am using a multiplication instead of a division

In clear (as if you needed clarification on such basic code), when I have compared the first 5% of the target image pixels and didn't reach 80% of match, I'll quit the loop, since there are almost no chance we're going to end up on a good match % at the very end.

I am pretty sure the line with 2 divisions and 1 multiplication can be optimized. Would you have an idea? I could have tried something on my own, but then I thought you may end up suggesting a built-in-%-function ...

[si_the_geek]

Assuming that intSmallUBound is set before the loop, there are improvements you can make to the speed of each of those lines, simply by storing the results to variables.

You could store (intSmallUBound \ 20) into a different variable (before the loop), then use it like this:

If xSmall > intSmallUBoundD20 Then

..it only removes a single multiplication or division, but as it is running so many times it should make a difference.

Similar can be done for the second line, but before we do that a bit of re-organisation is in order, so that we can get MatchCount on it's own (I presume it is the only variable in that line which actually changes inside the loop). Here are my steps:

    If ((MatchCount \ (intSmallUBound \ 20)) * 100) < 80 Then
    If (MatchCount \ (intSmallUBound \ 20)) < (80 / 100) Then
    If MatchCount < (intSmallUBound \ 20) * (80 / 100) Then

So, by setting up variable before the loop which contains (intSmallUBound \ 20) * (80 / 100) , you can do a simple comparison of the two variables instead.