バドミントンのショートサーブ、どこをめがけて打つか

[https://journals.sagepub.com/doi/pdf/10.1177/1747954118812662:title=journals.sagepub.com
ro.ecu.edu.au

  • シャトルコックは打ち出しの初期に速さの2乗に応じた減速加速度を受けて減速し、放物軌道に収束していくことが知られている
  • ショートサーブでは
    • ネットを越えること
    • ネットを越えるが高すぎないこと
    • サービスラインより奥に落ちること
    • サービスラインに近い方が「よいサービス」とみなされることが多いが、実際には、サービスラインを越えさえすれば、レシーバは着地より相当前のタイミングでシャトルに触るので、「打ちにくさ」の方が、着地点自体より重要
    • 「打ちにくさ」は、シャトルが上向きのときにレシーバが打てるかどうかと
    • レシーバが触るときに、シャトルがネットより高い位置で触れるかどうかとで決まってくる
    • レシーバがシャトルに触るのはネットを越えてからであるので、ネットを越えるタイミングで、それほど高い位置になく、かつ、すでに下向きの軌道に入っていると「打ちにくい」ことになる
    • ネットを越えるタイミングで下向きであるということは、「シャトルの回転が収束し、シャトルの軸と進行方向が一致している」とするならば、重心軌道が下向きであることと同一であり、それは、軌道の最高到達点がサーバー側コート内にあることである
  • このように「レシーバーが打ちにくい」=「良い」サービスの軌跡を、固定打ち出し点から描くために
    • 打ち出し角度
    • 打ち出し初速
  • の2要因のみでコントロールするとして、どのような軌跡が可能かを考えてみる
  • そして、「失敗の少ない、よいサービスの打ち方」とは、
    • 打ち出し角度と打ち出し初速とに、ある程度の乱雑項が入ってしまっても、
    • ネットにかかりにくく、
    • ネット越えのときの高さが高くなりすぎず、
    • サービスラインの手前に落ちにくく、
    • 最高到達点がサーバー側にとどまりやすい
  • ようなサービスを目標として打つ、ということと言える
  • サービスを打つ時の「気持ちとしての目標」は
    • 「ネットを越えるときの下向きベクトル」と「ネットを越えるときの高さ」にするのは難しいだろう(ネットの白帯の上、ぎりぎりを狙って打つ、というのは、白帯上に上向きベクトルを作ることを狙いがちになるので、うまくいかない)
    • それよりは、ネットよりも自陣側のある地点のある高さを目標に、そこを通過するときに軌道が水平になるように狙うことの方が簡単そうだ
  • Rでシミュレーションしてみる

f:id:ryamada:20220107152409p:plain

m <- 5 * 10^(-3)
g <- c(0,-9.8)

st <- c(-200,115) * 10^(-2)
net <- c(0,155) * 10^(-2)
end <- c(198,0) * 10^(-2)

rho <- 10^(-3.5)
# best service
#theta.init <- pi/5.5
#speed.init <- 6

dt <- 0.01

t <- seq(from=0,to=2,by=dt)

my.short.service.sim <- function(theta.init,speed.init,m=5 * 10^(-3),g=c(0,-9.8),st=c(-200,115) * 10^(-2),net=c(0,155) * 10^(-2),end=c(198,0) * 10^(-2),rho=10^(-3.5),dt=0.01){
	t <- seq(from=0,to=2,by=dt)

	cond <- expand.grid(theta.init,speed.init)
	n <- length(cond[,1])
	ret <- list()
	for(i in 1:n){
		#ret[[i]] <- 1:i
		this.theta <- cond[i,1]
		this.speed <- cond[i,2]
		vs <- matrix(0,length(t)+1,2)
		v.init <- this.speed * c(cos(this.theta),sin(this.theta))

		vs[1,] <- v.init
		for(ii in 1:length(t)){
			new.v <- vs[ii,]  + dt * (g + rho * sqrt(sum(vs[ii,]^2)) * (-vs[ii,]) / m)
			vs[ii+1,] <- new.v
		}

		xs <- apply(vs*dt,2,cumsum)
		xs <- t(t(xs)+st)
		#print(xs)
		ret[[i]] <- matrix(0,length(t)+1,2)
		#print(ret[[i]])
		ret[[i]] <- xs
	}
	#return(ret)
	

	return(list(ret=ret,cond=cond,t=t))
}

theta.init <- seq(from=pi/7,to=pi/5,length=30)
speed.init <- seq(from=5,to=8,length=30)

out <- my.short.service.sim(theta.init,speed.init)

plot(out$ret[[1]],type="l",ylim=c(0,2),asp=TRUE)
abline(h=0)
segments(0,0,net[1],net[2])
points(end[1],end[2],pch=20,col=2)
for(i in 2:length(out$ret)){
	points(out$ret[[i]],type="l",col=i)
}

too.high <- too.short <- peak.loc <- peak.hight <- rep(0,length(out$ret))


for(i in 1:length(too.high)){
	this.xs <- out$ret[[i]]
	too.high[i] <- this.xs[which.min(this.xs[,1]^2)[1],2]-net[2]
	too.short[i] <- this.xs[which.min(this.xs[,2]^2)[1],1]-end[1]
	peak.loc[i] <- this.xs[which(this.xs[,2]==max(this.xs[,2]))[1],1]
	peak.hight[i] <- max(this.xs[,2])-net[2]
}

oks <- which(too.high > 0 & too.short > 0 & too.high < 0.1 & peak.loc < 0)
oks.but.peakout <- which(too.high > 0 & too.short > 0 & too.high < 0.1 & peak.loc >= 0)
ok.but.high <- which(too.high >= 0.1 & too.short > 0)
ng.both <- which(too.high <= 0 & too.short <= 0)
ng.high <- which(too.high <= 0 & too.short > 0)
ng.short <- which(too.high > 0 & too.short <= 0)

cond <- cbind(out$cond[,1]/pi,out$cond[,2])
par(mfcol=c(1,1))
plot(cond[,1],cond[,2],xlab="angle, pi",ylab="speed, m/s")
points(cond[oks,],pch=20,col=2)
points(cond[oks.but.peakout,],pch=15,col=6)
points(cond[ng.both,],pch=20,col=1)
points(cond[ng.high,],pch=20,col=3)
points(cond[ng.short,],pch=20,col=4)
points(cond[ok.but.high,],pch=20,col=5)

# OKsの軌道だけを描く

plot(out$ret[[oks[1]]],type="l",ylim=c(0,2),asp=TRUE)
abline(h=0)
segments(0,0,net[1],net[2])
points(end[1],end[2],pch=20,col=2)
for(i in 2:length(oks)){
	points(out$ret[[oks[i]]],type="l",col=i)
}


hsp <- cbind(too.short,too.high,peak.loc,peak.hight)

pairs(hsp)
par(mfcol=c(2,2))
plot(too.short,too.high,xla="floor short",ylab="oevrnet")
abline(h=0,col=2)
abline(v=0,col=3)
plot(too.short,peak.loc,xla="floor short",ylab="peak.loc")
abline(h=0,col=2)
abline(v=0,col=3)
plot(too.high,peak.loc,xla="overnet",ylab="peak.loc")
abline(h=0,col=2)
abline(v=0,col=3)
plot(peak.loc,peak.hight,xla="peak.loc",ylab="peak.hight.overnet")
abline(h=0,col=2)
abline(v=0,col=3)


for(i in 1:length(overnet)){
	
	this.cond <- out$cond[i,]
	points(floor[i],overnet[i],pch=this.cond[1],col=this.cond[2])
}
  • 条件を変えて、コートの後ろ半分から、アンダーハンドでレシーブをしつつ、奥へ飛ばさずに、ネットを越えたあたりに落としたい。その際、ショートサービスと同様に軌道の最高到達点を自陣側に持ってくるためには、どのくらいの角度と初速で飛ばせばよいのだろうか

f:id:ryamada:20220107153825p:plain

m <- 5 * 10^(-3)
g <- c(0,-9.8)

st <- c(-450,30) * 10^(-2)
net <- c(0,155) * 10^(-2)
end <- c(198,0) * 10^(-2)

rho <- 10^(-3.5)
# best service
#theta.init <- pi/5.5
#speed.init <- 6

dt <- 0.01

t <- seq(from=0,to=2,by=dt)

my.short.service.sim <- function(theta.init,speed.init,m=5 * 10^(-3),g=c(0,-9.8),st=c(-200,115) * 10^(-2),net=c(0,155) * 10^(-2),end=c(198,0) * 10^(-2),rho=10^(-3.5),dt=0.01){
	t <- seq(from=0,to=2,by=dt)

	cond <- expand.grid(theta.init,speed.init)
	n <- length(cond[,1])
	ret <- list()
	for(i in 1:n){
		#ret[[i]] <- 1:i
		this.theta <- cond[i,1]
		this.speed <- cond[i,2]
		vs <- matrix(0,length(t)+1,2)
		v.init <- this.speed * c(cos(this.theta),sin(this.theta))

		vs[1,] <- v.init
		for(ii in 1:length(t)){
			new.v <- vs[ii,]  + dt * (g + rho * sqrt(sum(vs[ii,]^2)) * (-vs[ii,]) / m)
			vs[ii+1,] <- new.v
		}

		xs <- apply(vs*dt,2,cumsum)
		xs <- t(t(xs)+st)
		#print(xs)
		ret[[i]] <- matrix(0,length(t)+1,2)
		#print(ret[[i]])
		ret[[i]] <- xs
	}
	#return(ret)
	

	return(list(ret=ret,cond=cond,t=t))
}

theta.init <- seq(from=pi/5,to=pi/3,length=30)
speed.init <- seq(from=9,to=10,length=2)

out <- my.short.service.sim(theta.init,speed.init,st=st)

plot(out$ret[[1]],type="l",ylim=c(0,6),asp=TRUE)
abline(h=0)
segments(0,0,net[1],net[2])
points(end[1],end[2],pch=20,col=2)
for(i in 2:length(out$ret)){
	points(out$ret[[i]],type="l",col=i)
}

too.high <- too.short <- peak.loc <- peak.hight <- rep(0,length(out$ret))


for(i in 1:length(too.high)){
	this.xs <- out$ret[[i]]
	too.high[i] <- this.xs[which.min(this.xs[,1]^2)[1],2]-net[2]
	#too.short[i] <- this.xs[which.min(this.xs[,2]^2)[1],1]-end[1]
	too.short[i] <- this.xs[which.min(this.xs[,2]^2)[1],1]
	peak.loc[i] <- this.xs[which(this.xs[,2]==max(this.xs[,2]))[1],1]
	peak.hight[i] <- max(this.xs[,2])-net[2]
}

oks <- which(too.high > 0 & too.short > 0 & too.high < 0.1 & peak.loc < 0)
oks.but.peakout <- which(too.high > 0 & too.short > 0 & too.high < 0.1 & peak.loc >= 0)
ok.but.high <- which(too.high >= 0.1 & too.short > 0)
ng.both <- which(too.high <= 0 & too.short <= 0)
ng.high <- which(too.high <= 0 & too.short > 0)
ng.short <- which(too.high > 0 & too.short <= 0)

cond <- cbind(out$cond[,1]/pi,out$cond[,2])
par(mfcol=c(1,1))
plot(cond[,1],cond[,2],xlab="angle, pi",ylab="speed, m/s")
points(cond[oks,],pch=20,col=2)
points(cond[oks.but.peakout,],pch=15,col=6)
points(cond[ng.both,],pch=20,col=1)
points(cond[ng.high,],pch=20,col=3)
points(cond[ng.short,],pch=20,col=4)
points(cond[ok.but.high,],pch=20,col=5)

# OKsの軌道だけを描く

plot(out$ret[[oks[1]]],type="l",ylim=c(0,2),asp=TRUE)
abline(h=0)
segments(0,0,net[1],net[2])
points(end[1],end[2],pch=20,col=2)
for(i in 2:length(oks)){
	points(out$ret[[oks[i]]],type="l",col=i)
}