Line Intensity Profile From Image

Question

I can get line profiles from images using imagej but it would be nice to be able to do this in my mathematica notebooks.

I found this

http://library.wolfram.com/examples/intensityprofiles/

after some google searches and it is exactly what I want to be able to do. However it seems they removed this package. I cant seem to figure out how to do this in v 9.0.

Anyone know how to do this?

Edit: I added a picture to make it more clear what I'm talking about. Its important that I can take an arbitrary (diagonal) line and that mathematica interpolates between pixels in a way that makes sense.

Sorry if my formatting is off, this is my first post.

UPDATE: This is what I think I'm going to use to do what I want. Obviously the display isn't made, and details need to be sorted out, but ImageValue interpolates automatically and seems like the Built-In to use. Thanks for the help everyone.

  img = Import["http://i.imgur.com/szcChXh.png?1"]
    (*First Argument of ImageProfile is the arc length along the line profile,
    incremented in steps of 1/(npts-1)*)
    (*Second Argument of ImageValue is the parametric form of a line, incremented in       
    steps of 1/(npts-1)*)

    ImageProfile[img_, x1_, y1_, x2_, y2_, npts_] := 
     Table[{N@((i - 1)/(npts - 1)) Sqrt[(x1 - x2)^2 + (y1 - y2)^2], 
       ImageValue[
        img, {x1 + (x2 - x1) (i - 1)/(npts - 1), 
         y1 + (y2 - y1) (i - 1)/(npts - 1)}]}, {i, 1, npts}]
    pt1 = {500, 300};
    pt2 = {600, 600};
   Show[img, Graphics[{Red, Thick, Line[{pt1, pt2}]}]]
    ListPlot[ImageProfile[img, pt1[[1]], pt1[[2]], pt2[[1]], pt2[[2]],1000], Joined -> True]

Answer 1

Edit:

I've included the code from Bresenham's line algorithm of halirutan which is used to get positions of pixels of interest, ImageValue is more convenient but maybe one don't want to do any interpolations. Also couple of minor improvements added, I forgot Refresh[...,None] at the beginning. Looking forward for any sugesstions :)

img = ColorConvert[Import["http://newton.umsl.edu/run//nano/5102D120.png"],
                   "Grayscale"]

Deploy@With[{opt = Sequence[Frame -> True, ImageSize -> 450, BaseStyle -> {18, Bold}, 
             AspectRatio -> 1/GoldenRatio, ImagePadding -> 55, FrameLabel -> {"|pi-x|", 
             "Graylevel"}, FrameTicks -> {{Automatic, Automatic}, {Automatic, 
            {{#1, "x"}, {#2, "y"}} &}}]},
  DynamicModule[{x, y, w, pos, data, profile, label, linegraphics, sectionplot, fix, 
                 moveboth, bb, bresenham},
   Dynamic[Refresh[

    Panel@Grid[{{
        Show[img, linegraphics],
        Column[{
          sectionplot,
          "",
          moveboth,
          bb
          }, Center, BaseStyle -> {18, Bold}]
        }}, Alignment -> Top]

    , None]],
   Initialization :> (
     dim = ImageDimensions@img;
     x = Round[dim/2];
     y = Round[2 dim/3];
     fix = True;
     pos[] := bresenham[IntegerPart@x, IntegerPart@y];

     profile[] := With[{p = pos[]}, 
                   SortBy[Transpose@{Norm /@ N[# - x & /@ p], PixelValue[img, p]},
                          First]];


     linegraphics = Graphics[{
        Yellow, Dynamic@Line[{x, y}], AbsolutePointSize@8, Orange, 
        Dynamic@Point[{x, y}],            
        Locator[Dynamic[x, {(w = y - x) &, (x = #; If[fix, y = x + w];) &, None}], 
                Appearance -> None],
        Locator[Dynamic@y, Appearance -> None],
        Text[Style["x", 18], Dynamic[x + {20, 0}]],
        Text[Style["y", 18], Dynamic[y + {20, 0}]]}];

     moveboth = Grid[{{Checkbox[Dynamic@fix], "move both with x."}}];

     bb = ButtonBar[{"Set vertical" :> (x = Round[dim .5]; y = Round[dim {.5, .7}];), 
                     "Set horizontal" :> (x = Round[dim .5]; y = Round[dim {.7, .5}])}];

     sectionplot = Graphics[{
                    Dynamic[{Line[#], AbsolutePointSize@3, Red, Point[#]} &@profile[]]},
                    PlotRange -> {All, {0, 1}}, opt];

     ClearAll[bresenham];
     bresenham[p0_, p1_] := Module[{dx, dy, sx, sy, err, newp},
      {dx, dy} = Abs[p1 - p0];
      {sx, sy} = Sign[p1 - p0];
      err = dx - dy;
      newp[{x_, y_}] := With[{e2 = 2 err}, {
       If[e2 > -dy, err -= dy; x + sx, x], 
       If[e2 < dx, err += dx; y + sy, y]}];
      NestWhileList[newp, p0, # =!= p1 &, 1]];
     )]
  ]

Answer 2

You could use ImageTransformation:

img = ExampleData[{"TestImage", "Lena"}];
line = {{150.`, 406.`}, {271.`, 156.`}};

ImageTransformation[img, 
 line[[1]] + #[[1]]*(line[[2]] - line[[1]]) &, {100, 1}, 
 PlotRange -> {{0, 1}, {0, 1}}, DataRange -> Full]

If you want raw pixel values instead of an image, use ImageData[transformResult][[1]], to get the pixels in the first (and only) line of the result image

Answer 3

According to an example here:ImageValue, you could use an extension of this perhaps:

 ImageValue[yourimage, Table[{i, i}, {i, .5, 10, 1}]];

This takes the values of the diagonal pixels in the image and outputs them as a list - you could then interpolate this for your intensity plot.

Extending it to an arbitrary line shouldn't be too much of a leap!