提取粗线轮廓

Question

如何以矢量形式绘制如下粗线的轮廓？我所说的矢量形式是指一些图形基元的集合，它不是光栅或图像。

Graphics[{AbsoluteThickness[100], JoinForm["Round"], CapForm["Round"],
   Line[{{0, 0}, {0, 1}, {1, 1}}]}, ImageSize -> 200]

_{（来源：yaroslavvb.com）}

文档有以下示例用于提取文本轮廓，但我还没有找到一种方法来修改它以获取

ImportString[ExportString[Style["M8", FontFamily -> "Times", FontSize -> 72],"PDF"], "TextMode" -> "Outlines"]

我已经 还尝试对线条对象进行光栅化并从alpha中减去稍小的版本渠道。这会产生光栅化伪影，并且对于 ImageSize->500 来说，每个形状需要 5 秒，速度太慢，

也在 mathgroup

Update 上提出了要求 我尝试通过从 MorphologicalPerimeter 获得的点来拟合样条曲线。 ListCurvePathPlot 理论上可以做到这一点，但它会破坏像素“楼梯”模式。为了平滑楼梯，我们需要找到曲线周围点的排序。 FindCurvePath 看起来很有希望，但返回了损坏曲线的列表。 FindShortestTour 理论上也可以做到这一点，但在 20x20 像素图像中绘制轮廓需要花费一秒钟的时间。 ConvexHull 在圆形零件上表现出色，但会切除非凸形零件。

我最终得到的解决方案是在周界点上构建最近邻图，并使用版本 8 函数 FindEulerianCycle 来查找形状周围像素的顺序，然后使用 MoveAverage 进行平滑楼梯，然后用 ListCurvePathPlot 创建样条线对象。它并不完美，因为仍然存在“楼梯”图案的残余，而平均太多会平滑重要的角落。更好的方法可能会将形状分解为多个凸形状，使用 ConvexHull，然后重新组合。同时，这是我正在使用的

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]]

_{（来源：yaroslavvb.com）}

Answer 1

遗憾的是，EdgeForm[]（如文档中所述）不适用于Line对象。因此，我们能做的最好的事情就是要么不使用 Line[]，要么使用某种 hack。我能想到的最简单的是

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]

Answer 2

好吧，我不确定这是否值得，但我们开始：一种使用图像变换、最小二乘和数据聚类的方法。

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}]}]

编辑

更新：

Answer 3

仅使用几何

---

当然，使用笛卡尔几何应该能够击败这一点。唯一的问题是有很多弧线和交点需要计算。

我采取了一种方法。限制是它还不能处理“分支”线（例如树）。

一些例子：

计算是瞬时的，但代码很乱。

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] ];

试驾

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}]]

Answer 4

不是答案，只是解决您的光栅化评论。

我认为这可能会更快（在我的机器中图像大小为 500 需要 0.1 秒）

pp = Graphics[{AbsoluteThickness[100], JoinForm["Round"], 
    CapForm["Round"], Line[{{0, 0}, {0, 1}}]}, ImageSize -> 200];

ColorNegate@MorphologicalPerimeter@pp 

顺便说一句，我正在尝试“导出” " 对于所有矢量图像格式，令人惊讶的是，大多数矢量图像格式都丢失了圆角形式，但 PDF 格式除外，PDF 格式毫无用处，因为它在导入时恢复相同的线条定义。