MathGroup Archive 2000

[Date Index] [Thread Index] [Author Index]

Search the Archive

Bezier curves; FindMinimum

  • To: mathgroup at smc.vnet.net
  • Subject: [mg22783] Bezier curves; FindMinimum
  • From: dgolber at aol.com (DGolber)
  • Date: Sat, 25 Mar 2000 03:58:20 -0500 (EST)
  • Organization: AOL http://www.aol.com
  • Sender: owner-wri-mathgroup at wolfram.com

The file below the  "=====" line is a Notebook File.

What I'm doing is finding the Bezier curve that best fits a bunch of points.
(Begins and ends at the first and last points, and is horizontal there.)

Questions:

(1) Is there a package of good stuff for Bezier curves around somewhere?

(2) The thing runs very slowly.  Is there a way to modify what I'm doing to run
faster?
(I could modify the "find distance from a point to the curve" to remember the
value it found the last time, since the point is the same, and the curve has
changed very little.  This would speed some part of it up.)

(3) The "FindMinimum[bez7TargetFunc ...." converges very slowly indeed.
(Thousands of evaluations of the target function!)  And the parameters seem to
be moving a lot, with the curve moving only a little.  Seems to be some kind of
bad behavior of the functions going on.  Any comments?  Are there any more
parameters I can give it?
Things to make it wiser about what's going on?

Thanks

Dave Golber

==================

(***********************************************************************

                    Mathematica-Compatible Notebook

This notebook can be used on any computer system with Mathematica 4.0,
MathReader 4.0, or any compatible application. The data for the notebook 
starts with the line containing stars above.

To get the notebook into a Mathematica-compatible application, do one of 
the following:

* Save the data starting with the line of stars above into a file
  with a name ending in .nb, then open the file inside the application;

* Copy the data starting with the line of stars above to the
  clipboard, then use the Paste menu command inside the application.

Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode.  Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).

NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing the 
word CacheID, otherwise Mathematica-compatible applications may try to 
use invalid cache data.

For more information on notebooks and Mathematica-compatible 
applications, contact Wolfram Research:
  web: http://www.wolfram.com
  email: info at wolfram.com
  phone: +1-217-398-0700 (U.S.)

Notebook reader applications are available free of charge from 
Wolfram Research.
***********************************************************************)

(*CacheID: 232*)


(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[      7250,        166]*)
(*NotebookOutlinePosition[      7924,        190]*)
(*  CellTagsIndexPosition[      7880,        186]*)
(*WindowFrame->Normal*)



Notebook[{
Cell[BoxData[
    \(\(\(edgedefpts\  = {{0, 5.4`}, {9.9480439`, 
            5.54248327`}, {19.88410958`, 6.04387166`}, {29.7827598`, 
            7.03453726`}, {39.59462195`, 8.66975694`}, {49.23291011`, 
            11.12350173`}, {58.56009935`, 14.57081366`}, {67.37999284`, 
            19.15811361`}, {75.45165162`, 24.95900645`}, {82.52512523`, 
            31.94126306`}, {88.39785909`, 39.96269368`}, {92.94202527`, 
            48.80016403`}, {96.1192025`, 58.21958287`}, {97.93646567`, 
            67.99360384`}, {98.42285575`, 77.9238168`}, {97.59998779`, 
            87.83212547`}, {95.49371832`, 97.54891289`}, {92.25476356`, 
            106.9519202`}, {88.47627937`, 116.1558295`}, {63.88103746`, 
            150.6650253`}, {58.18321955`, 157.9593264`}, {54.26254516`, 
            166.3593006`}, {51.7089787`, 175.277851`}, {50.1625087`, 
            184.4283674`}, {49.3690132`, 193.6760397`}, {49.22616918`, 
            202.9566534`}, {49.8734703`, 212.2133016`}, {51.91982826`, 
            221.2508838`}, {56.48472277`, 229.2674844`}, {75.71937801`, 
            269.6054168`}, {77.43072613`, 278.7797642`}, {78.16370608`, 
            288.0810706`}, {77.6803686`, 297.3964801`}, {75.84065874`, 
            306.5397911`}, {72.60073605`, 315.2848174`}, {68.00229656`, 
            323.3975739`}, {62.15589737`, 330.6627379`}, {55.2124192`, 
            336.8877347`}, {47.34722856`, 341.8975199`}, {38.77375423`, 
            345.5669841`}, {29.75035074`, 347.9340238`}, {20.51301702`, 
            349.2618733`}, {11.20010479`, 349.8933437`}, {1.86712191`, 
            350.0951868`}};\)\(\[IndentingNewLine]\)\)\)], "Input"],

Cell[BoxData[""], "Input"],

Cell[BoxData[
    \(ptDistSq[p_, 
        q_]\  := \ \ \[Sum]\+\(i = 1\)\%\(Min[Length[p], Length[q]]\)\((\((p[\
\([i]\)] - q[\([i]\)])\)^2)\)\)], "Input"],

Cell[BoxData[
    \(ptCurveDistSq[p_, f_, 
        lims_]\  := \ \(FindMinimum[
          ptDistSq[p, f], {t, lims}]\)[\([1]\)]\)], "Input"],

Cell[BoxData[
    \(devSqPtSetFromCurve[ptset_, curve_, 
        lims_] := \[IndentingNewLine]\ \[Sum]\+\(i = \
1\)\%\(Length[ptset]\)ptCurveDistSq[ptset[\([i]\)], curve, lims]\)], "Input"],

Cell[BoxData[
    \(combs[n_, i_] := \(n!\)/\((\(\((n - i)\)!\)\ \(i!\))\)\)], "Input"],

Cell[BoxData[
    \(bez[t_, \ n_, i_]\  := \ 
      combs[n, i]\ t\^i\ \((1 - t)\)\^\((n - i)\)\)], "Input"],

Cell[BoxData[
    \(bezcurve[t_, n_, ptvec_, 
        wtvec_]\  := \[IndentingNewLine]\[IndentingNewLine]\((\[Sum]\+\(i = 0\
\)\%n bez[t, n, i]\[Times]wtvec[\([i + 1]\)]\[Times]
              ptvec[\([i + 
                    1]\)])\)\ \
/\[IndentingNewLine]\[IndentingNewLine]\((\[Sum]\+\(i = 0\)\%n bez[t, n, 
                i]\[Times]wtvec[\([i + 1]\)])\)\)], "Input"],

Cell[BoxData[
    \(bezedge7[t_, p1x_, p2x_, p2y_, p3x_, p3y_, p4x_, p4y_, p5x_, 
        p5y_, \[IndentingNewLine]p6x_, w1_, w2_, w3_, w4_, w5_, 
        w6_]\  := \[IndentingNewLine]\ 
      bezcurve[t, 
        7, \[IndentingNewLine]{\ 
          edgedefpts[\([1]\)], \[IndentingNewLine]{p1x, \(edgedefpts[\([1]\)]\
\)[\([2]\)]}, \[IndentingNewLine]{p2x, p2y}, {p3x, p3y}, {p4x, p4y}, {p5x, 
            p5y}, \[IndentingNewLine]{p6x, \(edgedefpts[\([\(-1\)]\)]\)[\([2]\
\)]}, \[IndentingNewLine]\ edgedefpts[\([\(-1\)]\)]}, \[IndentingNewLine]{1, 
          w1, w2, w3, w4, w5, w6, 1}\ ]\)], "Input"],

Cell[BoxData[
    \(bez7TargetFunc[{p1x_, \[IndentingNewLine]p2x_, p2y_, p3x_, p3y_, p4x_, 
          p4y_, p5x_, p5y_, \[IndentingNewLine]p6x_, \[IndentingNewLine]w1_, 
          w2_, w3_, w4_, w5_, w6_}]\  := \ 
      Module\[IndentingNewLine][{val}, \[IndentingNewLine]\((\(count++\); \
\[IndentingNewLine]val\  = \ 
            devSqPtSetFromCurve[
              edgedefpts, \[IndentingNewLine]bezedge7[t, 
                p1x, \[IndentingNewLine]p2x, p2y, p3x, p3y, p4x, p4y, p5x, 
                p5y, \[IndentingNewLine]p6x, w1, w2, w3, w4, w5, w6], {0, 
                1}]; \[IndentingNewLine]If[\ \((Mod[count\ , 
                  100]\  \[Equal] \ 0)\), \[IndentingNewLine]\(Print[
                count, "\<:  bez7TargetFunc called with args\>", \ \
\[IndentingNewLine]{p1x, p2x, p2y, p3x, p3y, p4x, p4y, p5x, 
                  p5y, \[IndentingNewLine]p6x, w1, w2, w3, w4, w5, 
                  w6}, \ "\<    Value is \>", 
                val];\)\[IndentingNewLine]]; \[IndentingNewLine]Return[
            val]\[IndentingNewLine])\)]\)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(count\  = \ \(\(-1\)\(\[IndentingNewLine]\)\)\)], "Input"],

Cell[BoxData[
    \(\(-1\)\)], "Output"]
}, Open  ]],

Cell[BoxData[
    \(\(\(\ \)\(FindMinimum[
      bez7TargetFunc[{p1x, p2x, p2y, p3x, p3y, p4x, p4y, p5x, 
          p5y, \[IndentingNewLine]p6x, w1, w2, w3, w4, w5, 
          w6}], \[IndentingNewLine]{p1x, {150. , 
          151. }}, \[IndentingNewLine]{p2x, {154. , 155. }}, {p2y, {156. , 
          157. }}, \[IndentingNewLine]{p3x, {\(-16. \), \(-15. \)}}, {p3y, \
{200, 201}}, \[IndentingNewLine]{p4x, {\(-34. \), \(-33. \)}}, {p4y, {174. , 
          175}}, \[IndentingNewLine]{p5x, {129. , 130. }}, {p5y, {208. , 
          209. }}, \[IndentingNewLine]{p6x, {125. , 
          126. }}, \[IndentingNewLine]{w1, {1.0, 
          1.1}}, \[IndentingNewLine]{w2, {1.0, 
          1.1}}, \[IndentingNewLine]{w3, {1.0, 
          1.1}}, \[IndentingNewLine]{w4, {1.0, 
          1.1}}, \[IndentingNewLine]{w5, {1.0, 
          1.1}}, \[IndentingNewLine]{w6, {1.0, 
          1.1}}\[IndentingNewLine]]\)\(\ \)\(\[IndentingNewLine]\)\)\)], \
"Input"]
},
FrontEndVersion->"4.0 for Microsoft Windows",
ScreenRectangle->{{0, 1280}, {0, 924}},
WindowSize->{1272, 888},
WindowMargins->{{0, Automatic}, {Automatic, 0}},
Magnification->1.5
]


(***********************************************************************
Cached data follows.  If you edit this Notebook file directly, not using
Mathematica, you must remove the line containing CacheID at the top of 
the file.  The cache data will then be recreated when you save this file 
from within Mathematica.
***********************************************************************)

(*CellTagsOutline
CellTagsIndex->{}
*)

(*CellTagsIndex
CellTagsIndex->{}
*)

(*NotebookFileOutline
Notebook[{
Cell[1717, 49, 1650, 23, 432, "Input"],
Cell[3370, 74, 26, 0, 42, "Input"],
Cell[3399, 76, 155, 3, 78, "Input"],
Cell[3557, 81, 140, 3, 42, "Input"],
Cell[3700, 86, 189, 3, 109, "Input"],
Cell[3892, 91, 87, 1, 42, "Input"],
Cell[3982, 94, 108, 2, 43, "Input"],
Cell[4093, 98, 372, 7, 224, "Input"],
Cell[4468, 107, 604, 10, 250, "Input"],
Cell[5075, 119, 1063, 17, 458, "Input"],

Cell[CellGroupData[{
Cell[6163, 140, 78, 1, 68, "Input"],
Cell[6244, 143, 40, 1, 41, "Output"]
}, Open  ]],
Cell[6299, 147, 947, 17, 432, "Input"]
}
]
*)




(***********************************************************************
End of Mathematica Notebook file.
***********************************************************************)



-----------------------------------
David Golber  dgolber at aol.com
1 Fayette Park, Cambridge MA USA
(617) 661-3670


  • Prev by Date: Re: Re: 3D graphics
  • Next by Date: Re: how to find roots of Bessel zero's
  • Previous by thread: Re: Problems with UnitStep and DiracDelta
  • Next by thread: Trying to define: Fractional Derivatives & Leibniz' display form for output and templates