Skip to main content

programming - How to make a curve selectable from a scaned image and convert it to a list of coordinates


I have a scanned image (binary-ized):


example picture


Is there any way to reduce one of these curved lines (full or dotted) to a series of its coordinates (e.g., sampling interval of 0.01 on x-axis)?


I've read some similar examples:




But my problem is slightly different:


I have several curves in one image. I would like to isolate them one from another and make each curved selectable by a simple click so that, for the selected curve, a series of coordinates of its sampled points (e.g., interval of 0.01 on x-axis) can be returned.


Like this:


clic


image selected


coordonnates returned



Answer



I am not sure, if one can separate one curve out of the image. There is, however, another possibility to do what you want. It is possible to get the curve points out of the image. I am not sure, if I have already published here this answer. I checked but did not find it. Hence, I am publishing it. The task is fulfilled by a copyCurve function first described and then given below.


The function copyCurve


Description



The function copyCurve enables one to get the coordinates of points of a curve plot found on an image, and memorizes them in a list entitled "listOfPoints"


Parameters


image is any image. It should have head Image. If it is a Graphics object, wrap it by the Image statement. The code uses specific Image properties during the rescaling.


Controls


The checkbox whiteLocatorRing defines, if locators are shown by a single color ring (unchecked), or with two rings, the outer having a color defined by the ColorSlider (see below), the inner one being white. This may be helpful, if working with a too dark image.


size controls the size of the image. The default value is 450. This slider is used to adjust the size to enable the most comfortable work with the image plot.


opacity controls the opacity of the line connecting the locators


thickness controls the thickness of the double ring that forms each locator.


lineThickness controls the thickness of the line connecting the locators


color is the colour slider that controls the colour of the outer ring forming the locator and the line connecting them. The inner locator ring is always white or no white ring at all.



radius controls the radius of the locators.


InputFields


The input fields should be supplied by the reference points x1 and x2 at the axis x, as well as y1 and y2 at the axis y.


Buttons


The buttons "Memorize scale X" and "Memorize scale Y" should be pressed after the first two locators are placed on the corresponding reference points (presumably, located at the x or y axes). Upon pressing the button "Memorize scale ..." the corresponding reference points are memorized. The button "Make list of the curve points" should be pressed at the end of the session. Upon its pressing the actual list of points representing those of the curve is assigned to the global variable listOfPoints.


Operation sequence




  1. Execute the function





  2. Enter the reference points at the plot x axes into the input fields. Press Enter.




  3. Alt+Click on the point with x-coordinate x1. This brings up the first locator visible as a circle. Alt+Click (Command + Click for Mac OS X) on that with x2 which gives rise to the second locator. Adjust the locators, if necessary. Press the button "Memorize scale X".




  4. Enter the reference points at the plot y axes into the input fields. Press Enter. Move the two already existing locators to the points with the coordinates y1 and y2. Press the button "Memorize scale Y". Now the both scales are captured.





  5. Move the two already existing locators to the first two points of the curve to be captured. Alt+Click on other points of the curve. Each Alt+Click will generate an additional locator. Adjust locators, if necessary. To remove, press Alt+Click on unnecessary locators.




  6. Press the button "Make the list...". This assigns the captured list to the global variable listOfPoints. Done.


    The listOfPoints is a global variable. It can be addressed everywhere in the notebook.




at work:


pic = Import["http://i.stack.imgur.com/gQvOw.jpg"]
copyCurve[pic]


enter image description here



The code


  Clear[copyCurve];

copyCurve[image_] :=

  Manipulate[
   DynamicModule[{pts = {}, x1 = Null, x2 = Null, y1 = Null, 

     y2 = Null, X1, X2, Y1, Y2, \[CapitalDelta]X, \[CapitalDelta]Y, g,
      myRound},

    myRound[x_] := Round[1000*x]/1000 // N;

    (* Begins the column with all the content of the manipulate *)
    Column[{
      (* Begin LocatorPane*)
      Dynamic@LocatorPane[Union[Dynamic[pts]],
        Dynamic@

         Show[{Image[image, ImageSize -> size], 
           Graphics[{color, AbsoluteThickness[lineThickness], 
             Opacity[opacity], Line[Union[pts]]}]
               }], LocatorAutoCreate -> True,
        (* Begin Locator appearance *)
        Appearance -> If[whiteLocatorRing,

          Graphics[{{color, AbsoluteThickness[thickness], 
             Circle[{0, 0}, radius + thickness/2]}, {White, 
             AbsoluteThickness[thickness], Circle[{0, 0}, radius]}}, 

           ImageSize -> 10]
          , 
          Graphics[{{color, AbsoluteThickness[thickness], 
             Circle[{0, 0}, radius + thickness/2]}}, 
           ImageSize -> 10]](* End Locator appearance *)
                              ],(* End LocatorPane*)

      (* Begin of the block of InputFields *)
      Row[{ Style["\!\(\*SubscriptBox[\(x\), \(1\)]\):"],
        InputField[Dynamic[x1], 

         FieldHint -> "Type  \!\(\*SubscriptBox[\(x\), \(1\)]\)", 
         FieldSize -> 7, FieldHintStyle -> {Red}],
        Spacer[20], Style["   \!\(\*SubscriptBox[\(y\), \(1\)]\):"],
        InputField[Dynamic[y1], 
         FieldHint -> "Type  \!\(\*SubscriptBox[\(y\), \(1\)]\)", 
         FieldSize -> 7, FieldHintStyle -> {Red}]
               }],
      Row[{ Style["\!\(\*SubscriptBox[\(x\), \(2\)]\):"],
        InputField[Dynamic[x2], 
         FieldHint -> "Type \!\(\*SubscriptBox[\(x\), \(2\)]\)", 

         FieldSize -> 7, FieldHintStyle -> {Red}],
        Spacer[20], Style["   \!\(\*SubscriptBox[\(y\), \(2\)]\):"],
        InputField[Dynamic[y2], 
         FieldHint -> 
          "Type  \!\(\*SubscriptBox[\(y\), \(2\)]\)+Enter", 
         FieldSize -> 7, FieldHintStyle -> {Red}]
               }],
      (* End of the block of InputFields *)
      (* Begin the buttons row *)
      Row[{Spacer[15],

        (* Begin button "Memorize scale X" *)
        Button["Memorize scale X",
         X1 = Min[Transpose[myRound /@ Union[pts]][[1]]];
         X2 = Max[Transpose[myRound /@ Union[pts]][[1]]];
         \[CapitalDelta]X = X2 - X1;
         ],(* End of button "Memorize scale X" *)
        Spacer[70],
        (* Begin button "Memorize scale Y" *)
        Button["Memorize scale Y",
         Y1 = Min[Transpose[myRound /@ Union[pts]][[2]]];

         Y2 = Max[Transpose[myRound /@ Union[pts]][[2]]];
         \[CapitalDelta]Y = Y2 - Y1;
         ](* End of button "Memorize scale Y" *)


        }],(* End the buttons row *)
      Spacer[0],

      (* Begin button "Make the list of the curve's points" *)
      Button[Style["Make the list of the curve's points" , Bold],

       g[{a_, b_}] := {(x1*X2 - x2*X1)/\[CapitalDelta]X + 
          a/\[CapitalDelta]X*Abs[x2 - x1], (
          y1*Y2 - y2*Y1)/\[CapitalDelta]Y + 
          b/\[CapitalDelta]Y*Abs[y2 - y1]};
       Clear[listOfPoints];
       listOfPoints = Map[myRound, Map[g, pts]]
                   ](* End of button "Make the list..." *)

      }, Alignment -> Center](* 
    End of column with all the content of the manipulate *)

    ],(* End of the DynamicModule *)

   (* The massive of sliders  begins *)
   Column[{Row[{Control[{whiteLocatorRing, {True, False}}], 
       Spacer[50]}],
     Row[{Spacer[32.35], Control[{{size, 450}, 300, 800}], 
       Spacer[38.5`], Control[{{opacity, 0.5}, 0, 1}]}],
     Row[{Spacer[10.], Control[{{thickness, 1}, 0.5, 5}], 
       Spacer[13.65], Control[{{lineThickness, 1}, 0, 10}] }],
     Row[{Spacer[22.8], Control[{color, Red}], Spacer[59.3], 

       Control[{{radius, 0.5}, 0, 3}]}]
     }, Alignment -> Center],(* The massive of sliders ends *)

   (* Definitions of sliders *)
   ControlType -> {Checkbox, Slider, Slider, Slider, Slider, 
     ColorSlider, Slider},
   ControlPlacement -> Top, SaveDefinitions -> True
   ];

Have fun.



Comments

Post a Comment

Popular posts from this blog

mathematical optimization - Minimizing using indices, error: Part::pkspec1: The expression cannot be used as a part specification

I want to use Minimize where the variables to minimize are indices pointing into an array. Here a MWE that hopefully shows what my problem is. vars = u@# & /@ Range[3]; cons = Flatten@ { Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; Minimize[{Total@((vec1[[#]] - vec2[[u[#]]])^2 & /@ Range[1, 3]), cons}, vars, Integers] The error I get: Part::pkspec1: The expression u[1] cannot be used as a part specification. >> Answer Ok, it seems that one can get around Mathematica trying to evaluate vec2[[u[1]]] too early by using the function Indexed[vec2,u[1]] . The working MWE would then look like the following: vars = u@# & /@ Range[3]; cons = Flatten@{ Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; NMinimize[ {Total@((vec1[[#]] - Indexed[vec2, u[#]])^2 & /@ R...
Post a Comment
Read more

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...
Post a Comment
Read more

What is and isn't a valid variable specification for Manipulate?

I have an expression whose terms have arguments (representing subscripts), like this: myExpr = A[0] + V[1,T] I would like to put it inside a Manipulate to see its value as I move around the parameters. (The goal is eventually to plot it wrt one of the variables inside.) However, Mathematica complains when I set V[1,T] as a manipulated variable: Manipulate[Evaluate[myExpr], {A[0], 0, 1}, {V[1, T], 0, 1}] (*Manipulate::vsform: Manipulate argument {V[1,T],0,1} does not have the correct form for a variable specification. >> *) As a workaround, if I get rid of the symbol T inside the argument, it works fine: Manipulate[ Evaluate[myExpr /. T -> 15], {A[0], 0, 1}, {V[1, 15], 0, 1}] Why this behavior? Can anyone point me to the documentation that says what counts as a valid variable? And is there a way to get Manpiulate to accept an expression with a symbolic argument as a variable? Investigations I've done so far: I tried using variableQ from this answer , but it says V[1...
Post a Comment
Read more