SRL Archive - Development

So to provide proper CTS 3 support (note: _not_ the same as SCAR's CTS 3), I'm currently rewriting most of the finding functions to implement the colour comparison in a more appropriate way. I've succeeded in this for the simple FindColor*Tolerance* functions; but the more complex functions are a different issue.

Taking FindBitmapToleranceIn as example. The actual comparison is done the in ColorSame function, which is supposed to be inline. (So we don't call it every time, the compiler compiles the function into the loop, for performance reasons)

function TMFinder.FindBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs,
  ys, xe, ye: Integer; tolerance: Integer): Boolean;
var
   MainRowdata : TPRGB32Array;
   BmpRowData : TPRGB32Array;
   PtrData : TRetData;
   BmpW,BmpH : integer;
   xBmp,yBmp : integer;
   tmpY : integer;
   dX, dY,  xx, yy: Integer;
   CCTS : integer;
   H,S,L,HMod,SMod : extended;
   SkipCoords : T2DBoolArray;
label NotFoundBmp;
  { Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. } 

begin
  Result := false;
  // checks for valid xs,ys,xe,ye? (may involve GetDimensions)
  DefaultOperations(xs,ys,xe,ye);

  // calculate delta x and y
  dX := xe - xs;
  dY := ye - ys;

  PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
  //Caculate the row ptrs
  MainRowdata:= CalculateRowPtrs(PtrData,dy+1);
  BmpRowData:= CalculateRowPtrs(bitmap);
  //Get the 'fixed' bmp size
  BmpW := bitmap.Width - 1;
  BmpH := bitmap.Height - 1;
  //Heck our bitmap cannot be outside the search area
  dX := dX - bmpW;
  dY := dY - bmpH;
  //Compiler hints
  HMod := 0;SMod := 0;H := 0.0;S := 0.0; L := 0.0;

  CCTS := Self.CTS;

  //Get the "skip coords".
  CalculateBitmapSkipCoords(Bitmap,SkipCoords);
  for yy := 0 to dY do
    for xx := 0 to dX do
    begin;
      for yBmp:= 0 to BmpH do
      begin;
        tmpY := yBmp + yy;
        for xBmp := 0 to BmpW do
          if not SkipCoords[yBmp][xBmp] then
            if not ColorSame(CCTS,tolerance,
                             BmpRowData[yBmp][xBmp].R,BmpRowData[yBmp][xBmp].G,BmpRowData[yBmp][xBmp].B,
                             MainRowdata[tmpY][xBmp +  xx].R,MainRowdata[tmpY][xBmp +  xx].G,MainRowdata[tmpY][xBmp +  xx].B,
                             H,S,L,HMod,SMod) then
               goto NotFoundBmp;

      end;
      //We did find the Bmp, otherwise we would be at the part below
      TClient(Client).IOManager.FreeReturnData;
      x := xx + xs;
      y := yy + ys;
      result := true;
      exit;
      NotFoundBmp:
    end;
  TClient(Client).IOManager.FreeReturnData;
end;

However, assuming that it is inlined; we can pass a lot of variables because they won't have to be ``passed'' anyway; the function is just inlined. Currently, we pass variables for *each* of the CTS'es: R,G,B and H,S,L as well as HueMod and SatMod. Obviously I could just add L_, a_, b_ (_ because some are already taken), but I think a different approach is required. There's a fat chance the functions aren't actually inlined and I think Nielsie95 told me the FPC inline implementation wasn't always as fast as you'd expect it to be.

This is how it is currently in FindColorsTolerance, note that it doesn't use ColorSame (after I cleaned it up, concept remains the same):

function TMFinder.FindColorsTolerance(out Points: TPointArray; Color, xs, ys,
  xe, ye, Tol: Integer): Boolean;
var
  PtrData: TRetData;
  Ptr: PRGB32;
  PtrInc,C: Integer;
  dX, dY, clR, clG, clB: Integer;

  procedure cts0;
    var xx, yy: integer;
  begin
    for yy := ys to ye do
    begin
      for xx := xs to xe do
      begin
         if ((abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clR-Ptr^.R) <= Tol)) then
         begin;
           ClientTPA[c].x := xx;
           ClientTPA[c].y := yy;
           inc(c);
         end;
        inc(Ptr);
      end;
      Inc(Ptr, PtrInc);
    end;
  end;


  procedure cts1;
    var xx, yy: integer;
  begin
    for yy := ys to ye do
    begin
      for xx := xs to xe do
      begin
         if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then
         begin;
           ClientTPA[c].x := xx;
           ClientTPA[c].y := yy;
           inc(c);
         end;
        inc(ptr);
      end;
      Inc(Ptr, PtrInc);
    end;
  end;

  procedure cts2;
    var xx, yy: integer;
        H1, S1, L1, H2, S2, L2, hueXTol, satXTol: Extended;
  begin
    ColorToHSL(color,H1,S1,L1);
    HueXTol := hueMod * Tol;
    SatXTol := satMod * Tol;
    for yy := ys to ye do
    begin
      for xx := xs to xe do
      begin
        RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
        if ((abs(H1 - H2) <= HueXTol) and (abs(S1 - S2) <= SatXTol) and (abs(L1 - L2) <= Tol)) then
        begin;
          ClientTPA[c].x := xx;
          ClientTPA[c].y := yy;
          Inc(c);
        end;
        Inc(Ptr)
      end;
      Inc(Ptr, PtrInc);
    end;
  end;

begin
  Result := false;
  DefaultOperations(xs,ys,xe,ye);

  dX := xe - xs;
  dY := ye - ys;
  //next, convert the color to r,g,b
  ColorToRGB(Color, clR, clG, clB);

  PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);

  // Do we want to "cache" these vars?
  // We will, for now. Easier to type.
  Ptr := PtrData.Ptr;
  PtrInc := PtrData.IncPtrWith;
  c := 0;
  case CTS of
    0: cts0();
    1: cts1();
    2: cts2();
  end;
  SetLength(Points, C);
  Move(ClientTPA[0], Points[0], C * SizeOf(TPoint));
  Result := C > 0;
  TClient(Client).IOManager.FreeReturnData;
end;

Note that for each cts, we have a subprocedure which also includes the entire ``loop''. This is not a *real* problem when the loops are small, even though it's not a perfect example of code reuse - but it'll get messy when we use it for those *big* loops, I think.

At the moment I can't think of another method that will supposedly be faster than the approach taken in FindColorsTolerance, but it will *add* a lot of code. And if you find a bug in one of those loops, you have to fix it for all the CTS subprocedures in the procedure, not optimal. Plus, if we add an extra CTS we have to add a subprocedure with the loop for the procedure for _each_ procedure.

From: Wizzup?
At the moment I can't think of another method that will supposedly be faster than the approach taken in FindColorsTolerance, but it will *add* a lot of code. And if you find a bug in one of those loops, you have to fix it for all the CTS subprocedures in the procedure, not optimal. Plus, if we add an extra CTS we have to add a subprocedure with the loop for the procedure for _each_ procedure.

Sounds like you're unsure whether or not to add CTS3? Also, what exactly is the difference between 2 and 3?

From: Coh3n
Sounds like you're unsure whether or not to add CTS3? Also, what exactly is the difference between 2 and 3?

No, I'm not unsure about adding CTS 3. I'm just discussing technical solutions to implementing it in an efficient an maintainable way. I already have a CTS 3 proof of concept, which I will show in a thread in a few days - it uses the L*a*b colour space based on human perception.

From: Wizzup?
No, I'm not unsure about adding CTS 3. I'm just discussing technical solutions to implementing it in an efficient an maintainable way. I already have a CTS 3 proof of concept, which I will show in a thread in a few days - it uses the L*a*b colour space based on human perception.

Oh okay. :p I definitely got he wrong impression from your post. :duh: I need to read up on the technical part of colors.

From: Coh3n
Oh okay. :p I definitely got he wrong impression from your post. :duh: I need to read up on the technical part of colors.

Well, this was actually not even about how the colours work, just really about how finder.pas should be rewritten, to make the code more maintainable and readable. :)

From: Wizzup?
Well, this was actually not even about how the colours work, just really about how finder.pas should be rewritten, to make the code more maintainable and readable. :)

I know, I was more or less just saying in general. The ***40; nonsense it kind of annoying when trying to read it hha.

E: I'm probably misunderstanding the advantages, but why have subprocedures? Doesn't that mean the same "subprocedure" will be used elseware meaning you're just repeating code? So why not have separate procedures?

I think what he wants is a more general approach, so it can be used multiple times without making more procedures. Like a template for it.

function TMFinder.FindColorsTolerance(out Points: TPointArray; Color, xs, ys,
  xe, ye, Tol: Integer): Boolean;
var
  PtrData: TRetData;
  Ptr: PRGB32;
  PtrInc,C: Integer;
  dX, dY, clR, clG, clB: Integer;
  b: boolean;

  procedure cts(which: integer);
  var
    b: boolean;
    xx, yy: integer;
    H1, S1, L1, H2, S2, L2, hueXTol, satXTol: Extended;
  begin
    if (which = 2) then
    begin
      ColorToHSL(color,H1,S1,L1);
      HueXTol := hueMod * Tol;
      SatXTol := satMod * Tol;
    end;

    for yy := ys to ye do
    begin
      for xx := xs to xe do
      begin
        case which of
          0: b := (abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clR-Ptr^.R) <= Tol);
          1: b := (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol);
          2: begin
               RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
               b := (abs(H1 - H2) <= HueXTol) and (abs(S1 - S2) <= SatXTol) and (abs(L1 - L2) <= Tol);
             end;
        end;

        if (b) then
        begin
          ClientTPA[c].x := xx;
          ClientTPA[c].y := yy;
          Inc(c);
        end;

        Inc(Ptr);
      end;

      Inc(Ptr, PtrInc);
    end;
  end;

begin
  Result := false;
  DefaultOperations(xs,ys,xe,ye);

  dX := xe - xs;
  dY := ye - ys;
  //next, convert the color to r,g,b
  ColorToRGB(Color, clR, clG, clB);

  PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);

  // Do we want to "cache" these vars?
  // We will, for now. Easier to type.
  Ptr := PtrData.Ptr;
  PtrInc := PtrData.IncPtrWith;
  c := 0;
  case CTS of
    0: cts0();
    1: cts1();
    2: cts2();
  end;
  SetLength(Points, C);
  Move(ClientTPA[0], Points[0], C * SizeOf(TPoint));
  Result := C > 0;
  TClient(Client).IOManager.FreeReturnData;
end;

Can you do this sub procedure thing in PS? Also not sure if CTS3 would require another nested loop or not.

I don't think you can do that.

I'll be completely honest, I'm only responding to what you said in IRC and not what was said in the post:

Cleanest/Best way I found to implement this was to have each comparison function written with the same deceleration (c pseudocode follows) that can be cast to:

typedef bool (compfunc*)(void *a, void *b);

void* is a bit of a hack, but it works with casting, say, any sort of pointer (i.e. HSL or LAB structure that might be more than 32/64 bits) or regular machine width numbers (32 bit int for RGB). Casting, at least in C, is just syntactic sugar and translates to no real overhead. Second step is to have a "global" pointer for the actual comparison function that all methods use. When you switch comparision functions, you switch out the pointers. This has the overhead of one dereference and one function call pushing two address sized arguments to the stack. In pascal you could declare these as "regcall" (or whatever that convention is called), and even though its a function pointer the arguments can be passed in the registers and you'll ONLY have the overhead of a function call per comparison.

Fastest/Dirtiest way is to write separate find routines for each comparison type, inline the comparisons, and do a similar trick where you have global function pointers to the actual searching routines instead of the comparison routine. I honestly don't know the speed difference between the two, but theoretically this will be faster. Don't be the guy that tries to make the case that a function call (especially using registers to pass data) has a lot of overhead, though.

EDIT: Read you post sort of, Wizzup. What sort of support does FPC have for compile time macros? Would be trivial to simply substitute in the appropriate code for the general algorithms of the searching routines. I could, perhaps, write something up in C as a proof of concept. Note that you all seem to be using nested procedures much the same way as I was suggesting using function pointers, however if I remember correctly, nested procedures add significant overhead related to variable scoping. Could be the case that FPC disallowed the use of the containing procedure's local variables, however.

I like BenLand's Idea of using functional pointers. To me, that makes a world of sense. If you make it global and maintain it in other means, then that would make sense.

Uhm, why not make a class which will encapsulate it and just have the finder class have it as a field. Then we can change it inside the object and no one is the wiser.

Functional pointers also mean that we can add more CTS (heaven forbid) with ease as well as maintain speed and little to no code reuse.

Seems like a jolly good idea to me!

@coh3n, thats what we had before.. but thats a waste of a sub-procedure as you might as well pull it out… or put that inside. We actually had that setup before lol.

From: Nava2
@coh3n, thats what we had before.. but thats a waste of a sub-procedure as you might as well pull it out… or put that inside. We actually had that setup before lol.

Yeah I don't know the point of a subprocedure, but I kept it just cause they were already used. Wizzup mentioned something about updating all three of the subprocedures if one broke so I just combined them.

The pointer idea sounds more organized and overall better.

I also brought the above suggestions up in a personal conversation with Wizzup. Separate functions would probably be the fastest, but results in "ugly" code. You could indeed try and make it a bit more maintainable by using macro's or perhaps even a script that generates your code.

Using a general comparing procedure is nice and clean, but would probably slow things down (especially if you're going to recalculate the HSL values for the first colour like in Ben's example). If you don't want to recalculate, you'll have to pass all those variables as it is now, which isn't elegant at all (and not very easy to maintain either).

Using pointers to maintain the current finding/matching function has the upside of being easily expandable, even from the outside (in theory, you could write your own CTS in Pascal Script or a plugin).

Refactoring* (not rewriting ;)) the current code to use subprocedures brings structure in the code and makes it easier to read, without making any real adjustments that affect performance. Speed-wise, I think this is the best solution. You could even abstract the matching functions (as there's no need for a CTS case anymore, as I assume the ColorSame function has now) and inline them.

Another thing that popped into my mind, but probably isn't really an option at this time, was using a JIT compiler to create a comparing function at runtime. That way, you'll only have to pass one colour every time. The first color, the CTS and tolerance will all be hardcoded.

Yeah, macros came to mind, it's probably not the most clean solution, though. I can't imagine it being too pretty anyway.

The void function call + pointer to args was something I've been wanted to check out as well, but it doesn't feel like a very pretty approach. (This is also why I wondered if Pascal had unions, although we can probably do it without unions)

From: BenLand100
I'll be completely honest, I'm only responding to what you said in IRC and not what was said in the post:

Cleanest/Best way I found to implement this was to have each comparison function written with the same deceleration (c pseudocode follows) that can be cast to:

typedef bool (compfunc*)(void *a, void *b);

void* is a bit of a hack, but it works with casting, say, any sort of pointer (i.e. HSL or LAB structure that might be more than 32/64 bits) or regular machine width numbers (32 bit int for RGB). Casting, at least in C, is just syntactic sugar and translates to no real overhead. Second step is to have a "global" pointer for the actual comparison function that all methods use. When you switch comparision functions, you switch out the pointers. This has the overhead of one dereference and one function call pushing two address sized arguments to the stack. In pascal you could declare these as "regcall" (or whatever that convention is called), and even though its a function pointer the arguments can be passed in the registers and you'll ONLY have the overhead of a function call per comparison.

Fastest/Dirtiest way is to write separate find routines for each comparison type, inline the comparisons, and do a similar trick where you have global function pointers to the actual searching routines instead of the comparison routine. I honestly don't know the speed difference between the two, but theoretically this will be faster. Don't be the guy that tries to make the case that a function call (especially using registers to pass data) has a lot of overhead, though.

I feel that it kind of matters at the moment, since we currently pass like 10+ variables to the function. It'd be terrible if it wasn't inlined.

From: BenLand100
EDIT: Read you post sort of, Wizzup. What sort of support does FPC have for compile time macros? Would be trivial to simply substitute in the appropriate code for the general algorithms of the searching routines. I could, perhaps, write something up in C as a proof of concept. Note that you all seem to be using nested procedures much the same way as I was suggesting using function pointers, however if I remember correctly, nested procedures add significant overhead related to variable scoping. Could be the case that FPC disallowed the use of the containing procedure's local variables, however.

FPC supports some macros, but they generally discourage it and told me to use inline when I asked about it. I'm unsure if they have multiline macros.

I don't think there should be an overhead in a subprocedure related to variable scoping… At least, I hope there isn't. Might be interesting to verify that.

From: nielsie95
I also brought the above suggestions up in a personal conversation with Wizzup. Separate functions would probably be the fastest, but results in "ugly" code. You could indeed try and make it a bit more maintainable by using macro's or perhaps even a script that generates your code.

Using a script feels … dirty. I know it can be common practice but I don't feel the code is that unmaintainable.

From: nielsie95
Using a general comparing procedure is nice and clean, but would probably slow things down (especially if you're going to recalculate the HSL values for the first colour like in Ben's example). If you don't want to recalculate, you'll have to pass all those variables as it is now, which isn't elegant at all (and not very easy to maintain either).

Using pointers to maintain the current finding/matching function has the upside of being easily expandable, even from the outside (in theory, you could write your own CTS in Pascal Script or a plugin).

I think benland meant to pass a struct / record with the precalculated data in there. (Or at least a pointer to the record…)

From: nielsie95
Refactoring* (not rewriting ;)) the current code to use subprocedures brings structure in the code and makes it easier to read, without making any real adjustments that affect performance. Speed-wise, I think this is the best solution. You could even abstract the matching functions (as there's no need for a CTS case anymore, as I assume the ColorSame function has now) and inline them.

Yes, ColorSame uses a case. I was also planning to add a ColorSame per CTS if we were going for the subprocedure tactic. It may be interesting to look at the scoping stuff, although I think there shouldn't be a real overhead.

From: nielsie95
Another thing that popped into my mind, but probably isn't really an option at this time, was using a JIT compiler to create a comparing function at runtime. That way, you'll only have to pass one colour every time. The first color, the CTS and tolerance will all be hardcoded.

I think you made something like this before, didn't you? Surely seems like a fun thing to investigate / look at.

From: nielsie95
especially if you're going to recalculate the HSL values for the first colour like in Ben's example

This is not necessary, as you could easily have the "reference" color be in whatever color space you are currently in, and the "compared" color be packed rgb, or the like.

From: Wizzup?
The void function call + pointer to args was something I've been wanted to check out as well, but it doesn't feel like a very pretty approach. (This is also why I wondered if Pascal had unions, although we can probably do it without unions)

You misunderstood, i think, what I meant by using a pointer. I only meant that the "pointer" could refer to a color that wouldn't fit in a single stack space, or rather simply be the argument, depending on the colorspace used.

From: Wizzup?
I feel that it kind of matters at the moment, since we currently pass like 10+ variables to the function. It'd be terrible if it wasn't inlined.

Why so many variables?

From: Wizzup?
I think benland meant to pass a struct / record with the precalculated data in there. (Or at least a pointer to the record…)

Yes, but it can depend on what the circumstances are (that's the beauty of void* in C).

Just as an aside, there is no reason you can't pack HSL, LAB, XYZ, etc into 32 bit numbers. True, that will limit you to about 2^10 levels (N.B. 2^8 levels might be better, performance wise), but with the added benefit of being able to pass things easier without all the heap overhead.

This program: https://github.com/BenLand100/CBAS has an implementation using function pointers (with the downside of having to convert the first color each time, but that could be quite easily avoided by simply using the reference/compared scheme I mentioned). Note that it was not really optimized, but the theory is there.

From: BenLand100
This is not necessary, as you could easily have the "reference" color be in whatever color space you are currently in, and the "compared" color be packed rgb, or the like.


You misunderstood, i think, what I meant by using a pointer. I only meant that the "pointer" could refer to a color that wouldn't fit in a single stack space, or rather simply be the argument, depending on the colorspace used.

I think that's what I meant.

From: BenLand100

Why so many variables?

The idea was: if it is inlined, the amount of variables shouldn't matter. So every R, G, B, H, S, L value already calculated is passed.

From: BenLand100

Yes, but it can depend on what the circumstances are (that's the beauty of void* in C).

Just as an aside, there is no reason you can't pack HSL, LAB, XYZ, etc into 32 bit numbers. True, that will limit you to about 2^10 levels (N.B. 2^8 levels might be better, performance wise), but with the added benefit of being able to pass things easier without all the heap overhead.

This program: https://github.com/BenLand100/CBAS has an implementation using function pointers (with the downside of having to convert the first color each time, but that could be quite easily avoided by simply using the reference/compared scheme I mentioned). Note that it was not really optimized, but the theory is there.

I think we currently use floats for all, so that should not be an issue.

From: BenLand100
This is not necessary, as you could easily have the "reference" color be in whatever color space you are currently in, and the "compared" color be packed rgb, or the like.

Ah, you're right, didn't think about that. :) Perhaps you could compare a few implementations (speed wise), wizzup?

From: nielsie95
Ah, you're right, didn't think about that. :) Perhaps you could compare a few implementations (speed wise), wizzup?

Yes. I will. I'm actually running into some bugs in Simba wrt CTS now as well,
FindBitmapToleranceIn apparently has never worked with CTS 2. H, S, and L are
just left at 0. ;)

E: Actually, this is a rather serious issue wrt to performance. We may have to make some modifications to TMufasaBitmap to provide a HSL bitmap (of the search bitmap only) as well, next to the RGB one… Or calculate it every time. :)




I actually thought of some other possible optimisations just now, but I have no idea if they will actually positively impact performance… :p
For example, if we know we are going to calculcate the H, S, L values of a pixel
more than once we could store the IR somewhere, although I have no idea how much
that will rape our cache. Same goes for L*a*b, but I think this is really only
required for those FindBitmapDeformedRotatedToleranceIn kind of functions. ;-)

I've fixed CTS 2 in FindBitmapToleranceIn, using the subprocedures and (hopefully… still have to test!) inline ColorSame.

A few benchmarks. (Look at the -O3 ones, not at the -O1 ones)

FindBitmapToleranceIn

    new: (1920x1080, bmp = 15x10, col=255, tol=10) (subprocedure; hopefully
    inline, -O3) (cts-sub-inline tag)
        cts 0: 81.8 ms each
        cts 1: 100.96 ms each
        cts 2: 208.47 ms each

    new: (1920x1080, bmp = 15x10, col=255, tol=10) (subprocedure; hopefully
    inline, -O1) (cts-sub-inline tag)
        cts 0: 102.64 ms each
        cts 1: 139.31 ms each
        cts 2: 235.33 ms each

    Old: (no cts 2; hopefully inline, no subprocedure, -O3) (cts-normal tag)
        CTS 0: 86.95 ms each
        CTS 1: 108.8 ms each

    Old: (no cts 2; hopefully inline, no subprocedure, -O1) (cts-normal tag)
        CTS 0: 98.73 ms each
        CTS 1: 136.6 ms each

And on an unrelated note, CTS 3 benchmark. It's kinda slow… but I'm sure
there's room for improvement.

FindColorsTolerance

new: (1920x1080, color clWhite, tol 30) (subprocedure; -O3) (HEAD for cts-rework with CIELab branch merged)
        cts 0: 74.74  ms each
        cts 1: 92.58  ms each
        cts 2: 214.57 ms each
        cts 3: 1796.57 ms each

I'll look at the other methods later. :)

From: Wizzup?
Point taken, although you must admit optimising is always fun. I know you've already seen the thread, but now you're gained some more theoretical insight as well as some more information about the context, want to take a look a this thread (http://villavu.com/forum/showthread.php?t=64908) and help decide on the ``best'' way to make the current code pretty?

Mainly, what do you think about the subprocedures? (see first post) AFAIK this is the only way to do inline without having a ``case'' for each and every cts. (As you can see in my last post that makes a big difference)
If you use a pointer to the current CTS comparison method, you can't inline it.

E: So, my conclusion for now is to keep it as subprocedures but make the actual comparison method inline. (That is, pass the two colours as RGB (with or without? struct) and in the loop call the cts_X_comparison() method. Any comments on that?

Mmk, if you all missed this thread then go read it.

• Sub-procedures == BLOATED CODE and offer no real benefits over Inline.
• Inlining is the fastest method, but extremely silly when you have multiple methods (accessing the global variable 'which' is going to be nearly as intensive as a function call, and will prevent the code from ever going into the cache)
• Function pointers offer relatively fast alternative to inlining, since chances are the variables will not be in registers when used anyway, nor will the code fit in the cache.

People have talked about using "structs" to pass things to functions, and this is only useful if your color data is already in some sort of structure (either way you look at it, the color will have to be loaded onto the stack whether in a structure or a function call). Pushing 7 values onto the stack is NOT that bad (and fpc has the register/fastcall option, look into it).

I would go with function pointers because the code is cleaner and involves less repetition. Sure inlining is fast, but not really applicable here. Last chance solution would be using macros to generate sub procedures, but ONLY if you can take advantage of variables already being on the stack (still very little gained from not passing them to a regular function call).

The Biggest Problem With Speed in this code is the programming, and the fact that the FPC compiler is shitty. Note the following:

program proof;  
 
{$mode objfpc}{$H+} 
 
uses 
  Classes, SysUtils; 

function slowest(Rref,Gref,Bref,r,g,b,tol:integer):boolean;
begin
    result:= sqrt(sqr(R - Rref) + sqr(G - Gref) + sqr(B - BRef)) <= Tol;
end;

function slower(Rref,Gref,Bref,r,g,b,tol:integer):boolean;
begin
    result:= sqr(R - Rref) + sqr(G - Gref) + sqr(B - BRef) <= Tol*Tol;
end;

function slow(Rref,Gref,Bref,r,g,b,tol:integer):boolean;
begin
    R -= Rref;
    G -= Gref;
    B -= Bref;
    result:= R*R+G*G+B*B <= Tol*Tol;
end;

function fast(Rref,Gref,Bref,r,g,b,tol:integer):boolean; register;
begin
    R -= Rref;
    G -= Gref;
    B -= Bref;
    result:= R*R+G*G+B*B <= Tol*Tol;
end;
 
var 
    R, G, B, Rref, Gref, Bref, Tol, c: Integer;
    t: TDateTime; 
begin 
    Rref := 128; 
    Gref := 128; 
    BRef := 128; 
    Tol := 10;
 
    c := 0; 
    t := Now(); 
    for R := 0 to 255 do 
        for G := 0 to 255 do 
            for B := 0 to 255 do 
                if slowest(Rref,Gref,Bref,R,G,B,tol) then 
                    Inc(c);
    t := Now() - t; 
    WriteLn('slowest: ', c, ' hits in ', t*1000*1000, ' &#956;s.');
     
    c := 0; 
    t := Now(); 
    for R := 0 to 255 do 
        for G := 0 to 255 do 
            for B := 0 to 255 do 
                if slower(Rref,Gref,Bref,R,G,B,tol) then 
                    Inc(c);
    t := Now() - t; 
    WriteLn('slower: ', c, ' hits in ', t*1000*1000, ' &#956;s.');
     
    c := 0; 
    t := Now(); 
    for R := 0 to 255 do 
        for G := 0 to 255 do 
            for B := 0 to 255 do 
                if slow(Rref,Gref,Bref,R,G,B,tol) then 
                    Inc(c);
    t := Now() - t; 
    WriteLn('slow: ', c, ' hits in ', t*1000*1000, ' &#956;s.');
     
    c := 0; 
    t := Now(); 
    for R := 0 to 255 do 
        for G := 0 to 255 do 
            for B := 0 to 255 do 
                if fast(Rref,Gref,Bref,R,G,B,tol) then 
                    Inc(c);
    t := Now() - t; 
    WriteLn('fast: ', c, ' hits in ', t*1000*1000, ' &#956;s.');
     
end.

benland100@bland:~/Desktop/segfault$ fpc -O3 proof.pas -a
Free Pascal Compiler version 2.4.0-2ubuntu1.10.10 [2011/06/17] for i386
Copyright (c) 1993-2009 by Florian Klaempfl
Note: Switching assembler to default source writing assembler
Target OS: Linux for i386
Compiling proof.pas
Assembling proof
Linking proof
/usr/bin/ld: warning: link.res contains output sections; did you forget -T?
83 lines compiled, 0.2 sec 
1 note(s) issued
benland100@bland:~/Desktop/segfault$ ./proof 
slowest: 4169 hits in  9.67592495726421E+000 μs.
slower: 4169 hits in  3.18287493428215E+000 μs.
slow: 4169 hits in  2.97453516395763E+000 μs.
fast: 4169 hits in  2.78935476671904E+000 μs.

Look at the relative time for algorithmically equivalent code (I actually have no idea what the unit of time is there, but that is beyond the point). For the love of god, don't use sqrt (or abs) ever if you can square the thing you compare it to (or the things themselves) easily. Computers are good at addition, subtraction, and multiplication — not much else. I do not trust FPC's sqr operator, either. Sometimes it makes things better, sometimes much worse. Of course, this might not ALWAYS be the case since FPC is notorious for making bad use of registers, but TRY other forms of the code and SEE which produces better machine code before trying to make everything more complex.

Okay, did some more work. So far master actually seems faster; at least for FindColorsTolerance. But in master that function is completely inlined, so not a fair comparison. The most important parts are the first two, cts-rework and cts-rework,pre-rewrite. Notice that not having the method inline doesn't really seem to matter. Currently I'm passing structs and have a comparison function pointer in cts-rework post-rewrite.

Bitmap: 1920x1081.

Cts-rework, 733a8cbf320ca29f1edf60b9e29f1ae5c0d68b67 (no cts 2 optimisation yet)
CTS 0: 20.76 - 150497
CTS 1: 35.48 - 102101
CTS 2: 220.54 - 9775

cts-rework, pre-rewrite
CTS 0: 18.42 - 150497
CTS 1: 36.96 - 102101
CTS 2: 194.7 - 9775

Master
CTS 0: 10.99 - 150597
CTS 1: 23.61 - 102101
CTS 2: 179.61 - 9775

Hiya,

I just finished the (new!) FindBitmapToleranceIn implementation, so I think I have all concepts covered. (cts-rework branch, and as far as I know it just works… but I'll do more exhaustive tests later)

Little benchmark, nothing interesting. I don't even remember the client size, I just know the old and new methods used an identical client:

Tolerance 255, new method:

cts: 0 - 6.16ms (found)
cts: 1 - 6.63ms (found)
cts: 2 - 21.84ms (not found, required higher tol, so proper result)

Tol 10, new method:

cts: 0 - 12.78ms
cts: 1 - 10.63ms
cts: 2 - 21.56ms

Tol 255, old method:

cts: 0 - 8.82ms (found)
cts: 1 - 5.92ms (found)
cts: 2 - not avail

Tol 10, old method:

cts: 0 - 11.97ms
cts: 1 - 14.94ms
cts: 2 - not avail

So the speed is really comparable, and the larger the bitmap gets, the more we should benefit from the new method. (speedwise)

Adding CTS 3 also worked fine (and it was a breeze to add it, especially compared to the old system), but more on that later.

E: So, now that this is done I can start converting all the finder.pas methods, which was the real point. It has been proven to be a viable alternative. And it's a *lot* more maintainable and expandable. And I have future ideas for optimisations.

I've written a simple test script in lape, unfinished but checks most of the colour finding functions. The results before and after merging cts-rework are the same, except for some speed differences. (Both positive and negative, negligible regardless. For bitmaps it will be faster)
If Bitmaps and DTMs also don't differ when it comes to results, then I'll release 0.98-rc1. :)

Note that the write_int and other procedures are really silly and can probably just use tostring(); there was something with the casting before but I don't think it was a lape bug, just me being tired. Regardless, this works.

program FinderTest;

{
    Use different CTS'es:
        CTS 0, 1, 2. (And 3, later on)

    SetToleranceSpeed, GetToleranceSpeed


    Color

    [X] function CountColor(Color, xs, ys, xe, ye: Integer): Integer;
    [X] function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
    [X] function FindColor(out x, y: Integer; Color, xs, ys, xe, ye: Integer): Boolean;
    [X] function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;
    [X] function FindColorSpiralTolerance(var x, y: Integer; color, xs, ys, xe, ye,Tol: Integer): Boolean;
    [X] function FindColorTolerance(out x, y: Integer; Color, xs, ys, xe, ye, tol: Integer): Boolean;
    [X] function FindColorsTolerance(out Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean;
    [X] function FindColorsSpiralTolerance(x, y: Integer; out Points: TPointArray; color, xs, ys, xe, ye: Integer; Tol: Integer) : boolean;
    [X] function FindColors(var TPA: TPointArray; Color, xs, ys, xe, ye: Integer): Boolean;
    [ ] function FindColoredArea(var x, y: Integer; color, xs, ys, xe, ye: Integer; MinArea: Integer): Boolean;
    [ ] function FindColoredAreaTolerance(var x, y: Integer; color, xs, ys, xe, ye: Integer; MinArea, tol: Integer): Boolean;

    Mask

    [ ] function FindMaskTolerance(const mask: TMask; out x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;

    Bitmap

    [ ] function FindBitmap(bitmap: TMufasaBitmap; out x, y: Integer): Boolean;
    [ ] function FindBitmapIn(bitmap: TMufasaBitmap; out x, y: Integer;  xs, ys, xe, ye: Integer): Boolean;
    [ ] function FindBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;
    [ ] function FindBitmapSpiral(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
    [ ] function FindBitmapSpiralTolerance(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;
    [ ] function FindBitmapsSpiralTolerance(bitmap: TMufasaBitmap; x, y: Integer; out Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;
    [ ] function FindDeformedBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; out accuracy: Extended): Boolean;

    DTM

    [ ] function FindDTM(DTM: TMDTM; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
    [ ] function FindDTMs(DTM: TMDTM; out Points: TPointArray; x1, y1, x2, y2 : integer; maxToFind: Integer = 0): Boolean;
    [ ] function FindDTMRotated(DTM: TMDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended; Alternating : boolean): Boolean;
    [ ] function FindDTMsRotated(DTM: TMDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray;Alternating : boolean; maxToFind: Integer = 0): Boolean;
}

const
    bench_times = 10;
    out_file = 'test.out';
    test_bmp = 'wall.bmp';

    col = 7698820;
    tol = 50;

var f: integer;
    bmp: integer;
    t: integer;
    w,h: integer;

const LE =
{$IFDEF LINUX}
#10;
{$ELSE}
#10#13;
{$ENDIF}

type
    PInteger = ^Integer;

procedure write_str(s: string);
begin
  writefilestring(f, s + LE);
  writeln(s);
end;

procedure write_int(int: integer);
begin
  write_str(inttostr(Pinteger(@int)^));
end;

procedure test_findcolor;
var i: integer;
var foo, bar: integer;
begin
  write_str('------------------------------------------------');
  t := gettickcount();
  for i := 0 to bench_times do
    findcolor(foo, foo, col, 0, 0, w - 1, h - 1);

  if findcolor(foo, bar, col, 0, 0, w - 1, h - 1) then
  begin
    write_str('found');
    write_int(foo);
    write_int(bar);
  end;

  write_str(tostring((gettickcount() - t) / bench_times));
end;

procedure test_findcolorspiral;
var i: integer;
var foo, bar: integer;
begin
  write_str('------------------------------------------------');
  t := gettickcount();
  for i := 0 to bench_times do
  begin
    foo := 42;
    bar := 500;
    findcolorspiral(foo, bar, col, 0, 0, w - 1, h - 1);
  end;

  foo := 42;
  bar := 500;
  if findcolorspiral(foo, bar, col, 0, 0, w - 1, h - 1) then
  begin
    write_str('found');
    write_int(foo);
    write_int(bar);
  end;

  write_str(tostring((gettickcount() - t) / bench_times));
end;

procedure test_findcolorspiraltolerance;
var i: integer;
var foo, bar: integer;
begin
  write_str('------------------------------------------------');
  t := gettickcount();
  for i := 0 to bench_times do
  begin
    foo := 42;
    bar := 500;
    findcolorspiraltolerance(foo, bar, col, 0, 0, w - 1, h - 1, tol);
  end;

  foo := 42;
  bar := 500;
  if findcolorspiraltolerance(foo, bar, col, 0, 0, w - 1, h - 1, tol) then
  begin
    write_str('found');
    write_int(foo);
    write_int(bar);
  end;

  write_str(tostring((gettickcount() - t) / bench_times));
end;

procedure test_findcolors;
var i: integer;
tpa: array of tpoint;
begin
  write_str('------------------------------------------------');
  t := gettickcount();
  for i := 0 to bench_times do
  begin
    findcolors(tpa, col, 0, 0, w - 1, h - 1);
  end;

  if findcolors(tpa, col, 0, 0, w - 1, h - 1) then
  begin
    write_str('found');
    write_int(length(tpa));
    write_str(tostring(tpa));
  end;

  write_str(tostring((gettickcount() - t) / bench_times));
end;

procedure test_findcolorstolerance;
var i: integer;
tpa: array of tpoint;
begin
  write_str('------------------------------------------------');
  t := gettickcount();
  for i := 0 to bench_times do
  begin
    findcolorstolerance(tpa, col, 0, 0, w - 1, h - 1, tol);
  end;

  if findcolorstolerance(tpa, col, 0, 0, w - 1, h - 1, tol) then
  begin
    write_str('found');
    write_int(length(tpa));
    setlength(tpa, 10); // only print first 10
    write_str(tostring(tpa));
  end;

  write_str(tostring((gettickcount() - t) / bench_times));
end;

procedure test_findcolorsspiraltolerance;
var i: integer;
foo,bar: integer;
tpa: array of tpoint;
begin
  write_str('------------------------------------------------');
  t := gettickcount();
  for i := 0 to bench_times do
  begin
    foo := 42; bar := 500;
    findcolorsspiraltolerance(foo, bar, tpa, col, 0, 0, w - 1, h - 1, tol);
  end;

  foo := 42; bar := 500;
  if findcolorsspiraltolerance(foo, bar, tpa, col, 0, 0, w - 1, h - 1, tol) then
  begin
    write_str('found');
    write_int(length(tpa));
    setlength(tpa, 10); // only print first 10
    write_str(tostring(tpa));
  end;

  write_str(tostring((gettickcount() - t) / bench_times));
end;

procedure test_countcolor;
var i: integer;
count: integer;
begin
  write_str('------------------------------------------------');
  t := gettickcount();
  for i := 0 to bench_times do
  begin
    countcolor(col, 0, 0, w-1,h-1);
  end;

  count := countcolor(col,0,0,w-1,h-1);
  write_int(count);

  write_str(tostring((gettickcount() - t) / bench_times));

end;

procedure test_countcolortolerance;
var i: integer;
count: integer;
begin
  write_str('------------------------------------------------');
  t := gettickcount();
  for i := 0 to bench_times do
  begin
    countcolortolerance(col, 0, 0, w-1,h-1,tol);
  end;

  count := countcolortolerance(col,0,0,w-1,h-1,tol);
  write_int(count);

  write_str(tostring((gettickcount() - t) / bench_times));

end;


var cts: integer;

begin
  f := rewritefile('/home/merlijn/Programs/simba/Tests/lape/' + out_file, false);
  bmp := loadbitmap(test_bmp);
  settargetbitmap(bmp);
  getbitmapsize(bmp,w,h);

  for cts := 0 to 2 do
  begin
    SetColorToleranceSpeed(cts);

    test_findcolor();
    test_findcolorspiral();
    test_findcolorspiraltolerance();

    test_findcolors();
    test_findcolorstolerance();
    test_findcolorsspiraltolerance();

    test_countcolor();
    test_countcolortolerance();
  end;

  setdesktopasclient();
  closefile(f);
  freebitmap(bmp);
end.

PS: This all ran fine on Linux, x86_64. :)

From: Wizzup?
PS: This all ran fine on Linux, x86_64. :)

This may actually be my incentive to move to Linux. :garfield:

Wizzup. Could you post some Benchmarks.

MML(Not sure what it's called) Vs Lape comparision.

~Home

From: Home
Wizzup. Could you post some Benchmarks.

MML(Not sure what it's called) Vs Lape comparision.

~Home

Ah, but this has nothing to do with lape. I just wrote the test script in lape. What did was test the results of stuff like findcolor() etc before and after a lot of changes I made (which will also bring cts 3 and others); it wasn't meant to be a lape benchmark. (These are all changes to the MML) Anyway, lape is a lot faster than pascalscript, our previous interpreter.

As for these changes, it'll most likely be positive, but I doubt you will notice a huge difference except for CTS 2; as Simba/MML is generally fast enough for all the tasks already. :p