Recent

Author Topic: Downscaling with Lanczos  (Read 4950 times)

domasz

  • Hero Member
  • *****
  • Posts: 557
Downscaling with Lanczos
« on: May 25, 2024, 09:14:27 am »
I am trying to implement Lanczos resampling. Just the simplest possible algorithm, no optimizations. Works fine when upscaling but when downscaling the resulting image is too sharp. My input image is 1500x2000 px. I am downscaling to 50x50. For each output pixel the algo finds a source pixel and its 48 neighbors (7x7 block). This means some source pixels are ignored by design (50x50 * 7x7 = 350x350 pixels of source image).

What am I missing?

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Math;
  9.  
  10. type
  11.   TResampleFilter = function(Value: Single): Single;
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     procedure Button1Click(Sender: TObject);
  17.   private
  18.  
  19.   public
  20.  
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.lfm}
  29.  
  30. { TForm1 }
  31.  
  32. function Sinc(Value: Single): Single;
  33. begin
  34.   if Value <> 0.0 then begin
  35.     Value := Value * Pi;
  36.     Result := Sin(Value) / Value;
  37.   end
  38.   else Result := 1.0;
  39. end;
  40.  
  41. function Lanczos3Filter(Value: Single): Single;
  42. begin
  43.   if Value < 0.0 then Value := -Value;
  44.  
  45.   if Value < 3.0 then
  46.     Result := SinC(Value) * SinC(Value / 3.0)
  47.   else
  48.     Result := 0.0;
  49. end;
  50.  
  51. function Limit(Min, Max, Val: Integer): Integer;
  52. begin
  53.   if Val < Min then Exit(Min);
  54.   if Val > Max then Exit(Max);
  55.   Exit(Val);
  56. end;
  57.  
  58. function Clip(Val: Extended): Byte;
  59. begin
  60.   if Val > 255 then Exit(255);
  61.   if Val < 0 then Exit(0);
  62.   Result := Round(Val);
  63. end;
  64.  
  65. function Resample(Bmp: TBitmap; AWidth, AHeight: Integer; Filter: TResampleFilter): TBitmap;
  66. var x,y: Integer;
  67.     P: TColor;
  68.     PP: array[0..3] of Byte absolute P;
  69.  
  70.     i,j: Integer;
  71.     ratioX,ratioY: Extended;
  72.     SumR, SumG, SumB: Extended;
  73.     xx,yy: Extended;
  74.     xxx,yyy: Integer;
  75.     xxxx,yyyy: Integer;
  76.     Tmp: Single;
  77.     RadX, RadY: Single;
  78. begin
  79.   Result := TBitmap.Create;
  80.   Result.PixelFormat := pf32bit;
  81.   Result.SetSize(AWidth, AHeight);
  82.  
  83.   ratioX := AWidth/ Bmp.Width;
  84.   ratioY := AHeight/ Bmp.Height;
  85.  
  86.   for y:=0 to AHeight-1 do begin
  87.     for x:=0 to AWidth-1 do begin
  88.  
  89.       xx := x / ratioX;
  90.       yy := y / ratioY;
  91.  
  92.       xxx := Floor(xx);
  93.       yyy := Floor(yy);
  94.  
  95.       SumR := 0;
  96.       SumG := 0;
  97.       SumB := 0;
  98.  
  99.       for j:=-3 to 3 do
  100.         for i:=-3 to 3 do begin
  101.           RadX := xx - (xxx + i);
  102.           RadY := yy - (yyy + j);
  103.           Tmp := Filter(RadX) * Filter(RadY);
  104.  
  105.           xxxx := Limit(0, Bmp.Width-1, xxx+i);
  106.           yyyy := Limit(0, Bmp.Height-1, yyy+j);
  107.  
  108.           P := Bmp.Canvas.Pixels[xxxx, yyyy];
  109.  
  110.           SumR := SumR + PP[0]*Tmp ;
  111.           SumG := SumG + PP[1]*Tmp ;
  112.           SumB := SumB + PP[2]*Tmp ;
  113.         end;
  114.  
  115.       Result.Canvas.Pixels[x,y] := RGBToColor( Clip(SumR), Clip(SumG), Clip(SumB) );
  116.     end;
  117.   end;
  118. end;
  119.  
  120.  
  121. procedure TForm1.Button1Click(Sender: TObject);
  122. var InB, OutB: TBitmap;
  123. begin
  124.   InB := TBitmap.Create;
  125.   InB.LoadFromFile('1.bmp'); //should be 32bpp
  126.  
  127.   OutB := Resample(InB, 50, 50, @Lanczos3Filter);
  128.   OutB.SaveToFile('2.bmp');
  129.   OutB.Free;
  130.   InB.Free;
  131. end;
  132.  
  133. end.
  134.  
« Last Edit: May 25, 2024, 09:37:08 am by domasz »

domasz

  • Hero Member
  • *****
  • Posts: 557
Re: Downscaling with Lanczos
« Reply #1 on: May 25, 2024, 09:29:55 am »
Here are test images.
1.jpg is the source image. You should convert it to bmp.
result.png is the result of the program. The image is too sharp.
should.png is how an image viewer downscaled 1.bmp using Lanczos. As you can see the image is smooth.

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Downscaling with Lanczos
« Reply #2 on: May 25, 2024, 10:26:41 am »
If a different approach is welcomed not using custom interpolation with the result you wanted:
Code: Pascal  [Select][+][-]
  1. procedure AntiAliasedStretchDrawBitmap(SourceBitmap, DestBitmap: TCustomBitmap);
  2. var
  3.   DestIntfImage, SourceIntfImage: TLazIntfImage;
  4.   DestWidth, DestHeight: Integer;
  5.   DestCanvas: TLazCanvas;
  6. begin
  7.   DestWidth := DestBitmap.Width;
  8.   DestHeight := DestBitmap.Height;
  9.   DestIntfImage := TLazIntfImage.Create(0, 0);
  10.   try
  11.     DestIntfImage.LoadFromBitmap(DestBitmap.Handle, DestBitmap.MaskHandle);
  12.     DestCanvas := TLazCanvas.Create(DestIntfImage);
  13.     try
  14.       SourceIntfImage := SourceBitmap.CreateIntfImage;
  15.       try
  16.         DestCanvas.Interpolation := TFPBaseInterpolation.Create;
  17.         try
  18.           DestCanvas.StretchDraw(0, 0, DestWidth, DestHeight, SourceIntfImage);
  19.           DestBitmap.LoadFromIntfImage(DestIntfImage);
  20.         finally
  21.           DestCanvas.Interpolation.Free;
  22.         end;
  23.       finally
  24.         SourceIntfImage.Free;
  25.       end;
  26.     finally
  27.       DestCanvas.Free;
  28.     end;
  29.   finally
  30.     DestIntfImage.Free;
  31.   end;
  32. end;
  33.  
  34. procedure TForm1.Button1Click(Sender: TObject);
  35. var
  36.   Source,
  37.   Dest: TBitmap;
  38. begin
  39.   Source := TBitmap.Create;
  40.   try
  41.     Source.Assign(Image2.Picture.Bitmap); // image2 got "1.jpg" assigned in designtime
  42.     Dest := TBitmap.Create;
  43.     try
  44.       Dest.SetSize(50, 50);
  45.       AntiAliasedStretchDrawBitmap(Source, Dest);
  46.       Image1.Picture.Assign(Dest);
  47.     finally
  48.       Dest.Free;
  49.     end;
  50.   finally
  51.     Source.Free;
  52.   end;
  53. end;
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

domasz

  • Hero Member
  • *****
  • Posts: 557
Re: Downscaling with Lanczos
« Reply #3 on: May 25, 2024, 11:27:25 am »
Thanks for the code, KodeZwerg, might be handy but I really need to know what I did wrong to sleep well :)

wp

  • Hero Member
  • *****
  • Posts: 12610
Re: Downscaling with Lanczos
« Reply #4 on: May 25, 2024, 02:11:37 pm »
I've never done this myself, so this answer may be nonsense. But anyway: I am not sure whether you apply the filter function correctly. You have i and j running over x and y and you calculate the filter function at the integer values -3, -2, -1, 0, 1, 2, 3 (for i and j). Now let's look at a plot of the Lanczos filter - see screenshot, where you can find that these values are always near the zero-crossings and thus close to zero, except for the center value which is 1. In total, only the center value really contributes to the sum - a complicated way of just selecting the center value in the filter interval.

In my opinion you should map the intervals [-3..3] to the original image (i.e. multiply i,j by the ratio of source image width to destination image width, height accordingly), and iterate over all original pixels in this area, apply the Lanczos function to them and sum them up.

As a consequence you'll notice that the program will probably become much slower (because many more pixels have to be evaluated). This is because accessing Canvas.Pixels is a very slow process. You should convert the bitmap to a TLazIntfImage, or load it into an even simpler TFPMemoryImage, where the access to individual pixels is much faster. And doing so, you might consider using the interpolation functions built into fcl-image - there's even a TLanczosInterpolation... Here is some code how to apply it:
Code: Pascal  [Select][+][-]
  1. uses
  2.   fpimage, fpcanvas, fpimgCanv, fpreadjpeg, fpwritebmp, extinterpolation;
  3.  
  4. procedure TForm1.Button2Click(Sender: TObject);
  5. var
  6.   srcImg, destImg: TFPMemoryImage;
  7.   canv: TFPImageCanvas;
  8. begin
  9.   // Create and load the source image
  10.   srcImg := TFPMemoryImage.Create(0, 0);
  11.   srcImg.LoadFromFile('1.jpg');
  12.  
  13.   // Create the destination image in the requested size
  14.   destimg := TFPMemoryImage.Create(50, 50);
  15.  
  16.   // Create a canvas for the destination image ...
  17.   canv := TFPImageCanvas.Create(destImg);
  18.  
  19.   // ... and an interpolation
  20.   canv.Interpolation := TLanczosInterpolation.Create;
  21.  
  22.   // Use the interpolation to stretch the source image to the new size
  23.   canv.StretchDraw(0, 0, destImg.Width, destImg.Height, srcImg);
  24.  
  25.   // Save destination image to file...
  26.   destImg.SaveToFile('2a.bmp');
  27.   // ... and display it in a TImage component
  28.   Image2.Picture.Assign(destImg);
  29.  
  30.   // Clean up
  31.   canv.Interpolation.Free;
  32.   canv.Free;
  33.   destImg.Free;
  34.   srcImg.Free;
  35. end;  

P.S.
Ah, sorry, KodeZwerg, I did not read your post before sending mine because you are doing essentially the same...
« Last Edit: May 25, 2024, 02:17:53 pm by wp »

domasz

  • Hero Member
  • *****
  • Posts: 557
Re: Downscaling with Lanczos
« Reply #5 on: May 25, 2024, 06:14:18 pm »
In my opinion you should map the intervals [-3..3] to the original image (i.e. multiply i,j by the ratio of source image width to destination image width, height accordingly), and iterate over all original pixels in this area, apply the Lanczos function to them and sum them up.
Thanks, wp!

domasz

  • Hero Member
  • *****
  • Posts: 557
Re: Downscaling with Lanczos
« Reply #6 on: May 26, 2024, 01:22:09 pm »
This is a problem with today scientific articles, presentations and the alike. I have seen dozens about Lanczos interpolation but they rarely give any code, pseudocode or even describe the nuances. Just focus on comparing Lanczos to Bilinear and other filters and how to use it in a given language.

Here's what I found in the book from 1992 (Graphic Gems 3):

"During magnification, we are stretching our reconstructed signal, lowering its component frequencies. However,
during minification, we are shrinking our reconstructed signal, raising its component frequencies, and possibly exceeding the Nyquist frequency of
our new sampling rate. To create proper samples, we must eliminate all frequency components above the resampling Nyquist frequency. This can
be accomplished by stretching the filter function by the image reduction factor."

So basically my algo is fine for upsampling but for downsampling what wp said is right.

runewalsh

  • Jr. Member
  • **
  • Posts: 86
Re: Downscaling with Lanczos
« Reply #7 on: May 26, 2024, 07:03:06 pm »
Downscale in several steps, each 7× at most (not sure if 2× will be better or not).

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Downscaling with Lanczos
« Reply #8 on: May 26, 2024, 08:06:15 pm »
This is a problem with today scientific articles, presentations and the alike. I have seen dozens about Lanczos interpolation but they rarely give any code, pseudocode or even describe the nuances. Just focus on comparing Lanczos to Bilinear and other filters and how to use it in a given language.

Here's what I found in the book from 1992 (Graphic Gems 3):

"During magnification, we are stretching our reconstructed signal, lowering its component frequencies. However,
during minification, we are shrinking our reconstructed signal, raising its component frequencies, and possibly exceeding the Nyquist frequency of
our new sampling rate. To create proper samples, we must eliminate all frequency components above the resampling Nyquist frequency. This can
be accomplished by stretching the filter function by the image reduction factor."

So basically my algo is fine for upsampling but for downsampling what wp said is right.
Take a look at Lánczos interpolation explained, its pretty in-depth with math formulas and some demo images to understand differences at usage.
For sourcecode you can take a look at ImageMagick (C Language), watch at resize, it offer a lot interpolation "filters".
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

domasz

  • Hero Member
  • *****
  • Posts: 557
Re: Downscaling with Lanczos
« Reply #9 on: May 26, 2024, 08:13:08 pm »
Thx, runewalsh. That might be an idea.

Generally speaking - the quality of code around us is total shit.

In 1992 Dale Schumacher published in Graphics Gems III (p. 8-16) his algorithm with source code (filter.c) which resamples images using Lanczos, Bilinear and a few other filters. About 95% lanczos resamplers out there are just ports of this code.
In 1997-98  Anders Melander released a Delphi port (resample.pas).
GraphicEx, Alcinoe, JEDI JCL, GXScene and many others all use that code (or ported filter.c themselves).

Lazarus also comes with a Lanczos resampler (extinterpolation.pas) but seems it's a different algorithm.

All of these claim to support also other filters (Bilinear, Nearest Neighbor, Bell, Mitchell). Just look at attachments of some quick tests...
« Last Edit: May 26, 2024, 08:28:21 pm by domasz »

domasz

  • Hero Member
  • *****
  • Posts: 557
Re: Downscaling with Lanczos
« Reply #10 on: May 26, 2024, 08:18:26 pm »
And here's Lazarus (extinterpolation.pas)

domasz

  • Hero Member
  • *****
  • Posts: 557
Re: Downscaling with Lanczos
« Reply #11 on: May 26, 2024, 08:25:07 pm »
And my slow code from the first post (which doesn't handle well downscaling too much).

So this is why you should reinvent the wheel sometimes.
« Last Edit: May 26, 2024, 08:27:41 pm by domasz »

wp

  • Hero Member
  • *****
  • Posts: 12610
Re: Downscaling with Lanczos
« Reply #12 on: May 26, 2024, 11:47:21 pm »
I would not swear that the fcl-image interpolation is bug-free. Some time ago I wrote a small test application which up- and downscales some test images using all built-in interpolation filters (see attachment). I have the impression that most of these filters do not support upscaling at all because they do not produce a smoothed image. And some images look really strange, such as the small Lena image upscaled to 600x600 using the Hermite filter.

Thaddy

  • Hero Member
  • *****
  • Posts: 16541
  • Kallstadt seems a good place to evict Trump to.
Re: Downscaling with Lanczos
« Reply #13 on: May 27, 2024, 04:41:54 pm »
Isn't graphics32 an option? It has fast and has also good filters. And it works on Lazarus.
But I am sure they don't want the Trumps back...

jamie

  • Hero Member
  • *****
  • Posts: 6801
Re: Downscaling with Lanczos
« Reply #14 on: May 27, 2024, 07:44:02 pm »
has anyone questioned the popup doc for the canvas.Draw(.....) ?

It states it calls the StretchDraw and so on, read the rest.
The only true wisdom is knowing you know nothing

 

TinyPortal © 2005-2018