Skip to content

Instantly share code, notes, and snippets.

View BrianWeinstein's full-sized avatar

Brian Weinstein BrianWeinstein

View GitHub Profile
View Sonic Booms and the Doppler Effect
vs = 1; \[Lambda] = 25;
dots[t_, vx_] := Flatten[Table[{vx*tt + (vs*(t - tt))*Cos[arg],
(vs*(t - tt))*Sin[arg]}, {tt, 0, t, vs*\[Lambda]},
{arg, 0, 2*Pi, 0.1}], 1]
(* To scale the SmoothDensityHistogram colors, use arg step
size .5/(t -tt/1.1) instead of 0.1 *)
wavefront[t_, vx_] := Graphics[{{Purple, Thick,
Table[Circle[{vx*tt, 0}, vs*(t - tt)],
View Rotational_Stability
m = 1; xd = 1; yd = 2; zd = 3; Ix = (1/12)*m*(yd^2 + zd^2);
Iy = (1/12)*m*(zd^2 + xd^2); Iz = (1/12)*m*(xd^2 + yd^2);
soln =
NDSolve[
{Ix*Derivative[2][\[Theta]x][t] == (Iy - Iz)*Derivative[1][\[Theta]y][t]*Derivative[1][\[Theta]z][t],
Iy*Derivative[2][\[Theta]y][t] == (Iz - Ix)*Derivative[1][\[Theta]z][t]*Derivative[1][\[Theta]x][t],
Iz*Derivative[2][\[Theta]z][t] == (Ix - Iy)*Derivative[1][\[Theta]x][t]*Derivative[1][\[Theta]y][t],
\[Theta]x[0] == 0, \[Theta]y[0] == 0, \[Theta]z[0] == 3*(Pi/2), Derivative[1][\[Theta]x][0] == 0,
Derivative[1][\[Theta]y][0] == 1, Derivative[1][\[Theta]z][0] == 0.0005},
View Signal Collection and Parabolic Reflectors
xmin = -3.6; xmax = 3.6;
p[x_] := 6 - Sqrt[6^2 - x^2] (* circle *)
p[x_] := x^2/7.5 (* parabola *)
img[t_, rays_] :=
Show[
Graphics[
{Thick, RGBColor[0.243, 0.62, 0.612],
Table[Line[{{xi, -t}, {xi, 20}}], {xi, xmin + 0.25, xmax - 0.25, (xmax - xmin - 0.5)/rays}],
View Curves of Constant Width and Odd-Sided Reuleaux Polygons
x[n_, \[Theta]_] := 2*Cos[Pi/(2*n)]*Cos[(1/2)*(\[Theta] + (Pi/n)*(2*Floor[(n*\[Theta])/(2*Pi)] + 1))] - Cos[(Pi/n)*(2*Floor[(n*\[Theta])/(2*Pi)] + 1)]
y[n_, \[Theta]_] := 2*Cos[Pi/(2*n)]*Sin[(1/2)*(\[Theta] + (Pi/n)*(2*Floor[(n*\[Theta])/(2*Pi)] + 1))] - Sin[(Pi/n)*(2*Floor[(n*\[Theta])/(2*Pi)] + 1)]
reuRotate[n_, \[Phi]_] :=
{pts[n, \[Phi]] = Table[RotationMatrix[\[Phi]] . {x[n, \[Theta]], y[n, \[Theta]]}, {\[Theta], 0, 2*Pi, (2*Pi)/100}];
xmin = Min[pts[n, \[Phi]][[All,1]]];
ymin = Min[pts[n, \[Phi]][[All,2]]];
xmax = Max[pts[n, \[Phi]][[All,1]]];
ymax = Max[pts[n, \[Phi]][[All,2]]];
View Lonely Runner Conjecture
circ = 1; rad = circ/(2 \[Pi]); nRunners = 5;
rList[t_] := {1 t, 2 t, 4 t, 8 t, 9.6 t, 21 t, 31 t, 33 t}[[1 ;; nRunners]]
dist[d\[Theta]_, circ_] :=
N[circ/2 (TriangleWave[(d\[Theta] - \[Pi]/2)/(2 \[Pi])] + 1)/2]
minDist[runnerList_, circ_] :=
Table[
runner = runnerList[[i]];
other = DeleteCases[runnerList, runner];
Min[dist[Abs[runner - other], circ]],
View Double Pendulum
x1[t_] := R1*Sin[\[Theta]1[t]]
y1[t_] := (-R1)*Cos[\[Theta]1[t]]
x2[t_] := R1*Sin[\[Theta]1[t]] + R2*Sin[\[Theta]2[t]]
y2[t_] := (-R1)*Cos[\[Theta]1[t]] - R2*Cos[\[Theta]2[t]]
v1[t_] := Sqrt[D[x1[t], t]^2 + D[y1[t], t]^2]
v2[t_] := Sqrt[D[x2[t], t]^2 + D[y2[t], t]^2]
T1[t_] := (1/2)*m1*v1[t]^2
T2[t_] := (1/2)*m2*v2[t]^2
U[t_] := m1*g*y1[t] + m2*g*y2[t]
@BrianWeinstein
BrianWeinstein / RemoveSparseTermsLarge.R
Last active October 19, 2016 16:43
remove sparse terms on a large document term matrix
View RemoveSparseTermsLarge.R
# tm::removeSparseTerms attempts to remove sparse terms via slicing a sparse matrix.
# The slicing operation tries to convert the sparse matrix to a dense matrix, but this
# fails if the dense matrix has more than ((2^31) - 1) entries [i.e., if (nrow * ncol) > ((2^31) - 1)]
#
# The error message is
# In nr * nc : NAs produced by integer overflow
#
# Instead of using tm::removeSparseTerms, the following function subsets the sparse matrix directly
# and avoids converting the sparse matrix to a dense one.
View Three-Body Problem in 3D
G = 1;
time = 20;
spScale = 8;
mA = 1.3;
xA0 = 0;
yA0 = 0;
zA0 = 0;
vxA0 = 0;
vyA0 = 0;
View bootstrap_confidence_interval.R
bootstrap_ci <- function(data, sample_size_pct = 0.50, samples = 100, conf_level = 0.95){
# Computes a bootstrapped confidence interval
# INPUT:
# data: a numeric vector
# sample_size_pct: the percentage of the input data to be used in each bootsrapped sample
# samples: the number of samples
# conf_level: the desired confidence level
# OUTPUT:
# a bootstrapped conf_level confidence interval
View Atomic Models
(* Rutherford model *)
es[t_] := {{Cos[t + Pi], 2.5*Sin[t + Pi], 2*Sin[t + Pi]},
{Cos[t + (4*Pi)/5], 2*Sin[t + (4*Pi)/5], -1.5*Sin[t + (4*Pi)/5]},
{2*Sin[t + (3*Pi)/5], Cos[t + (3*Pi)/5], 2*Sin[t + (3*Pi)/5]},
{2.5*Sin[t + (2*Pi)/5], Cos[t + (2*Pi)/5], -1.5*Sin[t + (2*Pi)/5]}}
Manipulate[Show[
ParametricPlot3D[Evaluate[es[2*u]], {u, 0, 2*Pi}, PlotStyle -> Directive[Thick, Dotted]],
Graphics3D[
{Specularity[White, 200],