Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 04.06.2009, 13:29   #1
antonyLW
Пользователь
 
Регистрация: 31.05.2009
Сообщений: 19
По умолчанию Как можно зашумить изображение?

Добрый день)
столкнулся с такой проблемой, мне нужно зашумлять изображение разными способами...
на данный момент реализованы два способа зашумления - гауссов шум и гауссово размытие..
что можно еще использовать?
одно НО - не надо производить изменения формы фигуры(в плане поворотов, растягиваний,сжатий и пр.), т.к. производится сравнение с эталонными фигурами....
заранее благодарен!!!

Последний раз редактировалось antonyLW; 04.06.2009 в 13:38.
antonyLW вне форума Ответить с цитированием
Старый 04.06.2009, 13:47   #2
BaronTreep
Форумчанин
 
Регистрация: 29.05.2009
Сообщений: 320
По умолчанию

Например по преобразованию Бернулли можно получить квази-зашумление:

// x(n+1) = k * x(n) (mod 1)
double BernoulyChaos(double Arg, double k)
{
double x = Arg;
long i = 0;
i = x *= k;
x -= i;
return x;
}

x = BernoulyChaos(x, 1.000002365); // Последовательно

+ Конечно метод Монте-Карло часто используют.
BaronTreep вне форума Ответить с цитированием
Старый 04.06.2009, 18:08   #3
antonyLW
Пользователь
 
Регистрация: 31.05.2009
Сообщений: 19
По умолчанию

на делфи это будет выглядеть вот так?
function BernoulyChaos(Arg,k: real): real;
var x,i: integer;
begin
x:=arg;
i:= x*k;
x:= x - i;
result:=x;
end;
щас буду пробовать, разбираться...

ps А что за метод монте карло? т.е. как преобразуется изображение?
antonyLW вне форума Ответить с цитированием
Старый 04.06.2009, 21:07   #4
antonyLW
Пользователь
 
Регистрация: 31.05.2009
Сообщений: 19
По умолчанию

попробовал сделать по Бернулли....написал следующий код
Код:
function BernoulyChaos(Arg,k: real): real;
var
  x,i: real;
begin
  x:=arg;
  i:= x*k;
  x:= x - i;
  result:=x;
end;

function BernNoise(Bitmap: TBitmap; k: Real): Tbitmap;
var
  r, g, b, i,j: integer;
  c: Tcolor;

begin
  for i:= 0 to Bitmap.Width-1 do
    for j:=0 to Bitmap.Height-1 do
    begin
      c:= Bitmap.Canvas.Pixels[i,j];
      r := c and $FF;
      g := (c and $FF00)div $100;
      b :=(c and $FF0000)div $10000;

      r:= round(BernoulyChaos(r,k));
      g:= round(BernoulyChaos(g,k));
      b:= round(BernoulyChaos(b,k));

      c:= r+g*$100+b*$10000;
      Bitmap.Canvas.Pixels[i,j]:= c;
    end;
  result:= Bitmap;
end;
но на выходе получил черное изображение, при указании значения К = 1.000236
при К = 2 при первом зашумлении получилась та же фигура, только белый свет стал сиреневым....
что не так?
antonyLW вне форума Ответить с цитированием
Старый 05.06.2009, 01:17   #5
antonyLW
Пользователь
 
Регистрация: 31.05.2009
Сообщений: 19
По умолчанию

еще трабла....извиняюсь за длинный код модуля...

проблема - при значениях радиуса в районе 0.5 - 0.8 монохромное изображение инвертируется...
как можно от этого избавиться?
просто при тестах у меня проходит зашумление этого изображения при разных коэффициентах (т.е. радиусах размывания, в среднем от 0.1 до 20), и возникает это инвертирование....

Код:
unit GBlur2;
interface
uses Windows, Graphics;
type
  PRGBTriple = ^TRGBTriple;
  TRGBTriple = packed record
    b: byte; //легче для использования чем типа rgbtBlue...
    g: byte;
    r: byte;
  end;
  PRow = ^TRow;
  TRow = array[0..1000000] of TRGBTriple;
  PPRows = ^TPRows;
  TPRows = array[0..1000000] of PRow;
const
  MaxKernelSize = 100;
type
  TKernelSize = 1..MaxKernelSize;
  TKernel = record
    Size: TKernelSize;
    Weights: array[-MaxKernelSize..MaxKernelSize] of single;
  end;
procedure GBlur(theBitmap: TBitmap; radius: double);

implementation

uses SysUtils;

procedure MakeGaussianKernel(var K: TKernel; radius: double;

  MaxData, DataGranularity: double);
var
  j: integer;
  temp, delta: double;
  KernelSize: TKernelSize;
begin

  for j := Low(K.Weights) to High(K.Weights) do
  begin
    temp := j / radius;
    K.Weights[j] := exp(-temp * temp / 2);
  end;

  //делаем так, чтобы sum(Weights) = 1:

  temp := 0;
  for j := Low(K.Weights) to High(K.Weights) do
    temp := temp + K.Weights[j];
  for j := Low(K.Weights) to High(K.Weights) do
    K.Weights[j] := K.Weights[j] / temp;

  KernelSize := MaxKernelSize;
  delta := DataGranularity / (2 * MaxData);
  temp := 0;
  while (temp < delta) and (KernelSize > 1) do
  begin
    temp := temp + 2 * K.Weights[KernelSize];
    dec(KernelSize);
  end;

  K.Size := KernelSize;
  temp := 0;
  for j := -K.Size to K.Size do
    temp := temp + K.Weights[j];
  for j := -K.Size to K.Size do
    K.Weights[j] := K.Weights[j] / temp;

end;

function TrimInt(Lower, Upper, theInteger: integer): integer;
begin

  if (theInteger <= Upper) and (theInteger >= Lower) then
    result := theInteger
  else if theInteger > Upper then
    result := Upper
  else
    result := Lower;
end;

function TrimReal(Lower, Upper: integer; x: double): integer;
begin

  if (x < upper) and (x >= lower) then
    result := trunc(x)
  else if x > Upper then
    result := Upper
  else
    result := Lower;
end;

procedure BlurRow(var theRow: array of TRGBTriple; K: TKernel; P: PRow);
var
  j, n, LocalRow: integer;
  tr, tg, tb: double; //tempRed и др.

  w: double;
begin

  for j := 0 to High(theRow) do

  begin
    tb := 0;
    tg := 0;
    tr := 0;
    for n := -K.Size to K.Size do
    begin
      w := K.Weights[n];

      //TrimInt задает отступ от края строки...

      with theRow[TrimInt(0, High(theRow), j - n)] do
      begin
        tb := tb + w * b;
        tg := tg + w * g;
        tr := tr + w * r;
      end;
    end;
    with P[j] do
    begin
      b := TrimReal(0, 255, tb);
      g := TrimReal(0, 255, tg);
      r := TrimReal(0, 255, tr);
    end;
  end;

  Move(P[0], theRow[0], (High(theRow) + 1) * Sizeof(TRGBTriple));
end;

procedure GBlur(theBitmap: TBitmap; radius: double);
var
  Row, Col: integer;
  theRows: PPRows;
  K: TKernel;
  ACol: PRow;
  P: PRow;
begin
  if (theBitmap.HandleType <> bmDIB) or (theBitmap.PixelFormat <> pf24Bit) then

    raise
      exception.Create('GBlur может работать только с 24-битными изображениями');

  MakeGaussianKernel(K, radius, 255, 1);
  GetMem(theRows, theBitmap.Height * SizeOf(PRow));
  GetMem(ACol, theBitmap.Height * SizeOf(TRGBTriple));

  for Row := 0 to theBitmap.Height - 1 do

    theRows[Row] := theBitmap.Scanline[Row];

  //размываем каждую строчку:
  P := AllocMem(theBitmap.Width * SizeOf(TRGBTriple));
  for Row := 0 to theBitmap.Height - 1 do

    BlurRow(Slice(theRows[Row]^, theBitmap.Width), K, P);
  ReAllocMem(P, theBitmap.Height * SizeOf(TRGBTriple));
  for Col := 0 to theBitmap.Width - 1 do
  begin

    for Row := 0 to theBitmap.Height - 1 do
      ACol[Row] := theRows[Row][Col];

    BlurRow(Slice(ACol^, theBitmap.Height), K, P);

    for Row := 0 to theBitmap.Height - 1 do
      theRows[Row][Col] := ACol[Row];
  end;

  FreeMem(theRows);
  FreeMem(ACol);
  ReAllocMem(P, 0);
end;

end.
antonyLW вне форума Ответить с цитированием
Старый 05.06.2009, 02:39   #6
DomiNick
Студент, не
Старожил
 
Аватар для DomiNick
 
Регистрация: 29.01.2009
Сообщений: 2,067
Лампочка

Цитата:
нужно зашумлять изображение разными способами
Цитата:
производится сравнение с эталонными фигурами
Может тогда попробовать просто добавлять случайный шум..?


Небольшой набросок:
Код:
Function RandomNoise(Bitmap: TBitmap): TBitmap;
Type
      TRGB=Record
            Blue, Green, Red: Byte
            End;
      ARGB=Array[0..0] Of TRGB;
      PARGB=^ARGB;
Var x, y, dx, dy: Integer; Line: PARGB;
Begin
dx:=Bitmap.Width-1;
dy:=Bitmap.Height-1;
For y:=0 To dy Do
      Begin
      Line:=Bitmap.ScanLine[y];
      For x:=0 To dx Do
            Begin
            Line[x].Red:=Line[x].Red+Random(10)+1;
            Line[x].Green:=Line[x].Green+Random(10)+1;
            Line[x].Blue:=Line[x].Blue+Random(10)+1;
            End;
      End;
Result:=Bitmap;
End;
I am the First of Cyber Evolution...
I am the First to Program your Future...
DomiNick вне форума Ответить с цитированием
Старый 05.06.2009, 08:57   #7
antonyLW
Пользователь
 
Регистрация: 31.05.2009
Сообщений: 19
По умолчанию

дык этот случайный есть уже...это обыкновенный гауссовский шум...
antonyLW вне форума Ответить с цитированием
Старый 05.06.2009, 23:19   #8
BaronTreep
Форумчанин
 
Регистрация: 29.05.2009
Сообщений: 320
По умолчанию

По Бернулли - это когда умножаешь дробное от 0 до 1 на 2 (или k) и берешь остаток по модулю 1. x(n+1) = k * x(n) (mod 1). Например:

{0.13; 0.26; 0.52; 0.04; 0.08; 0.16; 0.32; 0.64; 0.28... }

Получается непредсказуемая последовательность. Для картинки соответственно нужно организовать две таких последовательности, и смотреть когда они заканчиваются (начинают повторяться, для этого я взял k длинное).

На дельфи будет так:

BernoulyChaos(Arg : Double, k : Double) : Double;
begin
Result = frac(x * k);
end;

А про алгоритм Монте-Карло можно в Вики посмотреть. Там наверно про разные алгоритмы шума есть (псевдо, на основе чисел, реальный хаос).


Кстати, насчет randomize и random() в Дельфи. Если вы откроете их и посмотрите, то обнаружите, что в Дельфях случайные числа это некое арифметическое от текущего системного времени, т.е. берутся часы, минуты, секунды, все это в кучку - вот и случайное число :-) Далеко НЕ Гауссов шум!

Последний раз редактировалось BaronTreep; 06.06.2009 в 19:48.
BaronTreep вне форума Ответить с цитированием
Старый 07.06.2009, 20:48   #9
antonyLW
Пользователь
 
Регистрация: 31.05.2009
Сообщений: 19
По умолчанию

за объяснение Бернулли - спасибо!)))
вообще, меня больше интересуют не то чтобы алгоритмы шума, а эффекты, получающиеся при зашумление, т.е. например изображение размывается...или эффект распыления (распылитель в ms paint), просто случайные точки...
а гауссов шум у меня реализован, и не с помощью рандома)))) просто эффект примерно тот же - случайные точки на изображении
antonyLW вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как можно отбразить изображение Gif eldar Работа с сетью в Delphi 2 25.09.2008 23:07
Чем в Делфи можно открыть TIF(F) изображение dimfil Компоненты Delphi 2 12.12.2007 09:03
RichEdit. как можно вставлять картинку туда? как можно Скрол програмно вниз двигать? Svop Компоненты Delphi 7 28.11.2006 21:07