Extracting outline of thick line
How can I draw outline of thick line such as one below in vector form? By vector form I mean some collection of Graphics 开发者_如何学Pythonprimitives that's not Raster or Image.
Graphics[{AbsoluteThickness[100], JoinForm["Round"], CapForm["Round"],
Line[{{0, 0}, {0, 1}, {1, 1}}]}, ImageSize -> 200]
Documentation has the following example for extracting outlines of text, but I haven't found a way to modify it to get outlines of Line
objects
ImportString[ExportString[Style["M8", FontFamily -> "Times", FontSize -> 72],"PDF"], "TextMode" -> "Outlines"]
I've also tried doing Rasterize
on the line object and subtracting a slightly smaller version from the alpha channel. That gives rasterization artifacts, and is too slow at 5 seconds per shape for ImageSize->500
also asked on mathgroup
Update
I've tried fitting spline through points you get from MorphologicalPerimeter
. ListCurvePathPlot
theoretically does it, but it breaks on pixel "staircase" pattern. To smooth the staircase one needs to find ordering of points around the curve. FindCurvePath
seemed promising, but returned list of broken curves. FindShortestTour
could also theoretically do this, but it took over a second on outline in a 20x20 pixel image. ConvexHull
does perfect job on round parts, but cuts off the non-convex part.
Solution I finally ended up with was constructing nearest neighbor graph over perimeter points and using version 8 function FindEulerianCycle
to find the ordering of pixels around the shape, then using MovingAverage
to smooth out the staircase, followed by ListCurvePathPlot
to create the spline object. It's not perfect, as there's still a remnant of "staircase" pattern whereas averaging too much will smooth out important corners. A better approach might break the shape into multiple convex shapes, use ConvexHull
, then recombine. Meanwhile, here's what I'm using
getSplineOutline[pp_, smoothLen_: 2, interOrder_: 3] := (
(* need to negate before finding perimeter to avoid border *)
perim = MorphologicalPerimeter@ColorNegate@pp;
points =
Cases[ArrayRules@SparseArray@ImageData[perim],
HoldPattern[{a_Integer, b_Integer} -> _] :> {a, b}];
(* raster coordinate system is upside down, flip the points *)
points = {1, -1} (# - {0, m}) & /@ points;
(* make nearest neighbor graph *)
makeEdges[point_] := {Sort[{point, #}]} & /@
Nearest[DeleteCases[points, point], point];
edges = Union[Flatten[makeEdges /@ points, 2]];
graph = Graph[UndirectedEdge @@@ edges];
tour = FindEulerianCycle[graph] // First;
smoothed = MovingAverage[tour[[All, 1]], smoothLen];
g = ListCurvePathPlot[smoothed, InterpolationOrder -> interOrder];
Cases[g, BSplineCurve[___], Infinity] // First
);
scale = 200;
pp = Graphics[{AbsoluteThickness[scale/2], JoinForm["Round"],
CapForm["Round"], Line[{{0, 0}, {0, 1}, {1, 1}}]},
ImageSize -> scale];
Graphics[getSplineOutline[pp, 3, 3]]
It's a shame that EdgeForm[]
(as stated in the docs) does not apply to Line
objects. So the best we can do is either not use Line[]
or to use a hack of some sort. The simplest I could think of is
Graphics[{AbsoluteThickness[100], JoinForm["Round"], CapForm["Round"],
Line[{{0, 0}, {0, 1}, {1, 1}}], AbsoluteThickness[99], White,
Line[{{0, 0}, {0, 1}, {1, 1}}]}, ImageSize -> 200]
Ok, I am not sure if this is worth, but here we go: a method using image transformation, least squares and data clustering.
Clear["Global`*"];
(*Functions for Least Square Circle \
from http://www.dtcenter.org/met/users/docs/write_ups/circle_fit.pdf*)
t[x_] := Plus[#, -Mean[x]] & /@ x;
Suu[x_] := Sum[i[[1]]^2, {i, t[x]}];
Svv[x_] := Sum[i[[2]]^2, {i, t[x]}];
Suv[x_] := Sum[i[[1]] i[[2]], {i, t[x]}];
Suvv[x_] := Sum[i[[1]] i[[2]]^2, {i, t[x]}];
Svuu[x_] := Sum[i[[2]] i[[1]]^2, {i, t[x]}];
Suuu[x_] := Sum[i[[1]]^3, {i, t[x]}];
Svvv[x_] := Sum[i[[2]]^3, {i, t[x]}];
s[x_] := Solve[{uc Suu[x] + vc Suv[x] == 1/2 (Suuu[x] + Suvv[x]),
uc Suv[x] + vc Svv[x] == 1/2 (Svvv[x] + Svuu[x])}, {uc, vc}];
(*Utility fun*)
ppfilterCoords[x_, k_] := Module[{ppflat},
ppflat =
Flatten[Table[{i, j, ImageData[x][[i, j]]}, {i, k[[1]]}, {j,
k[[2]]}], 1];
Take[#, 2] & /@ Select[ppflat, #[[3]] == 0 &]
];
(*Start*)
thk = 100;
pp = Graphics[{AbsoluteThickness[100], JoinForm["Round"],
CapForm["Round"], Line[{{0, 0}, {0, 1}, {2, 1}, {2, 2}}]},
ImageSize -> 300]
(*
pp=Graphics[{AbsoluteThickness[thk],JoinForm["Round"],CapForm["Round"]\
,Line[{{0,0},{0,3},{1,3},{1,0}}]},ImageSize->300];
*)
pp1 = ColorNegate@MorphologicalPerimeter@pp;
(* Get vertex in pp3*)
pp3 = Binarize[ColorNegate@HitMissTransform[pp1,
{ {{1, -1}, {-1, -1}}, {{-1, 1}, {-1, -1}},
{{-1, -1}, {1, -1}}, {{-1, -1}, {-1, 1}}}], 0];
k = Dimensions@ImageData@pp3;
clus = FindClusters[ppfilterCoords[pp3, k],(*get circles appart*)
Method -> {"Agglomerate", "Linkage" -> "Complete"},
DistanceFunction -> (If [EuclideanDistance[#1, #2] <= thk/2, 0,
EuclideanDistance[#1, #2]] &)];
(*Drop Spurious clusters*)
clus = Select[clus, Dimensions[#][[1]] > 10 &];
(*Calculate centers*)
centerOffset = Flatten[{uc, vc} /. s[#] & /@ clus, 1];
(*coordinates correction*)
center = {-1, 1} Plus[#, {0, k[[2]]}] & /@ -N[
centerOffset + Mean /@ clus, 2];
Print["Circles Centers ", center];
(*get radius from coordinates. All radius are equal*)
radius = Max[Table[
{Max[First /@ clus[[i]]] - Min[First /@ clus[[i]]],
Max[Last /@ clus[[i]] - Min[Last /@ clus[[i]]]]}
, {i, Length[clus]}]]/2;
Print["Circles Radius ", radius];
(*Now get the straight lines*)
(*horizontal lines*)
const = 30;(*a number of aligned pixels for line detection*)
ph = ColorNegate@
HitMissTransform[ColorNegate@pp1, {Table[1, {const}]}];
(*vertical lines *)
pv = ColorNegate@
HitMissTransform[ColorNegate@pp1, {Table[{1}, {const}]}];
(*if there are diagonal lines add patterns accordingy*)
(*coordinates correction function*)
corr[x_, k_] := {-1, 1} Plus[-x, {0, k[[2]]}];
dfunH[x_, y_] := Abs[x[[1]] - y[[1]]];
dfunV[x_, y_] := Abs[x[[2]] - y[[2]]];
(*Get clusters for horiz*)
clusH = FindClusters[ppfilterCoords[ph, k],(*get lines appart*)
Method -> {"Agglomerate", "Linkage" -> "Complete"},
DistanceFunction -> dfunH];
hlines = Table[{Line[{corr[First[i], k] + {1, const/2 - 1},
corr[Last[i], k] + {1, -const/2 - 1}}]}, {i, clusH}];
clusV = FindClusters[ppfilterCoords[pv, k],(*get lines appart*)
Method -> {"Agglomerate", "Linkage" -> "Complete"},
DistanceFunction -> dfunV];
vlines = Table[{Line[{corr[First[i], k] - {const/2 - 1, 1},
corr[Last[i], k] + {const/2 - 1, -1}}]}, {i, clusV}];
Graphics[{vlines, hlines,
Table[Circle[center[[i]], radius], {i, Length@clus}]}]
Edit
Update:
Using only Geometry
Of course this one should be able to defeat using ol' Cartesian geometry. The only problem is that there are a lot of arcs and intersections to calculate.
I made an approach. The limitation is that it doesn't handle yet "branched" lines (trees, for example).
Some examples:
The calculation is instantaneous, but the code is a mess.
k[pp_] := Module[{ED(*TODO: make all symbols local*)}, (
(*follows some analytic geometry *)
(*Functions to calcu|late borderlines*)
linesIncrUpDown[{x0_, y0_}, {x1_, y1_}] :=
thk/2 {-(y1 - y0), (x1 - x0)}/ED[{x0, y0}, {x1, y1}];
lineUp[{{x0_, y0_}, {x1_, y1_}}] :=
Plus[linesIncrUpDown[{x0, y0}, {x1, y1}], #] & /@ {{x0, y0}, {x1,y1}};
lineDown[{{x0_, y0_}, {x1_, y1_}}] :=
Plus[-linesIncrUpDown[{x0, y0}, {x1, y1}], #] & /@ {{x0,y0}, {x1, y1}};
(*Distance from line to point*)
distanceLinePt[{{x1_, y1_}, {x2_, y2_}}, {x0_, y0_}] :=
Abs[(x2 - x1) (y1 - y0) - (x1 - x0) (y2 - y1)]/ED[{x1, y1}, {x2, y2}];
(*intersect between two lines without overflows for verticals*)
intersect[{{{x1_, y1_}, {x2_, y2_}}, {{x3_, y3_}, {x4_,
y4_}}}] := {((x3 - x4) (-x2 y1 + x1 y2) + (x1 - x2) (x4 y3 -
x3 y4))/(-(x3 - x4) (y1 - y2) + (x1 - x2) (y3 -
y4)), (-(x2 y1 - x1 y2) (y3 - y4) + (y1 - y2) (x4 y3 -
x3 y4))/(-(x3 - x4) (y1 - y2) + (x1 - x2) (y3 - y4))};
l2C := #[[1]] + I #[[2]] & ; (*list to complex for using Arg[]*);
ED = EuclideanDistance; (*shorthand*)
thk = Cases[pp, AbsoluteThickness[x_] -> x, Infinity][[1]];
lines = Cases[pp, Line[x_] -> x, Infinity][[1]];
isz = Cases[pp, Rule[ImageSize, x_] -> x, Infinity][[1]];
(*now get the scale *)
{minX, maxX} = {Min[#], Max[#]} &@Transpose[lines][[1]];
(*scale graphDiam +thk= isz *)
scale = (isz - thk)/(maxX - minX);
(*calculate absolute positions for lines*)
absL = (lines) scale + thk/2;
(*now we already got the centers for the circles*)
(*Calculate both lines Top Down*)
luT = Table[Line[lineUp[absL[[i ;; i + 1]]]], {i, Length[absL] - 1}];
luD = Table[Line[lineDown[absL[[i ;; i + 1]]]], {i, Length[absL] - 1}];
(*Calculate intersection points for Top and Down lines*)
iPuT =Table[intersect[{luT[[i, 1]], luT[[i + 1, 1]]}], {i,Length@luT - 1}];
iPuD =Table[intersect[{luD[[i, 1]], luD[[i + 1, 1]]}], {i,Length@luD - 1}];
(*beware drawArc has side effects as modifies luT and luD*)
drawArc[i_] := Module[{s},
Circle[absL[[i]], thk/2,
Switch[i,
1 , (*first point*)
If[ ED[absL[[i + 1]],absL[[i]] + {Cos[s = ((#[[2]] + #[[1]])/2)], Sin[s]}] <
ED[absL[[i + 1]],absL[[i]] + {Cos[s + Pi], Sin[s + Pi]}], # + Pi, #]
&@{Min@#, Max@#} &@
Mod[ {Arg[l2C @((luD[[i]])[[1, 1]] - absL[[i]])],
Arg[l2C @((luT[[i]])[[1, 1]] - absL[[i]])]}, 2 Pi],
Length@absL,(*last point*)
If[ED[absL[[i - 1]], absL[[i]] + {Cos[s = ((#[[2]] + #[[1]])/2)], Sin[s]}] <
ED[absL[[i - 1]], absL[[i]] + {Cos[s + Pi], Sin[s + Pi]}], # + Pi, #]
&@{Min@#, Max@#} &@
Mod[{Arg[l2C @((luD[[i - 1]])[[1, 2]] - absL[[i]])],
Arg[l2C@((luT[[i - 1]])[[1, 2]] - absL[[i]])]}, 2 Pi],
_,(*all middle points*)
(* here I must chose which lines to intersect luD or luT.
the correct answer is the line farthest to the previous point*)
If[
distanceLinePt[luD[[i, 1]], absL[[i - 1]]] >
distanceLinePt[luT[[i, 1]], absL[[i - 1]]],
(*shorten the other lines*)
luT[[i - 1, 1, 2]] = luT[[i, 1, 1]] = iPuT[[i - 1]]; lu = luD;
,
(*shorten the other lines*)
luD[[i - 1, 1, 2]] = luD[[i, 1, 1]] = iPuD[[i - 1]];
lu = luT;];
(If[ED[absL[[i - 1]], absL[[i]] + {Cos[s = ((#[[2]] + #[[1]])/2)], Sin[s]}] <
ED[absL[[i - 1]], absL[[i]] + {Cos[s + Pi], Sin[s + Pi]}], {#[[2]]-2 Pi, #[[1]]}, #])
&@{Min@#, Max@#} &@
{Arg[l2C @((lu[[i - 1]])[[1, 2]] - absL[[i]])],
Arg[l2C@((lu[[i]])[[1, 1]] - absL[[i]])]}
] ] ];
);
Graphics[{Black, Table[drawArc[i], {i, Length@absL}], Red, luT, Blue, luD},
ImageSize -> isz] ];
Test drive
isz = 250;
pp[1] = Graphics[{AbsoluteThickness[50], JoinForm["Round"],
CapForm["Round"], Line[{{0, 0}, {1, 0}, {0, 1}, {1, 1}}]},
ImageSize -> isz];
pp[2] = Graphics[{AbsoluteThickness[50], JoinForm["Round"],
CapForm["Round"],
Line[{{0, 0}, {1, 0}, {0, -1}, {0.7, -1}, {0, -4}, {2, -3}}]},
ImageSize -> isz];
pp[3] = Graphics[{AbsoluteThickness[50], JoinForm["Round"],
CapForm["Round"],
Line[{{0, 0}, {0, 1}, {1, 1}, {2, 0}, {2, 3}, {5, 5}, {5, 1}, {4,
1}}]}, ImageSize -> isz];
pp[4] = Graphics[{AbsoluteThickness[50], JoinForm["Round"],
CapForm["Round"],
Line[{{0, 0}, {0, 1}, {1, 1}, {1, 0}, {1/2, 0}}]},
ImageSize -> isz];
GraphicsGrid[Table[{pp[i], k@pp[i]}, {i, 4}]]
Not an answer, just addressing your rasterization comment.
I think this may be faster (0.1 secs for an imagesize of 500 in my machine)
pp = Graphics[{AbsoluteThickness[100], JoinForm["Round"],
CapForm["Round"], Line[{{0, 0}, {0, 1}}]}, ImageSize -> 200];
ColorNegate@MorphologicalPerimeter@pp
BTW I was trying "Export" with all vector image formats and surprisingly the rounded forms are lost in most of them, with the exception of the PDF format, which is useless because it recover the same line definition when importing.
精彩评论