Интерполяция / сглаживание в Mathematica с использованием графики - PullRequest
3 голосов
/ 16 июля 2011

Я пытаюсь сгладить траекторию, которую я рисую между точками.

Пожалуйста, примите во внимание:

 lesPoints = {{41, 26}, {42, 29}, {41, 31}, {46, 30}, {48, 30}, 
              {40, 30}, {43, 30}, {47, 30}, {48, 26}, {47, 20}}

Это настоящие координаты фиксации глаза, которые я использую для отслеживания временного пути.

Вот как я сейчас их рисую:

Graphics[{
         Table[Arrow[{lesPoints[[i]], lesPoints[[i + 1]]}], 
              {i,Length[lesPoints] - 1}], 
         MapThread[Text[Style[#1, Large, FontFamily -> "Impact"], {#2, #3}] &, 
         PrependTo[Transpose[lesPoints], Range[1, Length@lesPoints]]]}]

enter image description here

Я не мог ничего сделать правильно, пытаясь использовать интерполяцию.

Это был бы хороший способ сгладить путь, что было бы альтернативой?

Ответы [ 2 ]

6 голосов
/ 16 июля 2011

Как насчет этого

lesPoints = {{41, 26}, {42, 29}, {41, 31}, {46, 30}, {48, 30}, 
          {40, 30}, {43, 30}, {47, 30}, {48, 26}, {47, 20}}

interpolation = Interpolation[Table[{i, lesPoints[[i]]}, {i, Length[lesPoints]}]]

Путь становится чем-то вроде

plot = ParametricPlot[interpolation[t], {t, 1, Length[lesPoints]}];
Show[plot, Graphics[{Red, PointSize[0.02], Point /@ lesPoints}], Axes -> False]

Результат:

smooth curve

5 голосов
/ 17 июля 2011

Вот еще один способ:

Show[Graphics[{Red, PointSize[0.02], Point /@ lesPoints}], 
     ListLinePlot[lesPoints, InterpolationOrder -> 4]]

enter image description here

Редактировать

Также (проще)

ListLinePlot[lesPoints, InterpolationOrder -> 4, Mesh -> Full,  Axes -> None]

Редактировать

Используя этот прекрасный пакет , вы можете получить:

Show[Graphics[{Red, PointSize[0.015], Point /@ lesPoints}], 
 ListLinePlot[lesPoints, InterpolationOrder -> 4, Oriented     -> True, 
                                                  HowManyArrows -> 5]]

enter image description here

Редактировать

последний:)

Show[
  ListLinePlot[
     lesPoints, InterpolationOrder -> 4, 
     Epilog -> (MapIndexed[Inset[Style[Text@First@#2, Medium], #1 + {-.2, .4}] &, 
               lesPoints]), 
     PlotRangePadding -> 1, Oriented -> True, Axes -> False, 
     PlotStyle -> Directive[Arrowheads[.015]]], 
 Graphics[{Red, PointSize[0.008], Point /@ lesPoints}]]

enter image description here

...