確率論者あかねちゃん3についての補遺
閉じる
閉じる

新しい記事を投稿しました。シェアして読者に伝えましょう

×

確率論者あかねちゃん3についての補遺

2018-10-12 06:00
  • 4

ここから先は大学生向けやで。



1.確率密度関数を用いて3問目を計算する

 動画の通りxとyの場合分けをすると面倒なので、ここでは簡単に、最初の分割で出来た短い線分の長さをxとおいてしまうことにする。
 このとき、xは0≦x<L/2上で一様分布する。
 また、2回目の分割でできた線分の一方の長さをyとすると、yは0≦y≦L-x上で一様分布する。
 3本目の線分の長さはL-x-yである。   
 上記によって線分の長さから三角形ができる条件が分かる。y>L/2-x ,y<L/2 ,x<L/2である。つまり0≦x<L/2,L/2-x<y<L/2である。
 整理すると、

 ①xは0≦x<L/2上で一様分布し、yは0≦y≦L-x上で一様分布する。
 ②①において三角形が出来る条件は0≦x<L/2,L/2-x<y<L/2である。

 あとは確率密度関数の積分をして確率を求めるだけです。
 一様分布の確率密度関数は区間の差を分母に持ってくるだけですし、積分区間は三角形が出来る条件を当てはめればよいですね。従って以下が導けます。







2.エクセルVBAを用いた平面内の点の分布

動画内でも紹介しましたが、あかねちゃんが作ってくれたマクロをおすそわけします。
使い方等は各自検索してみてください。
ちなみに、1.では、線分の短いほうをxとしても一般性を失わないため0≦x<L/2としましたが、マクロでは視覚的なわかりやすさを重視して0≦x≦1の一様分布とし、線分の短い方をxとはしていませんので注意(マキちゃんの説明と同じ絵になるようにしています)。
ただし、確率としては同じになりますので問題ありません。


===以下、最下部までコピペしてください===

Option Explicit
' 40000の部分が無作為な点を打つ回数。数字を増やすとグラフが見えづらくなるし重くなるので注意'
Const N As Long = 40000

Sub 無作為に三分割()
' データ作成'
Dim A As Long, i As Long
Dim x As Double, y As Double
Randomize Timer
Cells(1, 1).Value = "条件を満たす座標数"
Cells(1, 2).Value = "全座標数"
Cells(1, 3).Value = "確率"
Cells(1, 5).Value = "無作為に選択された点x"
Cells(1, 6).Value = "無作為に選択された点y"
Cells(1, 7).Value = "条件を満たす点x"
Cells(1, 8).Value = "条件を満たす点y"
Cells(2, 1).Value = 0
Cells(2, 2).Value = 0
Cells(2, 3).Value = "=A2/B2"
Cells(3, 2).Value = "[参考]真の確率:"
Cells(3, 2).HorizontalAlignment = xlRight
Cells(3, 3).Formula = 0.25
While Cells(2, 2).Value < N
'xとyを同時に、無作為に取る⇔x、yともに0から1の一様分布⇔x、yともにRND関数で表せる'
'※xもyも「他方の影響を受けない」ため面積問題に置き換えられる。グラフを見れば点が一様に分布しているのがわかる'
x = Rnd: y = Rnd
A = 2 + Cells(2, 2).Value
'x<yのとき、3つの線分はx,y-x,1-yとなるから、三角形が出来る条件はy>1/2,y<1/2+x,x<1/2'
If x < y And y > 0.5 And y < 0.5 + x And x < 0.5 Then
Cells(2, 1).Value = Cells(2, 1).Value + 1
Cells(A, 7).Value = x: Cells(A, 8).Value = y
End If
'x>=yのとき、3つの線分はy,x-y,1-xとなるから、三角形が出来る条件はx>1/2,x<1/2+y,y<1/2'
If x >= y And x > 0.5 And x < 0.5 + y And y < 0.5 Then
Cells(2, 1).Value = Cells(2, 1).Value + 1
Cells(A, 7).Value = x: Cells(A, 8).Value = y
End If
Cells(A, 5).Value = x: Cells(A, 6).Value = y
Cells(2, 2).Value = Cells(2, 2).Value + 1
Wend

' グラフ削除'
With ActiveSheet
For i = .ChartObjects.Count To 1 Step -1
.ChartObjects(i).Delete
Next i
End With

' グラフ作成'
With ActiveSheet.Shapes.AddChart
.Name = "あかねちゃん"
.Chart.ChartType = xlXYScatter
.Chart.HasTitle = True
.Chart.ChartTitle.Text = "領域イメージ"
.Chart.HasLegend = False
.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(1).XValues = Range(Cells(2, 5), Cells(N + 1, 5))
.Chart.SeriesCollection(1).Values = Range(Cells(2, 6), Cells(N + 1, 6))
.Chart.SeriesCollection(1).MarkerStyle = -4118
.Chart.SeriesCollection(1).MarkerSize = 2

.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(2).XValues = Range(Cells(2, 7), Cells(N + 1, 7))
.Chart.SeriesCollection(2).Values = Range(Cells(2, 8), Cells(N + 1, 8))
.Chart.SeriesCollection(2).MarkerStyle = -4118
.Chart.SeriesCollection(2).MarkerSize = 2
End With

With ActiveSheet.Shapes.AddChart
.Name = "あおいちゃん"
.Chart.ChartType = xlXYScatter
.Chart.HasTitle = True
.Chart.ChartTitle.Text = "一様分布の確認"
.Chart.HasLegend = False
.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(1).XValues = Range(Cells(2, 5), Cells(N + 1, 5))
.Chart.SeriesCollection(1).Values = Range(Cells(2, 6), Cells(N + 1, 6))
.Chart.SeriesCollection(1).MarkerStyle = -4118
.Chart.SeriesCollection(1).MarkerSize = 2
End With

With ActiveSheet.ChartObjects("あおいちゃん")
.Top = Range("A4").Top
.Left = Range("A4").Left
.Width = Range("A4:I4").Width
.Height = Range("A4:I31").Height
End With

With ActiveSheet.ChartObjects("あかねちゃん")
.Top = Range("J4").Top
.Left = Range("J4").Left
.Width = Range("J4:R4").Width
.Height = Range("J4:J31").Height
End With


End Sub
Sub 無作為に二分割後長い方をさらに無作為に二分割()
Dim A As Long, i As Long
Dim x As Double, y As Double
Randomize Timer
Cells(1, 1).Value = "条件を満たす座標数"
Cells(1, 2).Value = "全座標数"
Cells(1, 3).Value = "確率"
Cells(1, 5).Value = "無作為に選択された点x"
Cells(1, 6).Value = "点x決定後、残りの長い方を分割するための点y"
Cells(1, 7).Value = "条件を満たす点x"
Cells(1, 8).Value = "条件を満たす点y"
Cells(2, 1).Value = 0
Cells(2, 2).Value = 0
Cells(2, 3).Value = "=A2/B2"
Cells(3, 2).Value = "参考:真の確率"
Cells(3, 2).HorizontalAlignment = xlRight
Cells(3, 3).Formula = "=Log(4, Exp(1)) - 1"
While Cells(2, 2).Value < N
'xは0から1の一様分布だが、yは①「x>0.5のとき0からxの一様分布」、②「x<=0.5のとき0から1-xの一様分布」の2つで場合分けが必要となる'
'※yの区間にxが絡んできている。そのため、この時点で「一方は他方の影響を受けない」という条件に反するため面積問題に置き換えられない点に注意'
'グラフを見ると濃淡があり、一様に分布していないことがわかる'
'xを0から1のRND関数としたあと、x>0.5のときy=RND*x,x<=0.5のときy=RND*(1-x)と表せることに着目する'
x = Rnd
A = 2 + Cells(2, 2).Value
'x>0.5のときy=RND*x'
If x > 0.5 Then
y = Rnd * x
'x>0.5のとき、3つの線分はy,x-y,1-xとなるから、三角形が出来る条件はx>1/2,x<1/2+y,y<1/2'
If x > 0.5 And x < 0.5 + y And y < 0.5 Then
Cells(2, 1).Value = Cells(2, 1).Value + 1
Cells(A, 7).Value = x: Cells(A, 8).Value = y
End If
End If
'x<=0.5のときy=RND*(1-x)'
If x <= 0.5 Then
y = Rnd * (1 - x)
'x<=0.5のとき、3つの線分はx,y,1-x-yとなるから、三角形が出来る条件はy>1/2-x,x<1/2,y<1/2'
If y > 0.5 - x And x < 0.5 And y < 0.5 Then
Cells(2, 1).Value = Cells(2, 1).Value + 1
Cells(A, 7).Value = x: Cells(A, 8).Value = y
End If
End If
Cells(A, 5).Value = x: Cells(A, 6).Value = y
Cells(2, 2).Value = Cells(2, 2).Value + 1
Wend

' グラフ削除'
With ActiveSheet
For i = .ChartObjects.Count To 1 Step -1
.ChartObjects(i).Delete
Next i
End With

' グラフ作成'
With ActiveSheet.Shapes.AddChart
.Name = "あかねちゃん"
.Chart.ChartType = xlXYScatter
.Chart.HasTitle = True
.Chart.ChartTitle.Text = "領域イメージ"
.Chart.HasLegend = False
.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(1).XValues = Range(Cells(2, 5), Cells(N + 1, 5))
.Chart.SeriesCollection(1).Values = Range(Cells(2, 6), Cells(N + 1, 6))
.Chart.SeriesCollection(1).MarkerStyle = -4118
.Chart.SeriesCollection(1).MarkerSize = 2

.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(2).XValues = Range(Cells(2, 7), Cells(N + 1, 7))
.Chart.SeriesCollection(2).Values = Range(Cells(2, 8), Cells(N + 1, 8))
.Chart.SeriesCollection(2).MarkerStyle = -4118
.Chart.SeriesCollection(2).MarkerSize = 2
End With

With ActiveSheet.Shapes.AddChart
.Name = "あおいちゃん"
.Chart.ChartType = xlXYScatter
.Chart.HasTitle = True
.Chart.ChartTitle.Text = "一様分布の確認"
.Chart.HasLegend = False
.Chart.SeriesCollection.NewSeries
.Chart.SeriesCollection(1).XValues = Range(Cells(2, 5), Cells(N + 1, 5))
.Chart.SeriesCollection(1).Values = Range(Cells(2, 6), Cells(N + 1, 6))
.Chart.SeriesCollection(1).MarkerStyle = -4118
.Chart.SeriesCollection(1).MarkerSize = 2
End With

With ActiveSheet.ChartObjects("あおいちゃん")
.Top = Range("A4").Top
.Left = Range("A4").Left
.Width = Range("A4:I4").Width
.Height = Range("A4:I31").Height
End With

With ActiveSheet.ChartObjects("あかねちゃん")
.Top = Range("J4").Top
.Left = Range("J4").Left
.Width = Range("J4:R4").Width
.Height = Range("J4:J31").Height
End With

'精度の問題はさておき、たかだか数万回の試行を見ても、明らかに1/3には収束しそうにないことが分かると思う'

End Sub



  • 前の記事
    これより過去の記事はありません。
広告
×
動画、相変わらず面白くためになりました。
そして、この捕捉を読んでみたものの、確実に勉強した内容なのにもうからっきし覚えておらず、随分歳を取ったんだなぁと凹みました…。
2週間前
×
xは0からL/2上で一様分布であるから式の一番最初にある2/Lがあるですよね?
個人的にピンと来ない位置にあるのでこれで合っているか確証がないです
1週間前
×
>>1
ご視聴ありがとうございます。普段から使っていないとどんどん忘れていきますよね…。
1週間前
×
>>4
その通りです。
定数なので前に出してしまいましたが、インテグラルの間に挟んだ方が良かったですね。失礼しました。
1週間前
コメントを書く
コメントをするには、
ログインして下さい。