京大学部入試数学問題をRで解く2021

  • 問題はこちら
  • □1
    • 問1 3次元空間の3点が指定する平面に対称な点の座標を求める
    • だいたいこのくらいの値
> Q
[1] 1.4444444 0.5555556 1.2222222

f:id:ryamada:20210226085535p:plain

# 平面を指定する3点
A <- c(1,0,0)
B <- c(0,-1,0)
C <- c(0,0,2)

# 3角形の3辺ベクトル
AB <- B-A
AC <- C-A

# その法線方向ベクトル
n <- c(AB[2] * AC[3] - AB[3] * AC[2],AB[3] * AC[1] - AB[1] * AC[3], AB[1] * AC[2] - AB[2] * AC[1])

# ある点
P <- c(1,1,1)

# Pを通る直線をパラメタ表示するためのパラメタ
t <- seq(from=-3,to=3,length=100)
# 直線状の座標をたくさん発生させる
L <- matrix(0,length(t),3)
# Pを通り法線方向の点の座標を求める
for(i in 1:length(L[,1])){
	L[i,] <- P + t[i] * n/sqrt(sum(n^2))
}
# 3Dplot用パッケージ
library(rgl)
# ディリクレ乱数用パッケージ
library(MCMCpack)
# 三角形ABC内乱点発生用、ディリクレ乱数
S <- as.matrix(rdirichlet(1000,c(1,1,1))) 

# A,B,C,P,L,三角形ABC内乱点を3列行列にする
X <- rbind(P,A,B,C,L,S %*% rbind(A,B,C))
# 3Dplotの3軸が等長になるようにちょっと工夫
rg <- range(X)
X <- rbind(X,rep(rg[1],3),rep(rg[2],3))
# 3次元プロット
plot3d(X)
# P,A,B,Cを強調してプロット
spheres3d(P,color="red",radius=0.05)
spheres3d(rbind(A,B,C),color="blue",radius=0.05)

# Lが面をよぎる点は、L上の点のうち、任意の面上の点と最短距離の点(ここではAを使った)
tmp <- apply((t(L)-A)^2,2,sum)
selected <- which(tmp==min(tmp))
# Lが面をよぎる点
M <- L[selected,]
# 面に対してPと対称な点は、PからM方向にMの2倍の距離進んだところ
Q <- P + 2 * t[selected] * n/sqrt(sum(n^2))

spheres3d(M,color="green",radius=0.05)
spheres3d(Q,color="purple",radius=0.05)
Q
    • 問2 4タイプの等確率サンプリングで、n回目に初めて特定のタイプが観察され、1-(n-1)回目までに残りの3タイプが1回以上観察される確率
    • 乱択実験する

f:id:ryamada:20210226092955p:plain

# 実験回数は十分に
n.trial <- 10^5
# 1実験ごとにせいぜい50回も観察すれば、特定タイプが1度は観察されるだろう
n.events <- 50
# 常に4タイプは等確率で観察されるから、実験回数x観察回数の乱数を行列に納める
X <- matrix(sample(1:4,n.trial*n.events,replace=TRUE),ncol=n.events)
# 特定観察を1、それ以外の観察を2,3,4とする
# 1 :: "red"
# n番目で初めて1が観察されて、他の条件を満たす回数を数え上げる
prob <- rep(0,n.events)
# 最低でも4回抜き出しは必要
for(i in 4:n.events){
	# n番目が1="red"である試行回
	tmp <- which(X[,i] == 1)
        # n番目が1である試行回について取り出して
	tmpX <- as.matrix(X[tmp,1:(i-1)],ncol=i-1)
        # n-1回までに、少なくとも1回以上、2が観察され、1回以上3が観察され、1回以上4が観察され、1は1回も観察されていないことを
        # 以下のような計算式で表す
        # apply(tmpX-2,1,prod) は各行に少なくとも2が1回以上あれば0となる。それが3でも4でもそうなることは、足し合わせても0のまま、と言える
        # さらに、apply(tmpX-1,1,prod)が0でないことは、1,,,(n-1)に1が観察されていないことを表す
	tmp2 <- (apply(tmpX-2,1,prod) + apply(tmpX-3,1,prod) + apply(tmpX-4,1,prod)) == 0 & (apply(tmpX-1,1,prod) !=0)
        # tmp2のうちTRUEの数を数え、総実験回数で割ってやれば、そのような確率が解る
	prob[i] <- sum(tmp2)/n.trial
}

plot(prob,type="h")
  • □2 2次曲線 y = /frac{1}{2}(x^2+1)上の点接線とx軸の交点距離の最小値
    • 1.303222 くらい

f:id:ryamada:20210226094356p:plain

x <- seq(from=-5,to=5,length=100)
y <- 1/2 * (x^2+1)

plot(x,y,type="l")
L <- rep(0,length(x))
for(i in 1:length(x)){
	Qx <- x[i]-y[i]/x[i]
	Qy <- 0
	L[i] <- sqrt((x[i]-Qx)^2 + (y[i]-Qy)^2)
}

s <- which(L==min(L))

min(L)

plot(x,y,type="l")
for(i in 1:length(x)){
	Qx <- x[i]-y[i]/x[i]
	Qy <- 0
	segments(x[i],y[i],x[i]-y[i]/x[i],0)
}

for(i in 1:length(s)){
	Qx <- x[s[i]]-y[s[i]]/x[s[i]]
	Qy <- 0
	segments(x[s[i]],y[s[i]],x[s[i]]-y[s[i]]/x[s[i]],0,col="red",lwd = 2)
}
  • □3 \sum_{n=0}^{\infty} (\frac{1}{2})^n \cos{\frac{n \pi}{6}の和
    • 収束するなら計算機は得意
    • だいたい 1.476627 ((14+3 \times \sqrt{3})/13)

f:id:ryamada:20210226095816p:plain

N <- 0:100

v <- rep(0,length(N))

for(i in 1:length(N)){
	v[i] <- sum((1/2)^(0:N[i]) * cos((0:N[i])*pi/6))
}
plot(N,v,pch=20)
v[length(v)]
  • □4 y = \log{1+\cos{x}}; 0 \le x \le \frac{\pi}{2}の曲線の長さ
    • 細かく点列を作って、折れ線の長さを求めれば近似値は求まる
    • 1.762747くらい (2log(sqrt(2)+1))
x <- seq(from=0,to=pi/2,length=10000)

y <- log(1+cos(x))

plot(x,y,type="l")

diff.x <- diff(x)
diff.y <- diff(y)

L <- sum(sqrt(diff(x)^2+diff(y)^2))
L
  • □5 (-\sqrt{3},-1),(\sqrt(3),-1)の2点B,Cを底辺とした2等辺三角形の頂点がy軸上にあるとき、それは正三角形であるから、外心が原点で半径が2であるような三角形ABCについての問題である
    • 原点中心の円周上に3点を持つ三角形の垂心座標は、(3点のx座標の和,3点のy座標の和)となることを使えば、以下のように、黒がAの座標で半径2の円周、緑と青で描かれれる円が、垂心座標であり、そのうち、青がAのy座標が正の場合

f:id:ryamada:20210226103109p:plain

B <- c(-sqrt(3),-1)
C <- c(sqrt(3),-1)
t <- seq(from=0,to=1,length=1000) * 2 * pi
A <- cbind(2*cos(t),2*sin(t))


points(B[1],B[2],pch=20,col=2)
points(C[1],C[2],pch=20,col=2)

# 単位円周上に3点を持つ三角形のの垂心は(xa+xb+xc,ya+yb+yc)なので
# 半径2の円周上の場合も同じ

S <- cbind(A[,1]+B[1]+C[1], A[,2]+B[2]+C[2])
plot(rbind(A,S))

points(S,pch=20,col=3) # 垂心をプロット

posi <- which(A[,2]>0) # Aのy座標が正のものを取り出す

points(S[posi,],pch=20,cex=3,col=4)
  • □6
    • 問1 素数3^n-2^n素数なら 、nは素数
      • 対偶。nが素数で内なら3^n-2^n素数ではない
      • いずれにしても、無限に大きい数に関して、ルールがはっきりしない素数に関する「証明問題」は単なる例示的計算機利用は苦手
library(primes)

n <- 2:10000
K <- 3^n - 2^n

p.or.notp.1 <- is_prime(K)

p.or.notp.2 <- is_prime(n)

# 3^n - 2^nが素数ならnは素数
table(p.or.notp.2[which(p.or.notp.1)])
# その逆は真ではない
table(p.or.notp.1[which(p.or.notp.2)])

# 対偶
# nが素数でないなら、3^n-2^nは素数ではない
table(p.or.notp.2[which(!p.or.notp.2)])
# その逆は真ではない
table(p.or.notp.2[which(!p.or.notp.1)])
    • 問2 点(1,p) と 点(a, ap) (a > 1)とを通る微分可能な関数の接線の中に原点を通るものがあることを示す
      • 2点を通り、一般性のある微分可能な関数を描いて見せて、原点を通る直線のなかに、接線になりそうなものがありそうなことを図示して、それっぽさを示すことにする
      • (x-1)(x-a) * g(x) + axという関数はg(x)が微分可能な時、確かに、(1,p)を通り、(a,ap)を通る

f:id:ryamada:20210226111757p:plain

# f(1) = pとする

p <- 1.3  
a <- pi/2 
# 適当な微分可能な関数
g <- function(x){
	sin(x^2) + 3 * x + 0.2 * x^2 - 0.004 * x^3 + 5
}

f <- function(x,p,a){
	0.1 * (x-1) * (x-a) * g(x) + x * p
}

x <- seq(from=-3,to=3,length=100)

y <- f(x,p,a)

plot(x,y,type="l")
# (1,p), (a, pa)を通ることを図示
abline(v=1)
abline(v=a)
abline(h=p)
abline(h=p*a)

# 原点を通る直線を放射状に描く
t <- seq(from=0,to=1,length=25) * 2 * pi

for(i in 1:length(t)){
	abline(0,tan(t[i]),col=2)
}