MathGroup Archive 2003

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Raster process

  • To: mathgroup at smc.vnet.net
  • Subject: [mg40603] Re: Raster process
  • From: Jens-Peer Kuska <kuska at informatik.uni-leipzig.de>
  • Date: Fri, 11 Apr 2003 01:59:44 -0400 (EDT)
  • Organization: Universitaet Leipzig
  • References: <b7394b$p0f$1@smc.vnet.net>
  • Reply-to: kuska at informatik.uni-leipzig.de
  • Sender: owner-wri-mathgroup at wolfram.com

Hi,

no because the conversion proceed in scanline direction and the
value of the binary image depend on all pixels that are binarized
before.
Compile[] help much to speed up the conversion

and 

Clear[FloydSteinberg]

floydSteinberg = Compile[{{bitmap, _Integer, 2}, {max, _Integer}},
    Module[{half, i, j, n, m, bm, nbm, err, inc},
      bm = bitmap;
      half = Round[max/2];
      {n, m} = Dimensions[bm];
      nbm = Table[0, {n}, {m}];
      (* Inner points *)
      Do[
        Do[
          
          If[bm\[LeftDoubleBracket]i, j\[RightDoubleBracket] < half, (*
Then *)

                        
            err = bm\[LeftDoubleBracket]i, j\[RightDoubleBracket],
            (* Else *)
            
            nbm\[LeftDoubleBracket]i, j\[RightDoubleBracket] = 1;
            err = bm\[LeftDoubleBracket]i, j\[RightDoubleBracket] - max
            ];
          
          bm\[LeftDoubleBracket]i + 1, 
              j\[RightDoubleBracket] += (inc = Round[3*err/8]);
          bm\[LeftDoubleBracket]i, j + 1\[RightDoubleBracket] += inc;
          
          bm\[LeftDoubleBracket]i + 1, j + 1\[RightDoubleBracket] += 
            Round[err/4],
          {j, m - 1}],
        {i, n - 1}];
      (* Boundaries *)
      Do[
        If[bm\[LeftDoubleBracket]i, m\[RightDoubleBracket] > half, 
          nbm\[LeftDoubleBracket]i, m\[RightDoubleBracket] = 1],
        {i, n}];
      Do[
        If[bm\[LeftDoubleBracket]n, j\[RightDoubleBracket] > half, 
          nbm\[LeftDoubleBracket]n, j\[RightDoubleBracket] = 1],
        {j, m}];
      nbm
      ]
    ]

FloydSteinberg[Graphics[gr_, opt___]] := 
  gr /. Raster[bm : {{_Integer ..} ..}, ___, 
        ColorFunction -> GrayLevel, ___] :> 
      Graphics[Raster[
          floydSteinberg[bm, 255], {{0, 0}, Dimensions[bm]}, {0, 1}],
opt]

may help you.

Regards
  Jens

Steve Gray wrote:
> 
>         I have a two-level list representing a raster of gray levels.
> I want to go through it fast, testing every element and at the same
> time modifying certain elements following it on the same line and in
> the next line. One such algorithm is known as the Floyd-Steinberg
> method for converting a gray-scale image to binary. The most obvious
> implementation using a double For loop seems to be extremely slow. Is
> there a way to use Map or whatever?
>         Thanks for any help.
> 
> floyd := Module[{cw, ch, err},
>   g    = Import[fili];
>   picd = Dimensions[g[[1, 1]]];   (* Actual array.    *)
>   pich = picd[[1]];
>   picw = picd[[2]];
>   gp   = g;                                 (* Make working copy *)
>   For [ ch = 1, ch < pich, ch++,
>         For [ cw = 2, cw < picw, cw++,
>                If[g[[1, 1, ch, cw]] > 128, gp[[1, 1, ch, cw]] = 255,
>                                        gp[[1, 1, ch, cw]] =  0];
>             err = gp[[1, 1, ch, cw]] - g [[1, 1, ch, cw]];
>            g[[1, 1, ch  , cw + 1]] -= er*7/16;
>            g[[1, 1, ch + 1, cw - 1]] -= er*3/16;
>            g[[1, 1, ch + 1, cw  ]] -= er*5/16;
>            g[[1, 1, ch + 1, cw + 1]] -= er/16;
>         ];
>   ];
>     Show[gp];
>     Export[filo, gp, "JPEG"];
>   ]


  • Prev by Date: Re: Re: split a list
  • Next by Date: Re: '#1' raised to a power in result of a Solve[] call?
  • Previous by thread: Re: Raster process
  • Next by thread: '#1' raised to a power in result of a Solve[] call?