臨床統計もおもしろいですよ、その3 (360ﾚｽ)
上下前次1-新

---

1(7): 2020/03/05(木)20:17 ID:naSB8128(1/2) AAS
　
　内科認定医受験の最低限の知識、
　製薬会社の示してくる臨床データ、
　論文の考察、
　論文を書くときの正当性、
　というのが、臨床統計の今までの目的の大きい部分でしたが、
　
　AI=機械学習の基本も、結局は統計学と確率に支配されます。
　そういう雑多な話をするスレです。
　
※前スレ
臨床統計もおもしろいですよ、その１
2chｽﾚ:hosp
臨床統計もおもしろいですよ、その2
2chｽﾚ:hosp

---

331: 03/29(土)14:28 ID:3Rix5Sdd(1) AAS
# Adverse Effect
# 副作用確率 p
# nサンプルサイズ
# 有意水準
# 1-(1-p)^n=conf.level
AE=\(p=NULL,n=NULL,conf.level=NULL){
if(is.null(p)) {
p=1-(1-conf.level)^(1/n)
re=list(p=p,'1/p'=1/p)
}
if(is.null(n)){
re=list(n=log(1 - conf.level)/log(1-p))
}
if(is.null(conf.level)){
re=list(conf.level=1-(1-p)^n)
}
return(re)
}

AE(p=1/1000,n=NULL,conf=0.95)
AE(p=NULL,n=828,conf=0.99)
AE(p=1/828,n=828) ; 1-1/exp(1)

---

332: 04/08(火)04:58 ID:oA/Cdcc5(1) AAS
# 3x3 グリッドの隣接関係を定義
adjacency <- list(
c(2,4), # 1
c(1,3,5), # 2
c(2,6), # 3
c(1,5,7), # 4
c(2,4,6,8), # 5
c(3,5,9), # 6
c(4,8), # 7
c(5,7,9), # 8
c(6,8) # 9
)

# 1回の操作を定義（選ばれたコインの上下左右を裏返す）
flip <- function(state, index) {
for (i in adjacency[[index]]) {
state[i] <- 1 - state[i]
}
return(state)
}

# 1回のゲームシミュレーション（初期状態：全て表）
simulate_game <- function() {
state <- rep(0, 9)
steps <- 0
while (!all(state == 1)) {
index <- sample(1:9, 1)
state <- flip(state, index)
steps <- steps + 1
}
return(steps)
}

simulate_game()

---

333: 04/17(木)22:02 ID:L538pzIa(1) AAS
# Function to compute P(X ≤ r0) for ratio parameters (RR, OR, HR, etc.)
# given a two-sided credible interval [L, U] at credibility level ‘cred’.
prob_ratio_le <- function(r0, L, U, cred = 0.95) {
# Input validation
if (L <= 0 || U <= 0) {
stop("L and U must both be greater than 0.")
}
if (L >= U) {
stop("Require L < U.")
}

# Compute the z‑score corresponding to the two‑sided credibility level
z <- qnorm((1 + cred) / 2)

# Take logarithms of the interval endpoints
logL <- log(L)
logU <- log(U)

# Recover the posterior normal parameters in log‑space
mu <- (logL + logU) / 2
sigma <- (logU - logL) / (2 * z)

# Compute P(log X ≤ log r0) under N(mu, sigma^2)
pnorm(log(r0), mean = mu, sd = sigma)
}

# ── Example usage ──
L <- 0.46 # Lower bound of 95% credible interval
U <- 1.37 # Upper bound of 95% credible interval
r0 <- 1.0 # Threshold value

p <- prob_ratio_le(r0, L, U, cred = 0.95)
cat(sprintf("P(X ≤ %.2f) ≈ %.2f%%\n", r0, p * 100))

---

334: 04/29(火)12:23 ID:1ANpcHSX(1/2) AAS
library(RcppAlgos)
library(fmsb)
options(warn = -1)
sim=\(){
part=partitionsGeneral(100,3,rep=TRUE)
n=part[sample(nrow(part),1),]
x=sapply(n,\(x) sample(x,1))
tbl=rbind(x,n)
contig=rbind(x,n-x)
#pf=fisher.test(contig)$p.value
pc=chisq.test(contig)$p.value
#fish=pairwise.fisher.test(x,n,p.adj="bon")
prop=pairwise.prop.test(x,n,p.adj="bon")
#minf=min(as.vector(fish$p.value),na.rm=TRUE)
minc=min(as.vector(prop$p.value),na.rm=TRUE)
list(pc,minc,tbl)
}
res=sim()
while(!(res[[1]]<0.05 & res[[2]]>0.05)) res=sim()
res[[3]]
res[[1]]
pairwise.prop.test(res[[3]][1,],res[[3]][2,])

#while(!(res[[1]]>0.05 & res[[2]]<0.05)) res=sim()
#res
del="
x=c(22,29,30)
n=c(25,32,43)

tbl=rbind(x,n)
contig=rbind(x,n-x)
#pf=fisher.test(contig)$p.value
chisq.test(contig)$p.value
#fish=pairwise.fisher.test(x,n,p.adj="bon")
pairwise.prop.test(x,n,p.adj="bon")
"

---

335: 04/29(火)18:19 ID:1ANpcHSX(2/2) AAS
Verfy this R code, please.

library(RcppAlgos)
N=50
cm=comboGeneral(0:N,3,repetition=FALSE)
f=\(x){
n=rep(N,3)
pf=fisher.test(rbind(x,n-x))$p.value
pps=as.vector(fmsb::pairwise.fisher.test(x,n,p.adj="bon")$p.value)
minp=min(pps,na.rm=TRUE)
pf>0.05 & minp<0.05
}
cm[apply(cm,1,f),]

---

336: 04/30(水)06:21 ID:KCRt3Jug(1) AAS
3群の比率の検定で全体のカイ二乗検定(Yatesの連続性補正付き）で有意差がないのに
ペアワイズな検定（Yatesの連続性補正とbonferrino補正付き）どれかに有意差がある
という条件を満たすデータを作ってください。

---

337: 05/08(木)07:48 ID:ViQw6hh2(1) AAS
尤度
P(データ∣θ) 「このサイコロ（θ）なら今の出目がどれくらい起こりやすいか？」
周辺尤度
∫P(データ∣θ)P(θ)dθ 「いろんなサイコロの平均として、この結果はどれくらい自然か？」

Likelihood
P(Data ∣ θ)
"How probable is this outcome assuming the die has parameter θ?"
"If we already knew which die we had (θ), how likely would this roll be?"

Marginal Likelihood
∫P(Data ∣ θ)P(θ)dθ
"How plausible is this result when averaged over all possible dice (θ), weighted by their prior probabilities?"
"Considering all possible dice, how expected is this result on average?"

P(Data ∣ θ)
"If we already knew what illness the patient had (θ), how likely is it that we would see these symptoms?"
∫P(Data ∣ θ)P(θ)dθ
"If we don’t know what illness the patient has, but we think about all the possible illnesses and how common they are, how likely are these symptoms overall?"

Likelihood
P(Data ∣ θ)
"If we already knew she’s a fashion-major university student who calls Starbucks her second home, how likely is it that she’d write her thesis in pink Comic Sans and include inspirational quotes from Instagram?"
Marginal Likelihood
∫P(Data ∣ θ)P(θ)dθ
"Even if we don’t know what kind of student she is, if we consider all kinds—from hardcore science nerds to TikTok influencers—how likely is it to get a thesis like this on average?"

---

338: 05/15(木)14:40 ID:t1v4yD36(1) AAS
rm(list=ls())

library(PropCIs)
noninferior.pitfall <- function(r0,n0, r1,n1, r2,n2, r3,n3, nim_coef, alpha=0.05, yates=FALSE) {
delta <- (r0/n0 - r1/n1) * nim_coef
if (min(r0, r1, r2, r3) < 5) {
p1 <- fisher.test(matrix(c(r1, n1-r1, r0, n0-r0), 2, 2))$p.value
p2 <- fisher.test(matrix(c(r2, n2-r2, r0, n0-r0), 2, 2))$p.value
ci_upper <- diffscoreci(r2, n2, r3, n3, conf.level=1-2*alpha)$conf.int[2]
} else {
p1 <- prop.test(c(r1, r0), c(n1, n0), correct=yates)$p.value
p2 <- prop.test(c(r2, r0), c(n1, n0), correct=yates)$p.value
ci_upper <- prop.test(c(r2, r1), c(n2, n1), conf.level=1-2*alpha, correct=yates)$conf.int[2]
}
all(
r1 < r0 && p1 < alpha,
p2 > alpha,
ci_upper < delta
)
}

noninferior.pitfall(16,201,6,202,7,203,6,204,0.684)

---

339: 05/18(日)10:39 ID:lhFLTkmB(1) AAS
# mcmc.list オブジェクトを単一の行列に変換
samples_matrix <- do.call(rbind, result$samples)

---

340: 05/24(土)21:24 ID:NTCihoQC(1) AAS
# dbeta(L,a,b) == dbbeta(U,a,b)
# Solve[L^(a-1)(1-L)^(b-1)==U^(a-1)(1-U)^(b-1), b]

beta.parameter <- function(L=1/7,U=1/5, credMass = 0.95){
f = function(a) 1 + ((a - 1) * log(U / L)) / log((1 - L) / (1 - U))
g = function(a) pbeta(U,a,f(a)) - pbeta(L,a,f(a)) - credMass
(re=uniroot(g,c(1,1e5)))
# curve(g(x),1,150,bty="l") ; abline(h=0,lty=3)
c(re$root,f(re$root))
}
beta.parameter()

---

341: 05/25(日)08:08 ID:ReDTq4fK(1) AAS
# 定義：左辺が変数名のベクトル、右辺が値のベクトル（またはリスト）
"%=%" <- function(lhs, rhs) {
# LHSは substitute により式として取得
lhs_vars <- as.list(substitute(lhs))[-1L] # 最初の要素は `c` なので除く

# 値の数と変数の数が一致するか確認
if (length(lhs_vars) != length(rhs)) {
stop("Number of variables on the left does not match number of values on the right")
}

# 呼び出し元の環境に代入
for (i in seq_along(lhs_vars)) {
var_name <- as.character(lhs_vars[[i]])
assign(var_name, rhs[[i]], envir = parent.frame())
}

invisible(NULL)
}

---

342: 05/28(水)01:51 ID:bjUL8g/8(1/5) AAS
備忘録

ポアソン分布ーガンマ分布階層モデルの周辺尤度
integrate(function(lambda) dpois(x, lambda) * dgamma(lambda, shape, rate), 0, Inf)$value
dnbinom(x, size=shape, mu=shape/rate)
dnbinom(x, size=shape, prob=rate/(1+rate))

二項分布ベータ分布階層モデルの周辺尤度
integrate(function(p) dbinom(x, size = n, prob = p) * dbeta(p, shape1 = alpha, shape2 = beta), lower = 0, upper = 1)$value
extraDistr::dbbinom(x, size = n, alpha = alpha, beta = beta)
VGAM::dbetabinom(x, size, prob = alpha/(alpha+beta) , rho = 1/(1+alpha+beta))
rho = 0：完全に独立な試行（普通の二項分布）
rho > 0：試行間に正の相関（例えば、成功しやすい試行が集まる）
rho → 1：完全な相関（試行結果が極端に偏る）

---

343: 05/28(水)01:53 ID:bjUL8g/8(2/5) AAS
全体の結論
両方の階層モデル（ポアソン-ガンマおよび二項-ベータ）の周辺尤度の記述は正確です。以下に要約します：
ポアソン-ガンマ階層モデル：
周辺尤度の積分形式は正しい。

負の二項分布による表現（dnbinom の mu 形式と prob 形式）はどちらも正しい。

二項-ベータ階層モデル：
周辺尤度の積分形式は正しい。

ベータ二項分布の表現（extraDistr::dbbinom および VGAM::dbetabinom）は正しい。

相関パラメータ ρ\rho\rho
の解釈は正確。

記述に誤りはなく、すべて正しいです。ご質問があれば、さらに詳しくお答えします！

---

344: 05/28(水)02:00 ID:bjUL8g/8(3/5) AAS
import numpy as np
from scipy.stats import poisson, gamma, nbinom
from scipy.integrate import quad

# ポアソン-ガンマ階層モデルの周辺尤度

# 周辺尤度の数値積分
def integrand(lambda_, x, shape, rate):
return poisson.pmf(x, lambda_) * gamma.pdf(lambda_, a=shape, scale=1/rate)

marginal_likelihood, _ = quad(integrand, 0, np.inf, args=(x, shape, rate))

# 負の二項分布: mu形式
nb_mu = nbinom.pmf(x, n=shape, p=rate/(shape + rate))

# 負の二項分布: prob形式
prob = rate / (1 + rate)
nb_prob = nbinom.pmf(x, n=shape, p=prob)

---

345: 05/28(水)02:00 ID:bjUL8g/8(4/5) AAS
(* 二項分布-ベータ分布階層モデルの周辺尤度 *)

(* 周辺尤度の数値積分 *)
marginalLikelihood = NIntegrate[
PDF[BinomialDistribution[n, p], x] * PDF[BetaDistribution[alpha, beta], p],
{p, 0, 1},
Method -> "GlobalAdaptive"
];

(* ベータ二項分布 *)
betaBinomialPMF[x_, n_, alpha_, beta_] := Binomial[n, x] * Beta[x + alpha, n - x + beta] / Beta[alpha, beta];
bbPMF = betaBinomialPMF[x, n, alpha, beta];

(* VGAM形式のパラメータ *)
prob = alpha/(alpha + beta);
rho = 1/(1 + alpha + beta);

---

346: 05/28(水)02:13 ID:bjUL8g/8(5/5) AAS
mathematica
(* ポアソン-ガンマ階層モデルの周辺尤度 *)

(* 周辺尤度の数値積分 *)
marginalLikelihood = NIntegrate[
PDF[PoissonDistribution[lambda], x] * PDF[GammaDistribution[shape, 1/rate], lambda],
{lambda, 0, Infinity},
Method -> "GlobalAdaptive"
];

(* 負の二項分布: mu形式 *)
nbMu = PDF[NegativeBinomialDistribution[shape, shape/(shape + rate)]][x];

(* 負の二項分布: prob形式 *)
prob = rate/(1 + rate);
nbProb = PDF[NegativeBinomialDistribution[shape, prob]][x];

python
import numpy as np
from scipy.stats import poisson, gamma, nbinom
from scipy.integrate import quad

# ポアソン-ガンマ階層モデルの周辺尤度

# 周辺尤度の数値積分
def integrand(lambda_, x, shape, rate):
return poisson.pmf(x, lambda_) * gamma.pdf(lambda_, a=shape, scale=1/rate)

marginal_likelihood, _ = quad(integrand, 0, np.inf, args=(x, shape, rate))

# 負の二項分布: mu形式
nb_mu = nbinom.pmf(x, n=shape, p=rate/(shape + rate))

# 負の二項分布: prob形式
prob = rate / (1 + rate)
nb_prob = nbinom.pmf(x, n=shape, p=prob)

---

347: 05/28(水)14:53 ID:8vNUcvi5(1) AAS
posterior_normal <- function(prior_mean, prior_sd, observations, obs_sd, credMass = 0.95, verbose = FALSE) {
# 変数変換
tau0_sq <- prior_sd^2
sigma_sq <- obs_sd^2
n <- length(observations)
x_bar <- mean(observations)

# 事後分布の計算
tau_n_sq <- 1 / (1 / tau0_sq + n / sigma_sq)
mu_n <- tau_n_sq * (prior_mean / tau0_sq + n * x_bar / sigma_sq)
posterior_sd <- sqrt(tau_n_sq)

# 信用区間（credMass = 0.95など）
alpha <- 1 - credMass
z <- qnorm(1 - alpha / 2)
ci_lower <- mu_n - z * posterior_sd
ci_upper <- mu_n + z * posterior_sd

if (verbose) {
# 描画範囲
x_min <- min(prior_mean - 4 * prior_sd, mu_n - 4 * posterior_sd)
x_max <- max(prior_mean + 4 * prior_sd, mu_n + 4 * posterior_sd)

# 描画
curve(dnorm(x, mean = prior_mean, sd = prior_sd), from = x_min, to = x_max,
col = "blue", lwd = 2, ylab = "Density", xlab = "IQ",
main = "Prior vs Posterior Distribution")
curve(dnorm(x, mean = mu_n, sd = posterior_sd), from = x_min, to = x_max,
col = "red", lwd = 2, add = TRUE)

abline(v = c(ci_lower, ci_upper), col = "red", lty = 2)
legend("topright", legend = c("Prior", "Posterior", paste0(credMass * 100, "% CI")),
col = c("blue", "red", "red"), lwd = c(2, 2, 1), lty = c(1, 1, 2))
}

# 結果をリストで返す
list(
posterior_mean = mu_n,
posterior_sd = posterior_sd,
posterior_variance = tau_n_sq,
credible_interval = c(lower = ci_lower, upper = ci_upper)
)
}

---

348: 05/29(木)06:17 ID:Rg/ouhbx(1) AAS
∫[0→1] [ (s+f)!/(s!f!) × p^s × (1-p)^f ] × [ (α+β-1)!/((α-1)!(β-1)!) × p^{α-1} × (1-p)^{β-1} ] dp

=

[ (s+f)!/(s!×f!) × p^s × (1-p)^f ]
× [ p^{α-1} × (1-p)^{β-1} × (α+β-1)!/((α-1)!×(β-1)!) ]
/ [ p^{α+s-1} × (1-p)^{β+f-1} × (α+β+s+f-1)!/((α+s-1)!×(β+f-1)!) ]

---

349: 07/13(日)17:25 ID:0B+1lzpC(1/2) AAS
# 局所実在論に基づくCHSH不等式シミュレーション
simulate_chsh_local_realism <- function(n_trials = 1000,verbose = FALSE) {
# 測定角度の設定（ラジアン）
theta_A <- 0 # Aの測定角度（0度）
theta_A_prime <- pi/2 # A'の測定角度（90度）
theta_B <- pi/4 # Bの測定角度（45度）
theta_B_prime <- 3*pi/4 # B'の測定角度（135度）

# 結果を格納するベクトル
E_AB <- numeric(n_trials)
E_AB_prime <- numeric(n_trials)
E_A_prime_B <- numeric(n_trials)
E_A_prime_B_prime <- numeric(n_trials)

# 局所実在論に基づくシミュレーション
for (i in 1:n_trials) {
# 隠れた変数λをランダムに生成（0から1の一様分布）
lambda <- runif(1, 0, 1)

# AとBの測定結果を隠れた変数に基づいて決定
# 例：λに基づいて確率的に結果を生成（局所性を保証）
# 各測定設定で結果（±1）を確率的に決定
prob_A <- 0.5 + 0.5 * cos(2 * pi * lambda - theta_A) # Aの結果の確率
prob_A_prime <- 0.5 + 0.5 * cos(2 * pi * lambda - theta_A_prime) # A'の結果の確率
prob_B <- 0.5 + 0.5 * cos(2 * pi * lambda - theta_B) # Bの結果の確率
prob_B_prime <- 0.5 + 0.5 * cos(2 * pi * lambda - theta_B_prime) # B'の結果の確率

A <- if (runif(1) < prob_A) 1 else -1
A_prime <- if (runif(1) < prob_A_prime) 1 else -1
B <- if (runif(1) < prob_B) 1 else -1
B_prime <- if (runif(1) < prob_B_prime) 1 else -1

# 各ペアの相関を計算
E_AB[i] <- A * B
E_AB_prime[i] <- A * B_prime
E_A_prime_B[i] <- A_prime * B
E_A_prime_B_prime[i] <- A_prime * B_prime
}

---

350: 07/13(日)17:26 ID:0B+1lzpC(2/2) AAS
# 相関関数の平均を計算
E_AB_mean <- mean(E_AB)
E_AB_prime_mean <- mean(E_AB_prime)
E_A_prime_B_mean <- mean(E_A_prime_B)
E_A_prime_B_prime_mean <- mean(E_A_prime_B_prime)

# CHSH値の計算
S <- abs(E_AB_mean - E_AB_prime_mean + E_A_prime_B_mean + E_A_prime_B_prime_mean)

if(verbose){
# 結果の出力
cat("E(A,B) =", E_AB_mean, "\n")
cat("E(A,B') =", E_AB_prime_mean, "\n")
cat("E(A',B) =", E_A_prime_B_mean, "\n")
cat("E(A',B') =", E_A_prime_B_prime_mean, "\n")
cat("CHSH S value =", S, "\n")

# ベルの不等式の検証
if (S > 2) {
cat("Bell's inequality is violated (S > 2)\n")
} else {
cat("Bell's inequality is not violated (S <= 2)\n")
}
}
return(S)
}

res=replicate(1000,simulate_chsh_local_realism())
summary(res)

---

351: 07/13(日)19:54 ID:/RTJqZrH(1) AAS
Bell_CHSH_optimized <- function(N = 1000) {
ai <- sample(c(1, 2), N, replace = TRUE)
bi <- sample(c(1, 2), N, replace = TRUE)

particles_a1 <- sample(c(-1, 1), N, replace = TRUE)
particles_a2 <- sample(c(-1, 1), N, replace = TRUE)
particles_b1 <- sample(c(-1, 1), N, replace = TRUE)
particles_b2 <- sample(c(-1, 1), N, replace = TRUE)

a <- ifelse(ai == 1, particles_a1, particles_a2)
b <- ifelse(bi == 1, particles_b1, particles_b2)

idx_A1B1 <- (ai == 1 & bi == 1)
idx_A1B2 <- (ai == 1 & bi == 2)
idx_A2B1 <- (ai == 2 & bi == 1)
idx_A2B2 <- (ai == 2 & bi == 2)

safe_mean <- function(x) {
if (length(x) == 0) return(0)
return(mean(x))
}

rA1B1 <- safe_mean(a[idx_A1B1] * b[idx_A1B1])
rA1B2 <- safe_mean(a[idx_A1B2] * b[idx_A1B2])
rA2B1 <- safe_mean(a[idx_A2B1] * b[idx_A2B1])
rA2B2 <- safe_mean(a[idx_A2B2] * b[idx_A2B2])

S <- rA1B1 + rA1B2 + rA2B1 - rA2B2

return(S)
}

# 1000回シミュレーションを実行
res_optimized <- replicate(1000, Bell_CHSH_optimized())

# 結果を確認
all_abs_res_le_2 <- all(abs(res_optimized) <= 2)

print(paste("全てのS値が絶対値2以下であるか: ", all_abs_res_le_2))
print(paste("S値の平均: ", mean(res_optimized)))
print(paste("S値の範囲: ", range(res_optimized)[1], "から", range(res_optimized)[2]))

---

352: 08/09(土)07:36 ID:hJupetNI(1/7) AAS
#' Calculate the magnitude of relativistic relative velocity
#'
#' Computes the relative velocity magnitude of two objects moving at different angles.
#'
#' @param u Speed magnitude of the first object (along X-axis).
#' @param v Speed magnitude of the second object.
#' @param theta Angle between the second object's velocity and the X-axis (in radians).
#' @param c Speed of light (default: 299792.458 km/s).
#' @return Magnitude of the relative velocity between the two objects.
relativistic_relative_velocity <- function(u, v, theta, c = 299792.458) {
cos_theta <- cos(theta)
sin_theta <- sin(theta)

numerator <- sqrt(u^2 + v^2 - 2 * u * v * cos_theta - (u^2 * v^2 * sin_theta^2) / c^2)
denominator <- 1 - (u * v * cos_theta) / c^2

numerator / denominator
}

# --- Example usage ---

c <- 300000 # Speed of light in km/s

# Example 1: Two cars moving towards each other at 200,000 km/s along X-axis
u_val <- 200000
v_val <- 200000
theta_val <- pi # 180 degrees
relative_speed_ex1 <- relativistic_relative_velocity(u_val, v_val, theta_val, c)
cat("Example 1 (Head-on collision):\nRelative speed =", relative_speed_ex1, "km/s\n\n")

# Example 2: Two objects moving perpendicular at 200,000 km/s
theta_val <- pi / 2 # 90 degrees
relative_speed_ex2 <- relativistic_relative_velocity(u_val, v_val, theta_val, c)
cat("Example 2 (Perpendicular velocities):\nRelative speed =", relative_speed_ex2, "km/s\n\n")

# Example 3: Speeds close to the speed of light, moving head-on
u_val <- 0.9 * c
v_val <- 0.9 * c
theta_val <- pi # 180 degrees
relative_speed_ex3 <- relativistic_relative_velocity(u_val, v_val, theta_val, c)
cat("Example 3 (Near light-speed head-on):\nRelative speed =", relative_speed_ex3, "km/s\n")

---

353: 08/09(土)10:42 ID:hJupetNI(2/7) AAS
画像ﾘﾝｸ


relativeVelocity[u_, v_, theta_: Pi, c_: 1] := Module[{
numerator,
denominator
},
numerator = Sqrt[u^2 + v^2 - 2*u*v*Cos[theta] - (u^2*v^2*Sin[theta]^2)/c^2];
denominator = 1 - (u*v*Cos[theta])/c^2;

numerator/denominator
]

u = Range[0, 1, 1/99];
v = Range[0, 1, 1/99];

z = Outer[relativeVelocity, u, v];

ContourPlot[relativeVelocity[x, y], {x, 0, 1}, {y, 0, 1},
PlotLegends -> Automatic,
Contours -> 50,
FrameLabel -> {"u", "v"}
]

relativeVelocity[15/30,15/30]
relativeVelocity[20/30,20/30]
relativeVelocity[9/10,9/10]

---

354: 08/09(土)10:50 ID:hJupetNI(3/7) AAS
relativeVelocity[u_, v_, theta_: Pi, c_: 1] := Module[{
numerator,
denominator
},
numerator = Sqrt[u^2 + v^2 - 2*u*v*Cos[theta] - (u^2*v^2*Sin[theta]^2)/c^2];
denominator = 1 - (u*v*Cos[theta])/c^2;

numerator/denominator
]

u = Range[0, 1, 1/99];
v = Range[0, 1, 1/99];

z = Outer[relativeVelocity, u, v];

ContourPlot[relativeVelocity[x, y], {x, 0, 1}, {y, 0, 1},
PlotLegends -> Automatic,
Contours -> 50,
FrameLabel -> {"u", "v"}
]

V = Range[0, 1, 1/1000];
Plot[relativeVelocity[v, v], {v, 0, 1},
AspectRatio -> 1
]

---

355: 08/09(土)16:04 ID:hJupetNI(4/7) AAS
#-------------------------------------------------------------------------------
# GPSにおける時間のずれを計算するRコード
#-------------------------------------------------------------------------------

#===============================================================================
# 物理定数とパラメータの定義
#===============================================================================
# 単位はすべてSI単位系（m, kg, s）
G <- 6.674e-11 # 万有引力定数 (m^3 kg^-1 s^-2)
M <- 5.972e24 # 地球の質量 (kg)
c <- 299792458 # 光速 (m/s)

# GPS衛星のパラメータ
v_satellite <- 3870 # GPS衛星の軌道速度 (m/s)
r_earth <- 6.371e6 # 地球の平均半径 (m)
r_satellite <- 26.571e6 # GPS衛星の軌道半径 (m) - 地球半径 + 軌道高度 (約20200km)

# 計算期間（1日）
seconds_per_day <- 24 * 60 * 60 # 1日あたりの秒数

#===============================================================================
# 1. 速度による時間の遅れ（特殊相対性理論）
#===============================================================================
# ローレンツ因子を計算
gamma <- 1 / sqrt(1 - (v_satellite^2 / c^2))

# 1日あたりの時間の遅れ（負の値）を計算
# 地上から見て、衛星の時間はgamma倍ゆっくり進む
delta_t_v <- (1 - gamma) * seconds_per_day
# または、近似式: delta_t_v <- -0.5 * (v_satellite^2 / c^2) * seconds_per_day
cat("速度による時間の遅れ (1日あたり):", delta_t_v * 1e6, "マイクロ秒\n")

---

356: 08/09(土)16:04 ID:hJupetNI(5/7) AAS
#===============================================================================
# 2. 重力による時間の進み（一般相対性理論）
#===============================================================================
# 弱重力場での近似式を使用して計算
# 衛星軌道上と地表の重力ポテンシャル差から時間のずれを計算
delta_t_g <- (G * M / c^2) * (1/r_earth - 1/r_satellite) * seconds_per_day
cat("重力による時間の進み (1日あたり):", delta_t_g * 1e6, "マイクロ秒\n")

#===============================================================================
# 3. 合計の時間のずれ
#===============================================================================
total_delta_t <- delta_t_v + delta_t_g
cat("---------------------------------------------------\n")
cat("合計の時間のずれ (1日あたり):", total_delta_t * 1e6, "マイクロ秒\n")

---

357: 08/09(土)16:12 ID:hJupetNI(6/7) AAS
# 定数の定義
c <- 3.0e8 # 光速 (m/s)
G <- 6.67430e-11 # 万有引力定数 (m^3 kg^-1 s^-2)
M <- 5.972e24 # 地球の質量 (kg)
R_earth <- 6.378e6 # 地球の半径 (m)
h <- 2.020e7 # GPS衛星の高度 (m)
r <- R_earth + h # 地球中心からの距離 (m)
v <- 3.874e3 # GPS衛星の軌道速度 (m/s)
t <- 86400 # 1日 (秒)

# 特殊相対性理論（SRT）による時間の遅れ
# 時間遅れ率: sqrt(1 - v^2/c^2)
srt_factor <- sqrt(1 - (v^2 / c^2))
srt_delay <- t * (1 - srt_factor) # 1日あたりの遅れ (秒)

# 一般相対性理論（GRT）による時間の進み
# 重力ポテンシャル: Phi = -GM/r
Phi_earth <- -G * M / R_earth # 地球表面
Phi_sat <- -G * M / r # 衛星軌道
grt_factor <- 1 + (Phi_sat - Phi_earth) / c^2
grt_advance <- t * (grt_factor - 1) # 1日あたりの進み (秒)

# 合計の時間ずれ
total_shift <- srt_delay + grt_advance # 秒
total_shift_us <- total_shift * 1e6 # マイクロ秒に変換

# 結果の出力
cat("SRTによる時間の遅れ（マイクロ秒/日）：", srt_delay * 1e6, "\n")
cat("GRTによる時間の進み（マイクロ秒/日）：", grt_advance * 1e6, "\n")
cat("合計の時間ずれ（マイクロ秒/日）：", total_shift_us, "\n")

---

358: 08/09(土)16:14 ID:hJupetNI(7/7) AAS
# 定数の定義
c <- 3.0e8 # 光速 (m/s)
G <- 6.67430e-11 # 万有引力定数 (m^3 kg^-1 s^-2)
M <- 5.972e24 # 地球の質量 (kg)
R_earth <- 6.378e6 # 地球の半径 (m)
h <- 2.020e7 # GPS衛星の高度 (m)
r <- R_earth + h # 地球中心からの距離 (m)
v <- 3.874e3 # GPS衛星の軌道速度 (m/s)
t <- 86400 # 1日 (秒)

# 特殊相対性理論（SRT）による時間の遅れ
# 時間遅れ率: sqrt(1 - v^2/c^2)
srt_factor <- sqrt(1 - (v^2 / c^2))
srt_delay <- t * (1 - srt_factor) # 1日あたりの遅れ (秒)

# 一般相対性理論（GRT）による時間の進み
# 重力ポテンシャル: Phi = -GM/r
Phi_earth <- -G * M / R_earth # 地球表面
Phi_sat <- -G * M / r # 衛星軌道
grt_factor <- 1 + (Phi_sat - Phi_earth) / c^2
grt_advance <- t * (grt_factor - 1) # 1日あたりの進み (秒)

# 合計の時間ずれ
total_shift <- srt_delay + grt_advance # 秒
total_shift_us <- total_shift * 1e6 # マイクロ秒に変換

# 結果の出力
cat("SRTによる時間の遅れ（マイクロ秒/日）：", srt_delay * 1e6, "\n")
cat("GRTによる時間の進み（マイクロ秒/日）：", grt_advance * 1e6, "\n")
cat("合計の時間ずれ（マイクロ秒/日）：", total_shift_us, "\n")

---

359: 08/16(土)05:40 ID:CkAl0b77(1/2) AAS
大規模言語モデル（LLM）は、「確率に基づいて次単語を出力するだけのツール」であり、検索能力においては人間に遠く及ばない、と結論づけることができます。

ここまでの議論で明らかになったように、この2つの根本的な違いが、LLMから誤った情報が返ってくる原因です。

LLMと人間の情報処理の決定的な違い
項目 大規模言語モデル（LLM） 人間
情報の処理 パターンの学習と予測。<br>膨大なテキストから単語同士の関連性を学習し、次にくる単語を確率的に予測します。事実に基づいているかは考慮しません。 事実の検索と検証。<br>疑問が生じたときには、能動的に検索を行い、複数の情報源を比較して事実を特定します。
情報の正確性 もっともらしさを優先。<br>文脈上、もっともらしい文章を生成することに特化しており、真偽は保証されません。 真実を優先。<br>矛盾する情報があれば、どちらが正しいかを判断し、真実を追求します。
能力の限界 事実の検索や最新情報の把握は苦手。<br>学習データにない情報や、学習時点以降に発生した出来事には対応できません。 能動的に最新情報を検索できる。<br>検索エンジンなどを使い、常に新しい情報を取得・検証できます。

---

360: 08/16(土)05:41 ID:CkAl0b77(2/2) AAS
LLMの「検索」と「生成」
LLMは、しばしば「賢い検索エンジン」のように思われがちですが、それは大きな誤解です。

検索エンジンは、ユーザーのクエリ（質問）に基づいて、インターネット上から既存の情報を探し出し、その情報源（ウェブサイト）を提示します。検索結果には、情報の真偽を判断するための複数の情報源が含まれています。

LLMは、ユーザーのプロンプト（指示）に基づいて、学習データから得たパターンを組み合わせて新しいテキストを「生成」します。情報源を提示することは基本的になく、その回答が事実に基づいているかの保証はありません。

結論
あなたがご指摘されたように、「ちょっと調べれば分かる」という事実は、LLMが「検索」と「事実確認」という人間の基本的な情報探索プロセスを代替するものではないことを明確に示しています。

LLMは強力な文章生成ツールですが、その回答はあくまで「生成物」であり、事実関係の確認は、引き続き人間が責任を持って行う必要があります。この点を理解せずにLLMを過信すると、今回のケースのように、誤った情報を鵜呑みにしてしまうリスクが非常に高まります。

---

上下前次1-新書関写板覧索設栞歴

---

ｽﾚ情報 赤ﾚｽ抽出 画像ﾚｽ抽出 歴の未読ｽﾚ

---

ぬこの手 ぬこTOP 1.164s*