Медианный фильтр не до конца - применяется не до конца изображения где то на 75% справа остаётся нетронутым примерно 25% - Общие вопросы Delphi - Страница 2

noveek · 14.12.2021, 21:20

Цитата:

Сообщение от BDA

Покритиковать код и дать советы могу, но писать готовое не интересно.

Кому-то было лень прочесть комментарии в коде

Можно не на каждой итерации цикла по y вызывать три ScanLine, а вызвать два раза до циклов обработки, а потом верно переписывать значения переменных и один раз вызывать ScanLine. На мой взгляд, довольно странный способ вычисления яркости пикселя - не сталкивался с таким. Сейчас половина кода просто лишняя - определитесь, хотите ли использовать PixIndx или нет. Если нет, то нужно удалить его сортировку и кучу if, где заполняются r1, r2, g1, g2, b1, b2 на его основе. И последняя проблема - плохая идея, писать результат фильтрации в то же изображение, откуда берутся пиксели.

Да меня сейчас устраивает результат если не хочешь писать никто не будет заставлять, но интересно просто чтобы ты изменил и как сделал, по обрывкам из комментариев куча времени уйдёт собирать а проект тоже имеет сроки свои

BDA · 17.12.2021, 18:15

Чуть-чуть потыкал:

Код:

type
  TRGBArray = array[0..32767] of TRGBTriple;
  PRGBArray = ^TRGBArray;

  BrightnessIdx = record
    bri: Double;
    idx: Integer;
  end;

implementation

function getBrightness(p: TRGBTriple): Double;
begin
  Result := 0.3 * p.rgbtRed + 0.59 * p.rgbtGreen + 0.11 * p.rgbtBlue;
end;

procedure Median(in_bmp, out_bmp: TBitmap);
var
  x, y, j, k: integer;
  BrightnessIdxs: array[0..8] of BrightnessIdx;
  b: BrightnessIdx;
  RowL, RowM, RowH, resM: PRGBArray;
begin
  RowM := in_bmp.ScanLine[0];
  RowH := in_bmp.ScanLine[1];
  for y := 1 to in_bmp.Height - 2 do
  begin
    RowL := RowM;
    RowM := RowH;
    RowH := in_bmp.ScanLine[y + 1];
    resM := out_bmp.ScanLine[y];

    for x := 1 to in_bmp.Width - 2 do
    begin
      for k := 0 to 8 do
        BrightnessIdxs[k].idx := k;

      BrightnessIdxs[0].bri := getBrightness(RowL[x - 1]);
      BrightnessIdxs[1].bri := getBrightness(RowL[x]);
      BrightnessIdxs[2].bri := getBrightness(RowL[x + 1]);
      BrightnessIdxs[3].bri := getBrightness(RowM[x - 1]);
      BrightnessIdxs[4].bri := getBrightness(RowM[x]);
      BrightnessIdxs[5].bri := getBrightness(RowM[x + 1]);
      BrightnessIdxs[6].bri := getBrightness(RowH[x - 1]);
      BrightnessIdxs[7].bri := getBrightness(RowH[x]);
      BrightnessIdxs[8].bri := getBrightness(RowH[x + 1]);

      for j := 0 to 7 do
        for k := j + 1 to 8 do
          if BrightnessIdxs[k].bri < BrightnessIdxs[j].bri then
          begin
            b := BrightnessIdxs[j];
            BrightnessIdxs[j] := BrightnessIdxs[k];
            BrightnessIdxs[k] := b;
          end;

      case BrightnessIdxs[4].idx of
        0: resM[x] := RowL[x - 1];
        1: resM[x] := RowL[x];
        2: resM[x] := RowL[x + 1];
        3: resM[x] := RowM[x - 1];
        4: resM[x] := RowM[x];
        5: resM[x] := RowM[x + 1];
        6: resM[x] := RowH[x - 1];
        7: resM[x] := RowH[x];
        8: resM[x] := RowH[x + 1];
      end;
    end;
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  bmp1, bmp2: TBitmap;
begin
  bmp1 := TBitmap.Create;
  bmp1.LoadFromFile('112a.bmp');
  bmp2 := TBitmap.Create;
  bmp2.Assign(bmp1); // чтобы не мучаться с размерами и краями

  Median(bmp1, bmp2);

  bmp1.Free;
  bmp2.SaveToFile('112b.bmp');
  bmp2.Free;

  ShowMessage('OK');
end;

end.

Тестил на 112a.bmp, который оказался 24битный. Мелкие точки пропали, но крупные остались.

noveek · 17.12.2021, 21:07

Цитата:

Сообщение от BDA

Чуть-чуть потыкал:
Тестил на 112a.bmp, который оказался 24битный. Мелкие точки пропали, но крупные остались.

У меня точки не пропали они перекрасились в другие цвета)

Код:

function getBrightness(p: TRGBQuad): Double;
begin
  Result := 0.3 * p.rgbRed + 0.59 * p.rgbGreen + 0.11 * p.rgbBlue;
end;

procedure Median(in_bmp:TBitmap);
var
  x, y, j, k: integer;
  BrightnessIdxs: array[0..8] of BrightnessIdx;
  b: BrightnessIdx;
  RowL, RowM, RowH, resM: PRGBArray;
begin
  RowM := in_bmp.ScanLine[0];
  RowH := in_bmp.ScanLine[1];
  for y := 1 to in_bmp.Height - 2 do
  begin
    RowL := RowM;
    RowM := RowH;
    RowH := in_bmp.ScanLine[y + 1];
    resM := in_bmp.ScanLine[y];

    for x := 1 to in_bmp.Width - 2 do
    begin
      for k := 0 to 8 do
        BrightnessIdxs[k].idx := k;

      BrightnessIdxs[0].bri := getBrightness(RowL[x - 1]);
      BrightnessIdxs[1].bri := getBrightness(RowL[x]);
      BrightnessIdxs[2].bri := getBrightness(RowL[x + 1]);
      BrightnessIdxs[3].bri := getBrightness(RowM[x - 1]);
      BrightnessIdxs[4].bri := getBrightness(RowM[x]);
      BrightnessIdxs[5].bri := getBrightness(RowM[x + 1]);
      BrightnessIdxs[6].bri := getBrightness(RowH[x - 1]);
      BrightnessIdxs[7].bri := getBrightness(RowH[x]);
      BrightnessIdxs[8].bri := getBrightness(RowH[x + 1]);

      for j := 0 to 7 do
        for k := j + 1 to 8 do
          if BrightnessIdxs[k].bri < BrightnessIdxs[j].bri then
          begin
            b := BrightnessIdxs[j];
            BrightnessIdxs[j] := BrightnessIdxs[k];
            BrightnessIdxs[k] := b;
          end;

      case BrightnessIdxs[4].idx of
        0: resM[x] := RowL[x - 1];
        1: resM[x] := RowL[x];
        2: resM[x] := RowL[x + 1];
        3: resM[x] := RowM[x - 1];
        4: resM[x] := RowM[x];
        5: resM[x] := RowM[x + 1];
        6: resM[x] := RowH[x - 1];
        7: resM[x] := RowH[x];
        8: resM[x] := RowH[x + 1];
      end;
    end;
  end;
end;

34ee.bmp

BDA · 18.12.2021, 05:21

Цитата:

Сообщение от noveek

они перекрасились в другие цвета

Проверьте PixelFormat - смена цветов, скорее всего, из-за того, что 24битный битмап обрабатывается как будто это 32битный.

noveek · 18.12.2021, 07:07

Цитата:

Сообщение от BDA

Проверьте PixelFormat - смена цветов, скорее всего, из-за того, что 24битный битмап обрабатывается как будто это 32битный.

Ага работает теперь просто медиан фильтр надо было ставить вначале, как сделать посильнее чтобы и крупные убрал и полосы ?

BDA · 20.12.2021, 06:58

Можно увеличить радиус фильтра (сейчас окно 3 на 3 рассматривается), но тогда полезные цифры и буквы тоже пострадают и превратятся в пятна.

noveek · 20.12.2021, 08:46

Цитата:

Сообщение от BDA

Можно увеличить радиус фильтра (сейчас окно 3 на 3 рассматривается), но тогда полезные цифры и буквы тоже пострадают и превратятся в пятна.

А полосы можно хотя бы убрать как то ?

noveek · 20.12.2021, 13:58

Цитата:

Сообщение от BDA

Можно увеличить радиус фильтра (сейчас окно 3 на 3 рассматривается), но тогда полезные цифры и буквы тоже пострадают и превратятся в пятна.

Ты знаешь твоя функция медиан фильтра очень хороша просто бы регулировать мощность например чтобы так вызывался

Код:

Median(bmp,0.5); // 0.5 мощность

BDA · 21.12.2021, 05:14

Цитата:

Сообщение от noveek

регулировать мощность

Не представляю нецелые аргументы для медианного фильтра. Можно задавать радиус (целый от 1 и больше), но края остаются нефильтрованные:

Код:

type
  BriPix = record
    bri: Double;
    pix: TRGBTriple;
  end;

implementation

procedure MedianR(in_bmp, out_bmp: TBitmap; r: Integer);
var
  x, y, i, j, k, next_row, d: integer;
  BriPixs: array of BriPix;
  b: BriPix;
  res_row: PRGBArray;
  Rows: array of PRGBArray;
begin
  d := 2 * r + 1;
  SetLength(BriPixs, d * d);
  SetLength(Rows, d);

  for y := 0 to d - 2 do
    Rows[y] := in_bmp.ScanLine[y];
  next_row :=  d - 1;

  for y := r to in_bmp.Height - 1 - r do
  begin
    Rows[next_row] := in_bmp.ScanLine[y + r];
    next_row := (next_row + 1) mod d;
    res_row := out_bmp.ScanLine[y];

    for x := r to in_bmp.Width - 1 - r do
    begin
      for i := 0 to d - 1 do
        for j := 0 to d - 1 do
        begin
          k := d * i + j;
          BriPixs[k].pix := Rows[i][x - r + j];
          BriPixs[k].bri := getBrightness(BriPixs[k].pix);
        end;

      for i := 0 to d * d - 2 do
        for j := i + 1 to d * d - 1 do
          if BriPixs[j].bri < BriPixs[i].bri then
          begin
            b := BriPixs[i];
            BriPixs[i] := BriPixs[j];
            BriPixs[j] := b;
          end;

      res_row[x] := BriPixs[(d * d) div 2].pix;
    end;
  end;

  SetLength(BriPixs, 0);
  SetLength(Rows, 0);
end;

Цитата:

Сообщение от noveek

А полосы можно хотя бы убрать как то ?

Я не занимался распознаванием капчей с таким мусором, поэтому не знаю, какой именно подход будет эффективнее. То есть стоит ли именно медианным фильтром пытаться давить полосы, или все-таки пробовать правильно интерпретировать результаты работы Хафа, чтобы закрасить полосы.
Кстати, так и не понял, вы занимаетесь учебным или коммерческим проектом? Для коммерческого лучше, на мой взгляд, пытаться использовать готовые библиотеки (например, OpenCV).

noveek · 21.12.2021, 09:31

Цитата:

Сообщение от BDA

Я не занимался распознаванием капчей с таким мусором, поэтому не знаю, какой именно подход будет эффективнее. То есть стоит ли именно медианным фильтром пытаться давить полосы, или все-таки пробовать правильно интерпретировать результаты работы Хафа, чтобы закрасить полосы.
Кстати, так и не понял, вы занимаетесь учебным или коммерческим проектом? Для коммерческого лучше, на мой взгляд, пытаться использовать готовые библиотеки (например, OpenCV).

Проект не коммерческий пишу ради своего личного интереса, спасибо теперь переделанная тобой процедура хорошо работает отрегулировал на 2 вроде нормально =)
MedianR(bmp,2);
Оставлю её тут без ошибок в коде мало ли кому нужно тоже будет:

Код:

type
  BriPix = record
    bri: Double;
    pix: TRGBTriple;
  end;

function getBrightness(p: TRGBTriple): Double;
begin
  Result := 0.3 * p.rgbtRed + 0.59 * p.rgbtGreen + 0.11 * p.rgbtBlue;
end;

procedure MedianR(in_bmp: TBitmap; r: Integer);
var
  x, y, i, j, k, next_row, d: integer;
  BriPixs: array of BriPix;
  b: BriPix;
  res_row: PRGBTripleArray;
  Rows: array of PRGBTripleArray;
begin
  d := 2 * r + 1;
  SetLength(BriPixs, d * d);
  SetLength(Rows, d);

  for y := 0 to d - 2 do
    Rows[y] := in_bmp.ScanLine[y];
  next_row :=  d - 1;

  for y := r to in_bmp.Height - 1 - r do
  begin
    Rows[next_row] := in_bmp.ScanLine[y + r];
    next_row := (next_row + 1) mod d;
    res_row := in_bmp.ScanLine[y];

    for x := r to in_bmp.Width - 1 - r do
    begin
      for i := 0 to d - 1 do
        for j := 0 to d - 1 do
        begin
          k := d * i + j;
          BriPixs[k].pix := Rows[i][x - r + j];
          BriPixs[k].bri := getBrightness(BriPixs[k].pix);
        end;

      for i := 0 to d * d - 2 do
        for j := i + 1 to d * d - 1 do
          if BriPixs[j].bri < BriPixs[i].bri then
          begin
            b := BriPixs[i];
            BriPixs[i] := BriPixs[j];
            BriPixs[j] := b;
          end;
      res_row[x] := BriPixs[(d * d) div 2].pix;
    end;
  end;

  SetLength(BriPixs, 0);
  SetLength(Rows, 0);
end;

20.12.2021, 06:58	#16
BDA МегаМодератор СуперМодератор Регистрация: 09.11.2010 Сообщений: 7,291	Можно увеличить радиус фильтра (сейчас окно 3 на 3 рассматривается), но тогда полезные цифры и буквы тоже пострадают и превратятся в пятна. Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Поиск конца БД	Vladimir_Der	Microsoft Office Excel	3	03.06.2019 10:34
Не до конца доходит dt,dd,dl	AnweeKey	HTML и CSS	4	19.09.2018 22:35
накласть медианный фильтр	Anriuser	JavaScript, Ajax	1	05.03.2017 22:21
Qt - OpenCV - Медианный фильтр	fredz	Qt и кроссплатформенное программирование С/С++	0	13.12.2014 13:47
Медианный фильтр	Каскадер	Помощь студентам	3	26.01.2014 15:10