title: “孤立頂点が消滅するしきい値に関する実験” format: html editor: visual —

直径<=３となる場合

確率pの閾値

ランダムグラフG(n, p)の直径が3である確率pのしきい値は、グラフに直径が3を超える「bad pair」が存在する確率が0に近づくようなpの値。

「bad pair」の総数の期待値をE(n, p)とする。 E(n, p) = 0となるpの値を求める。

bad pairである確率:

2つの頂点i, jがbad pairである確率P(i, j)は、以下の3つの条件が同時に満たされる確率。

iとjが隣接していない確率: \[(1 - p)\] iとjに共通の隣接頂点がない確率: \[(1 - p²)⁽ⁿ⁻²⁾\]

iの隣接頂点とjの隣接頂点の間に辺がない確率: \[ (1 - p^2)^{\binom{n - 2}{2} }\] \[ したがって、P(i, j) = (1 - p) \cdot (1 - p^2)^{(n - 2)} \cdot (1 - p^2)^{\binom{n - 2}{2}}となる。 \] ## bad pairの総数の期待値:

bad pairの総数の期待値E(n, p)は、すべての頂点ペアについてP(i, j)を合計したものです

n個の頂点から2つを選ぶ組み合わせはₙC₂なので $$ E(n, p) = ₙC_2 P(i, j) \= ₙC₂ (1 - p) (1 - p²)^{(n-2)} (1 - p²⁾{}

\= (1 - p) (1 - p²⁾{(n - 2)} (1 - p²⁾{} $$

library(igraph)

## 
## Attaching package: 'igraph'

## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum

## The following object is masked from 'package:base':
## 
##     union

n <- 100 # 頂点数
N <- 400 # サンプル数
cs <- seq(1, 1.8, 0.1)

ratio <- c()
for (c in cs) {
  count <- 0
  for (i in 1:N) {
    p <- c * sqrt(log(n) / n)
    g <- sample_gnp(n, p)
    if (diameter(g) <= 3) { # 直径が3以下の場合
      count <- count + 1
    }
  }
  ratio <- c(ratio, count / N)
}

plot(cs, ratio, type = "l", xlab = "c", ylab = "直径が3以下であるグラフの割合")
title("ランダムグラフ G(n, p) における直径3以下の割合")