How to optimize this code?

Everything else that doesn't fall into one of the other PB categories.
User avatar
jacdelad
Addict
Addict
Posts: 2010
Joined: Wed Feb 03, 2021 12:46 pm
Location: Riesa

How to optimize this code?

Post by jacdelad »

Hello,
I am currently checking out how different binarization algorithms work (and it's amazing, what you can do with a little afford). Currently I only implemented different greyscaling algorithms and a threshold given as absolute or relative (in percent) value. Next will be including histograms and some filters.
However, I initially planned to use a CustomFilterCallback, but this isn't possible, because I can't add more variables to the function (I need them to tell which algorithm to use). I could use a global variable, but then it won't be threadsafe.

So here's my question: Has anyone maybe an idea how to pass this additional variables to the callback function? Is this even better than including the code in the main function like I do now?

Code for reference (use a compiled version when testing the live function; may not work as expected with enabled desktop scaling):

Code: Select all

Enumeration Binarization
  #Bin_Alg_Relative
  #Bin_Alg_Absolute
EndEnumeration
Enumeration PreBinarization
  #Bin_Pre_BT709
  #Bin_Pre_Equal
  #Bin_Pre_REC601
  #Bin_Pre_BT2100
  #Bin_Pre_RedChannel
  #Bin_Pre_GreenChannel
  #Bin_Pre_BlueChannel
EndEnumeration

Procedure Binarize(Image.i,Border.a=50,Algorithm.a=#Bin_Alg_Relative,PreProcessing.a=#Bin_Pre_BT709)
  Protected Result.i,x.l,y.l,Pixel.l,r.a,g.a,b.a,Res.a,Color.l
  If IsImage(Image)
    Result=CopyImage(Image,#PB_Any)
    If Result
      StartDrawing(ImageOutput(Result))
      For x=0 To ImageWidth(Result)-1
        For y=0 To ImageHeight(Result)-1
          Pixel=Point(x,y)
          r=Red(Pixel)
          g=Green(Pixel)
          b=Blue(Pixel)
          
          Select PreProcessing
            Case #Bin_Pre_BT709
              Res=0.2126*r+0.7152*g+0.0722*b
            Case #Bin_Pre_Equal
              Res=(r+g+b)/3
            Case #Bin_Pre_REC601
              Res=0.299*r+0.587*g+0.114*b
            Case #Bin_Pre_BT2100
              Res=0.2627*r+0.678*g+0.0593*b
            Case #Bin_Pre_RedChannel
              Res=r
            Case #Bin_Pre_GreenChannel
              Res=g
            Case #Bin_Pre_BlueChannel
              Res=b
          EndSelect
          
          Select Algorithm
            Case #Bin_Alg_Absolute
              If Res>Border
                Color=#White
              Else
                Color=#Black
              EndIf
            Case #Bin_Alg_Relative
              If Res>Border*2.55
                Color=#White
              Else
                Color=#Black
              EndIf
          EndSelect
          
          Plot(x,y,Color)
        Next
      Next
      StopDrawing()
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  
  Procedure LiveEvents()
    If GetGadgetState(7)
      If Bin And IsImage(Bin):FreeImage(Bin):EndIf
      Bin=Binarize(0,Val(GetGadgetText(4)),GetGadgetState(2),GetGadgetState(1))
      SetGadgetState(0,ImageID(Bin))
    EndIf
  EndProcedure
  
  UseJPEGImageDecoder()
  LoadImage(0,OpenFileRequester("Load file","","*.jpg",0))
  If IsImage(0)
    OpenWindow(0,0,0,ImageWidth(Bin)+200,ImageHeight(Bin)+20,"Binarization Test",#PB_Window_SystemMenu)
    ImageGadget(0,10,10,WindowWidth(0),WindowHeight(0),ImageID(0))
    ComboBoxGadget(1,GadgetWidth(0)+20,10,170,25)
    ComboBoxGadget(2,GadgetWidth(0)+20,45,170,25)
    TextGadget(3,GadgetWidth(0)+20,85,100,20,"Border:")
    StringGadget(4,GadgetWidth(0)+120,80,70,25,"50",#PB_String_Numeric)
    SetGadgetState(4,50)
    SetGadgetText(4,"50")
    ButtonGadget(5,GadgetWidth(0)+20,115,170,25,"Let's go!")
    ButtonGadget(6,GadgetWidth(0)+20,150,170,25,"Original")
    ButtonGadget(7,GadgetWidth(0)+20,185,170,25,"Go live!",#PB_Button_Toggle)
    
    AddGadgetItem(1,-1,"BT709")
    AddGadgetItem(1,-1,"Equal")
    AddGadgetItem(1,-1,"REC601")
    AddGadgetItem(1,-1,"BT2100")
    AddGadgetItem(1,-1,"Red Channel")
    AddGadgetItem(1,-1,"Green Channel")
    AddGadgetItem(1,-1,"Blue Channel")
    SetGadgetState(1,0)
    
    AddGadgetItem(2,-1,"Relative")
    AddGadgetItem(2,-1,"Absolute")
    SetGadgetState(2,0)
    
    BindGadgetEvent(1,@LiveEvents(),#PB_EventType_Change)
    BindGadgetEvent(2,@LiveEvents(),#PB_EventType_Change)
    BindGadgetEvent(4,@LiveEvents(),#PB_EventType_Change)
    
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 5;Do binarization
              If Bin And IsImage(Bin):FreeImage(Bin):EndIf
              Bin=Binarize(0,Val(GetGadgetText(4)),GetGadgetState(2),GetGadgetState(1))
              SetGadgetState(0,ImageID(Bin))
            Case 6;Revert to original image
              SetGadgetState(0,ImageID(0))
            Case 7;Live view
              If GetGadgetState(7)
                DisableGadget(5,#True)
                If Bin And IsImage(Bin):FreeImage(Bin):EndIf
                Bin=Binarize(0,Val(GetGadgetText(4)),GetGadgetState(2),GetGadgetState(1))
                SetGadgetState(0,ImageID(Bin))
              Else
                DisableGadget(5,#False)
              EndIf
          EndSelect
      EndSelect
    ForEver
  Else
    MessageRequester("Error","Image could not be loaded!",#PB_MessageRequester_Error)  
  EndIf
CompilerEndIf
Also, when I'm done, is there any interest to have it put Tips&Tricks? As I told before I am working for a company that processes PCBs and I am programming the machines that test them after printing and again after soldering. Binarization is the main key to find out whether the board is fine or not. This caught my interest and I'm trying to recreate the algorithms the software uses.
Good morning, that's a nice tnetennba!

PureBasic 6.21/Windows 11 x64/Ryzen 7900X/32GB RAM/3TB SSD
Synology DS1821+/DX517, 130.9TB+50.8TB+2TB SSD
User avatar
Demivec
Addict
Addict
Posts: 4269
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: How to optimize this code?

Post by Demivec »

Here's my thoughts on a few things you mentioned.

I think the CustomFilterCallback is not the best way to handle the things you mentioned. One of the reasons is that you are probably always going to be operating on either the entire image or rectangular sections of the same. You would primarily be using the callback to give you access to each pixel in turn to operate on and that can be done by accessing the DrawingBuffer also. I think it is fine if the processing is minimal or especially useful if you are doing things with drawing operations that aren't simply a Box().

If you are needing to perform a filtert with values from several pixels instead of just one then a callback won't work either. It would most likely use a lot of book keeping to keep track of things and you would have to test for edge cases for the sides of an image or area as well.

If the variables you are passing can be encoded in a single RGBA color value (i.e. a long), you can pass them as a drawing color used with the drawing operation making use of the callback. This unfortunately isn't big enough for a pointer except in x86 compilations. My opinion is that you have to use a global structure of some sort.

I appreciate you mentioning the ideas on binarization and think those are worthy of a posting in Tips N Tricks or continuing a descussion of as you try things out.
User avatar
jacdelad
Addict
Addict
Posts: 2010
Joined: Wed Feb 03, 2021 12:46 pm
Location: Riesa

Re: How to optimize this code?

Post by jacdelad »

Aye thanks for that.

I always thought using a custom filter callback would be much faster than doing it with two for loops. It was just an idea for use when manipulating the pixels directly without referring to the neighborhood and such. When using a histogram and other methods I'll need two passes anyway, so I can keep it all in the main function.
Good morning, that's a nice tnetennba!

PureBasic 6.21/Windows 11 x64/Ryzen 7900X/32GB RAM/3TB SSD
Synology DS1821+/DX517, 130.9TB+50.8TB+2TB SSD
User avatar
jacdelad
Addict
Addict
Posts: 2010
Joined: Wed Feb 03, 2021 12:46 pm
Location: Riesa

Re: How to optimize this code?

Post by jacdelad »

Worked a bit on it. Some optimizations and 3 new modes: Adaptive (narrows the spectrum down to the used colors), Count (you decide how many pixels are black (in percent) and the darkest will be affected) and Rasterize (which I discovered by accident and may not work; try it out!).

Code: Select all

Enumeration Binarization
  #Bin_Binarization_Relative ;0..100:  Percentage
  #Bin_Binarization_Absolute ;0..255:  8bit value
  #Bin_Binarization_Adaptive ;0..100:  Percentage, only within range of used colors
  #Bin_Binarization_Count    ;0..100:  Percent of pixels that are white
  #Bin_Binarization_Rasterize;ignored: Rasterize image
EndEnumeration
Enumeration Greyscale
  #Bin_Greyscale_BT709
  #Bin_Greyscale_Equal
  #Bin_Greyscale_REC601
  #Bin_Greyscale_BT2100
  #Bin_Greyscale_RedChannel
  #Bin_Greyscale_GreenChannel
  #Bin_Greyscale_BlueChannel
  #Bin_Greyscale_Custom
EndEnumeration

Procedure Greyscale(Image.i,Algorithm.a=#Bin_Greyscale_BT709,fR.f=0,fG.f=0,fB.f=0)
  Protected Result.i=-1,x.l,y.l,r.a,g.b,b.a
  If IsImage(Image)
    Result=CopyImage(Image,#PB_Any)
    If Result<>0 And IsImage(Result)
      StartDrawing(ImageOutput(Result))
      For x=0 To w-1
        For y=0 To h-1
          Pixel=Point(x,y)
          r=Red(Pixel)
          g=Green(Pixel)
          b=Blue(Pixel)
          
          Select Algorithm
            Case #Bin_Greyscale_BT709
              Res=0.2126*r+0.7152*g+0.0722*b
            Case #Bin_Greyscale_Equal
              Res=(r+g+b)/3
            Case #Bin_Greyscale_REC601
              Res=0.299*r+0.587*g+0.114*b
            Case #Bin_Greyscale_BT2100
              Res=0.2627*r+0.678*g+0.0593*b
            Case #Bin_Greyscale_RedChannel
              Res=r
            Case #Bin_Greyscale_GreenChannel
              Res=g
            Case #Bin_Greyscale_BlueChannel
              Res=b
            Case #Bin_Greyscale_Custom
              Res=fR*R+fG*g+fB*b
          EndSelect
          
          Plot(x,y,Res)
        Next
      Next
      StopDrawing()      
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure Binarize(Image.i,Border.a=50,Algorithm.a=#Bin_Binarization_Relative,PreProcessing.a=#Bin_Greyscale_BT709)
  Protected Result.i=-1,x.l,y.l,Pixel.l,r.a,g.a,b.a,Res.a,Min.a=255,Max.a,w.l=ImageWidth(Image),h.l=ImageHeight(Image),Dim Values.a(w-1,h-1),Dim Count.l(255),Count.l,Counter.l
  If IsImage(Image)
    Result=CopyImage(Image,#PB_Any)
    If Result<>0 And IsImage(Result)
      StartDrawing(ImageOutput(Result))
      
      If Algorithm=#Bin_Binarization_Relative
        Border=Border*2.55
      EndIf
      
      For x=0 To w-1
        For y=0 To h-1
          Pixel=Point(x,y)
          r=Red(Pixel)
          g=Green(Pixel)
          b=Blue(Pixel)
          
          Select PreProcessing
            Case #Bin_Greyscale_BT709
              Res=0.2126*r+0.7152*g+0.0722*b
            Case #Bin_Greyscale_Equal
              Res=(r+g+b)/3
            Case #Bin_Greyscale_REC601
              Res=0.299*r+0.587*g+0.114*b
            Case #Bin_Greyscale_BT2100
              Res=0.2627*r+0.678*g+0.0593*b
            Case #Bin_Greyscale_RedChannel
              Res=r
            Case #Bin_Greyscale_GreenChannel
              Res=g
            Case #Bin_Greyscale_BlueChannel
              Res=b
            Case #Bin_Greyscale_Custom
              Res=fR*R+fG*g+fB*b
          EndSelect
          
          Select Algorithm
            Case #Bin_Binarization_Absolute,#Bin_Binarization_Relative
              If Res>Border
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Case #Bin_Binarization_Absolute,#Bin_Binarization_Rasterize
              If Res>Border
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
              Border=Border*2.55
            Case #Bin_Binarization_Adaptive
              Values(x,y)=Res
              If Res<Min:Min=Res:EndIf
              If Res>Max:Max=Res:EndIf
            Case #Bin_Binarization_Count
              Values(x,y)=Res
              Count(Res)+1
          EndSelect
          
        Next
      Next
      
      Select Algorithm
        Case #Bin_Binarization_Adaptive
          Border=Min+Border*(Max-Min)/100
          For x=0 To w-1
            For y=0 To h-1
              If Values(x,y)>Border
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
        Case #Bin_Binarization_Count
          
          Count=Border*w*h/100
          Counter=0
          
          For x=0 To 255
            Counter+Count(x)
            If Counter>Count
              Border=x-1
              Break
            EndIf
          Next
          
          For x=0 To w-1
            For y=0 To h-1
              If Values(x,y)>Border
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
      EndSelect
      
      StopDrawing()
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  
  Procedure LiveEvents()
    If GetGadgetState(7)
      If Bin And IsImage(Bin):FreeImage(Bin):EndIf
      Bin=Binarize(0,Val(GetGadgetText(4)),GetGadgetState(2),GetGadgetState(1))
      SetGadgetState(0,ImageID(Bin))
    EndIf
  EndProcedure
  
  UseJPEGImageDecoder()
  LoadImage(0,OpenFileRequester("Load file","","*.jpg",0))
  If IsImage(0)
    OpenWindow(0,0,0,ImageWidth(Bin)/1.5+200,ImageHeight(Bin)/1.5+20,"Binarization Test",#PB_Window_SystemMenu)
    ImageGadget(0,10,10,WindowWidth(0),WindowHeight(0),ImageID(0))
    ComboBoxGadget(1,GadgetWidth(0)+20,10,170,25)
    ComboBoxGadget(2,GadgetWidth(0)+20,45,170,25)
    TextGadget(3,GadgetWidth(0)+20,85,100,20,"Border:")
    StringGadget(4,GadgetWidth(0)+120,80,70,25,"50",#PB_String_Numeric)
    SetGadgetState(4,50)
    SetGadgetText(4,"50")
    ButtonGadget(5,GadgetWidth(0)+20,115,170,25,"Let's go!")
    ButtonGadget(6,GadgetWidth(0)+20,150,170,25,"Original")
    ButtonGadget(7,GadgetWidth(0)+20,185,170,25,"Go live!",#PB_Button_Toggle)
    
    AddGadgetItem(1,-1,"BT709")
    AddGadgetItem(1,-1,"Equal")
    AddGadgetItem(1,-1,"REC601")
    AddGadgetItem(1,-1,"BT2100")
    AddGadgetItem(1,-1,"Red Channel")
    AddGadgetItem(1,-1,"Green Channel")
    AddGadgetItem(1,-1,"Blue Channel")
    SetGadgetState(1,0)
    
    AddGadgetItem(2,-1,"Relative")
    AddGadgetItem(2,-1,"Absolute")
    AddGadgetItem(2,-1,"Adaptive")
    AddGadgetItem(2,-1,"Count")
    AddGadgetItem(2,-1,"Rasterize")
    SetGadgetState(2,0)
    
    BindGadgetEvent(1,@LiveEvents(),#PB_EventType_Change)
    BindGadgetEvent(2,@LiveEvents(),#PB_EventType_Change)
    BindGadgetEvent(4,@LiveEvents(),#PB_EventType_Change)
    
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 5;Do binarization
              If Bin And IsImage(Bin):FreeImage(Bin):EndIf
              Bin=Binarize(0,Val(GetGadgetText(4)),GetGadgetState(2),GetGadgetState(1))
              SetGadgetState(0,ImageID(Bin))
            Case 6;Revert to original image
              SetGadgetState(0,ImageID(0))
            Case 7;Live view
              If GetGadgetState(7)
                DisableGadget(5,#True)
                If Bin And IsImage(Bin):FreeImage(Bin):EndIf
                Bin=Binarize(0,Val(GetGadgetText(4)),GetGadgetState(2),GetGadgetState(1))
                SetGadgetState(0,ImageID(Bin))
              Else
                DisableGadget(5,#False)
              EndIf
          EndSelect
      EndSelect
    ForEver
  Else
    MessageRequester("Error","Image could not be loaded!",#PB_MessageRequester_Error)  
  EndIf
CompilerEndIf
Edit: Regression fix and added function for greyscaling a picture (without binarization). Also renamed the constants.
Good morning, that's a nice tnetennba!

PureBasic 6.21/Windows 11 x64/Ryzen 7900X/32GB RAM/3TB SSD
Synology DS1821+/DX517, 130.9TB+50.8TB+2TB SSD
User avatar
jacdelad
Addict
Addict
Posts: 2010
Joined: Wed Feb 03, 2021 12:46 pm
Location: Riesa

Re: How to optimize this code?

Post by jacdelad »

I implemented BlockMode which is my first attempt on weighing the pixel related to its neigbour pixels. I like the outcome (though I will improve the algorithm), but it becomes quite slow, because for every pixel it has to process a looooot of neighbour pixels. Maybe someone has an idea how to speed this up.
I also implemented a version of the OTSU algorithm, which doesn't need a threshold and calculates it itself. Try it out!

Code: Select all

EnableExplicit
Enumeration Binarization
  #Bin_Binarization_Relative ;0..100:  Percentage
  #Bin_Binarization_Absolute ;0..255:  8bit value
  #Bin_Binarization_Range    ;0..100:  Percentage, only within range of used colors
  #Bin_Binarization_Count    ;0..100:  Percent of pixels that are black
  #Bin_Binarization_Rasterize;ignored: Rasterize image
  #Bin_Binarization_BlockMode;2..?:    Adapts to neighbour pixels, blocksize (always even numbers, not lower than 2!) to control the block size; speed decreases drastically with bigger block sizes!
  #Bin_Binarization_OTSU     ;Self adaption, doesn't need threshold
EndEnumeration
Enumeration Greyscale
  #Bin_Greyscale_BT709
  #Bin_Greyscale_Equal
  #Bin_Greyscale_REC601
  #Bin_Greyscale_BT2100
  #Bin_Greyscale_RedChannel
  #Bin_Greyscale_GreenChannel
  #Bin_Greyscale_BlueChannel
  #Bin_Greyscale_Custom
EndEnumeration

Procedure Greyscale(Image.i,Algorithm.a=#Bin_Greyscale_BT709,fR.f=0,fG.f=0,fB.f=0)
  Protected Result.i=-1,x.l,y.l,r.a,g.b,b.a,w.l,h.l,Pixel.l,Res.l
  If IsImage(Image)
    Result=CopyImage(Image,#PB_Any)
    If Result<>0 And IsImage(Result)
      StartDrawing(ImageOutput(Result))
      For x=0 To w-1
        For y=0 To h-1
          Pixel=Point(x,y)
          r=Red(Pixel)
          g=Green(Pixel)
          b=Blue(Pixel)
          
          Select Algorithm
            Case #Bin_Greyscale_BT709
              Res=0.2126*r+0.7152*g+0.0722*b
            Case #Bin_Greyscale_Equal
              Res=(r+g+b)/3
            Case #Bin_Greyscale_REC601
              Res=0.299*r+0.587*g+0.114*b
            Case #Bin_Greyscale_BT2100
              Res=0.2627*r+0.678*g+0.0593*b
            Case #Bin_Greyscale_RedChannel
              Res=r
            Case #Bin_Greyscale_GreenChannel
              Res=g
            Case #Bin_Greyscale_BlueChannel
              Res=b
            Case #Bin_Greyscale_Custom
              Res=fR*R+fG*g+fB*b
          EndSelect
          
          Plot(x,y,Res)
        Next
      Next
      StopDrawing()      
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure _Min(a.l,b.l)
  If a>b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
Procedure _Max(a.l,b.l)
  If a<b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure

Procedure Binarize(Image.i,Threshold.a=50,Algorithm.a=#Bin_Binarization_Relative,PreProcessing.a=#Bin_Greyscale_BT709,fR.f=0,fG.f=0,fB.f=0)
  Protected Result.i=-1,x.l,y.l,Pixel.l,r.a,g.a,b.a,Res.a,Min.a=255,Max.a,w.l=ImageWidth(Image),h.l=ImageHeight(Image),Count.l,Counter.l
  Protected Dim Values.a(w-1,h-1),Dim Count.l(255),xa.l,ya.l
  
  Select Algorithm
    Case #Bin_Binarization_BlockMode
      Threshold=Threshold/2
    Case #Bin_Binarization_Relative
      Threshold=Threshold*2.55
  EndSelect
  
  If IsImage(Image)
    Result=CopyImage(Image,#PB_Any)
    If Result<>0 And IsImage(Result)
      StartDrawing(ImageOutput(Result))
      
      For x=0 To w-1
        For y=0 To h-1
          Pixel=Point(x,y)
          r=Red(Pixel)
          g=Green(Pixel)
          b=Blue(Pixel)
          
          Select PreProcessing
            Case #Bin_Greyscale_BT709
              Res=0.2126*r+0.7152*g+0.0722*b
            Case #Bin_Greyscale_Equal
              Res=(r+g+b)/3
            Case #Bin_Greyscale_REC601
              Res=0.299*r+0.587*g+0.114*b
            Case #Bin_Greyscale_BT2100
              Res=0.2627*r+0.678*g+0.0593*b
            Case #Bin_Greyscale_RedChannel
              Res=r
            Case #Bin_Greyscale_GreenChannel
              Res=g
            Case #Bin_Greyscale_BlueChannel
              Res=b
            Case #Bin_Greyscale_Custom
              Res=fR*R+fG*g+fB*b
          EndSelect
          
          Select Algorithm
            Case #Bin_Binarization_Absolute,#Bin_Binarization_Relative
              If Res>Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Case #Bin_Binarization_Absolute,#Bin_Binarization_Rasterize
              If Res>Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
              Threshold=Threshold*2.55
            Case #Bin_Binarization_Range
              Values(x,y)=Res
              If Res<Min:Min=Res:EndIf
              If Res>Max:Max=Res:EndIf
            Case #Bin_Binarization_Count,#Bin_Binarization_OTSU
              Values(x,y)=Res
              Count(Res)+1
            Case #Bin_Binarization_BlockMode
              Values(x,y)=Res
          EndSelect
          
        Next
      Next
      
      Select Algorithm
        Case #Bin_Binarization_Range
          Threshold=Min+Threshold*(Max-Min)/100
          For x=0 To w-1
            For y=0 To h-1
              If Values(x,y)>Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
        Case #Bin_Binarization_Count
          Count=Threshold*w*h/100
          Counter=0
          For x=0 To 255
            Counter+Count(x)
            If Counter>Count
              Threshold=x-1
              Break
            EndIf
          Next
          For x=0 To w-1
            For y=0 To h-1
              If Values(x,y)>Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_BlockMode
          For x=0 To w-1
            For y=0 To h-1
              Count=0
              Counter=-1
              For xa=_Min(x-Threshold,0) To _Max(x+Threshold,w-1)
                For ya=_Min(y-Threshold,0) To _Max(y+Threshold,h-1)
                  Counter+1
                  Count+Values(xa,ya)
                Next
              Next
              If Values(x,y)*Counter>Count-Values(x,y)
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_OTSU
          
          Count=0
          For x=0 To 255
            If Count(x)>Count
              Count=Count(x)
              Max=x
            EndIf
          Next
          Counter=0
          For x=255 To 0 Step -1
            If Count(x)>counter And (Count(x)<Count Or x<>Max)
              Counter=Count(x)
              Min=x
            EndIf
          Next
          Threshold=Max+(Min-Max)/2
          For x=0 To w-1
            For y=0 To h-1
              If Values(x,y)>Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
      EndSelect
      
      StopDrawing()
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  Global Bin  
  
  Procedure LiveEvents()
    If GetGadgetState(7)
      If Bin And IsImage(Bin):FreeImage(Bin):EndIf
      Bin=Binarize(0,Val(GetGadgetText(4)),GetGadgetState(2),GetGadgetState(1))
      SetGadgetState(0,ImageID(Bin))
    EndIf
  EndProcedure
  
  UseJPEGImageDecoder()
  LoadImage(0,OpenFileRequester("Load file","","*.jpg",0))
  If IsImage(0)
    OpenWindow(0,0,0,ImageWidth(Bin)/1.5+200,ImageHeight(Bin)/1.5+20,"Binarization Test",#PB_Window_SystemMenu)
    ImageGadget(0,10,10,WindowWidth(0),WindowHeight(0),ImageID(0))
    ComboBoxGadget(1,GadgetWidth(0)+20,10,170,25)
    ComboBoxGadget(2,GadgetWidth(0)+20,45,170,25)
    TextGadget(3,GadgetWidth(0)+20,85,95,20,"Threshold:")
    StringGadget(4,GadgetWidth(0)+120,80,70,25,"50",#PB_String_Numeric)
    ButtonGadget(5,GadgetWidth(0)+20,115,170,25,"Let's go!")
    ButtonGadget(6,GadgetWidth(0)+20,150,170,25,"Original")
    ButtonGadget(7,GadgetWidth(0)+20,185,170,25,"Go live!",#PB_Button_Toggle)
    
    AddGadgetItem(1,-1,"BT709")
    AddGadgetItem(1,-1,"Equal")
    AddGadgetItem(1,-1,"REC601")
    AddGadgetItem(1,-1,"BT2100")
    AddGadgetItem(1,-1,"Red Channel")
    AddGadgetItem(1,-1,"Green Channel")
    AddGadgetItem(1,-1,"Blue Channel")
    SetGadgetState(1,0)
    
    AddGadgetItem(2,-1,"Relative")
    AddGadgetItem(2,-1,"Absolute")
    AddGadgetItem(2,-1,"Range")
    AddGadgetItem(2,-1,"Count")
    AddGadgetItem(2,-1,"Rasterize")
    AddGadgetItem(2,-1,"BlockMode")
    AddGadgetItem(2,-1,"OTSU")
    SetGadgetState(2,0)
    
    BindGadgetEvent(1,@LiveEvents(),#PB_EventType_Change)
    BindGadgetEvent(2,@LiveEvents(),#PB_EventType_Change)
    BindGadgetEvent(4,@LiveEvents(),#PB_EventType_Change)
    
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 5;Do binarization
              If Bin And IsImage(Bin):FreeImage(Bin):EndIf
              Bin=Binarize(0,Val(GetGadgetText(4)),GetGadgetState(2),GetGadgetState(1))
              SetGadgetState(0,ImageID(Bin))
            Case 6;Revert to original image
              SetGadgetState(0,ImageID(0))
            Case 7;Live view
              If GetGadgetState(7)
                DisableGadget(5,#True)
                If Bin And IsImage(Bin):FreeImage(Bin):EndIf
                Bin=Binarize(0,Val(GetGadgetText(4)),GetGadgetState(2),GetGadgetState(1))
                SetGadgetState(0,ImageID(Bin))
              Else
                DisableGadget(5,#False)
              EndIf
          EndSelect
      EndSelect
    ForEver
  Else
    MessageRequester("Error","Image could not be loaded!",#PB_MessageRequester_Error)  
  EndIf
CompilerEndIf
Good morning, that's a nice tnetennba!

PureBasic 6.21/Windows 11 x64/Ryzen 7900X/32GB RAM/3TB SSD
Synology DS1821+/DX517, 130.9TB+50.8TB+2TB SSD
User avatar
Demivec
Addict
Addict
Posts: 4269
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: How to optimize this code?

Post by Demivec »

Your _Min() and _Max() procedures seem to be misnamed, they return the maximum and minimum respectively. Is that intentional?

Code: Select all

Procedure _Min(a.l,b.l)
  If a>b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
Procedure _Max(a.l,b.l)
  If a<b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
User avatar
jacdelad
Addict
Addict
Posts: 2010
Joined: Wed Feb 03, 2021 12:46 pm
Location: Riesa

Re: How to optimize this code?

Post by jacdelad »

Hi Demivrc,
yes. The _Min procedure limits the value when starting the loop (the loop counts up, so the lower value). The value must not be lower than 0, so it returns the bigger one. _Max does the the same the other way round. Maybe naming it LimitMin and LimitMax would be more clear.
Good morning, that's a nice tnetennba!

PureBasic 6.21/Windows 11 x64/Ryzen 7900X/32GB RAM/3TB SSD
Synology DS1821+/DX517, 130.9TB+50.8TB+2TB SSD
User avatar
jacdelad
Addict
Addict
Posts: 2010
Joined: Wed Feb 03, 2021 12:46 pm
Location: Riesa

Re: How to optimize this code?

Post by jacdelad »

In the meantime I have corrected/improved the example code and changed some things suggested by idle. The (in the example not used) Greyscale function is currently not working correct, will fix this in the next version. I also added the Sauvola algorithm, which has 3 parameters; only one is dynamically set at the time (set it to 5, the higher the value, the longer the calculation takes).

Code: Select all

EnableExplicit
Enumeration Binarization
  #Bin_Binarization_Relative ;0..100:  Percentage
  #Bin_Binarization_Absolute ;0..255:  8bit value
  #Bin_Binarization_Range    ;0..100:  Percentage, only within range of used colors
  #Bin_Binarization_Count    ;0..100:  Percent of pixels that are black
  #Bin_Binarization_Rasterize;ignored: Rasterize image
  #Bin_Binarization_BlockMode;2..254:    Adapts to neighbour pixels, blocksize (always even numbers, not lower than 2!) to control the block size; speed decreases drastically with bigger block sizes!
  #Bin_Binarization_OTSU     ;Self adaption, doesn't need threshold
  #Bin_Binarization_Sauvola  ;1..255: Mean/deviation calculation, very cpu consuming, higher value=darker result
EndEnumeration
Enumeration Greyscale
  #Bin_Greyscale_BT709
  #Bin_Greyscale_Equal
  #Bin_Greyscale_REC601
  #Bin_Greyscale_BT2100
  #Bin_Greyscale_RedChannel
  #Bin_Greyscale_GreenChannel
  #Bin_Greyscale_BlueChannel
  #Bin_Greyscale_Custom
EndEnumeration

Structure sRGB 
  sr.f
  sg.f
  sb.f 
  sa.f 
EndStructure   

Structure mRGB 
  StructureUnion 
    col.l 
    b.a
    g.a
    r.a 
    a.a 
  EndStructureUnion 
EndStructure 

Procedure CopyMemoryToImage(Memory, ImageNumber)
 
  Protected TemporaryDC, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO
 
  TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
 
  GetObject_(ImageID(ImageNumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
 
  TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
  TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
  TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
  TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
  TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
  TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
 
  SetDIBits_(TemporaryDC, ImageID(ImageNumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo, #DIB_RGB_COLORS)
 
  DeleteDC_(TemporaryDC)
 
EndProcedure

Procedure CopyImageToMemory(ImageNumber, Memory)
 
  Protected TemporaryDC, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO
 
  TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
 
  GetObject_(ImageID(ImageNumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
  
   
  TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
  TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
  TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
  TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
  TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
  TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
 
  GetDIBits_(TemporaryDC, ImageID(ImageNumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo, #DIB_RGB_COLORS)
 
  DeleteDC_(TemporaryDC)
 
EndProcedure

Procedure Greyscale(Image.i,Algorithm.a=#Bin_Greyscale_BT709,fR.f=0,fG.f=0,fB.f=0)
  Protected Result.i=-1,x.l,y.l,r.a,g.b,b.a,w.l,h.l,Pixel.l,Res.l
  Protected srgb.sRGB,*mem.mRGB,*out, size,ct       
  If IsImage(Image)
    
     size = (ImageWidth(image)*ImageHeight(image)*SizeOf(mrgb)) 
    *mem = AllocateMemory(size) 
    *out = *mem 
    
    srgb\sa = 1.0 
    Select Algorithm
      Case #Bin_Greyscale_BT709
        srgb\sr = 0.2126 : srgb\sg = 0.7152 : srgb\sb = 0.0722
      Case #Bin_Greyscale_Equal
        srgb\sr = 1.0 : srgb\sg = 1.0 : srgb\sb = 1.0 : srgb\sa = 1.0 / 3.0 
      Case #Bin_Greyscale_REC601
        srgb\sr = 0.299 : srgb\sg = 0.587 : srgb\sb = 0.114 
      Case #Bin_Greyscale_BT2100
        srgb\sr = 0.2627 : srgb\sg = 0.678 : srgb\sb = 0.0593 
      Case #Bin_Greyscale_RedChannel
        srgb\sr = 1.0 : srgb\sg = 0 : srgb\sb = 0
      Case #Bin_Greyscale_GreenChannel
        srgb\sr = 0 : srgb\sg = 1.0 : srgb\sb = 0
      Case #Bin_Greyscale_BlueChannel
        srgb\sr = 0 : srgb\sg = 0 : srgb\sb = 1.0 
      Case #Bin_Greyscale_Custom
        srgb\sr = fr : srgb\sg = fg : srgb\sb = fb : srgb\sa=1/(fr+fg+fb)
    EndSelect
            
     CopyImageToMemory(Image,*mem)      
     
     While ct < size    
        *mem\col = ((*mem\r * srgb\sr) + (*mem\g * srgb\sg) + (*mem\b * srgb\sb)) * srgb\sa  
        *mem+SizeOf(mrgb) 
        ct+SizeOf(mrgb)    
     Wend   
     
     CopyMemoryToImage(*out,Image) 
     
  EndIf
  ProcedureReturn image
EndProcedure

Procedure _LimitMin(a.l,b.l)
  If a>b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
Procedure _LimitMax(a.l,b.l)
  If a<b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
  
Procedure Binarize(Image.i,Threshold.a=50,Algorithm.a=#Bin_Binarization_Relative,PreProcessing.a=#Bin_Greyscale_BT709,fR.f=0,fG.f=0,fB.f=0)
  Protected Result.i=-1,x.l,y.l,Pixel.l,r.a,g.a,b.a,Res.a,Min.a=255,Max.a,w.l=ImageWidth(Image),h.l=ImageHeight(Image),Count.l,Counter.l
  Protected srgb.srgb 
  Protected Dim Values.a(w-1,h-1),Dim Count.l(255),Dim Deviation.a(0),xa.l,ya.l
  
  Select Algorithm
    Case #Bin_Binarization_BlockMode
      Threshold=Threshold/2
  EndSelect
  
  If IsImage(Image)
    srgb\sa = 1.0 
    Select PreProcessing
      Case #Bin_Greyscale_BT709
        srgb\sr = 0.2126 : srgb\sg = 0.7152 : srgb\sb = 0.0722
      Case #Bin_Greyscale_Equal
        srgb\sr = 1.0 : srgb\sg = 1.0 : srgb\sb = 1.0 : sRGB\sa = 1.0 / 3.0
      Case #Bin_Greyscale_REC601
        srgb\sr = 0.299 : srgb\sg = 0.587 : srgb\sb = 0.114 
      Case #Bin_Greyscale_BT2100
        srgb\sr = 0.2627 : srgb\sg = 0.678 : srgb\sb = 0.0593 
      Case #Bin_Greyscale_RedChannel
        srgb\sr = 1.0 : srgb\sg = 0 : srgb\sb = 0
      Case #Bin_Greyscale_GreenChannel
        srgb\sr = 0 : srgb\sg = 1.0 : srgb\sb = 0
      Case #Bin_Greyscale_BlueChannel
        srgb\sr = 0 : srgb\sg = 0 : srgb\sb = 1.0 
      Case #Bin_Greyscale_Custom
        srgb\sr = fr : srgb\sg = fg : srgb\sb = fb : srgb\sa=1/(fr+fg+fb)
    EndSelect
    
    Result=CopyImage(Image,#PB_Any)
    If Result<>0
      StartDrawing(ImageOutput(Result))
      
      
      Select Algorithm
        Case #Bin_Binarization_Absolute,#Bin_Binarization_Relative
          Threshold=Threshold*2.55
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              r=Red(Pixel)
              g=Green(Pixel)
              b=Blue(Pixel)
              If ((r * srgb\sr) + (g* srgb\sg) + (b * srgb\sb)) * srgb\sa > Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_Rasterize
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              r=Red(Pixel)
              g=Green(Pixel)
              b=Blue(Pixel)
              If ((r * srgb\sr) + (g* srgb\sg) + (b * srgb\sb)) * srgb\sa > Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
              Threshold=Threshold*2.55
            Next
          Next
          
        Case #Bin_Binarization_Range
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              r=Red(Pixel)
              g=Green(Pixel)
              b=Blue(Pixel)
              res = ((r * srgb\sr) + (g* srgb\sg) + (b * srgb\sb)) * srgb\sa  
              Values(x,y)=Res
              If Res<Min:Min=Res:EndIf
              If Res>Max:Max=Res:EndIf
            Next
          Next
          Threshold=Min+Threshold*(Max-Min)/100
          For x=0 To w-1
            For y=0 To h-1
              If Values(x,y)>Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_Count
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              r=Red(Pixel)
              g=Green(Pixel)
              b=Blue(Pixel)
              res = ((r * srgb\sr) + (g* srgb\sg) + (b * srgb\sb)) * srgb\sa  
              Values(x,y)=Res
              Count(Res)+1
            Next
          Next
          Count=Threshold*w*h/100
          Counter=0
          For x=0 To 255
            Counter+Count(x)
            If Counter>Count
              Threshold=x-1
              Break
            EndIf
          Next
          For x=0 To w-1
            For y=0 To h-1
              If Values(x,y)>Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_OTSU
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              r=Red(Pixel)
              g=Green(Pixel)
              b=Blue(Pixel)
              res = ((r * srgb\sr) + (g* srgb\sg) + (b * srgb\sb)) * srgb\sa  
              Values(x,y)=Res
              Count(Res)+1
            Next
          Next
          Count=0
          For x=0 To 255
            If Count(x)>Count
              Count=Count(x)
              Max=x
            EndIf
          Next
          Counter=0
          For x=255 To 0 Step -1
            If Count(x)>counter And (Count(x)<Count Or x<>Max)
              Counter=Count(x)
              Min=x
            EndIf
          Next
          Threshold=Max+(Min-Max)/2
          For x=0 To w-1
            For y=0 To h-1
              If Values(x,y)>Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_BlockMode
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              r=Red(Pixel)
              g=Green(Pixel)
              b=Blue(Pixel)
              Values(x,y)=((r * srgb\sr) + (g* srgb\sg) + (b * srgb\sb)) * srgb\sa
            Next
          Next
          For x=0 To w-1
            For y=0 To h-1
              Count=0
              Counter=-1
              For xa=_LimitMin(x-Threshold,0) To _LimitMax(x+Threshold,w-1)
                For ya=_LimitMin(y-Threshold,0) To _LimitMax(y+Threshold,h-1)
                  Counter+1
                  Count+Values(xa,ya)
                Next
              Next
              If Values(x,y)*Counter>Count-Values(x,y)
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_Sauvola
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              r=Red(Pixel)
              g=Green(Pixel)
              b=Blue(Pixel)
              Values(x,y)=((r * srgb\sr) + (g* srgb\sg) + (b * srgb\sb)) * srgb\sa
            Next
          Next
          Protected Mean.a,Dev.q,Variance.a
          For x=0 To w-1
            For y=0 To h-1
              Count=0
              Counter=0
              ReDim Deviation((_LimitMax(x+Threshold,w-1)-_LimitMin(x-Threshold,0)+1)*(_LimitMax(y+Threshold,h-1)-_LimitMin(y-Threshold,0)+1)-1)
              For xa=_LimitMin(x-Threshold,0) To _LimitMax(x+Threshold,w-1)
                For ya=_LimitMin(y-Threshold,0) To _LimitMax(y+Threshold,h-1)
                  Count+Values(xa,ya)
                  Deviation(counter)=Values(xa,ya)
                  Counter+1
                Next
              Next
              Mean=Count/Counter
              Dev=0
              For xa=0 To Counter-1
                Dev+Pow(Deviation(xa)-Mean)
              Next
              Variance=Pow(Dev/Counter,0.5)
              If Values(x,y)>Mean*(1+0.2*((Variance/128)-1))
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
            ;SetGadgetText(#Text2,Str(100*x/w)+"%")  
          Next
          ;SetGadgetText(#Text2,"")  
          
      EndSelect
      
      
      StopDrawing()
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  Global Bin,XML$
  
  Runtime Enumeration Windows
    #Window
  EndEnumeration
  Runtime Enumeration Gadgets
    #Image
    #Combo1
    #Combo2
    #Text1
    #String1
    #Button1
    #Button2
    #Button3
    #Text2
  EndEnumeration
  Enumeration XML
    #XML
  EndEnumeration
  Enumeration Dialogs
    #Dialog
  EndEnumeration

  Procedure LiveEvents()
    If GetGadgetState(#Button3)
      If Bin And IsImage(Bin):FreeImage(Bin):EndIf
        Bin=Binarize(0,Val(GetGadgetText(#String1)),GetGadgetState(#Combo2),GetGadgetState(#Combo1))
        SetGadgetState(#Image,ImageID(Bin))
    EndIf
  EndProcedure
  
  UseJPEGImageDecoder()
  LoadImage(0,OpenFileRequester("Load file","","*.jpg",0))
  
  XML$="<window id='#Window' name='MainWindow' text='Binarization Test' flags='#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget'>"+
       "<hbox expand='item:1'>"+
       "<image id='#Image' width='400' height='400'/>"+     
       "<vbox expand='item:8'>"+
       "<combobox id='#Combo1' width='150'/>"+
       "<combobox id='#Combo2' width='150'/>"+
       "<hbox expand='item:1'>"+
       "<text id='#Text1' text='Threshold:'/>"+
       "<string id='#String1' text='50' width='50' flags='#PB_String_Numeric'/>"+
       "</hbox>"+
       "<button id='#Button1' text='Lets go!'/>"+
       "<button id='#Button2' text='Original'/>"+
       "<button id='#Button3' text='Go live!' flags='#PB_Button_Toggle'/>"+
       "<text id='#Text2' text=''/>"+
       "<empty/>"+
       "</vbox>"+
       "</hbox>"+
       "</window>"
  
  If IsImage(0)
    
    ParseXML(#Xml, XML$)
    XMLStatus(#XML)
    CreateDialog(#Dialog)
    OpenXMLDialog(#Dialog, #Xml, "MainWindow")
    
    AddGadgetItem(#Combo1,-1,"BT709")
    AddGadgetItem(#Combo1,-1,"Equal")
    AddGadgetItem(#Combo1,-1,"REC601")
    AddGadgetItem(#Combo1,-1,"BT2100")
    AddGadgetItem(#Combo1,-1,"Red Channel")
    AddGadgetItem(#Combo1,-1,"Green Channel")
    AddGadgetItem(#Combo1,-1,"Blue Channel")
    SetGadgetState(#Combo1,0)
    
    AddGadgetItem(#Combo2,-1,"Relative")
    AddGadgetItem(#Combo2,-1,"Absolute")
    AddGadgetItem(#Combo2,-1,"Range")
    AddGadgetItem(#Combo2,-1,"Count")
    AddGadgetItem(#Combo2,-1,"Rasterize")
    AddGadgetItem(#Combo2,-1,"BlockMode")
    AddGadgetItem(#Combo2,-1,"OTSU")
    AddGadgetItem(#Combo2,-1,"Sauvola")
    SetGadgetState(#Combo2,0)
    
    BindGadgetEvent(#Combo1,@LiveEvents(),#PB_EventType_Change)
    BindGadgetEvent(#Combo2,@LiveEvents(),#PB_EventType_Change)
    BindGadgetEvent(#String1,@LiveEvents(),#PB_EventType_Change)
    SetGadgetState(#Image,ImageID(0))
    RefreshDialog(#Dialog)
    
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #Button1;Do binarization
              If Bin And IsImage(Bin):FreeImage(Bin):EndIf
              Bin=Binarize(0,Val(GetGadgetText(#String1)),GetGadgetState(#Combo2),GetGadgetState(#Combo1))
              ;bin = Greyscale(0,GetGadgetState(#Combo1))
              SetGadgetState(#Image,ImageID(Bin))
            Case #Button2;Revert to original image
              SetGadgetState(#Image,ImageID(0))
            Case #Button3;Live view
              If GetGadgetState(#Button3)
                DisableGadget(#Button1,#True)
                If Bin And IsImage(Bin):FreeImage(Bin):EndIf
                Bin=Binarize(0,Val(GetGadgetText(#String1)),GetGadgetState(#Combo2),GetGadgetState(#Combo1))
                SetGadgetState(#Image,ImageID(Bin))
              Else
                DisableGadget(#Button1,#False)
              EndIf
          EndSelect
      EndSelect
    ForEver
  Else
    MessageRequester("Error","Image could not be loaded!",#PB_MessageRequester_Error)  
  EndIf
CompilerEndIf
Upcoming:
Full control over parameters for algorithms that use more than one parameter, Bernsen algorithm (already done), possibly Niblack and Phansalkar algorithm (not done yet), multithreading test for algorithms that use more than one pass to work and tests with segment elimination.
Last edited by jacdelad on Tue Jul 25, 2023 9:15 am, edited 1 time in total.
Good morning, that's a nice tnetennba!

PureBasic 6.21/Windows 11 x64/Ryzen 7900X/32GB RAM/3TB SSD
Synology DS1821+/DX517, 130.9TB+50.8TB+2TB SSD
User avatar
idle
Always Here
Always Here
Posts: 5899
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: How to optimize this code?

Post by idle »

fixed the GreyScale and changed 1st 3 cases
If you have my tool you can uncomment the gccflags and it'll generate AVX rather than SSE optimizations

Code: Select all


;!//gccflags -mavx -O2;

EnableExplicit
Enumeration Binarization
  #Bin_Binarization_Relative ;0..100:  Percentage
  #Bin_Binarization_Absolute ;0..255:  8bit value
  #Bin_Binarization_Range    ;0..100:  Percentage, only within range of used colors
  #Bin_Binarization_Count    ;0..100:  Percent of pixels that are black
  #Bin_Binarization_Rasterize;ignored: Rasterize image
  #Bin_Binarization_BlockMode;2..254:    Adapts to neighbour pixels, blocksize (always even numbers, not lower than 2!) to control the block size; speed decreases drastically with bigger block sizes!
  #Bin_Binarization_OTSU     ;Self adaption, doesn't need threshold
  #Bin_Binarization_Sauvola  ;1..255: Mean/deviation calculation, very cpu consuming, higher value=darker result
EndEnumeration
Enumeration Greyscale
  #Bin_Greyscale_BT709
  #Bin_Greyscale_Equal
  #Bin_Greyscale_REC601
  #Bin_Greyscale_BT2100
  #Bin_Greyscale_RedChannel
  #Bin_Greyscale_GreenChannel
  #Bin_Greyscale_BlueChannel
  #Bin_Greyscale_Custom
EndEnumeration

Structure sRGB 
  sr.f
  sg.f
  sb.f 
  sa.f 
EndStructure   

Structure mRGB 
    r.a
    g.a
    b.a 
    a.a
EndStructure 

Procedure CopyMemoryToImage(Memory, ImageNumber)
 
  Protected TemporaryDC, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO
 
  TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
 
  GetObject_(ImageID(ImageNumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
 
  TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
  TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
  TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
  TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
  TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
  TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
 
  SetDIBits_(TemporaryDC, ImageID(ImageNumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo, #DIB_RGB_COLORS)
 
  DeleteDC_(TemporaryDC)
 
EndProcedure

Procedure CopyImageToMemory(ImageNumber, Memory)
 
  Protected TemporaryDC, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO
 
  TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
 
  GetObject_(ImageID(ImageNumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
  
   
  TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
  TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
  TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
  TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
  TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
  TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
 
  GetDIBits_(TemporaryDC, ImageID(ImageNumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo, #DIB_RGB_COLORS)
 
  DeleteDC_(TemporaryDC)
 
EndProcedure

Procedure Greyscale(Image.i,Algorithm.a=#Bin_Greyscale_BT709,fR.f=0,fG.f=0,fB.f=0)
  Protected Result.i=-1,x.l,y.l,r.a,g.b,b.a,w.l,h.l,Pixel.l,Res.l
  Protected srgb.sRGB,*mem.mRGB,*out, size,ct,col.f,ImageOut        
  If IsImage(Image)
    
    ImageOut = CopyImage(0,-1)  
    size = (ImageWidth(image)*ImageHeight(image)) << 2 
    *mem = AllocateMemory(size) 
    *out = *mem 
        
    srgb\sa = 1.0 
    Select Algorithm
      Case #Bin_Greyscale_BT709
        srgb\sr = 0.2126 : srgb\sg = 0.7152 : srgb\sb = 0.0722
      Case #Bin_Greyscale_Equal
        srgb\sr = 1.0 : srgb\sg = 1.0 : srgb\sb = 1.0 : srgb\sa = 1.0 / 3.0 
      Case #Bin_Greyscale_REC601
        srgb\sr = 0.299 : srgb\sg = 0.587 : srgb\sb = 0.114 
      Case #Bin_Greyscale_BT2100
        srgb\sr = 0.2627 : srgb\sg = 0.678 : srgb\sb = 0.0593 
      Case #Bin_Greyscale_RedChannel
        srgb\sr = 1.0 : srgb\sg = 0 : srgb\sb = 0
      Case #Bin_Greyscale_GreenChannel
        srgb\sr = 0 : srgb\sg = 1.0 : srgb\sb = 0
      Case #Bin_Greyscale_BlueChannel
        srgb\sr = 0 : srgb\sg = 0 : srgb\sb = 1.0 
      Case #Bin_Greyscale_Custom
        srgb\sr = fr : srgb\sg = fg : srgb\sb = fb
    EndSelect
            
     CopyImageToMemory(Image,*mem)      
     
     While ct < size    
       col.f = ((*mem\r * srgb\sr) + (*mem\g * srgb\sg ) + (*mem\b * srgb\sb)) *  srgb\sa  
       *mem\r = col 
       *mem\g = col 
       *mem\b = col 
       *mem+4
       ct+4    
     Wend   
     
     CopyMemoryToImage(*out,Imageout) 
     
     FreeMemory(*out) 
     
  EndIf
  ProcedureReturn imageout
EndProcedure

Procedure _LimitMin(a.l,b.l)
  If a>b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
Procedure _LimitMax(a.l,b.l)
  If a<b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
  
Procedure Binarize(Image.i,Threshold.a=50,Algorithm.a=#Bin_Binarization_Relative,PreProcessing.a=#Bin_Greyscale_BT709,fR.f=0,fG.f=0,fB.f=0)
  Protected Result.i=-1,x.l,y.l,Pixel.l,r.a,g.a,b.a,Res.a,Min.a=255,Max.a,w.l=ImageWidth(Image),h.l=ImageHeight(Image),Count.l,Counter.l
  Protected srgb.srgb 
  Protected Dim Values.a(w-1,h-1),Dim Count.l(255),Dim Deviation.a(0),xa.l,ya.l
  
  Result  = CopyImage(0,-1)  
  
  Protected size,*mem.mRGB,*out,ct 
  size = (ImageWidth(image)*ImageHeight(image)) << 2 
  *mem = AllocateMemory(size) 
  *out = *mem 
    
  Select Algorithm
    Case #Bin_Binarization_BlockMode
      Threshold=Threshold/2
  EndSelect
  
  If IsImage(Image)
    srgb\sa = 1.0 
    Select PreProcessing
      Case #Bin_Greyscale_BT709
        srgb\sr = 0.2126 : srgb\sg = 0.7152 : srgb\sb = 0.0722
      Case #Bin_Greyscale_Equal
        srgb\sr = 1.0 : srgb\sg = 1.0 : srgb\sb = 1.0 : sRGB\sa = 1.0 / 3.0
      Case #Bin_Greyscale_REC601
        srgb\sr = 0.299 : srgb\sg = 0.587 : srgb\sb = 0.114 
      Case #Bin_Greyscale_BT2100
        srgb\sr = 0.2627 : srgb\sg = 0.678 : srgb\sb = 0.0593 
      Case #Bin_Greyscale_RedChannel
        srgb\sr = 1.0 : srgb\sg = 0 : srgb\sb = 0
      Case #Bin_Greyscale_GreenChannel
        srgb\sr = 0 : srgb\sg = 1.0 : srgb\sb = 0
      Case #Bin_Greyscale_BlueChannel
        srgb\sr = 0 : srgb\sg = 0 : srgb\sb = 1.0 
      Case #Bin_Greyscale_Custom
        srgb\sr = fr : srgb\sg = fg : srgb\sb = fb : srgb\sa=1/(fr+fg+fb)
    EndSelect
    
    CopyImageToMemory(Image,*mem)      
    
    If Result<>0
           
      
      Select Algorithm
        Case #Bin_Binarization_Absolute,#Bin_Binarization_Relative
          Threshold=Threshold*2.55
          
           While ct < size    
             If (((*mem\r * srgb\sr) + (*mem\g * srgb\sg ) + (*mem\b * srgb\sb)) * srgb\sa) > Threshold   
               *mem\r = 255 : *mem\g = 255 : *mem\b = 255    
             Else 
                *mem\r = 0 : *mem\g = 0 : *mem\b = 0   
             EndIf 
             *mem+4
             ct+4    
           Wend   
           
           CopyMemoryToImage(*out,result) 
           FreeMemory(*out) 
           
           ProcedureReturn Result
           
        Case #Bin_Binarization_Rasterize
          
           While ct < size    
             If (((*mem\r * srgb\sr) + (*mem\g * srgb\sg ) + (*mem\b * srgb\sb))* srgb\sa) > Threshold   
               *mem\r = 255 : *mem\g = 255 : *mem\b = 255    
             Else 
                *mem\r = 0 : *mem\g = 0 : *mem\b = 0   
             EndIf 
             *mem+4
             ct+4 
             Threshold * 2.55
           Wend   
           
           CopyMemoryToImage(*out,result) 
           FreeMemory(*out) 
           
           ProcedureReturn Result
                   
        Case #Bin_Binarization_Range
          
          While ct < size    
            res = ((*mem\r * srgb\sr) + (*mem\g * srgb\sg ) + (*mem\b * srgb\sb))* srgb\sa
            *mem\r = res     
             If Res<Min:Min=Res:EndIf
             If Res>Max:Max=Res:EndIf
             *mem+4
             ct+4 
          Wend   
          
          *mem = *out 
           ct =0 
          Threshold=Min+Threshold*(Max-Min)/100
          
          While ct < size    
            If *mem\r > Threshold 
               *mem\r = 255 : *mem\g = 255 : *mem\b = 255     
             Else 
                *mem\r = 0 : *mem\g = 0 : *mem\b = 0   
             EndIf     
            *mem+4
            ct+4 
          Wend     
          
          CopyMemoryToImage(*out,result) 
          FreeMemory(*out) 
           
          ProcedureReturn Result

        Case #Bin_Binarization_Count
          StartDrawing(ImageOutput(Result))
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              r=Red(Pixel)
              g=Green(Pixel)
              b=Blue(Pixel)
              res = ((r * srgb\sr) + (g* srgb\sg) + (b * srgb\sb)) * srgb\sa  
              Values(x,y)=Res
              Count(Res)+1
            Next
          Next
          Count=Threshold*w*h/100
          Counter=0
          For x=0 To 255
            Counter+Count(x)
            If Counter>Count
              Threshold=x-1
              Break
            EndIf
          Next
          For x=0 To w-1
            For y=0 To h-1
              If Values(x,y)>Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_OTSU
          StartDrawing(ImageOutput(Result))
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              r=Red(Pixel)
              g=Green(Pixel)
              b=Blue(Pixel)
              res = ((r * srgb\sr) + (g* srgb\sg) + (b * srgb\sb)) * srgb\sa  
              Values(x,y)=Res
              Count(Res)+1
            Next
          Next
          Count=0
          For x=0 To 255
            If Count(x)>Count
              Count=Count(x)
              Max=x
            EndIf
          Next
          Counter=0
          For x=255 To 0 Step -1
            If Count(x)>counter And (Count(x)<Count Or x<>Max)
              Counter=Count(x)
              Min=x
            EndIf
          Next
          Threshold=Max+(Min-Max)/2
          For x=0 To w-1
            For y=0 To h-1
              If Values(x,y)>Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_BlockMode
          StartDrawing(ImageOutput(Result))
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              r=Red(Pixel)
              g=Green(Pixel)
              b=Blue(Pixel)
              Values(x,y)=((r * srgb\sr) + (g* srgb\sg) + (b * srgb\sb)) * srgb\sa
            Next
          Next
          For x=0 To w-1
            For y=0 To h-1
              Count=0
              Counter=-1
              For xa=_LimitMin(x-Threshold,0) To _LimitMax(x+Threshold,w-1)
                For ya=_LimitMin(y-Threshold,0) To _LimitMax(y+Threshold,h-1)
                  Counter+1
                  Count+Values(xa,ya)
                Next
              Next
              If Values(x,y)*Counter>Count-Values(x,y)
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_Sauvola
          StartDrawing(ImageOutput(Result))
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              r=Red(Pixel)
              g=Green(Pixel)
              b=Blue(Pixel)
              Values(x,y)=((r * srgb\sr) + (g* srgb\sg) + (b * srgb\sb)) * srgb\sa
            Next
          Next
          Protected Mean.a,Dev.q,Variance.a
          For x=0 To w-1
            For y=0 To h-1
              Count=0
              Counter=0
              ReDim Deviation((_LimitMax(x+Threshold,w-1)-_LimitMin(x-Threshold,0)+1)*(_LimitMax(y+Threshold,h-1)-_LimitMin(y-Threshold,0)+1)-1)
              For xa=_LimitMin(x-Threshold,0) To _LimitMax(x+Threshold,w-1)
                For ya=_LimitMin(y-Threshold,0) To _LimitMax(y+Threshold,h-1)
                  Count+Values(xa,ya)
                  Deviation(counter)=Values(xa,ya)
                  Counter+1
                Next
              Next
              Mean=Count/Counter
              Dev=0
              For xa=0 To Counter-1
                Dev+Sqr(Deviation(xa)-Mean)
              Next
              Variance=Pow(Dev/Counter,0.5)
              If Values(x,y)>Mean*(1+0.2*((Variance/128)-1))
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
            ;SetGadgetText(#Text2,Str(100*x/w)+"%")  
          Next
          ;SetGadgetText(#Text2,"")  
          
      EndSelect
      
      
      StopDrawing()
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  Global Bin,XML$
  
  Runtime Enumeration Windows
    #Window
  EndEnumeration
  Runtime Enumeration Gadgets
    #Image
    #Combo1
    #Combo2
    #Text1
    #String1
    #Button1
    #Button2
    #Button3
    #Text2
  EndEnumeration
  Enumeration XML
    #XML
  EndEnumeration
  Enumeration Dialogs
    #Dialog
  EndEnumeration

  Procedure LiveEvents()
    If GetGadgetState(#Button3)
      If Bin And IsImage(Bin):FreeImage(Bin):EndIf
        Bin=Binarize(0,Val(GetGadgetText(#String1)),GetGadgetState(#Combo2),GetGadgetState(#Combo1))
        SetGadgetState(#Image,ImageID(Bin))
    EndIf
  EndProcedure
  
  UseJPEGImageDecoder()
  LoadImage(0,OpenFileRequester("Load file","","*.jpg",0))
  
  XML$="<window id='#Window' name='MainWindow' text='Binarization Test' flags='#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget'>"+
       "<hbox expand='item:1'>"+
       "<image id='#Image' width='400' height='400'/>"+     
       "<vbox expand='item:8'>"+
       "<combobox id='#Combo1' width='150'/>"+
       "<combobox id='#Combo2' width='150'/>"+
       "<hbox expand='item:1'>"+
       "<text id='#Text1' text='Threshold:'/>"+
       "<string id='#String1' text='50' width='50' flags='#PB_String_Numeric'/>"+
       "</hbox>"+
       "<button id='#Button1' text='Lets go!'/>"+
       "<button id='#Button2' text='Original'/>"+
       "<button id='#Button3' text='Go live!' flags='#PB_Button_Toggle'/>"+
       "<text id='#Text2' text=''/>"+
       "<empty/>"+
       "</vbox>"+
       "</hbox>"+
       "</window>"
  
  If IsImage(0)
    
    ParseXML(#Xml, XML$)
    XMLStatus(#XML)
    CreateDialog(#Dialog)
    OpenXMLDialog(#Dialog, #Xml, "MainWindow")
    
    AddGadgetItem(#Combo1,-1,"BT709")
    AddGadgetItem(#Combo1,-1,"Equal")
    AddGadgetItem(#Combo1,-1,"REC601")
    AddGadgetItem(#Combo1,-1,"BT2100")
    AddGadgetItem(#Combo1,-1,"Red Channel")
    AddGadgetItem(#Combo1,-1,"Green Channel")
    AddGadgetItem(#Combo1,-1,"Blue Channel")
    SetGadgetState(#Combo1,0)
    
    AddGadgetItem(#Combo2,-1,"Relative")
    AddGadgetItem(#Combo2,-1,"Absolute")
    AddGadgetItem(#Combo2,-1,"Range")
    AddGadgetItem(#Combo2,-1,"Count")
    AddGadgetItem(#Combo2,-1,"Rasterize")
    AddGadgetItem(#Combo2,-1,"BlockMode")
    AddGadgetItem(#Combo2,-1,"OTSU")
    AddGadgetItem(#Combo2,-1,"Sauvola")
    SetGadgetState(#Combo2,0)
    
    BindGadgetEvent(#Combo1,@LiveEvents(),#PB_EventType_Change)
    BindGadgetEvent(#Combo2,@LiveEvents(),#PB_EventType_Change)
    BindGadgetEvent(#String1,@LiveEvents(),#PB_EventType_Change)
    SetGadgetState(#Image,ImageID(0))
    RefreshDialog(#Dialog)
    
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #Button1;Do binarization
              If Bin And IsImage(Bin):FreeImage(Bin):EndIf
              Bin=Binarize(0,Val(GetGadgetText(#String1)),GetGadgetState(#Combo2),GetGadgetState(#Combo1))
              ;bin = Greyscale(0,GetGadgetState(#Combo1))
              SetGadgetState(#Image,ImageID(Bin))
              RefreshDialog(#Dialog)
            Case #Button2;Revert to original image
              SetGadgetState(#Image,ImageID(0))
            Case #Button3;Live view
              If GetGadgetState(#Button3)
                DisableGadget(#Button1,#True)
                If Bin And IsImage(Bin):FreeImage(Bin):EndIf
                Bin=Binarize(0,Val(GetGadgetText(#String1)),GetGadgetState(#Combo2),GetGadgetState(#Combo1))
                SetGadgetState(#Image,ImageID(Bin))
              Else
                DisableGadget(#Button1,#False)
              EndIf
          EndSelect
      EndSelect
    ForEver
  Else
    MessageRequester("Error","Image could not be loaded!",#PB_MessageRequester_Error)  
  EndIf
CompilerEndIf


User avatar
jacdelad
Addict
Addict
Posts: 2010
Joined: Wed Feb 03, 2021 12:46 pm
Location: Riesa

Re: How to optimize this code?

Post by jacdelad »

Thanks idle!!!
I added Bernsen and Niblack, fixed the Sauvola formula and changed the parameters of the call to a structure to include more parameters. I also included a description for the algorithms (and used parameters). Bonus: Sepia algorithm (the one GIMP and Microsoft use), but this one isn't good, so I'll search for a better one.

Code: Select all

;Binarization algorithms (used parameters are written with CAPITAL LETTERS):
;- Relative:
;Converts the range of 8bit greyscale into a percentage scale. The given THRESHOLD defines which pixels are white (<threshold) or black (<=threshold).
;- Absolute:
;Same as relative, but THRESHOLD uses the whole 8bit range (0..255)
;- Range:
;Same as relative, but first finds the darkest and lightest pixel and narrows the range down. THRESHOLD is percentage within this found range.
;- Count:
;Creates a histogram and uses THRESHOLD as percentage (0..100) of how many pixels are drawn black.
;- Rasterize:
;Same as Absolute, but the picture is rasterized. This algorithm has no scientific foundation and I discovered it "accidently".
;It will be adapted IN the future, because For now it doesn't work as intended! More like a fun-mode.
;- BlockMode:
;Determines the threshold by adapting to the neighbourhood pixels. The BLOCKSIZE (3..255) defines the size of the block, e.g. a blocksize of 5 uses a 5x5 block.
;- OTSU:
;This algorithm doesn't need any parameters, because it defines the threshold by itself.
;It creates a histogram, finds the two highest peaks And SETS the threshold To the exact middle between them.
;- Niblack:
;Local intensity averagd and standard deviation. The BLOCKSIZE (3.255) defines the size of each block
;While a CONSTANT (Default=-0.2) defines the weight of the deviation. This algorithm tends To produce noisy results.
;- Sauvola:
;Improvement of the Niblack algorithm (less noisy). The BLOCKSIZE (3..255) defines the size of each block, CONSTANT is a measure for
;weighing the deviation (0.2..0.5, default=0.5) and DYNAMICRANGE defines the variance of the deviation (1..255, default=128).
;- Bernsen:
;Calculates a dynamic threshold based on the minimum and maximum intensities based on the neighbourhood pixels. The BLOCKSIZE (3..255) defines
;the size of each block while BACKGROUND defines whether the background is light or dark.
;Additionally And DYNAMICRANGE defines the local contrast limit (default=15).
;
;When using #Bin_Greyscale_Custom you can use fR, fG and fB to define the weight of each channel.

EnableExplicit

Enumeration Binarization     ;THRESHOLD:
  #Bin_Binarization_Relative ;0..100:  Range, percentage
  #Bin_Binarization_Absolute ;0..255:  Range, 8bit value
  #Bin_Binarization_Range    ;0..100:  Range percentage, only within range of used colors
  #Bin_Binarization_Count    ;0..100:  Percent of pixels that are black
  #Bin_Binarization_Rasterize;0..255:  Range, 8bit value, rasterize image
  #Bin_Binarization_BlockMode;         Adapts to neighbour pixels, blocksize (always odd numbers, not lower than 3!) to control the block size; speed decreases drastically with bigger block sizes!
  #Bin_Binarization_OTSU     ;         Self adapting, doesn't need threshold
  #Bin_Binarization_Sauvola  ;         Mean/deviation calculation, very cpu consuming, higher value=darker result
  #Bin_Binarization_Bernsen  ;         Predecessor of Sauvola
  #Bin_Binarization_Niblack  ;         Adapts to neighbour pixels, but noisier than Sauvola, blocksize (always odd numbers, not lower than 3!) to control the block size; speed decreases drastically with bigger block sizes!
EndEnumeration
Enumeration Greyscale
  #Bin_Greyscale_BT709
  #Bin_Greyscale_Equal
  #Bin_Greyscale_REC601
  #Bin_Greyscale_BT2100
  #Bin_Greyscale_RedChannel
  #Bin_Greyscale_GreenChannel
  #Bin_Greyscale_BlueChannel
  #Bin_Greyscale_Custom
EndEnumeration
#Bin_Background_Dark  = 255
#Bin_Background_Light =   0
Enumeration Sepia
  #Bin_Sepia_Simple
EndEnumeration

Structure Binarization
  Threshold.a
  Algorithm.a
  PreProcessing.a
  BlockSize.a
  Background.a
  fR.f
  fG.f
  fB.f
  Constant.f
  DynamicRange.a
EndStructure

Structure sRGB 
  sr.f
  sg.f
  sb.f 
  sa.f 
EndStructure   

Structure mRGB 
  StructureUnion 
    col.l 
    b.a
    g.a
    r.a 
    a.a 
  EndStructureUnion 
EndStructure 

Procedure CopyMemoryToImage(Memory, ImageNumber)
  
  Protected TemporaryDC, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO
  
  TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
  
  GetObject_(ImageID(ImageNumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
  
  TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
  TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
  TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
  TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
  TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
  TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
  
  SetDIBits_(TemporaryDC, ImageID(ImageNumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo, #DIB_RGB_COLORS)
  
  DeleteDC_(TemporaryDC)
  
EndProcedure
Procedure CopyImageToMemory(ImageNumber, Memory)
  
  Protected TemporaryDC, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO
  
  TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
  
  GetObject_(ImageID(ImageNumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
  
  
  TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
  TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
  TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
  TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
  TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
  TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
  
  GetDIBits_(TemporaryDC, ImageID(ImageNumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo, #DIB_RGB_COLORS)
  
  DeleteDC_(TemporaryDC)
  
EndProcedure
Procedure Greyscale(Image.i,Algorithm.a=#Bin_Greyscale_BT709,fR.f=0,fG.f=0,fB.f=0)
  Protected Result.i=-1,x.l,y.l,r.a,g.b,b.a,w.l,h.l,Pixel.l,Res.l
  Protected srgb.sRGB,*mem.mRGB,*out, size,ct,col.f,ImageOut        
  If IsImage(Image)
    
    ImageOut = CopyImage(0,-1)  
    size = (ImageWidth(image)*ImageHeight(image)) << 2 
    *mem = AllocateMemory(size) 
    *out = *mem 
    
    srgb\sa = 1.0 
    Select Algorithm
      Case #Bin_Greyscale_BT709
        srgb\sr = 0.2126 : srgb\sg = 0.7152 : srgb\sb = 0.0722
      Case #Bin_Greyscale_Equal
        srgb\sr = 1.0 : srgb\sg = 1.0 : srgb\sb = 1.0 : srgb\sa = 1.0 / 3.0 
      Case #Bin_Greyscale_REC601
        srgb\sr = 0.299 : srgb\sg = 0.587 : srgb\sb = 0.114 
      Case #Bin_Greyscale_BT2100
        srgb\sr = 0.2627 : srgb\sg = 0.678 : srgb\sb = 0.0593 
      Case #Bin_Greyscale_RedChannel
        srgb\sr = 1.0 : srgb\sg = 0 : srgb\sb = 0
      Case #Bin_Greyscale_GreenChannel
        srgb\sr = 0 : srgb\sg = 1.0 : srgb\sb = 0
      Case #Bin_Greyscale_BlueChannel
        srgb\sr = 0 : srgb\sg = 0 : srgb\sb = 1.0 
      Case #Bin_Greyscale_Custom
        srgb\sr = fr : srgb\sg = fg : srgb\sb = fb
    EndSelect
    
    CopyImageToMemory(Image,*mem)      
    
    While ct < size    
      col.f = ((*mem\r * srgb\sr) + (*mem\g * srgb\sg ) + (*mem\b * srgb\sb)) *  srgb\sa  
      *mem\r = col 
      *mem\g = col 
      *mem\b = col 
      *mem+4
      ct+4    
    Wend   
    
    CopyMemoryToImage(*out,Imageout) 
    
    FreeMemory(*out) 
    
  EndIf
  ProcedureReturn imageout
EndProcedure
Procedure Sepia(Image.i,Algorithm.a=#Bin_Sepia_Simple)
  Protected Result.i=-1,x.l,y.l,Pixel.l,R.a,G.a,B.a,wR.w,wG.w,wB.w
  If IsImage(Image)
    Result=CopyImage(Image,#PB_Any)
    If Result<>0
      StartDrawing(ImageOutput(Result))
      
      Select Algorithm
          
        Case #Bin_Sepia_Simple
          For x=0 To ImageWidth(Image)-1
            For y=0 To ImageHeight(Image)-1
              Pixel=Point(x,y)
              R=Red(Pixel)
              G=Green(Pixel)
              B=Blue(Pixel)
              wR=0.393*R + 0.769*G + 0.189*B
              If wR>255:wR=255:EndIf
              wG=0.349*R + 0.686*G + 0.168*B
              If wG>255:wG=255:EndIf
              wB=0.272*R + 0.534*G + 0.131*B
              If wB>255:wB=255:EndIf
              Plot(x,y,RGB(wR,wG,wB))
            Next
          Next
          
      EndSelect      
      StopDrawing()
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure
Procedure _LimitMin(a.l,b.l)
  If a>b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
Procedure _LimitMax(a.l,b.l)
  If a<b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure

Procedure Binarize(Image.i,*Binarization.Binarization)
  Protected Result.i=-1,x.l,y.l,Pixel.l,r.a,g.a,b.a,Res.a,Min.a=255,Max.a,w.l=ImageWidth(Image),h.l=ImageHeight(Image),Count.l,Counter.l
  Protected srgb.srgb,Dim Values.a(w-1,h-1),Dim Count.l(255),Dim Deviation.a(0),xa.l,ya.l,Mean.a,Dev.q,Threshold.a=*Binarization\Threshold,BlockSize.a
  
  Select *Binarization\Algorithm
    Case #Bin_Binarization_BlockMode
      Threshold=Threshold/2
    Case #Bin_Binarization_Relative
      Threshold=Threshold*2.55
  EndSelect
  
  If IsImage(Image)
    
    Result=CopyImage(Image,#PB_Any)
    If Result<>0
      
      srgb\sa = 1.0 
      Select *Binarization\PreProcessing
        Case #Bin_Greyscale_BT709
          srgb\sr = 0.2126 : srgb\sg = 0.7152 : srgb\sb = 0.0722
        Case #Bin_Greyscale_Equal
          srgb\sr = 1.0 : srgb\sg = 1.0 : srgb\sb = 1.0 : sRGB\sa = 1.0 / 3.0
        Case #Bin_Greyscale_REC601
          srgb\sr = 0.299 : srgb\sg = 0.587 : srgb\sb = 0.114 
        Case #Bin_Greyscale_BT2100
          srgb\sr = 0.2627 : srgb\sg = 0.678 : srgb\sb = 0.0593 
        Case #Bin_Greyscale_RedChannel
          srgb\sr = 1.0 : srgb\sg = 0 : srgb\sb = 0
        Case #Bin_Greyscale_GreenChannel
          srgb\sr = 0 : srgb\sg = 1.0 : srgb\sb = 0
        Case #Bin_Greyscale_BlueChannel
          srgb\sr = 0 : srgb\sg = 0 : srgb\sb = 1.0 
        Case #Bin_Greyscale_Custom
          srgb\sr = *Binarization\fR : srgb\sg = *Binarization\fG : srgb\sb = *Binarization\fB : srgb\sa=1/(*Binarization\fR+*Binarization\fG+*Binarization\fB)
      EndSelect
      
      StartDrawing(ImageOutput(Result))
      
      
      Select *Binarization\Algorithm
        Case #Bin_Binarization_Absolute,#Bin_Binarization_Relative
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              If ((Red(Pixel) * srgb\sr) + (Green(Pixel) * srgb\sg) + (Blue(Pixel) * srgb\sb)) * srgb\sa > Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_Rasterize
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              If ((Red(Pixel) * srgb\sr) + (Green(Pixel) * srgb\sg) + (Blue(Pixel) * srgb\sb)) * srgb\sa > Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
              Threshold=Threshold*2.55
            Next
          Next
          
        Case #Bin_Binarization_Range
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              Res = ((Red(Pixel) * srgb\sr) + (Green(Pixel) * srgb\sg) + (Blue(Pixel) * srgb\sb)) * srgb\sa  
              Values(x,y)=Res
              If Res<Min:Min=Res:EndIf
              If Res>Max:Max=Res:EndIf
            Next
          Next
          Threshold=Min+Threshold*(Max-Min)/100
          For x=0 To w-1
            For y=0 To h-1
              If Values(x,y)>Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_Count
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              Res = ((Red(Pixel) * srgb\sr) + (Green(Pixel) * srgb\sg) + (Blue(Pixel) * srgb\sb)) * srgb\sa  
              Values(x,y)=Res
              Count(Res)+1
            Next
          Next
          Count=Threshold*w*h/100
          Counter=0
          For x=0 To 255
            Counter+Count(x)
            If Counter>Count
              Threshold=x-1
              Break
            EndIf
          Next
          For x=0 To w-1
            For y=0 To h-1
              If Values(x,y)>Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_OTSU
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              Res = ((Red(Pixel) * srgb\sr) + (Green(Pixel) * srgb\sg) + (Blue(Pixel) * srgb\sb)) * srgb\sa  
              Values(x,y)=Res
              Count(Res)+1
            Next
          Next
          Count=0
          For x=0 To 255
            If Count(x)>Count
              Count=Count(x)
              Max=x
            EndIf
          Next
          Counter=0
          For x=255 To 0 Step -1
            If Count(x)>Counter And (Count(x)<Count Or x<>Max)
              Counter=Count(x)
              Min=x
            EndIf
          Next
          Threshold=Max+(Min-Max)/2
          For x=0 To w-1
            For y=0 To h-1
              If Values(x,y)>Threshold
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_BlockMode
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              Values(x,y)=((Red(Pixel) * srgb\sr) + (Green(Pixel) * srgb\sg) + (Blue(Pixel) * srgb\sb)) * srgb\sa
            Next
          Next
          BlockSize=Int(*Binarization\BlockSize/2)
          For x=0 To w-1
            For y=0 To h-1
              Count=0
              Counter=-1
              For xa=_LimitMin(x-BlockSize,0) To _LimitMax(x+BlockSize,w-1)
                For ya=_LimitMin(y-BlockSize,0) To _LimitMax(y+BlockSize,h-1)
                  Counter+1
                  Count+Values(xa,ya)
                Next
              Next
              If Values(x,y)*Counter>Count-Values(x,y)
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_Sauvola
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              Values(x,y)=((Red(Pixel) * srgb\sr) + (Green(Pixel) * srgb\sg) + (Blue(Pixel) * srgb\sb)) * srgb\sa
            Next
          Next
          BlockSize=Int(*Binarization\BlockSize/2)
          For x=0 To w-1
            For y=0 To h-1
              Count=0
              Counter=0
              ReDim Deviation((_LimitMax(x+BlockSize,w-1)-_LimitMin(x-BlockSize,0)+1)*(_LimitMax(y+BlockSize,h-1)-_LimitMin(y-BlockSize,0)+1)-1)
              For xa=_LimitMin(x-BlockSize,0) To _LimitMax(x+BlockSize,w-1)
                For ya=_LimitMin(y-BlockSize,0) To _LimitMax(y+BlockSize,h-1)
                  Count+Values(xa,ya)
                  Deviation(counter)=Values(xa,ya)
                  Counter+1
                Next
              Next
              Mean=Count/Counter
              Dev=0
              For xa=0 To Counter-1
                Dev+Pow(Deviation(xa)-Mean,2)
              Next
              If Values(x,y)>Mean*(1+*Binarization\Constant*((Pow(Dev/Counter,0.5)/*Binarization\DynamicRange)-1))
                Plot(x,y,#White)
              Else
                Plot(x,y,#Black)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_Bernsen
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              Values(x,y)=((Red(Pixel) * srgb\sr) + (Green(Pixel) * srgb\sg) + (Blue(Pixel) * srgb\sb)) * srgb\sa
            Next
          Next
          BlockSize=Int(*Binarization\BlockSize/2)
          For x=0 To w-1
            For y=0 To h-1
              Min=255
              Max=0
              For xa=_LimitMin(x-BlockSize,0) To _LimitMax(x+BlockSize,w-1)
                For ya=_LimitMin(y-BlockSize,0) To _LimitMax(y+BlockSize,h-1)
                  If Values(xa,ya)<Min:Min=Values(xa,ya):EndIf
                  If Values(xa,ya)>Max:Max=Values(xa,ya):EndIf
                Next
              Next
              If Max-Min<*Binarization\DynamicRange;=15
                                                   ;Max=0;Bright Background
                                                   ;Max=255;Dark Background
                Max=*Binarization\Background
              Else
                Max=(Min+Max)/2
              EndIf
              If Values(x,y)<Max
                Plot(x,y,#Black)
              Else
                Plot(x,y,#White)
              EndIf
            Next
          Next
          
        Case #Bin_Binarization_Niblack
          For x=0 To w-1
            For y=0 To h-1
              Pixel=Point(x,y)
              Values(x,y)=((Red(Pixel) * srgb\sr) + (Green(Pixel) * srgb\sg) + (Blue(Pixel) * srgb\sb)) * srgb\sa
            Next
          Next
          BlockSize=Int(*Binarization\BlockSize/2)
          For x=0 To w-1
            For y=0 To h-1
              Count=0
              Counter=0
              ReDim Deviation((_LimitMax(x+BlockSize,w-1)-_LimitMin(x-BlockSize,0)+1)*(_LimitMax(y+BlockSize,h-1)-_LimitMin(y-BlockSize,0)+1)-1)
              For xa=_LimitMin(x-BlockSize,0) To _LimitMax(x+BlockSize,w-1)
                For ya=_LimitMin(y-BlockSize,0) To _LimitMax(y+BlockSize,h-1)
                  Count+Values(xa,ya)
                  Deviation(counter)=Values(xa,ya)
                  Counter+1
                Next
              Next
              Mean=Count/Counter
              Dev=0
              For xa=0 To Counter-1
                Dev+Pow(Deviation(xa)-Mean,2)
              Next
              If Values(x,y)<Mean+*Binarization\Constant*Pow(Dev/Counter,0.5)
                Plot(x,y,#Black)
              Else
                Plot(x,y,#White)
              EndIf
            Next
          Next
          
      EndSelect
      
      
      StopDrawing()
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  Global Bin,XML$,MyBinarization.Binarization
  
  Runtime Enumeration Windows
    #Window
  EndEnumeration
  Runtime Enumeration Gadgets
    #Image
    #Checkbox1
    #Combo1
    #Combo2
    #Text1
    #Text2
    #Text3
    #Text4
    #Text5
    #String1
    #String2
    #String3
    #String4
    #Button1
    #Button2
    #Button3
  EndEnumeration
  Enumeration XML
    #XML
  EndEnumeration
  Enumeration Dialogs
    #Dialog
  EndEnumeration
  
  Procedure LiveEvents()
    If GetGadgetState(#Button3)
      If Bin And IsImage(Bin):FreeImage(Bin):EndIf
      MyBinarization\Threshold=Val(GetGadgetText(#String1))
      MyBinarization\Algorithm=GetGadgetState(#Combo2)
      MyBinarization\PreProcessing=GetGadgetState(#Combo1)
      MyBinarization\BlockSize=Val(GetGadgetText(#String2))
      MyBinarization\Constant=Val(GetGadgetText(#String3))
      MyBinarization\DynamicRange=Val(GetGadgetText(#String4))
      If GetGadgetState(#Checkbox1)&#PB_Checkbox_Checked
        MyBinarization\Background=#Bin_Background_Dark
      Else
        MyBinarization\Background=#Bin_Background_Light
      EndIf
      Bin=Binarize(0,MyBinarization)
      SetGadgetState(#Image,ImageID(Bin))
    EndIf
  EndProcedure
  
  UseJPEGImageDecoder()
  LoadImage(0,OpenFileRequester("Load file","","*.jpg",0))
  
  XML$="<window id='#Window' name='MainWindow' text='Binarization Test' flags='#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget'>"+
       "<hbox expand='item:1'>"+
       "<image id='#Image' width='400' height='400'/>"+     
       "<vbox expand='item:12'>"+
       "<combobox id='#Combo1' width='150'/>"+
       "<combobox id='#Combo2' width='150'/>"+
       "<hbox expand='item:1'>"+
       "<text id='#Text1' text='Threshold:'/>"+
       "<string id='#String1' text='50' width='50' flags='#PB_String_Numeric'/>"+
       "</hbox>"+
       "<hbox expand='item:1'>"+
       "<text id='#Text2' text='Blocksize:'/>"+
       "<string id='#String2' text='5' width='50' flags='#PB_String_Numeric'/>"+
       "</hbox>"+
       "<hbox expand='item:1'>"+
       "<text id='#Text3' text='Constant:'/>"+
       "<string id='#String3' text='0.2' width='50'/>"+
       "</hbox>"+
       "<hbox expand='item:1'>"+
       "<text id='#Text4' text='Dynamic Range:'/>"+
       "<string id='#String4' text='128' width='50' flags='#PB_String_Numeric'/>"+
       "</hbox>"+
       "<checkbox id='#Checkbox1' text='Background dark'/>"+
       "<button id='#Button1' text='Lets go!'/>"+
       "<button id='#Button2' text='Original'/>"+
       "<button id='#Button3' text='Go live!' flags='#PB_Button_Toggle'/>"+
       "<text id='#Text5' text=''/>"+
       "<empty/>"+
       "</vbox>"+
       "</hbox>"+
       "</window>"
  
  If IsImage(0)
    
    ParseXML(#Xml, XML$)
    XMLStatus(#XML)
    CreateDialog(#Dialog)
    OpenXMLDialog(#Dialog, #Xml, "MainWindow")
    
    AddGadgetItem(#Combo1,-1,"BT709")
    AddGadgetItem(#Combo1,-1,"Equal")
    AddGadgetItem(#Combo1,-1,"REC601")
    AddGadgetItem(#Combo1,-1,"BT2100")
    AddGadgetItem(#Combo1,-1,"Red Channel")
    AddGadgetItem(#Combo1,-1,"Green Channel")
    AddGadgetItem(#Combo1,-1,"Blue Channel")
    SetGadgetState(#Combo1,0)
    
    AddGadgetItem(#Combo2,-1,"Relative")
    AddGadgetItem(#Combo2,-1,"Absolute")
    AddGadgetItem(#Combo2,-1,"Range")
    AddGadgetItem(#Combo2,-1,"Count")
    AddGadgetItem(#Combo2,-1,"Rasterize")
    AddGadgetItem(#Combo2,-1,"BlockMode")
    AddGadgetItem(#Combo2,-1,"OTSU")
    AddGadgetItem(#Combo2,-1,"Sauvola")
    AddGadgetItem(#Combo2,-1,"Bernsen")
    AddGadgetItem(#Combo2,-1,"Niblack")
    SetGadgetState(#Combo2,0)
    
    BindGadgetEvent(#Combo1,@LiveEvents(),#PB_EventType_Change)
    BindGadgetEvent(#Combo2,@LiveEvents(),#PB_EventType_Change)
    BindGadgetEvent(#String1,@LiveEvents(),#PB_EventType_Change)
    SetGadgetState(#Image,ImageID(0))
    RefreshDialog(#Dialog)
    
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #Button1;Do binarization
              If Bin And IsImage(Bin):FreeImage(Bin):EndIf
              MyBinarization\Threshold=Val(GetGadgetText(#String1))
              MyBinarization\Algorithm=GetGadgetState(#Combo2)
              MyBinarization\PreProcessing=GetGadgetState(#Combo1)
              MyBinarization\BlockSize=Val(GetGadgetText(#String2))
              MyBinarization\Constant=Val(GetGadgetText(#String3))
              MyBinarization\DynamicRange=Val(GetGadgetText(#String4))
              If GetGadgetState(#Checkbox1)&#PB_Checkbox_Checked
                MyBinarization\Background=#Bin_Background_Dark
              Else
                MyBinarization\Background=#Bin_Background_Light
              EndIf
              Bin=Binarize(0,MyBinarization)
              ;bin = Greyscale(0,GetGadgetState(#Combo1))
              SetGadgetState(#Image,ImageID(Bin))
            Case #Button2;Revert to original image
              SetGadgetState(#Image,ImageID(0))
            Case #Button3;Live view
              If GetGadgetState(#Button3)
                DisableGadget(#Button1,#True)
                If Bin And IsImage(Bin):FreeImage(Bin):EndIf
                MyBinarization\Threshold=Val(GetGadgetText(#String1))
                MyBinarization\Algorithm=GetGadgetState(#Combo2)
                MyBinarization\PreProcessing=GetGadgetState(#Combo1)
                MyBinarization\BlockSize=Val(GetGadgetText(#String2))
                MyBinarization\Constant=Val(GetGadgetText(#String3))
                MyBinarization\DynamicRange=Val(GetGadgetText(#String4))
                If GetGadgetState(#Checkbox1)&#PB_Checkbox_Checked
                  MyBinarization\Background=#Bin_Background_Dark
                Else
                  MyBinarization\Background=#Bin_Background_Light
                EndIf
                Bin=Binarize(0,MyBinarization)
                SetGadgetState(#Image,ImageID(Bin))
              Else
                DisableGadget(#Button1,#False)
              EndIf
          EndSelect
      EndSelect
    ForEver
  Else
    MessageRequester("Error","Image could not be loaded!",#PB_MessageRequester_Error)  
  EndIf
CompilerEndIf
Good morning, that's a nice tnetennba!

PureBasic 6.21/Windows 11 x64/Ryzen 7900X/32GB RAM/3TB SSD
Synology DS1821+/DX517, 130.9TB+50.8TB+2TB SSD
User avatar
idle
Always Here
Always Here
Posts: 5899
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: How to optimize this code?

Post by idle »

You missed the 1st 3 cases in the binarize procedure.
User avatar
jacdelad
Addict
Addict
Posts: 2010
Joined: Wed Feb 03, 2021 12:46 pm
Location: Riesa

Re: How to optimize this code?

Post by jacdelad »

Wut??
Good morning, that's a nice tnetennba!

PureBasic 6.21/Windows 11 x64/Ryzen 7900X/32GB RAM/3TB SSD
Synology DS1821+/DX517, 130.9TB+50.8TB+2TB SSD
User avatar
idle
Always Here
Always Here
Posts: 5899
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: How to optimize this code?

Post by idle »

I was trying to say I redid the 1st 3 routines in the binaries procedure. Getting rid of the for loop branching and function calls.
If you follow the method you can get the free benefit of SSE or AVX optimization from the c backend. If can't magically transform code to simd without some help but the result will be maybe 10 times faster.
User avatar
jacdelad
Addict
Addict
Posts: 2010
Joined: Wed Feb 03, 2021 12:46 pm
Location: Riesa

Re: How to optimize this code?

Post by jacdelad »

I...am lost, mostly because I don't understand asm well. I need a push.
Good morning, that's a nice tnetennba!

PureBasic 6.21/Windows 11 x64/Ryzen 7900X/32GB RAM/3TB SSD
Synology DS1821+/DX517, 130.9TB+50.8TB+2TB SSD
User avatar
idle
Always Here
Always Here
Posts: 5899
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: How to optimize this code?

Post by idle »

I don't know what or how to explain, the code changes just re arranges what you have into a form the c compiler can understand to promote to simd vector instructions, it should be able to do it with nested loops too but it won't if there are function calls in the inner loop.
Post Reply