Wolfram Data Repository

Immediate Computable Access to Curated Contributed Data

Wilberforce Pendulum Model

Model of a Wilberforce pendulum

Examples

Basic Examples (3) 

Retrieve the model:

In[1]:=
ResourceData[\!\(\* TagBox["\"\<Wilberforce Pendulum Model\>\"", #& , BoxID -> "ResourceTag-Wilberforce Pendulum Model-Input", AutoDelete->True]\)]
Out[1]=

The icon:

In[2]:=
ResourceData[\!\(\* TagBox["\"\<Wilberforce Pendulum Model\>\"", #& , BoxID -> "ResourceTag-Wilberforce Pendulum Model-Input", AutoDelete->True]\), "Icon"]
Out[2]=

The annotation:

In[3]:=
ResourceData[\!\(\* TagBox["\"\<Wilberforce Pendulum Model\>\"", #& , BoxID -> "ResourceTag-Wilberforce Pendulum Model-Input", AutoDelete->True]\), "Annotation"]
Out[3]=

Scope & Additional Elements (4) 

Available content elements:

In[4]:=
\!\(\* TagBox[ RowBox[{"ResourceObject", "[", "\"\<Wilberforce Pendulum Model\>\"", "]"}], #& , BoxID -> "ResourceTag-Wilberforce Pendulum Model-Input", AutoDelete->True]\)["ContentElements"]
Out[4]=

The available model types:

In[5]:=
ResourceData[\!\(\* TagBox["\"\<Wilberforce Pendulum Model\>\"", #& , BoxID -> "ResourceTag-Wilberforce Pendulum Model-Input", AutoDelete->True]\), "AvailableModelTypes"]
Out[5]=

The operating point:

In[6]:=
ResourceData[\!\(\* TagBox["\"\<Wilberforce Pendulum Model\>\"", #& , BoxID -> "ResourceTag-Wilberforce Pendulum Model-Input", AutoDelete->True]\), "OperatingPoint"]
Out[6]=

The parameters:

In[7]:=
ResourceData[\!\(\* TagBox["\"\<Wilberforce Pendulum Model\>\"", #& , BoxID -> "ResourceTag-Wilberforce Pendulum Model-Input", AutoDelete->True]\), "Parameters"]
Out[7]=

Visualizations (4) 

The numerical state space model:

In[8]:=
ssm = ResourceData[\!\(\* TagBox["\"\<Wilberforce Pendulum Model\>\"", #& , BoxID -> "ResourceTag-Wilberforce Pendulum Model-Input", AutoDelete->True]\)] /. ResourceData[\!\(\* TagBox["\"\<Wilberforce Pendulum Model\>\"", #& , BoxID -> "ResourceTag-Wilberforce Pendulum Model-Input", AutoDelete->True]\), "Parameters"]
Out[8]=

It's state response to an initial angular displacement:

In[9]:=
sr = StateResponse[{ssm, {0, 0, 10^°}}, {0, 0}, {t, 0, 60}]
Out[9]=

A parametric plot of the vertical position and its velocity:

In[10]:=
ParametricPlot[sr[[{1, 2}]], {t, 0, 30}, Sequence[ AspectRatio -> 1, PlotRange -> All, ColorFunction -> (ColorData["TemperatureMap"][#3]& ), PlotTheme -> "Web", GridLines -> Automatic, FrameLabel -> { Style["z", FontSize -> 14], Style["z'", FontSize -> 14]}, Epilog -> { PointSize[Large], RGBColor[0.178927, 0.305394, 0.933501], Point[{0., 0.}]}]]
Out[10]=

A parametric plot of the angular position and its velocity:

In[11]:=
ParametricPlot[sr[[{3, 4}]], {t, 0, 60}, Sequence[ AspectRatio -> 1, PlotRange -> All, ColorFunction -> (ColorData["TemperatureMap"][#3]& ), PlotTheme -> "Web", GridLines -> Automatic, FrameLabel -> { Style["\[Theta]", FontSize -> 14], Style["\[Theta]'", FontSize -> 14]}, Epilog -> { PointSize[Large], RGBColor[0.178927, 0.305394, 0.933501], Point[{1.0410061435288196`, 0.}]}]]
Out[11]=

Analysis (4) 

The numerical state space model:

In[12]:=
ssm = ResourceData[\!\(\* TagBox["\"\<Wilberforce Pendulum Model\>\"", #& , BoxID -> "ResourceTag-Wilberforce Pendulum Model-Input", AutoDelete->True]\)] /. ResourceData[\!\(\* TagBox["\"\<Wilberforce Pendulum Model\>\"", #& , BoxID -> "ResourceTag-Wilberforce Pendulum Model-Input", AutoDelete->True]\), "Parameters"]
Out[12]=

Compute the translational oscillation frequency:

In[13]:=
Sqrt[k/m] /. ResourceData[\!\(\* TagBox["\"\<Wilberforce Pendulum Model\>\"", #& , BoxID -> "ResourceTag-Wilberforce Pendulum Model-Input", AutoDelete->True]\), "Parameters"]
Out[13]=

It's the same as the rotational oscillation frequency:

In[14]:=
Sqrt[\[Delta]/\[ScriptCapitalI]] /. ResourceData[\!\(\* TagBox["\"\<Wilberforce Pendulum Model\>\"", #& , BoxID -> "ResourceTag-Wilberforce Pendulum Model-Input", AutoDelete->True]\), "Parameters"]
Out[14]=

This enables the beat phenomenon, transferring energy between translational and rotational motions:

In[15]:=
OutputResponse[{ssm, {0.01, 0, 0, 0}}, {0, 0}, {t, 0, 200}]; GraphicsRow[ Plot[%, {t, Splice[#]}, PlotRange -> All, ImageSize -> 300] & /@ {{0, 100}, {100, 200}}]
Out[16]=

Suba Thomas, "Wilberforce Pendulum Model" from the Wolfram Data Repository (2025)  

Data Resource History

  • Date Created:

Source Metadata

  • Citation:
    • E. Debowska, S. Jakubowicz, and Z. Mazur, "Computer visualization of the beating of a Wilberforce pendulum", European Journal of Physics, vol. 20, no. 2, pp. 89–95, 1999.

Publisher Information

  • Prepared for the Wolfram Data Repository By: Maher Kuzbari, Suba Thomas
  • Publisher of Record: Suba Thomas