József Attila egy matematikai kérdése

A kézirat letölthető innen: Ferenci Tamás: József Attila egy matematikai kérdése.

A megjelent publikáció: Ferenci Tamás: József Attila egy matematikai kérdése (Érintő : Elektronikus Matematikai Lapok. 2020, Paper: 1029).

Ez a weboldal a kéziratban hivatkozott szemléltető animációkat tartalmazza. Mindenhol megadom az R kódot is, mely az ábrák, animációk reprodukciójához szükséges, hogy akit érdekel, tudja ezeket is hasznosítani.

A ciklois szemléltetése

A következő kód lehetővé teszi mindenféle (tehát akár csúcsos vagy nyújtott) cikloisok ábrázolását:

plotcyclois <- function(tmax, a = 1, radius = TRUE, xl = c(-1, 21),
                        yl = c(0, 2), trace = TRUE, drawline = FALSE) {
  t <- seq(0, tmax, length.out = 200)
  tact <- tail(t, 1)
  plot(NA, NA, type = "l", asp = 1, xlim = xl,
       ylim = yl, xlab = "", ylab = "", yaxt = "n")
  if(drawline) lines(c(mean(xl), xl[2]), c(0, 3), col = scales::alpha("red", 0.2))
  if(trace) lines(t-a*sin(t), 1-a*cos(t))
  axis(2, at = 0:2)
  abline(h = 0)
  points(tact-a*sin(tact), 1-a*cos(tact), pch = 19, col = "red")
  if(radius) lines(c(tact, tact-a*sin(tact)), c(1, 1-a*cos(tact)))
  points(tact, 1, pch = 19, cex = 0.3)
  plotrix::draw.circle(tact, 1, 1)
}

A “szokásos” (csúcsos) ciklois kialakulásának szemléltetése:

for(t in seq(0, 20, 0.1)) plotcyclois(t, radius = FALSE)

A hurkolt ciklois kialakulásának szemléltetése:

for(t in seq(0, 20, 0.1)) plotcyclois(t, 1.5)

A nyújtott ciklois kialakulásának szemléltetése:

for(t in seq(0, 20, 0.1)) plotcyclois(t, 0.5)

A brachisztochron probléma szemléltetése

yline <- expression(x/(3/2*pi+1))
ysq1 <- expression(-((-14+15*pi)/(6*(-8-6*pi+9*pi^2)))*x^2 -
                     ((124-60*pi-45*pi^2)/(12*(-8-6*pi+9*pi^2)))*x)
ysq2 <- expression(-((-2+15*pi)/(3*(-8-6*pi+9*pi^2)))*x^2 -
                     ((52-60*pi-45*pi^2)/(6*(-8-6*pi+9*pi^2)))*x)
ysq3 <- expression(-((-14+3*pi)/(4*(-8-6*pi+9*pi^2)))*x^2 -
                     ((92-12*pi-9*pi^2)/(8*(-8-6*pi+9*pi^2)))*x)
yroot <- expression((x/(3/2*pi+1))^(1/2))
tcyclo <- Vectorize(function(x) uniroot(function(s) x-s+sin(s), c(0, 2*pi))$root)
ycyclo <- function(x) ifelse(is.na(x), NA, 1-cos(tcyclo(x)))
yderivcyclo <- function(x) sin(tcyclo(x))/(1-cos(tcyclo(x)))

ts <- seq(1e-10, integrate(function(b) sqrt((1+(yderivcyclo(b))^2)/(2*(ycyclo(b)-ycyclo(0)))), 0,
                           3/2*pi+1)$value,
          length.out = 200)
xs <- seq(0, 3/2*pi+1, length.out = 200)

traj <- function(yexpr, ts, yderiv = NULL, start = 0) {
  if(is.null(yderiv)) {
    y <- function(x) eval(yexpr)
    derivexpr <- caracas::as_expr(caracas::der(caracas::as_sym(as.character(yexpr)),
                                            caracas::as_sym("x")))
    yderiv <- function(x) eval(derivexpr)
  } else y <- yexpr
  maxx <- if(any(y(start)>y(seq(start, 3/2*pi+1, 0.01))))
    uniroot(function(b) y(b)-y(start), c(start+1e-10, 3/2*pi+1))$root else 3/2*pi+1
  maxt <- integrate(function(b) sqrt((1+(yderiv(b))^2)/(2*(y(b)-y(start)))), start, maxx)$value
  c(sapply(ts[ts<maxt], function(t) uniroot(function(u)
    integrate(function(b) sqrt((1+(yderiv(b))^2)/(2*(y(b)-y(start)))),
              start+2e-10, u, subdivisions = 200L)$value-t, c(start+1e-10, maxx))$root),
    rep(NA, sum(ts>=maxt)))
}

linetraj <- traj(yline, ts)
sq1traj <- traj(ysq1, ts)
sq2traj <- traj(ysq2, ts)
sq3traj <- traj(ysq3, ts)
roottraj <- traj(yroot, ts)
cyclotraj <- traj(ycyclo, ts, yderivcyclo)

for(i in 1:length(ts)) {
  plot(linetraj[i], -eval(yline, data.frame(x = linetraj[i])), xlim = c(0, 6), ylim = c(-2.5, 0),
       xaxt = "n", yaxt = "n", xlab = "", ylab = "")
  lines(xs, -sapply(xs,function(x) eval(yline)))
  points(sq1traj[i], -eval(ysq1, data.frame(x = sq1traj[i])))
  lines(xs, -sapply(xs,function(x) eval(ysq1)))
  points(sq2traj[i], -eval(ysq2, data.frame(x = sq2traj[i])))
  lines(xs, -sapply(xs,function(x) eval(ysq2)))
  points(sq3traj[i], -eval(ysq3, data.frame(x = sq3traj[i])))
  lines(xs, -sapply(xs,function(x) eval(ysq3)))
  points(roottraj[i], -eval(yroot, data.frame(x = roottraj[i])))
  lines(xs, -sapply(xs,function(x) eval(yroot)))
  points(cyclotraj[i], -ycyclo(cyclotraj[i]), col = "red")
  lines(xs, -ycyclo(xs), col = "red")
}

A tautochron probléma szemléltetése

ts <- seq(1e-10, integrate(function(b) sqrt((1+(yderivcyclo(b))^2)/(2*(ycyclo(b)-ycyclo(0)))),
                           0, pi)$value, length.out = 150)

cyclotraj <- traj(ycyclo, ts, yderivcyclo)
cyclotraj1 <- traj(ycyclo, ts, yderivcyclo, 1)
cyclotraj2 <- traj(ycyclo, ts, yderivcyclo, 2)
cyclotraj3 <- traj(ycyclo, ts, yderivcyclo, 3)

tautochronplot <- function(i) {
  plot(cyclotraj[i], -ycyclo(cyclotraj[i]), xlim = c(0, 6), ylim = c(-2.5, 0),
       xaxt = "n", yaxt = "n", xlab = "", ylab = "", cex = 1.5)
  lines(xs, -ycyclo(xs), col = "red")
  points(cyclotraj1[i], -ycyclo(cyclotraj1[i]), col = "green", cex = 1.5)
  points(cyclotraj2[i], -ycyclo(cyclotraj2[i]), col = "blue", cex = 1.5)
  points(cyclotraj3[i], -ycyclo(cyclotraj3[i]), col = "orange", cex = 1.5)
}

for(i in 1:length(ts)) tautochronplot(i)

József Attila és Pákozdy Ferenc kérdésére adható válasz szemléltetése

for(t in seq(0, 20, 0.1)) plotcyclois(t, radius = FALSE, trace = FALSE,
                                      xl = -(1-cos(t)+sin(t)-t)+c(-3, 3), drawline = TRUE)