18/11/17 12:29:55.67 MdaDRZ5p.net
非対称分布の信頼区間算出にパッケージないのかな？
pmf2hdi <- function(pmf,conf.level=0.95,Print=TRUE){ # pmf 2 higest density interval indices
pdf=pmf/sum(pmf) # sum(pdf)==1
if(Print) hist(pdf,breaks=length(pdf),ann=FALSE)
spdf=sort(pdf,decreasing=TRUE) # sort pdf from highest
cdf=cumsum(spdf) # culmutive probability
threshold=spdf[which(cdf>=conf.level)[1]]
# which(cdf>conf.level)[1] : cdf.index of 1st value when cdf > 0.95
# threshold : its corresponding spdf value
index=which(pdf>=threshold) # pdf.index whose value > threshold
clevel=sum(pdf[index]) # actual conf.level, a little bit greater than 0.95
n.index=length(index)
if(n.index==index[n.index]-index[1]+1){ # check if unimodal by its length
interval=c(index[1],index[n.index]) # if unimodal print lower and upper limit
print(c(lower=pmf[index[1]],upper=pmf[index[n.index]]))
}else{interval=index
}
list(indices=interval,actual.CI=clevel)
}
224:卵の名無しさん
18/11/17 13:55:53.88 ZSsSLaRh.net
>>210
> marked.fish(3)
lower upper
0.009921656 0.009682298
$`mode`
[1] 839
$median
[1] 1430
$mean
[1] 1963.967
$CI.hdi
[1] 295 5445
$CI.Qqtl
[1] 473 6825
225:卵の名無しさん
18/11/17 13:56:56.74 ZSsSLaRh.net
> marked.fish2(3)
lower upper
0.0006438142 0.0006421482
$`mode`
[1] 840
$median
[1] 1445
$mean
[1] 1985.835
$CI.hdi
[1] 280 5525
$CI.Qqtl
[1] 463 6902
負の二項分布でも超幾何分布のときとさほど変わらないなぁ
226:卵の名無しさん
18/11/17 14:05:11.77 oN/r/5pI.net
さて来週の３本は
よくもこんな〇〇〇〇レコードを
これから毎日スレ上げしようぜ
んほおぉぉぉおぉぉ
でお送りしま~す、んっわっほっぅ
227:純粋大和
18/11/17 14:17:58.42 bEfId4t4.net
どうせ助からない（死ぬ奴）の集まりかよ 笑
228:卵の名無しさん
18/11/17 17:37:00.95 ZSsSLaRh.net
数学板のこれ面白かった。情報量とか調べながら解答してきた。
789 名前：１３２人目の素数さん[] 投稿日：2018/11/17(土) 01:54:23.54 ID:SOe/0VMF
情報理論の問題です。（１）は解けるのですが、（２）でつまずいています...
＜問題＞
50人の生徒からなるクラスがある。
そのうち30人は男子、20人は女子であり、男子のうち18人、女子のうち2人は眼鏡をかけている仮定とする。
（１）男女の別、眼鏡の有無のそれぞれが持つ平均自己相互量を求めよ。
（２）男女の性別が判っているという条件のもとで、眼鏡の有無が持つ条件付き自己情報量を求めよ。
答えは、
（１）H(X) = 0.97ビット, H(Y) = 0.97ビット
（２）H(Y|X) = 0.77ビット
となっております。
得意な方がいましたら、（２）の答えを出すまでの計算過程を教えていただきたいです。
よろしくお願い致します。
229:卵の名無しさん
18/11/17 17:38:33.02 ZSsSLaRh.net
数時間潰しての結果がこれ、わずか２行ｗ
Prelude> let entropy x = sum $ map (\i -> -i*(logBase 2 i)) ( map(/sum(x)) x )
Prelude> 30/50 * entropy [18, 12] + 20/50 * entropy [2, 18]
0.7701685941085136
230:卵の名無しさん
18/11/17 18:43:39.12 ZSsSLaRh.net
>>219
再利用できるように関数化しておいた。
{-
＜問題＞
120(n)人の生徒からなるクラスがある。
そのうち90(m)人は男子、30(f)人は女子であり、男子のうち80(um)人、女子のうち10(uf)人は裏口入学であると仮定とする。
（１）男女の別、裏口の有無のそれぞれが持つ平均自己相互量をビット値で求めよ。
（２）男女の性別が判っているという条件のもとで、裏口の有無が持つ条件付き自己情報量（ビット値）を求めよ。
-}
entropy x = sum $ map (\i -> -i*(logBase 2 i)) ( map(/sum(x)) x )
entr_ura_gender n m f um uf = do
m/n*entropy[um,m-um] + f/n*entropy[uf,f-uf]
231:卵の名無しさん
18/11/17 19:20:41.23 XNk+eTpQ.net
Prudence, indeed, will dictate that "uraguchi" long established cannot be changed for light and transient causes;
and accordingly all experience has shown, that BMS are more disposed to suffer, while evils are sufferable, than to right themselves by abolishing the forms from which they can pursue profit.
But when a long train of misbehavior and misconduct , showing invariably the same Imbecility evinces a design to reveal themselves as absolute Bona Fide Moron ,
it is their right, it is their duty, to expel such "uraguchi", and to provide new guards for their future security.
232:卵の名無しさん
18/11/17 20:12:01.95 ZSsSLaRh.net
# URLﾘﾝｸ(logics-of-blue.com)
"予想がつかない→不確実性（情報エントロピー）が大きい→平均情報量も大きい"
entropy <- function(x){ # 情報エントロピー（平均情報量）
x=x/sum(x)
sum(x*(-log2(x)))
}
"各々の確率分布の情報量の差分の期待値をとります
確率分布が異なっていれば、情報量があるとみなすのが
カルバック・ライブラーの情報量です。"
KLd <- function(P,Q){ # Kullback?Leibler divergence, relative entropy,Information gain
n=length(P)
if(n!=length(Q)) return(NULL)
P=P/sum(P)
Q=Q/sum(Q)
sum(Q*(log2(Q)-log2(P)))
}
# 相互情報量は不確実性（情報エントロピー）の減少量とみなすことができます
233:卵の名無しさん
18/11/17 21:45:47.30 ZSsSLaRh.net
KLd <- function(P,Q){ # Kullback-Leibler divergence, relative entropy,Information gain
n=length(P)
if(n!=length(Q)) return(NULL)
P=P/sum(P)
Q=Q/sum(Q)
sum(P*log(P)/log(Q)) # P relative to Q
}
kld p q = do -- Kullback-Leibler divergence
-- if length p /= length q
-- then return ()
-- else do
let pp = map (/sum(p)) p
qq = map (/sum(q)) q
in sum $ zipWith (\x y -> x * (log x)/(log y)) pp qq
234:卵の名無しさん
18/11/17 21:50:36.68 ZSsSLaRh.net
Prelude> p = [80,10]
Prelude> q = [10,20]
Prelude> let pp = map (/sum(p)) p
Prelude> let qq = map (/sum(q)) q
Prelude> sum $ zipWith (\x y -> x * (log x)/(log y)) pp qq
0.6974120552208812
KLd <- function(P,Q){ # Kullback-Leibler divergence, relative entropy,Information gain
n=length(P)
if(n!=length(Q)) return(NULL)
P=P/sum(P)
Q=Q/sum(Q)
sum(P*log(P)/log(Q)) # P relative to Q
}
> KLd(c(80,10),c(10,20))
[1] 0.6974121
235:卵の名無しさん
18/11/17 23:42:40.77 7FfFKHDd.net
It is common knowledge among doctors and patients that Do-Teihen(exclusively bottom-leveled medical school) graduates mean morons who bought their way to Gachi'Ura(currently called by themselves)
According to the experience of entrance exam to medical school in the era of Showa, when the sense of discrimination against
privately-founded medical schools were more intense than it is now,
all such schools but for Keio had been so compared to some specialized institution for educable mentally retarded kids that nobody but imbecile successors of physicians in private practice had applied for admission.
There had been NOT a single classmate who chose willingly against his/her common sense to go to the Do-Teihen(exclusively bottom-leveled medical school, currently also known as Gachi'Ura),
which would have cost outrageous money and its graduates are destined to be called Uraguchi morons who bought thier way into the Do-Teihen, by thier colleagues and even by thier own clients.
Although people won't call them names to their face,
certain 80-90% people of about my age have been yet scorning and sneering at Uraguchi graduates, speaking in the back of our mind,
" Uraguchi morons shall not behave like somebody."
We never speak out face to face in real life.
236:卵の名無しさん
18/11/18 06:08:27.82 YaOZKwLp.net
事務員で遊ぶのも飽きてきたし
そろそろコミケの原稿を書き始めなきゃなぁ
237:卵の名無しさん
18/11/18 06:55:57.87 deJ1Cp/X.net
中学入試を難問化した問題で遊んでみる。
池の鯉を網で５６匹すくいました。
すくった５６匹に目印をつけ、池にもどしました。
次の日に鯉４５匹をすくったところ、３６匹に目印がついていました。
(1)池の鯉の鯉の数の最尤値を述べよ（２つある）。
(2)最尤値が２つあるのは何匹の目印鯉が捕獲されたときか述べよ。
238:卵の名無しさん
18/11/18 08:16:59.52 afl5ZxKK.net
It is common knowledge among doctors and patients that Do-Teihen(exclusively bottom-leveled medical school) graduates mean morons who bought their way to Gachi'Ura(currently called by themselves)
According to the experience of entrance exam to medical school in the era of Showa, when the sense of discrimination against
privately-founded medical schools were more intense than it is now,
all such schools but for Keio had been so compared to some specialized institution for educable mentally retarded kids that nobody but imbecile successors of physicians in private practice had applied for admission.
There had been NOT a single classmate who chose willingly against his/her common sense to go to the Do-Teihen(exclusively bottom-leveled medical school, currently also known as Gachi'Ura),
which would have cost outrageous money and its graduates are destined to be called Uraguchi morons who bought thier way into the Do-Teihen, by thier colleagues and even by thier own clients.
Although people won't call them names to their face,
certain 80-90% people of about my age have been yet scorning and sneering at Uraguchi graduates, speaking in the back of our mind,
" Uraguchi morons shall not behave like somebody."
We never speak out face to face in real life.
239:卵の名無しさん
18/11/18 10:01:00.69 deJ1Cp/X.net
>>223
kld p q = do -- Kullback-Leibler divergence
if length p /= length q
then error "Not equal length"
else do
let pp = map (/sum(p)) p
qq = map (/sum(q)) q
in sum $ zipWith (\x y -> x * (log x)/(log y)) pp qq
main = do
print $ kld [1,1] [1,3]
print $ kld [1,1] [1,2,3]
240:卵の名無しさん
18/11/18 11:18:38.60 uPZ4H5RS.net
>>227
pmf2hdi <- function(pmf,conf.level=0.95,Print=TRUE){ # pmf 2 higest density interval indices
pdf=pmf/sum(pmf) # sum(pdf)==1
if(Print) hist(pdf,breaks=length(pdf),ann=FALSE)
spdf=sort(pdf,decreasing=TRUE) # sort pdf from highest
cdf=cumsum(spdf) # culmutive probability
threshold=spdf[which(cdf>=conf.level)[1]]
# which(cdf>conf.level)[1] : cdf.index of 1st value when cdf > 0.95
# threshold : its corresponding spdf value
index=which(pdf>=threshold) # pdf.index whose value > threshold
clevel=sum(pdf[index]) # actual conf.level, a little bit greater than 0.95
n.index=length(index)
if(n.index==index[n.index]-index[1]+1){ # check if unimodal by its length
interval=c(index[1],index[n.index]) # if unimodal print lower and upper limit
print(c(lower=pmf[index[1]],upper=pmf[index[n.index]]))
}else{interval=index
}
list(indices=interval,actual.CI=clevel)
}
241:卵の名無しさん
18/11/18 11:18:46.99 uPZ4H5RS.net
marked.fish <- function(.x,Nmax=10000, Print=FALSE){ # marked fish # to 95%CI
N2p= function(N,g=56,s=45,x=.x){ # N:total number of fishe
if(N < g + s - x) return(0)
b = N-g # g:genuine(marked) b:bogus(unmarked) s:re-sampled
dhyper(x,g,b,s) # choose(g,x)*choose(b,s-x)/choose(g+b,s)
}
pmf=Vectorize(N2p)
N=1:Nmax
y=pmf(N)
z=y/sum(y)
mode.idx=N[y==max(y)] # can be multiple
n.idx=length(mode.idx)
mode=min(mode.idx)+(n.idx-1)/10
mean=sum(N*z)
hdi = pmf2hdi(y,Print=FALSE)$indices
zc=cumsum(z)
median=which.max((zc>0.5))
if(Print){
par(mfrow=c(2,1))
plot(N,z,type='h',col='gray',ylab='density',bty='l')
abline(v=c(mode,median,mean),lty=c(1,2,3))
legend('topright',bty='n',legend=c('mode','median','mean'),lty=1:3)
plot(N,zc,type='l',col='gray',ylab='cdf',bty='l')
abline(h=0.5,lty=3)}
qtl = c(min(which(zc>0.025)) , min(which(zc>0.975)))
list(mode=mode, median=median, mean=mean,CI.hdi=hdi,CI.Qqtl=qtl)
}
242:卵の名無しさん
18/11/18 11:19:33.02 uPZ4H5RS.net
marked.fish(36,Print=T)
marked.fish(3,Print=T)
n=0:45
Y=sapply(n,function(n) marked.fish(n))
y=matrix(unlist(Y["CI.hdi",]),nrow=2)
plot(n,y[2,],type='n',bty='l',xlab='re-sampled marked fish',
ylab='estimated size of total')
segments(n,y[1,],n,y[2,],lwd=3,col='gray')
points(n,unlist(Y['mode',]),pch=21)
points(n,unlist(Y['median',]),pch='+')
points(n,unlist(Y['mean',]),pch='*')
legend('center',bty='n',pch=c('○','+','*'),legend=c('mode','median','mean'))
result=data.frame(n,mode=unlist(Y['mode',]),median=unlist(Y['median',]),
mean=round(unlist(Y['mean',]),1))
result[1:20,]
result[21:40,]
tail(result)
n[floor(result[,'mode'])!=result[,'mode']] # multiple
243:卵の名無しさん
18/11/18 11:20:38.75 uPZ4H5RS.net
>>227
(2)の答は4個あるな。
244:卵の名無しさん
18/11/18 13:29:06.59 uPZ4H5RS.net
>>224
プログラミンの練習にpythonに移植、Rより面倒。
import math
def simplex(x): # convert vector to whose sum =1
s=sum(x)
return ([y/s for y in x]) # return(list(map( (lambda y: y/s) , x )))
def kld(p,q): # Kullback-Leibler divergence
if len(p)!=len(q):
raise Exception("Not equal length!")
p = simplex(p)
q = simplex(q)
return(sum(list (map (lambda x,y: x* math.log(x)/math.log(y), p,q))))
245:卵の名無しさん
18/11/18 17:41:08.98 uPZ4H5RS.net
>>234
エラー処理はなしにして無理矢理、one-liner にすると
def Kullback_Leiber(p,q): return(sum(list (map (lambda x,y: x* math.log(x)/math.log(y), [i/sum(p) for i in p],[j/sum(q) for j in q]))))
246:卵の名無しさん
18/11/19 00:27:20.08 6+hS1SxI.net
i tried it in Showa u motherfucker. in that time niggers were supposed be in what niggahz were supposed to be motherfucking in, which we call a discrimination.
they pay shit loaded money to motherfucking niggers ass-bitch cocksucker fucking gringo homosexual hobo
i mean fuck you all go down hell
247:卵の名無しさん
18/11/19 06:06:04.36 tA4kj3ba.net
2^3はpythonで１を返す
ビット演算子(~, &, |, ^, <<, >>)
2**3 か pow(2,3）で冪乗
248:卵の名無しさん
18/11/19 06:40:59.39 tA4kj3ba.net
練習に、これを移植したいなぁ。
URLﾘﾝｸ(www.geocities.jp)
249:卵の名無しさん
18/11/19 06:43:11.58 tA4kj3ba.net
すでにやった人がいた:P
URLﾘﾝｸ(dev.ariel-networks.com)
250:卵の名無しさん
18/11/19 07:27:32.80 tA4kj3ba.net
>>238
数が小さいので頭で考えると (4L,3L)
[(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3),(2,0)]
になるが、
Haskellの解は無駄な汲み出しをしている気がするなぁ。
[(0,0),(4,0),(0,3),(4,3),(1,3),(3,0),(1,0),(3,3),(0,1),(4,2),(4,1),(0,2),(2,3),(2,0)]
251:卵の名無しさん
18/11/19 07:29:17.17 tA4kj3ba.net
>>240
問題はこれ
問題 : ４ リットルと ３ リットルの容器を使って ２ リットルの水を測るにはどうすればいい？
252:卵の名無しさん
18/11/19 07:31:08.11 tA4kj3ba.net
こっちの方が断然、難関。
油分け算
[問題] 油分け算
14 リットルの容器 A に油が満杯に入っています。これを 11 リットルの容器 B と 3 リットルの容器 C を使って二等分してください。
容器 A と B には 7 リットルずつ油が入ります。油を二等分する最短手順を求めてください。
容器 B と C のサイズが 9 リットルと 5 リットルの場合の手順は？
253:卵の名無しさん
18/11/19 08:12:59.88 tA4kj3ba.net
>>239
WinGCHiで動作するように少し改変
import Data.List
basicState = (0,0)
actions = let xmax = 4
ymax = 3
in [(\(x, y) -> (xmax, y)),
(\(x, y) -> (x, ymax)),
(\(x, y) -> (0, y)),
(\(x, y) -> (x, 0)),
(\(x, y) -> if (x + y > xmax) then (xmax, y+x-xmax) else (x+y, 0)),
(\(x, y) -> if (x + y > y
254:max) then (x+y-ymax, ymax) else (0, x+y))] main = print $ searchStates [basicState] searchStates :: [(Int, Int)] -> [(Int, Int)] searchStates states = let nexts = filter (not . (checkState states)) $ concat $ map (execSeek actions) states in if length nexts > 0 then searchStates $ states ++ (nub nexts) else states execSeek :: [((Int, Int) -> (Int, Int))] -> (Int, Int) -> [(Int, Int)] execSeek (f:fs) crnt | null fs = (f crnt : []) | True = (f crnt : []) ++ execSeek fs crnt checkState :: [(Int, Int)] -> (Int, Int) -> Bool checkState states (crnt_x, crnt_y) = any isSameState states where isSameState :: (Int, Int) -> Bool isSameState (x, y) = if (x == crnt_x && y == crnt_y) then True else False
255:卵の名無しさん
18/11/19 08:25:49.04 tA4kj3ba.net
>>239
これは可能な組み合わせを列挙しているだけで必ずしも手順をしめすプログラムじゃないな。
256:卵の名無しさん
18/11/19 08:30:40.71 L6cqzabr.net
i tried it in Showa u motherfucker. in that time niggers were supposed be in what niggahz were supposed to be motherfucking in, which we call a discrimination.
they pay shit loaded money to motherfucking niggers ass-bitch cocksucker fucking gringo homosexual hobo
i mean fuck you all go down hell
257:卵の名無しさん
18/11/19 12:28:58.07 xPquTj4a.net
>>240
[(0,0),(0,3),(3,0),(3,3),(4,2),(0,2)] というのが数学板で返された
258:卵の名無しさん
18/11/19 14:10:23.88 lgLouqKT.net
>>246 は国試に２３回も落ちた挙句
婚活にも失敗してる素人童貞で
くるくるぱーの裏口バカに
なっちゃってるのらぁあぁぁ
Ｆラン事務員の濃ゆぅぅい生ガキ汁
ド底辺の臭いが落ちないよぉ
んほおぉぉぉおぉぉ
259:卵の名無しさん
18/11/19 15:18:00.83 /8nCvktv.net
>>242
(14,0,0),(3,11,0),(3,8,3),(6,8,0),(6,5,3),(9,5,0),(9,2,3),(12,2,0),(12,0,2),(1,11,2),(1,10,3),(4,10,0),(4,7,3),(7,7,0)
これでできるけど、最短かどうかは自信がないなぁ。
260:卵の名無しさん
18/11/19 15:21:56.75 /8nCvktv.net
>>247
ド底辺シリツ医大卒の知性を表すような文章だなぁ。
>242の答でもだせばいいのに、
馬鹿なのか？馬鹿なのにどうして大学に入れるわけ？
あれかな？
あれだよね？
あれ
あれ
う
ら
ぐ
ち
261:卵の名無しさん
18/11/19 15:46:07.22 /8nCvktv.net
[問題]
30 リットルの容器 A に油が満杯に入っています。これを 1７ リットルの容器 B と １3 リットルの容器 C を使って二等分してください。容器 A と B には 15 リットルずつ油が入ります。油を二等分する手順を求めてください。
[30,0,0]
[13,17,0]
[13,4,13]
[26,4,0]
[26,0,4]
[9,17,4]
[9,8,13]
[22,8,0]
[22,0,8]
[5,17,8]
[5,12,13]
[18,12,0]
[18,0,12]
[1,17,12]
[1,16,13]
[14,16,0]
[14,3,13]
[27,3,0]
[27,0,3]
[10,17,3]
[10,7,13]
[23,7,0]
[23,0,7]
[6,17,7]
[6,11,13]
[19,11,0]
[19,0,11]
[2,17,11]
[2,15,13]
[15,15,0]
262:卵の名無しさん
18/11/19 18:20:27.15 lgLouqKT.net
ネットで口汚くあちこちのスレを荒らしている国試浪人の事務員だが
この世に彼奴を下回るカスがいるだろうか
いや居ない
リアルではだれも口にしないが、みな思っていることだ
事務員本人も内心は自覚していることだろう
でなければ毎日毎日、専門医や開業医や皮膚科でもないのに
それぞれのスレを荒らしに来るはずがない
よっぽど妬ましいんだろうなW
263:卵の名無しさん
18/11/19 20:30:41.47 /8nCvktv.net
rm(list=ls())
Amax=10 ; Bmax=7 ; Cmax=3
init = c(10,0,0)
stacks=t(as.matrix(init))
a2b <- function(abc){
a=abc[1];b=abc[2];c=abc[3]
if(a+b > Bmax) c(a+b-Bmax,Bmax,c)
else c(0, a+b, c)
}
a2c <- function(abc){
a=abc[1];b=abc[2];c=abc[3]
if(a+c > Cmax) c(a+c-Cmax, b, Cmax)
else c(0, b, a+c)
}
b2c <- function(abc){
a=abc[1];b=abc[2];c=abc[3]
if(b+c > Cmax) c(a, b+c-Cmax,Cmax)
else c(a, 0, b+c)
}
b2a <- function(abc){
a=abc[1];b=abc[2];c=abc[3]
if(b+a > Amax) c(Amax, b+a-Amax,c)
else c(b+a, 0, c)
}
264:卵の名無しさん
18/11/19 20:31:14.24 /8nCvktv.net
c2a <- function(abc){
a=abc[1];b=abc[2];c=abc[3]
if(c+a > Amax) c(Amax, b, c
265:+a-Amax) else c(c+a, b, 0) } c2b <- function(abc){ a=abc[1];b=abc[2];c=abc[3] if(c+b > Bmax) c(a, Bmax, c+b-Bmax) else c(a, c+b, 0) } actions = c(a2b,a2c,b2c,c2a,c2a,c2b) transfer <- function(x){ re=NULL for(fun in actions){ re=rbind(re,fun(x)) } unique(re) } transit=transfer(init) is.vim <- function(vector,matrix){ # is vector in matrix any(apply(matrix,1,function(x) all(x==vector))) }
266:卵の名無しさん
18/11/19 21:00:32.27 /8nCvktv.net
URLﾘﾝｸ(ailaby.com)
267:卵の名無しさん
18/11/19 22:04:51.47 vmWf+9X3.net
actions = c(a2b,a2c,b2c,c2a,c2a,c2b)
is.vim <- function(vector,matrix){ # is vector in matrix
any(apply(matrix,1,function(x) all(x==vector)))
}
is.goal <- function(x){
all(x==goal)
}
transfer <- function(x){
re=NULL
for(fun in actions){
v=fun(x)
if(!is.vim(v,stacks)) re=rbind(re,fun(x))
}
unique(re)
}
transit=transfer(init)
push <- function(x){
n=nrow(x)
for(i in 1:n){
if(!is.vim(x[i,],stacks)) stacks=rbind(x[i,],stacks)
if(is.goal(x[i,])) break
}
return(stacks)
}
stacks=push(transit)
268:卵の名無しさん
18/11/19 22:22:12.67 vmWf+9X3.net
URLﾘﾝｸ(jprogramer.com)
269:卵の名無しさん
18/11/19 22:29:14.48 vmWf+9X3.net
>>251
期待に反して悪いが俺、事務員じゃないんだね。
臨床やってるからこういう議論もできる。
URLﾘﾝｸ(egg.2ch.net)
879 卵の名無しさん sage 2018/11/15(木) 07:18:18.94 ID:LT687Ilf
>>878
>875は脾弯越えの操作でpullする時の話。
URLﾘﾝｸ(i.imgur.com)
んで、あんたどこ卒？
ド底辺シリツ医大へ裏口入学なんだろ？
中学入試を少し難問化した>227に答えてみ!
270:卵の名無しさん
18/11/19 22:31:41.85 vmWf+9X3.net
>>251
国立卒はちゃんとわかってる。
開業医スレのシリツ三法則（試案、名投稿より作成）
1.私立医が予想通り糞だからしょうがない
>ｽﾚﾘﾝｸ(hosp板:101番)-102
>ｽﾚﾘﾝｸ(hosp板:844番)-853
ID:RFPm1BdQ
>ｽﾚﾘﾝｸ(hosp板:869番)
>ｽﾚﾘﾝｸ(hosp板:874番)-875
>ｽﾚﾘﾝｸ(hosp板:874番)-880
>ｽﾚﾘﾝｸ(hosp板:882番)
ID:liUvUPgn
2.馬鹿に馬鹿と言っちゃ嫌われるのは摂理
実例大杉！
3.リアルでは皆思ってるだけで口に出してないだけ
URLﾘﾝｸ(ishikisoku.com)
271:卵の名無しさん
18/11/19 22:42:33.31 zhu5ykUr.net
Prudence, indeed, will dictate that "uraguchi" long established cannot be changed for light and transient causes;
and accordingly all experience has shown, that BMS are more disposed to suffer, while evils are sufferable, than to right themselves by abolishing the forms from which they can pursue profit.
But when a long train of misbehavior and misconduct , showing invariably the same Imbecility evinces a design to reveal themselves as absolute Bona Fide Moron ,
it is their right, it is their duty, to expel such "uraguchi", and to provide new guards for their future security.
272:卵の名無しさん
18/11/19 23:01:00.76 vmWf+9X3.net
>>251
統計スレに投稿するならこれくらい答えてみ。
話題のド底辺シリツ医大裏口入学を題材にした問題。
ド底辺シリツ裏口調査団が100人を順次調査した。
裏口判明人数をそのまま公表はヤバすぎる結果であったため、
連続して裏口がみつかった最大数は4人であったとだけ公表した。
公表結果が正しいとして裏口入学人数の期待値、最頻値、及び95%信頼区間を述べよ。
273:卵の名無しさん
18/11/19 23:13:28.02 vmWf+9X3.net
actions = c(a2b,a2c,b2c,c2a,c2a,c2b)
is.vim <- function(vector,matrix){ # 配列が行列に含まれるか
any(apply(matrix,1,function(x) all(x==vector)))}
is.goal <- function(x){ #ゴール判定
all(x==goal)}
transfer <- function(x){ # 移動してにスタックにない配列のみ返す
re=NULL
for(fun in actions){
v=fun(x)
if(!is.vim(v,stacks)) re=rbind(re,fun(x)) }
unique(re)}
transit=transfer(init) #最初の移動
push <- function(x){ #新規のみスタックに積む
n=nrow(x)
for(i in 1:n){
if(!is.vim(x[i,],stacks)) stacks=rbind(x[i,],stacks)
if(is.goal(x[i,])) break #ゴールしてたらループをぬける
}
return(stacks) #新スタックを返す
}
stacks=push(transit)
274:卵の名無しさん
18/11/20 07:42:56.98 jEVjKi6n.net
>>251
んで、あんたどこ卒？
275:卵の名無しさん
18/11/20 07:48:14.29 jEVjKi6n.net
>>261
探索経路を記録するのと
移転で過去の状態に戻るのをカウントから外す必要があるなぁ。
276:卵の名無しさん
18/11/20 08:30:59.02 GReM9fuK.net
ネットで口汚くあちこちのスレを荒らしている国試浪人の事務員だが
この世に彼奴を下回るカスがいるだろうか
いや居ない
リアルではだれも口にしないが、みな思っていることだ
事務員本人も内心は自覚していることだろう
でなければ毎日毎日、専門医や開業医や皮膚科でもないのに
それぞれのスレを荒らしに来るはずがない
よっぽど妬ましいんだろうなW
277:卵の名無しさん
18/11/20 11:38:05.66 +LTJHbMS.net
278:油分け算のRスクリプトようやく完成 rm(list=ls()) Amax=10 ; Bmax=7 ; Cmax=3 # capacity t0 = c(10,0,0) # initial state goal = c(5,5,0) # goal .stack <<- t(as.matrix(t0)) # stack (converted to one row matrix) .checked <<- .stack # checked list # pouring methods a2b <- function(abc){ # pour from A to B a=abc[1];b=abc[2];c=abc[3] if(a+b > Bmax) c(a+b-Bmax,Bmax,c) else c(0, a+b, c) } a2c <- function(abc){ a=abc[1];b=abc[2];c=abc[3] if(a+c > Cmax) c(a+c-Cmax, b, Cmax) else c(0, b, a+c) } b2c <- function(abc){ a=abc[1];b=abc[2];c=abc[3] if(b+c > Cmax) c(a, b+c-Cmax,Cmax) else c(a, 0, b+c) }
279:卵の名無しさん
18/11/20 11:38:32.07 +LTJHbMS.net
b2a <- function(abc){
a=abc[1];b=abc[2];c=abc[3]
if(b+a > Amax) c(Amax, b+a-Amax,c)
else c(b+a, 0, c)
}
c2a <- function(abc){
a=abc[1];b=abc[2];c=abc[3]
if(c+a > Amax) c(Amax, b, c+a-Amax)
else c(c+a, b, 0)
}
c2b <- function(abc){
a=abc[1];b=abc[2];c=abc[3]
if(c+b > Bmax) c(a, Bmax, c+b-Bmax)
else c(a, c+b, 0)
}
actions = c(a2b,a2c,b2c,c2a,c2a,c2b) # all pouring method
is.rim <- function(row,matrix){ # is row in matrix?
any(apply(matrix,1,function(x) all(x==row))) # comparble to %in%
}
is.goal <- function(x){ # goal reached?
all(x==goal)
}
280:卵の名無しさん
18/11/20 11:38:51.94 +LTJHbMS.net
pop <- function(){ # pop LIFO
if(is.null(.stack)) return()
LIFO=.stack[1,]
if(nrow(.stack)==1) .stack <<- NULL
else .stack <<- .stack[-1,] # changed GLOBALLY
return(LIFO)
}
push <- function(rows){ # push rows at head of stack
if(is.null(rows)) invisible(NULL) # no NULL show
else .stack <<- rbind(rows , .stack) # changed GLOBELY
}
transfer <- function(x){ # return unchekcked transferred state
re=NULL
for(fun in actions){ # try all methods
v=fun(x) # drop checked state and itself
if(!is.rim(v,.checked) & !all(v==x)) re=rbind(re,fun(x))
}
uni.re=unique(re) # delete duplicated
.checked <<- rbind(uni.re,.checked) # add to .checked GLOBELY
return(uni.re)
}
281:卵の名無しさん
18/11/20 11:39:23.04 +LTJHbMS.net
state=NULL
while(!is.goal(.stack[1,])){
push(transfer(pop()))
state=rbind(state,.stack[1,])
}
> state
[,1] [,2] [,3]
[1,] 3 7 0
[2,] 0 7 3
[3,] 3 4 3
[4,] 6 4 0
[5,] 6 1 3
[6,] 9 1 0
[7,] 9 0 1
[8,] 2 7 1
[9,] 2 5 3
[10,] 5 5 0
282:卵の名無しさん
18/11/20 13:27:38.76 +LTJHbMS.net
>>268
これだと無駄な手順も返しているな。
while(!is.goal(.stack[1,])){
tr=transfer(pop())
push(tr)
if(!is.null(tr))state=rbind(state,.stack[1,])
}
state
> state
[,1] [,2] [,3]
[1,] 3 7 0
[2,] 0 7 3
[3,] 6 4 0
[4,] 6 1 3
[5,] 9 1 0
[6,] 9 0 1
[7,] 2 7 1
[8,] 2 5 3
[9,] 5 5 0
283:卵の名無しさん
18/11/20 15:06:09.76 6Tvud5kf.net
i tried it in Showa u motherfucker. in that time niggers were supposed be in what niggahz were supposed to be motherfucking in, which we call a discrimination.
they pay shit loaded money to motherfucking niggers ass-bitch cocksucker fucking gringo homosexual hobo
i mean fuck you all go down hell
284:卵の名無しさん
18/11/20 17:14:24.57 +LTJHbMS.net
ようやくデバッグできた。
> state=t0
> while(!is.goal(.stack[1,])){
+ (p=pop())
+ (tr=transfer(p))
+ (.checked <<- unique(rbind(p,.checked))) # add to .checked GLOBELY
+ push(tr)
+ (.stack)
+ if(!is.null(transfer(.stack[1,]))) state=rbind(state,.stack[1,])
+ }
> rownames(state)=NULL
> colnames(state)=c(Amax,Bmax,Cmax)
> state
10 7 3
[1,] 10 0 0
[2,] 3 7 0
[3,] 3 4 3
[4,] 6 4 0
[5,] 6 1 3
[6,] 9 1 0
[7,] 9 0 1
[8,] 2 7 1
[9,] 2 5 3
[10,] 5 5 0
285:卵の名無しさん
18/11/20 17:15:16.68 +LTJHbMS.net
目的のノードを見つけたら終了する仕様だから、最短かどうかはわからないなぁ。
286:卵の名無しさん
18/11/20 17:21:50.40 cc4OhAKi.net
仕事しないとなぁ
287:卵の名無しさん
18/11/20 17:53:04.65 3jy0dpIg.net
>>264
>>251
んで、あんたどこ卒？
きっと凄いとこ出てますね、と言われるぞｗ
288:卵の名無しさん
18/11/20 18:23:06.98 cc4OhAKi.net
時給の良い仕事ないかなぁ？
289:卵の名無しさん
18/11/20 18:44:46.44 cc4OhAKi.net
ハローワークで警備の仕事があるなぁ。
290:卵の名無しさん
18/11/20 19:45:03.72 +LTJHbMS.net
# 問題 : 7 リットルと 3 リットルの容器を使って 5 リットルの水を測るにはどうすればいい？
> state
7 3
[1,] 0 0
[2,] 7 0
[3,] 4 3
[4,] 4 0
[5,] 1 3
[6,] 1 0
[7,] 0 1
[8,] 7 1
[9,] 5 3
[10,] 5 0
291:卵の名無しさん
18/11/20 20:18:02.67 HF+OgDBw.net
Prudence, indeed, will dictate that "uraguchi" long established cannot be changed for light and transient causes;
and accordingly all experience has shown, that BMS are more disposed to suffer, while evils are sufferable, than to right themselves by abolishing the forms from which they can pursue profit.
But when a long train of misbehavior and misconduct , showing invariably the same Imbecility evinces a design to reveal themselves as absolute Bona Fide Moron ,
it is their right, it is their duty, to expel such "uraguchi", and to provide new guards for their future security.
292:卵の名無しさん
18/11/20 22:25:53.92 cc4OhAKi.net
人間関係のない時給の良い仕事はないかなぁ？いじめられるからなぁ
293:卵の名無しさん
18/11/20 22:27:11.31 D0iJ9Tsc.net
It is common knowledge among doctors and patients that Do-Teihen(exclusively bottom-leveled medical school) graduates mean morons who bought their way to Gachi'Ura(currently called by themselves)
According to the experience of entrance exam to medical school in the era of Showa, when the sense of discrimination against
privately-founded medical schools were more intense than it is now,
all such schools but for Keio had been so compared to some specialized institution for educable mentally retarded kids that nobody but imbecile successors of physicians in private practice had applied for admission.
There had been NOT a single classmate who chose willingly against his/her common sense to go to the Do-Teihen(exclusively bottom-leveled medical school, currently also known as Gachi'Ura),
which would have cost outrageous money and its graduates are destined to be called Uraguchi morons who bought thier way into the Do-Teihen, by thier colleagues and even by thier own clients.
Although people won't call them names to their face,
certain 80-90% people of about my age have been yet scorning and sneering at Uraguchi graduates, speaking in the back of our mind,
" Uraguchi morons shall not behave like somebody."
We never speak out face to face in real life.
294:卵の名無しさん
18/11/20 22:32:57.27 cc4OhAKi.net
仕事ください
295:卵の名無しさん
18/11/20 22:39:03.37 cc4OhAKi.net
なんの取り柄もない私に仕事をください
296:卵の名無しさん
18/11/20 22:41:23.23 cc4OhAKi.net
なんかの資格があったらなぁ 仕事がないなぁ 今になって悔やんでしまう
297:卵の名無しさん
18/11/20 22:48:29.81 cc4OhAKi.net
金がない！
298:卵の名無しさん
18/11/20 22:51:11.25 cc4OhAKi.net
もっと金になる勉強をすべきだった 仕事がないなぁ
299:卵の名無しさん
18/11/20 22:57:18.11 cc4OhAKi.net
このまま 社会に出ずに 人生が終わってしまうのか？なんだったんだろう俺の人生�
300:ﾍ？
301:卵の名無しさん
18/11/20 23:39:20.88 cc4OhAKi.net
明日 また ハローワーク行こう！
302:卵の名無しさん
18/11/21 09:42:48.41 Jctp5Wds.net
>268-269のバグを指摘できていたら見直すのだが
底辺学力でできるのは>197のような漢字の誤変換だけ。
303:卵の名無しさん
18/11/21 12:38:48.27 m3dnATiO.net
ド底辺スレの定期上げ
304:卵の名無しさん
18/11/21 13:50:41.23 cCF4eIpe.net
じゃ、定期あげ
305:卵の名無しさん
18/11/21 15:05:19.22 UV5R2p03.net
>>277
幅優先探索だとこんな感じだな。
.que <<- t(as.matrix(t0))
transfer(c(0,0)) # 70 03
transfer(c(7,0)) # 43 73
transfer(c(4,3)) # 40
transfer(c(4,0)) # 13
transfer(c(1,3)) #10
transfer(c(1,0)) #01
transfer(c(0,1)) #71
transfer(c(7,1))#53
transfer(c(5,3))#50
transfer(c(7,3)) # NULL
transfer(c(0,3)) # 30
transfer(c(3,0)) # 33
transfer(c(3,3)) # 60
transfer(c(6,0)) # 63
transfer(c(6,3)) # 72
transfer(c(7,2)) # 02
transfer(c(0,2))# 10
transfer(c(2,0)) #23
transfer(c(2,3))#50
#
306:卵の名無しさん
18/11/21 20:50:08.75 5Xwsg5oK.net
It is common knowledge among doctors and patients that Do-Teihen(exclusively bottom-leveled medical school) graduates mean morons who bought their way to Gachi'Ura(currently called by themselves)
According to the experience of entrance exam to medical school in the era of Showa, when the sense of discrimination against
privately-founded medical schools were more intense than it is now,
all such schools but for Keio had been so compared to some specialized institution for educable mentally retarded kids that nobody but imbecile successors of physicians in private practice had applied for admission.
There had been NOT a single classmate who chose willingly against his/her common sense to go to the Do-Teihen(exclusively bottom-leveled medical school, currently also known as Gachi'Ura),
which would have cost outrageous money and its graduates are destined to be called Uraguchi morons who bought thier way into the Do-Teihen, by thier colleagues and even by thier own clients.
Although people won't call them names to their face,
certain 80-90% people of about my age have been yet scorning and sneering at Uraguchi graduates, speaking in the back of our mind,
" Uraguchi morons shall not behave like somebody."
We never speak out face to face in real life.
307:卵の名無しさん
18/11/21 21:27:39.69 m3dnATiO.net
非医師の人たちへむけて 今日の１曲
愛国戦隊大日本
308:卵の名無しさん
18/11/21 22:11:11.00 UV5R2p03.net
rm(list=ls())
graphics.off()
dlevy <- function (x,m,c) sqrt(c/2/pi)*exp(-c/2/(x-m))/(x-m)^3/2
set.seed(123)
dat=rgamma(1e4,1)
hist(dat,freq=F) ; summary(dat)
x=density(dat)$x ; y=density(dat)$y
lines(x,y)
f<-function(mc){
m=mc[1];c=mc[2]
sum((y-dlevy(x,m,c))^2)
}
(mc=optim(c(0,1),f, method='N')$par)
curve(dlevy(x,mc[1],mc[2]),add=T,col=2)
309:卵の名無しさん
18/11/21 22:12:01.19 UV5R2p03.net
>>294
これへの回答
あるデータ群に対して、確率密度関数のパラメータをフィッティングさせる方法ってないですか？
ちなみに、フィッティングさせたいのはレブィフライト確率密度関数です。
310:卵の名無しさん
18/11/21 22:46:03.55 uT58TBet.net
量子力学は？www
311:卵の名無しさん
18/11/21 23:46:11.38 tbX2fKWG.net
ボーズ粒子の実態は確率
312:卵の名無しさん
18/11/21 23:59:20.99 uT58TBet.net
国試諦めたんだねw
313:卵の名無しさん
18/11/22 00:06:46.65 jXQTlLg4.net
>>172
残念ながら、事務員じゃないのね。
こういうの書いているの俺な。
内視鏡検査について Part.2 [無断転載禁止](c)2ch.net
ｽﾚﾘﾝｸ(hosp板:875番)
875 名前：卵の名無しさん[sage] 投稿日：2018/11/14(水) 20:29:50.55 ID:lTkyjX2F
>>874
俺は肝弯より脾損傷の方がやだね。
開腹手術での受動時の経験と透視でのファイバーの動きを見る機会があるとこんなに可動性あったっけとか思う。
幸い脾損傷の経験はないけど、検査後に左肩への放散痛があったら疑わなくてはと思っている。
314:卵の名無しさん
18/11/22 00:32:25.51 by7Pc9VA.net
Prudence, indeed, will dictate that "uraguchi" long established cannot be changed for light and transient causes;
and accordingly all experience has shown, that BMS are more disposed to suffer, while evils are sufferable, than to right themselves by abolishing the forms from which they can pursue profit.
But when a long train of misbehavior and misconduct , showing invariably the same Imbecility evinces a design to reveal themselves as absolute Bona Fide Moron ,
it is their right, it is their duty, to expel such "uraguchi", and to provide new guards for their future security.
315:卵の名無しさん
18/11/22 19:48:22.68 EhyhVVko.net
30L 17L 13L
[1,] 30 0 0
[2,] 13 17 0
[3,] 13 4 13
[4,] 26 4 0
[5,] 26 0 4
[6,] 9 17 4
[7,] 9 8 13
[8,] 22 8 0
[9,] 22 0 8
[10,] 5 17 8
[11,] 5 12 13
[12,] 18 12 0
[13,] 18 0 12
[14,] 1 17 12
[15,] 1 16 13
[16,] 14 16 0
[17,] 14 3 13
[18,] 27 3 0
[19,] 27 0 3
[20,] 10 17 3
[21,] 10 7 13
[22,] 23 7 0
[23,] 23 0 7
[24,] 6 17 7
[25,] 6 11 13
[26,] 19 11 0
[27,] 19 0 11
[28,] 2 17 11
[29,] 2 15 13
[30,] 15 15 0
316:卵の名無しさん
18/11/22 22:15:42.49 jXQTlLg4.net
>>300
it is their right, it is their duty, to expel such "uraguchi", and to provide new guards for their future security.
この通り、実践すべき！
裏口入学の学生を除籍処分にしないかぎり、信頼の回復はないね。つまり、いつまで経ってもシリツ医大卒＝裏口バカと汚名は拭えない。シリツ出身者こそ、裏口入学に厳しい処分せよを訴えるべき。
裏口入学医師の免許剥奪を！の国民運動の先頭に立てばよいぞ。
僕も裏口入学とか、言ってたら信頼の回復はない。
317:卵の名無しさん
18/11/22 22:49:22.84 s6txpOAx.net
Prudence, indeed, will dictate that "uraguchi" long established cannot be changed for light and transient causes;
and accordingly all experience has shown, that BMS are more disposed to suffer, while evils are sufferable, than to right themselves by abolishing the forms from which they can pursue profit.
But when a long train of misbehavior and misconduct , showing invariably the same Imbecility evinces a design to reveal themselves as absolute Bona Fide Moron ,
it is their right, it is their duty, to expel such "uraguchi", and to provide new guards for their future security.
318:卵の名無しさん
18/11/23 07:36:18.66 t+QLwcrH.net
main = print $ length [(x,y)|x<-[-100..100],y<-[-100..100],7*x+3*y==5,abs x + abs y <= 100]
319:卵の名無しさん
18/11/23 07:45:24.89 Qqz1atCA.net
統計の話をしよう！！
サルを何千万匹殺しても無問題！！ただし、共産主義の香りづけをすれば
320:卵の名無しさん
18/11/23 08:10:20.25 QoVjbOvp.net
for x in range(-100,101):
for y in range(-100,101):
if(7*x+3*y==5 and x+y<=100):
print("(" + str(x) + "," + str(y) + ")")
321:卵の名無しさん
18/11/23 08:27:21.45 QoVjbOvp.net
>>306 debugged
for x in range(-100,101):
for y in range(-100,101):
if(7*x+3*y==5 and abs(x)+abs(y)<=100):
print("(" + str(x) + "," + str(y) + ")")
322:卵の名無しさん
18/11/23 08:28:05.53 QoVjbOvp.net
R
gr=expand.grid(-100:100,-100:100)
f=function(x,y) 7*x+3*y==5 & abs(x)+abs(y)<=100
sum(mapply(f,gr[,1],gr[,2]))
323:卵の名無しさん
18/11/23 08:29:57.03 QoVjbOvp.net
R
re=NULL
for(x in -100:100){
for(y in -100:100){
if(7*x+3*y==5 & abs(x)+abs(y)<=100){
re=rbind(re,(c(x,y)))}}}
nrow(re)
324:卵の名無しさん
18/11/23 10:32:55.82 QoVjbOvp.net
# Python
a=7; b=3; c=5
n=100
xy = []
for x in range(-n,n+1):
for y in range(-n,n+1):
if(a*x+b*y==c and abs(x)+abs(y)<=n):
xy.append([x,y])
print (len(xy))
print (xy)
325:卵の名無しさん
18/11/23 18:35:27.02 QoVjbOvp.net
# ある医院に１時間あたり平均５人の患者が来院し、その人数の分布はポアソン分布にしたがうとする。
# 1時間あたりの平均診療人数は６人（平均診療時間１０分）で、一人あたりの診療時間は指数分布に従うとする。
# 診察までの平均の待ち時間は何分か？
λ=5
μ=6
N=1e5
sum(rpois(N,λ)*rexp(N,μ))/N
w8t=replicate(1e3,sum(rpois(N,λ)*rexp(N,μ))/N)*60
summary(w8t)
シミュレーション結果も
> summary(w8t)
Min. 1st Qu. Median Mean 3rd Qu. Max.
49.33 49.88 50.01 50.01 50.14 50.61
理論値通りだな。
326:卵の名無しさん
18/11/23 19:10:32.75 QoVjbOvp.net
URLﾘﾝｸ(www.f.waseda.jp)
327:卵の名無しさん
18/11/23 22:53:03.27 t+QLwcrH.net
１時間に平均値５人の患者がくる医院で
次の患者がくるまでの時間が１０分以内である確率と
３０分以上である確率はいくらか？
328:卵の名無しさん
18/11/24 01:25:40.73 5hOk6q/8.net
It is common knowledge among doctors and patients that Do-Teihen(exclusively bottom-leveled medical school) graduates mean morons who bought their way to Gachi'Ura(currently called by themselves)
According to the experience of entrance exam to medical school in the era of Showa, when the sense of discrimination against
privately-founded medical schools were more intense than it is now,
all such schools but for Keio had been so compared to some specialized institution for educable mentally retarded kids that nobody but imbecile successors of physicians in private practice had applied for admission.
There had been NOT a single classmate who chose willingly against his/her common sense to go to the Do-Teihen(exclusively bottom-leveled medical school, currently also known as Gachi'Ura),
which would have cost outrageous money and its graduates are destined to be called Uraguchi morons who bought thier way into the Do-Teihen, by thier colleagues and even by thier own clients.
Although people won't call them names to their face,
certain 80-90% people of about my age have been yet scorning and sneering at Uraguchi graduates, speaking in the back of our mind,
" Uraguchi morons shall not behave like somebody."
We never speak out face to face in real life.
329:卵の名無しさん
18/11/24 11:07:29.76 wOJ88Y8z.net
deli <- function(course=90,hr=15,call=5){
# average 5 calls during 15 hours with 90 min delivery
k=call/hr
integrate(function(x)k*exp(-k*x),0,course/60)$value
}
vd=Vectorize(deli)
dc=0:180
plot(dc,vd(dc),type='l',lw
330:d=2,bty='l', xlab='Deli.course(min)',ylab='Prob of call')
331:卵の名無しさん
18/11/24 11:42:17.66 wOJ88Y8z.net
deli <- function(course=90,hr=15,call=5){
# average 5 calls during 15 hours with 90 min delivery
k=call/hr
integrate(function(x)k*exp(-k*x),0,course/60)$value
}
vd=Vectorize(deli)
dc=0:180
plot(dc,vd(dc),type='l',lwd=2,bty='l',
xlab='Deli.course(min)',ylab='Prob of call')
uniroot(function(x,u0=0.5)vd(x)-u0,c(0,180))$root
DH <- function(course=90,hr=15,call=5){
k=call/hr
x=course/60
1-exp(-k*x)
}
p2c=function(p,k=5/15) (-60*log(1-p)/k)
curve(p2c(x),bty='l',xlab='p',ylab='course(min)')
332:卵の名無しさん
18/11/24 13:12:14.88 owOvYQ4F.net
このスレの自称医者のほんまもん医師確率は？
検索した知識で医者を騙りMath
ｽﾚﾘﾝｸ(hosp板)
333:卵の名無しさん
18/11/24 14:11:47.95 4kuDQ9FR.net
こういうのを見ればわかるだろうに
URLﾘﾝｸ(egg.2ch.net)
>>878
>875は脾弯越えの操作でpullする時の話。
URLﾘﾝｸ(i.imgur.com)
馬鹿なのか、馬鹿じゃなきゃ、これにでも答えてみ！
１時間に平均値５人の患者がくる医院で
次の患者がくるまでの時間が１０分以内である確率と
３０分以上である確率はいくらか？
334:卵の名無しさん
18/11/24 14:18:05.42 4kuDQ9FR.net
>>316
これ用のスクリプト
18時から翌朝9時までの15時間の当直帯に平均5回のコールがある。当直室にデリヘル90分コースで呼んだとすると
デリヘル滞在中にコールされる確率はいくらか？
335:卵の名無しさん
18/11/24 16:38:49.21 wOJ88Y8z.net
two sample poisson test
パッケージでｐ値が異なるのでソースを確認。
X=2 ; Y=9
N=17877;M=16660
P=N/(N+M)
poisson.test(c(X,Y),c(N,M))$p.value
binom.test(X,X+Y,P)$p.value
library(rateratio.test)
rateratio.test(c(X,Y),c(N,M))$p.value
2*min(binom.test(X,X+Y,P,alt='l')$p.value,
binom.test(X,X+Y,P,alt='g')$p.value)
336:卵の名無しさん
18/11/24 17:00:00.40 wOJ88Y8z.net
救急車搬送数が日勤の８時間で０、夜勤の１６時間で５であったときに
夜勤帯の方が時間あたり救急搬送が多いと言えるか？
救急車搬送数はポアソン分布に従うとして有意水準５％で検定せよ。
日勤０のとき夜勤で何台以上の搬送があれば有意と言えるか？
rm(list=ls())
library(rateratio.test)
poisson.test(c(0,5),c(8,16))$p.value
rateratio.test(c(0,5),c(8,16))$p.value
x=0:20
y=sapply(x,function(x) poisson.test(c(1,x),c(8,16))$p.value)
plot(x,y,bty='l')
x[which.max(y<0.05)]
y=sapply(x,function(x) rateratio.test(c(1,x),c(8,16))$p.value)
plot(x,y,bty='l')
x[which.max(y<0.05)]
337:卵の名無しさん
18/11/24 17:01:06.35 wOJ88Y8z.net
>>321
日勤と夜勤でお看取り件数に差があるかも検定できるな。
338:卵の名無しさん
18/11/24 20:15:42.14 mGu7MkO8.net
Last but not least, three laws of Do-Teihen(lowest-tier) Medical School, currently called Gachi'Ura by its graduates.
It is not the bottom medical school but its enrollee that is despicable, which deserves to be called a bona fide moron beyond redemption.
The graduates of Do-Teihen are so ashamed that none of them dare to mention their own alma mater they had gone through.
The Do-Teihen graduates are so ashamed of having bought their way into the exclusively lowest-tier medical school
that they tend to call a genuine doctor a charlatan who elucidates their imbecility.
339:卵の名無しさん
18/11/24 20:20:35.00 4kuDQ9FR.net
f = function(A=1,B=2,N=100){
p=0
for (i in 1:N){
for(j in 0:(i-1)){
p=p+dpois(i,A)*dpois(j,B)}}
p
}
f()
f(1,3)
340:卵の名無しさん
18/11/24 20:31:46.81 4kuDQ9FR.net
soccer= function(A=1,B=2,N=1000){
pa=pd=0
for (i in 1:N){
for(j in 0:(i-1)){
pa=pa+dpois(i,A)*dpois(j,B)
pd=pd+dpois(i,A)*dpois(i,B)
}}
c(Awin=pa,Bwin=1-pa-pd,Draw=pd)
}
soccer()
341:卵の名無しさん
18/11/24 20:39:49.49 4kuDQ9FR.net
>>325
サッカーの勝敗確率
342:卵の名無しさん
18/11/24 20:47:34.09 4kuDQ9FR.net
>>326 debugged
soccer= function(A=5,B=10,N=100){
pa=pd=0
for (i in 1:N){
pd=pd+dpois(i,A)*dpois(i,B)
for(j in 0:(i-1)){
pa=pa+dpois(i,A)*dpois(j,B)
}}
c(Awin=pa,Bwin=1-pa-pd,Draw=pd)
}
343:卵の名無しさん
18/11/25 02:02:43.79 JOuyBVrN.net
ポイント乞食ご用達の楽天銀行に貯金していて、
楽天に口座凍結されて無一文になった世田谷のS君 元気？？
一応 開業医なのに楽天銀行って
慶応のOBらが泣いてるよww
344:卵の名無しさん
18/11/25 08:07:10.02 Vr8P87vG.net
マルコフの確認
(pexp(2+4,1/3)-pexp(2,1/3))/(1-pexp(2,1/3))
pexp(4,1/3)
345:卵の名無しさん
18/11/25 09:08:24.99 B7CJHmdM.net
k=15
a=20
b=30
(pexp(a+b,1/k)-pexp(a,1/k))/(1-pexp(a,1/k))
pexp(b,1/k)
346:卵の名無しさん
18/11/25 12:02:52.13 9toFqzz4.net
k=15
a=20
b=30
y=function(x) 1-exp(-x/k)
(y(a+b)-y(a))/(1-y(a))
y(b)
347:卵の名無しさん
18/11/25 12:19:14.40 9toFqzz4.net
>>327
debugged again
soccer= function(A=5,B=10,N=100){
if(A>B){
tmp=A
A=B
B=tmp
}
pa=pd=0
for (i in 1:N){
pd=pd+dpois(i,A)*dpois(i,B)
for(j in 0:(i-1)){
pa=pa+dpois(i,A)*dpois(j,B)
}}
c(Upset=pa,Ordinal=1-pa-pd,Draw=pd)
}
348:卵の名無しさん
18/11/25 12:22:57.28 9toFqzz4.net
debugged with equivalent routine
soccer= function(A=5,B=10,N=100){
if(A==B) return(c(c(Upset=0,Ordinal=0,Draw=1)))
if(A>B){
tmp=A
A=B
B=tmp
}
pa=pd=0
for (i in 1:N){
pd=pd+dpois(i,A)*dpois(i,B)
for(j in 0:(i-1)){
pa=pa+dpois(i,A)*dpois(j,B)
}}
return(c(Upset=pa,Ordinal=1-pa-pd,Draw=pd))
}
349:卵の名無しさん
18/11/25 12:45:46.33 9toFqzz4.net
>>333
if(A==B) return(c(c(Upset=0,Ordinal=0,Draw=1)))
は不要だな。
350:卵の名無しさん
18/11/25 12:49:45.63 9toFqzz4.net
サッカーの特典はポアソン分布に従うとされている。
PK戦はなしで考える。
平均得点２点のチームAと平均得点３点のチームBが戦ったとき
Aが勝つ確率、Bが勝つ確率 および 引き分けの確率を求めよ。
得点の上限Nを100として計算。
soccer= function(A=2,B=3,N=100){
if(A>B){
tmp=A
A=B
B=tmp
}
pa=pd=0
for (i in 1:N){
pd=pd+dpois(i,A)*dpois(i,B)
for(j in 0:(i-1)){
pa=pa+dpois(i,A)*dpois(j,B)
}}
return(c(Upset=pa,Ordinal=1-pa-pd,Draw=pd))
}
> soccer(2,3)
Upset Ordinal Draw
0.2469887 0.5920274 0.1609839
351:卵の名無しさん
18/11/25 12:52:38.63 9toFqzz4.net
>>335
１億回シミュレーションしてみた。
> sim <- function(A=2,B=3,K=1e8) {
+ a=rpois(K,A) ; b=rpois(K,B)
+ c(Upset=mean(a>b),Ordinal=mean(a<b),Draw=mean(a==b))
+ }
> sim()
Upset Ordinal Draw
0.2470561 0.5851947 0.1677492
ほぼ同じした結果がでて、気分が( ・∀・)ｲｲ!!
352:卵の名無しさん
18/11/25 14:41:03.20 9toFqzz4.net
λ0=3/60 # 平均到達率
μ0=4/60 # 平均サービス率 1/μ0 : 平均サービス時間
(ρ0=λ0/μ0) # 平均トラフィック密度
# □ ← ○○○○○○
ρ0/(1-ρ0)*(1/μ0)
ρ0/(1-ρ0)*(1/μ0)+1/μ0
# □ ← ○○○
# □ ← ○○○
(λ1=λ0/2)
(ρ1=λ1/μ0)
ρ1/(1-ρ1)*(1/μ0)
ρ1/(1-ρ1)*(1/μ0)+(1/μ0)
# □ ←
# \
# ○○○○○
# /
# □ ←
(μ2=2*μ0)
(ρ2=λ0/μ2)
2*ρ2^3/(1-ρ2^2) * (1/μ0)
2*ρ2^3/(1-ρ2^2) * (1/μ0) + (1/μ0)
# □□ ← ○○○○○○
(μ3=2*μ0)
(ρ3=λ0/μ3)
ρ3/(1-ρ3)*(1/μ3)
ρ3/(1-ρ3)*(1/μ3) + (1/μ3)
353:卵の名無しさん
18/11/25 15:33:46.37 9toFqzz4.net
>>331
答えから、指数分布のマルコフ性が導き出されていることを確認
354:卵の名無しさん
18/11/25 21:52:47.06 9toFqzz4.net
# 10分に2本の割合で電車が到着するダイヤ。
# それぞれの平均待ち時間を求めてみよう
# 5分おきのダイヤでの、平均待ち時間は何分か？
i=j=5
fij <- function(x){
if(x<i) return(i-x)
return(i+j-x)
}
fij=Vectorize(fij)
curve(fij(x),0,10,type='h')
integrate(fij,0,10)$value/10
# 2(=i)分後、8(=j)分後、と電車が到着するダイヤでの平均待ち時間は何分か？
i=2 ; j=8 # 8:00,8:02,8:10,8:12,8:20,...
fij <- function(x){
if(x<i) return(i-x)
return(i+j-x)
}
fij=Vectorize(fij)
curve(fij(x),0,i+j,type='h')
integrate(fij,0,i+j)$value/(i+j)
355:卵の名無しさん
18/11/25 22:09:31.18 9toFqzz4.net
# 8:15,8:50,
356:9:15,9:50,10:15,10:50.... i=50-15 ; j=60-(50-15) fij <- function(x){ if(x<i) return(i-x) return(i+j-x) } fij=Vectorize(fij) curve(fij(x),0,i+j,type='h') integrate(fij,0,i+j)$value/(i+j) (i*i/2+(60-i)*j/2)/(i+j)
357:卵の名無しさん
18/11/25 22:53:07.02 JHTxnUVJ.net
Prudence, indeed, will dictate that "uraguchi" long established cannot be changed for light and transient causes;
and accordingly all experience has shown, that BMS are more disposed to suffer, while evils are sufferable, than to right themselves by abolishing the forms from which they can pursue profit.
But when a long train of misbehavior and misconduct , showing invariably the same Imbecility evinces a design to reveal themselves as absolute Bona Fide Moron ,
it is their right, it is their duty, to expel such "uraguchi", and to provide new guards for their future security.
358:卵の名無しさん
18/11/26 00:38:59.24 ZChMNBQH.net
数学板の質問スレに俺でも答えられる問題がでるとホッとするな。
簡単すぎて誰も答えないからというのもあるが。
359:卵の名無しさん
18/11/26 01:19:35.09 ZChMNBQH.net
時刻表から平均待ち時間を算出する。
tt=c(0,10,13,20,23,30,40,47,50,60) # time table
ct2wt <- function(x){ # clock time to waiting time
n=length(tt)
if(x<=tt[1]){w8=tt[1]-x
}else{
for(i in 1:(n-1)){
if(tt[i]<=x & x<=tt[i+1]){
w8=(tt[i+1]-x)
break
}
}}
return(w8)
}
ct2wt=Vectorize(ct2wt)
curve(ct2wt(x),0,60,type='h',bty='l')
integrate(ct2wt,0,60)$value/60
x=diff(tt)
sum(x^2/2)/sum(x)
360:卵の名無しさん
18/11/26 01:24:22.62 iwt1L6U2.net
ちっちっ×××× ちっち××××
××××ち××××
へいたんな×× おうとつない
×××だけぷっくりしてるの
あまいあじがするから××てほしいな？
にゃにゃにゃにゃにゃにゃにゃん☆
ちっちっ×××× ちっち××××
××××ち××××
つるつるな×× おにくがない
しるくの×××ごこちなんだ
ほおずりですりすりっとしてほしいな？
×××××でいっぱい××て？
ぜんぶ××××から♪
ちっちっ×××× ちっち××××
××××ち××××
すべすべの×× おおきくない
けんこうにすっごくいいんだよ
ゆびさきで××××ってしてほしいな？ 👀
Rock54: Caution(BBR-MD5:1341adc37120578f18dba9451e6c8c3b)
361:卵の名無しさん
18/11/26 07:32:00.16 ZChMNBQH.net
>>343
Haskellの練習
Prelude> let tt = [0,10,13,20,23,30,40,47,50,60]
Prelude> let diff = zipWith (-) (tail tt) (init tt)
Prelude> sum (map (\x -> x^2/2) diff) / sum(diff)
3.95
362:卵の名無しさん
18/11/26 07:50:43.97 ZChMNBQH.net
>>343
python の 練習
import numpy as np
diff=np.diff([0,10,13,20,23,30,40,47,50,60])
print ( sum(map (lambda x: x**2/2,diff))/sum(diff ))
363:卵の名無しさん
18/11/26 07:51:08.82 ZChMNBQH.net
>>343
問題はこれ
東京駅からのぞみ号で朝8時から9時に出発する（9時発も可）。
無作為に選んだ8時台の時間に出発ホームに到着したとすると平均の待ち時間は何分か？
以下が東京8時台発のぞみ号の時刻表である。
8:00 8:10 8:13 8:20 8:23 8:30 8:40 8:47 8:50 9:00
364:卵の名無しさん
18/11/26 18:21:38.38 ZDBUmL4t.net
>>347
この問題を数学板に書いたら応用問題が返ってきた。
ある駅のホームの1番線には1時間ごと、2番線には(1/2)時間ごと、3番線には(1/3)時間ごとに電車が来るようにダイヤを組みたい。
ランダムな時間に駅に着いたときの平均待ち時間を最小にするには、どのようにダイヤを組めば良いか。
ただし、何番線の電車に乗っても向かう方向や停車駅に違いは無いとする。
プログラミングで簡単に解けた。
w8 <- function(xy,Print=FALSE){
x=xy[1];y=xy[2]
if(x<0|x>20|y<0|y>30)return(Inf)
tt=c(0,x,x+20,x+40,y,y+30,60)
tt=sort(tt)
d=diff(tt)
w=sum(d^2/2)/sum(d)
if(Print){
print(tt)
cat(sum(d^2/2),'/',sum(d))
}
return(w)
}
optim(par=c(0,0),w8,method='Nelder-Mead')
365:w8(c(10,15),P=T) optim(par=c(0,0),w8,method='Nelder-Mead',control=list(fnscale=-1)) w8(c(0,0),P=T)
366:卵の名無しさん
18/11/26 19:10:20.76 WZnn9Mtx.net
Last but not least, three laws of Do-Teihen(lowest-tier) Medical School, currently called Gachi'Ura by its graduates.
It is not the bottom medical school but its enrollee that is despicable, which deserves to be called a bona fide moron beyond redemption.
The graduates of Do-Teihen are so ashamed that none of them dare to mention their own alma mater they had gone through.
The Do-Teihen graduates are so ashamed of having bought their way into the exclusively lowest-tier medical school
that they tend to call a genuine doctor a charlatan who elucidates their imbecility.
367:卵の名無しさん
18/11/26 20:45:26.65 G0yfFsA6.net
>>348
１時間に４本の４番線にも拡大できるようにプログラムを一般化。
densha <- function(init,Print=FALSE){
init=c(0,init)
J=length(init)
if(any(init*(1:J)>60)|any(init<0)) return(60)
H=list()
for(i in 1:J){
H[[i]]=init[i]+60/i*(0:(i-1))
}
tt=sort(unlist(H))
tt=c(tt,tt[1]+60)
d=diff(tt)
w=sum(d^2/2)/sum(d)
if(Print){
print(H)
cat(sum(d^2/2),'/',sum(d),'\n')
}
return(w)
}
densha(c(15,10),P=T)
optim(par=c(10,10,10),densha,method='BFGS')
densha(c(15,10,7.5),P=T)
368:卵の名無しさん
18/11/27 08:33:47.65 WzO5TT32.net
Pn(t)=rho^n/n!P0(t) ,1<=n<=s
Pn(t)=rho^n/s!s^(n-s)P0(t) , n>=s
P0(t)= 1/{sigma[n=0,n=s]rho^m/n! + rho^(s+1)/(s!(s-rho))}
URLﾘﾝｸ(www.geocities.co.jp)
369:卵の名無しさん
18/11/27 08:48:31.40 WzO5TT32.net
Pn(t)=rho^n/n!P0(t) ,1<=n<=s
Pn(t)=rho^n/(s!s^(n-s))P0(t) , n>=s
P0(t)= 1/{sigma[n=0,n=s]rho^n/n! + rho^(s+1)/(s!(s-rho))}
URLﾘﾝｸ(www.geocities.co.jp)
MMS = function(t, n, lamda,mu,s){
rho=lamda/mu
sig=0
for(i in 0:n) sig=sig+rho^i/factorial(i)
p0t=1/( sig + rho^(s+1)/factorial(s)/(s-rho) )
ifelse(n >= s, rho^n/factorial(s)/s^(n-s)*p0t, rho^n/factorial(n)*p0t)
}
370:卵の名無しさん
18/11/27 09:47:23.68 WzO5TT32.net
MMS = function(n, lamda=1/20,mu=1/10,s=3){
rho=lamda/mu
sig=0
for(i in 0:s) sig=sig+rho^i/factorial(i)
p0=1/( sig + rho^(s+1)/factorial(s)/(s-rho) )
ifelse(n >= s, rho^n/factorial(s)/s^(n-s)*p0, rho^n/factorial(n)*p0)
}
1-sum(sapply(0:3,MMS))
371:卵の名無しさん
18/11/27 09:48:36.29 WzO5TT32.net
演習問題
 問題
 電話回線のチケット予約システムがあり、その窓口数は3であ
る
 予約の電話は平均して20秒に1回
 窓口は1件あたり10秒必要
 予約時3つの窓口がすべて応対中であれば話中になる
 このシステム全体を損失系M/M/3とみなせるとする
このとき、
 話中である確率を求めなさい
 話中となる確率を1%未満とするには、窓口はいくつ必要です
か？
372:卵の名無しさん
18/11/27 09:56:32.58 WzO5TT32.net
>>354 MMS = function(n, lamda=1/20,mu=1/10,s=3){
rho=s*lamda/mu
sig=0
for(i in 0:s) sig=sig+rho^i/factorial(i)
p0=1/( sig + rho^(s+1)/factorial(s)/(s-rho) )
ifelse(n >= s, rho^n/factorial(s)/s^(n-s)*p0, rho^n/factorial(n)*p0)
}
1-sum(sapply(0:3,MMS))
373:卵の名無しさん
18/11/27 09:57:04.81 WzO5TT32.net
MMS = function(n, lamda=1/20,mu=1/10,s=3){
rho=s*lamda/mu
sig=0
for(i in 0:s) sig=sig+rho^i/factorial(i)
p0=1/( sig + rho^(s+1)/factorial(s)/(s-rho) )
ifelse(n >= s, rho^n/factorial(s)/s^(n-s)*p0, rho^n/factorial(n)*p0)
}
1-sum(sapply(0:3,MMS))
374:卵の名無しさん
18/11/27 09:59:56.71 WzO5TT32.net
MMS = function(n, λ=1/20,μ=1/10,s=3){
ρ=s*λ/μ
sig=0
for(i in 0:s) sig=sig+ρ^i/factorial(i)
p0=1/( sig + ρ^(s+1)/factorial(s)/(s-ρ) )
ifelse(n >= s, ρ^n/factorial(s)/s^(n-s)*p0, ρ^n/factorial(n)*p0)
}
1-sum(sapply(0:3,MMS))
375:卵の名無しさん
18/11/27 10:36:18.18 WzO5TT32.net
MMS = function(n, λ=1/20,μ=1/10,s=3){
ρ=λ/μ
sig=0
for(i in 0:s) sig=sig+ρ^i/factorial(i)
p0=1/( sig + ρ^(s+1)/factorial(s)/(s-ρ) )
ifelse(n >= s, ρ^n/factorial(s)/s^(n-s)*p0, ρ^n/factorial(n)*p0)
}
376:卵の名無しさん
18/11/27 11:23:34.49 WzO5TT32.net
draft
.lambda=1/20
.mu=1/10
.s=1
MMS = function(n, lambda=.lambda ,mu=.mu,s=.s){
rho=lambda/mu
sig=0
for(i in 0:s) sig=sig+rho^i/factorial(i)
p0=1/( sig + rho^(s+1)/factorial(s)/(s-rho) )
ifelse(n >= s, rho^n/factorial(s)/s^(n-s)*p0, rho^n/factorial(n)*p0)
}
now8=function(x){
p=0
for(i in 0:x) p=p+MMS(i,s=x)
}
1-now8(1)
E=0
for(i in 0:1e4) E=E+i*MMS(i)
E*(1/.mu)
n=(1:10)[which.max(sapply(1:10,now8)>0.9)]
now8(n)
377:卵の名無しさん
18/11/27 12:44:46.57 RTIAbEXI.net
”お待たせしません”を謳い文句にした真面耶馬医院で
患者の来院は平均して20分に1人、診療は1人あたり10分とする。
診察医は一人。
謳い文句に反して患者が待たされる確率は？
患者の平均待ち時間は？
待たされる確率を10%以下にするには何人の医師が必要か？
待ち時間を３分以下にするには何人の医師が必要か？
lambda=1/20;mu=1/10
MMS = function(n, lambda ,mu, s){
rho=lambda/mu # rho < s
sig=0
for(i in 0:s) sig=sig+rho^i/factorial(i)
p0=1/( sig + rho^(s+1)/factorial(s)/(s-rho) )
# Pn : probability of n guests in system
Pn=ifelse(n >= s, rho^n/factorial(s)/s^(n-s)*p0, rho^n/factorial(n)*p0)
Ps=rho^s/factorial(s)*p0
L=rho + Ps*s*rho/(s-rho)^2 # guests in system
Lq=Ps*s*rho/(s-rho)^2 # guests in que
Wq=Lq/lambda # waiting time in que
c(`Pn(t)`=Pn,L=L,Lq=Lq,Wq=Wq)
}
# No Wait Probability
378:when s=x nwp=function(x,lambda,mu){ p=0 for(i in 0:x) p=p+MMS(i,lambda,mu,s=x) p } nwp(1,lambda,mu) nwp(2,lambda,mu)
379:卵の名無しさん
18/11/27 13:05:37.04 RTIAbEXI.net
問題（第１種情報処理技術者試験・平成元年度春期午前問１７を改題）
ある医院では、患者が平均１０分間隔でポアソン到着にしたがって訪ねてくることがわかった。
医者は１人であり、１人の患者の診断及び処方にかかる時間は平均８分の指数分布であった。
設問１ 患者が待ち始めてから、診断を受け始めるまでの「平均待ち時間」を求めなさい。
設問２ 待っている患者の平均人数を求めなさい。
設問３ 患者の「平均待ち時間」が６０分となるような平均到着間隔は約何分か？秒単位を
切り捨てた値を答えなさい。
これに
設問４ 「平均待ち時間」を１０分以下にするには同じ診察効率の医師が何人に必要か？
380:卵の名無しさん
18/11/27 13:53:38.67 RTIAbEXI.net
# ある医院では、患者が平均１０分間隔でポアソン到着にしたがって訪ねてくることがわかった。
# 医者は１人であり、１人の患者の診療にかかる時間は平均８分の指数分布であった。
# 「平均待ち時間」を5分以下にするには同じ診察効率の医師が何人に必要か？
# その最小人数で「平均待ち時間」を5分以下に保って診療するには１時間に何人まで受付可能か？
sapply(1:3,function(x) MMS(0,1/10,1/8,x)['Wq'])
MMS(0,1/10,1/8,s=2)
f= function(l) MMS(0,l,mu=1/8,s=2)['Wq']
v=Vectorize(f)
curve(v(x),bty='l',0,2/8) # rho=l/m < s , l < s*m
abline(h=5,lty=3)
60*uniroot(function(x)v(x)-5,c(0.1,0.2))$root
MMS(0,9.3/60,mu=1/8,s=2)
381:卵の名無しさん
18/11/27 15:40:44.01 RTIAbEXI.net
# M/M/S(s)
MMSs <- function(n,lambda,mu,s){
if(n > s) return(0)
rho=lambda/mu # rho < s
sig=0
for(i in 0:s) sig=sig+rho^i/factorial(i)
Pn=rho^n/factorial(n)/sig
return(Pn)
}
s=3
sapply(0:s,function(x) MMSs(x,1/20,1/10,s))
cnvg=function(x,lambda,mu) MMSs(x,lambda,mu,x) # 輻輳 convergence
vc=Vectorize(function(x) cnvg(x,10/60,1/30))
(1:10)[vc(1:10) < 0.05]
382:卵の名無しさん
18/11/27 18:51:54.59 sOmaXwxS.net
It is common knowledge among doctors and patients that Do-Teihen(exclusively bottom-leveled medical school) graduates mean morons who bought their way to Gachi'Ura(currently called by themselves)
According to the experience of entrance exam to medical school in the era of Showa, when the sense of discrimination against
privately-founded medical schools were more intense than it is now,
all such schools but for Keio had been so compared to some specialized institution for educable mentally retarded kids that nobody but imbecile successors of physicians in private practice had applied for admission.
There had been NOT a single classmate who chose willingly against his/her common sense to go to the Do-Teihen(exclusively bottom-leveled medical school, currently also known as Gachi'Ura),
which would have cost outrageous money and its graduates are destined to be called Uraguchi morons who bought thier way into the Do-Teihen, by thier colleagues and even by thier own clients.
Although people won't call them names to their face,
certain 80-90% people of about my age have been yet scorning and sneering at Uraguchi graduates, speaking in the back of our mind,
" Uraguchi morons shall not behave like somebody."
We never speak out face to face in real life.
383:卵の名無しさん
18/11/27 20:30:45.92 RTIAbEXI.net
mms <- function(n,lambda,mu,s,t=0,Print=TRUE){
alpha=lambda/mu
rho=lambda/s/mu # alpha=s*rho
sig0=0
for(i in 0:(s-1)) sig0=sig0+alpha^i/factorial(i)
P0=1/( sig0 + alpha^s/factorial(s-1)/(s-alpha) )
Pn=ifelse(n >= s, alpha^n/factorial(s)/s^(n-s)*P0, alpha^n/factorial(n)*P0)
Lq=lambda*mu*alpha^s/factorial(s-1)/(s*mu-lambda)^2*P0
L=Lq+alpha
Wq=Lq/lambda
#=mu*alpha^s/factorial(s-1)/(s*mu-lambda)^2*P0
W=Wq+1/mu
Pc=mu*P0*alpha^s/factorial(s-1)/(s*mu-lambda)
#=s^s*P0/factorial(s)*rho^s/(1-rho)
PTt=Pc*exp(-(1-rho)*s*mu*t)
output=c(P0=P0,Pn=Pn,Lq=Lq,L=L,Wq=Wq,W=W,Pc=Pc,PTt=PTt)
# P0:0 in system, Pn:n in system, Lq:guests in que, Wq: waiting time in que
# L:quests in system, W:total waiting time, Pc:all windows occupied,
# P: waiting time in que greater than t
if(Print) print(output,digits=3)
invisible(output)
}
mms(n=0,lambda=1/60,mu=1/10,s=1,t=0)
384:卵の名無しさん
18/11/27 20:40:29.10 2tUinJG4.net
It is common knowledge among doctors and patients that Do-Teihen(exclusively bottom-leveled medical school) graduates mean morons who bought their way to Gachi'Ura(currently called by themselves)
According to the experience of entrance exam to medical school in the era of Showa, when the sense of discrimination against
privately-founded medical schools were more intense than it is now,
all such schools but for Keio had been so compared to some specialized institution for educable mentally retarded kids that nobody but imbecile successors of physicians in private practice had applied for admission.
There had been NOT a single classmate who chose willingly against his/her common sense to go to the Do-Teihen(exclusively bottom-leveled medical school, currently also known as Gachi'Ura),
which would have cost outrageous money and its graduates are destined to be called Uraguchi morons who bought thier way into the Do-Teihen, by thier colleagues and even by thier own clients.
Although people won't call them names to their face,
certain 80-90% people of about my age have been yet scorning and sneering at Uraguchi graduates, speaking in the back of our mind,
" Uraguchi morons shall not behave like somebody."
We never speak out face to face in real life.
385:卵の名無しさん
18/11/27 21:06:39.05 RTIAbEXI.net
レジが1台ある。客の到着が１時間あたり平均１２人であり、
レジの所要時間が平均３分のとき，次の値を求めてみよう。
?到着したとき，すぐにサービスが受けられる確率
?系の中にいる人の平均人数
?サービスを待っている人の平均人数
?到着してからサービスを受けて去るまでの平均時間
?到着してからサービスを受けるまでの平均待ち時間
?客の到着が２倍の平均２４人になった。到着してからサービスを受けて去るまでの平均時間を変えないようにするには
レジの平均サービス時間を何分にすればよいか？求めてみよう。
386:卵の名無しさん
18/11/27 21:08:46.15 RTIAbEXI.net
筆算は面倒。数値を変えても算出できるようにした。
mms <- function(n,lambda,mu,s,t=0,Print=TRUE){
alpha=lambda/mu
rho=lambda/s/mu # alpha=s*rho
sig0=0
for(i in 0:(s-1)) sig0=sig0+alpha^i/factorial(i)
P0=1/( sig0 + alpha^s/factorial(s-1)/(s-alpha) )
Pn=ifelse(n >= s, alpha^n/factorial(s)/s^(n-s)*P0, alpha^n/factorial(n)*P0)
Lq=lambda*mu*alpha^s/factorial(s-1)/(s*mu-lambda)^2*P0
L=Lq+alpha
Wq=Lq/lambda
#=mu*alpha^s/factorial(s-1)/(s*mu-lambda)^2*P0
W=Wq+1/mu
Pc=mu*P0*alpha^s/factorial(s-1)/(s*mu-lambda)
#=s^s*P0/factorial(s)*rho^s/(1-rho)
PTt=Pc*exp(-(1-rho)*s*mu*t)
output=c(P0=P0,Pn=Pn,Lq=Lq,L=L,Wq=Wq,W=W,Pc=Pc,PTt=PTt)
# P0:0 in system, Pn:n in system, Lq:guests in que, Wq: waiting time in que
# L:quests in system, W:total waiting time, Pc:all windows occupied,
# P: waiting time in que greater than t
if(Print) print(output,digits=3)
invisible(output)
}
> mms(0,12/60,1/3,1)
P0 Pn Lq L Wq W Pc PTt
0.4 0.4 0.9 1.5 4.5 7.5 0.6 0.6
> uniroot(function(x) mms(0,24/60,1/x,1,P=F)['W']-7.5,c(0.1,2))$root
[1]
387: 1.874993
388:卵の名無しさん
18/11/27 23:07:59.15 RTIAbEXI.net
# M/M/s/K
MMSK <- function(lambda,mu,s,k){
alpha=lambda/mu
sig1=sig2=0
for(n in 0:s) sig1=sig1+alpha^n/factorial(n)
if(k>s) for(n in 1:(k-s)) sig2=sig2+alpha^s/s*(alpha/s)^n
Psk=s^s/factorial(s)*(alpha/s)^k/(sig1+sig2)
return(Psk)
}
MMSK(lambda=1/20,mu=1/10,s=3,k=3)
MMSS(n=3,l=1/20,m=1/10,s=3)
E2s <- function(alpha,s) MMSK(alpha,1,s,s)
E2s(0.5,3) # call loss, convergence α^s/s! / Σ[n=0,s]a^n/n!
a=seq(0,3,len=101)
plot(a,sapply(a,function(x)E2s(x,s=1)),type='l',bty='l',ylab='call loss prob.')
lines(a,sapply(a,function(x)E2s(x,s=2)),lty=2)
lines(a,sapply(a,function(x)E2s(x,s=3)),lty=3)
389:卵の名無しさん
18/11/27 23:08:01.08 yIHJQdw7.net
音楽の問題です
アヘ顔ダブルPEA～～～CE
v(゜∀。)v
390:卵の名無しさん
18/11/28 07:55:01.98 5n5kFcMp.net
f <- function() sum(rbinom(10,3,1/3)==rbinom(10,3,1/3))
g <- function(k) mean(replicate(k,f()))
h=Vectorize(g)
x=seq(1000,100000,by=1000)
re=h(x)
plot(x,re,pch=19,bty='l',ann=F)
391:卵の名無しさん
18/11/28 08:08:55.83 5n5kFcMp.net
f <- function() sum(rbinom(10,3,1/3)==rbinom(10,3,1/3))
g <- function(k) mean(replicate(k,f()))
h=Vectorize(g)
x=seq(1000,100000,by=1000)
re=h(x)
plot(x,re,pch=19,bty='l',ann=F)
x=rep(100,10000)
y=h(x)
cx=cumsum(x)
cy=cumsum(y)/1:10000
plot(cx,cy,type='l')
392:卵の名無しさん
18/11/28 13:47:18.06 5n5kFcMp.net
rm(list=ls())
n=10 ; lambda=10/60 ; mu=1/8
# service starc clock time(ssct) since 9:00
ssct=numeric(n)
# waiting time(w8)
w8=numeric(n)
# service end clock time(sect)
sect=numeric(n)
# arrival clock time(act)
set.seed(1234) ; act=round(cumsum(rexp(n,lambda)))
# duration of service(ds)
set.seed(5678) ; ds=round(rexp(n,mu))
# step by step
act
ds
ssct[1]=act[1] # 9:15
sect[1]=act[1]+ds[1] # 9:25
act[2] # 9:16
max(sect[1]-act[2],0) # 9:25-9:16 vs 0
w8[2]=max(sect[1]-act[2],0) # 9 min
ssct[2]=max(sect[1],act[2]) # 9:25 vs 9:16
sect[2]=ssct[2]+ds[2] # 9:25 + 8 = 9:33
act[3] # 9:17
max(sect[2]-act[3],0) # 9:33 - 9:17 vs 0
w8[3]=max(sect[2]-act[3],0) # 16 min
ssct[3]=max(sect[2],act[3]) # 9:33 vs 9:17
sect[3]=ssct[3]+ds[3] # 9:33 + 11 = 9:44
393:卵の名無しさん
18/11/28 15:01:41.58 5n5kFcMp.net
# ある医院に１時間あたり平均５人の患者が来院し、その人数の分布はポアソン分布にしたがうとする。
# 1時間あたりの平均診療人数は６人で、一人あたりの診療時間は指数分布に従うとする。
# 診察までの平均の待ち時間は何時間か？
rm(list=ls())
# Five patients comes every hour on average to the clinic,
# and the single physicaina treats six patients every hour on average.
# n=40 ; lambda=5/60 ; mu=6/60
MM1sim <- function(n=40,lambda=5/60,mu=6/60,seed=FALSE,Print=TRUE){
# service starc clock time(ssct) since 9:00
ssct=numeric(n)
# waiting time(w8)
w8=numeric(n)
# service end clock time(sect)
sect=numeric(n)
# arrival clock time(act)
if(seed) set.seed(1234) ;
act=round(cumsum(rexp(n,lambda)))
# duration of service(ds)
if(seed) set.seed(5678) ;
ds=round(rexp(n,mu))
# simulation assuming service starts at 9:00
head(act) # act : arrival clock time
head(ds) # ds : duration of service
# initial values
ssct[1]=act[1] # 9:15 service start clock time for 1st guest
sect[1]=act[1]+ds[1] # 9:25 sevice end clock time for 1st guest
w8[1]=0
394:卵の名無しさん
18/11/28 15:02:14.90 5n5kFcMp.net
# simulation step by step
#
# act[2] # 9:16 arrival clock time of 2nd
# max(sect[1]-act[2],0) # 9:25-9:16 vs 0 = ?sevice for 1st ends b4 2nd arrival
# w8[2]=max(sect[1]-act[2],0) # 9 min : w8ing time of 2nd
# ssct[2]=max(sect[1],act[2]) # 9:25 vs 9:16 = service start clock time for 2nd
# sect[2]=ssct[2]+ds[2] # 9:25 + 8 = 9:33 service end clock time for 2nd
#
# act[3] # 9:17 arrival clock time of 3rd
# max(sect[2]-act[3],0) # 9:33 - 9:17 vs 0 = ?serivce for 2nd ends b4 3rd arrival?
# w8[3]=max(sect[2]-act[3],0) # 16 min : w8ting time of 3rd
# ssct[3]=max(sect[2],act[3]) # 9:33 vs 9:17 = service start clock time for 3rd
# sect[3]=ssct[3]+ds[3] # 9:33 + 11 = 9:44 service end clock time for 3rd
#
for(i in 2:n){
w8[i]=max(sect[i-1]-act[i],0)
ssct[i]=max(sect[i-1],act[i])
sect[i]=ssct[i]+ds[i]
}
if(Print){
print(summary(w8))
hist(w8,freq=FALSE,col="lightblue",main="")
}
invisible(w8)
}
w8m=replicate(1e3,mean(MM1sim(P=F)))
summary(w8m)
395:卵の名無しさん
18/11/28 19:33:11.50 5n5kFcMp.net
>>374
行列の長さが変わらない定常状態達したら理論値通りに動作してい�
396:驍謔､だ。 エラー処理はしていなし、細かいバグがあるかもしれないが、 一応完成。 https://www.tutorialspoint.com/tpcg.php?p=7psmrQ
397:卵の名無しさん
18/11/28 21:10:01.72 CEw4d3xR.net
It is common knowledge among doctors and patients that Do-Teihen(exclusively bottom-leveled medical school) graduates mean morons who bought their way to Gachi'Ura(currently called by themselves)
According to the experience of entrance exam to medical school in the era of Showa, when the sense of discrimination against
privately-founded medical schools were more intense than it is now,
all such schools but for Keio had been so compared to some specialized institution for educable mentally retarded kids that nobody but imbecile successors of physicians in private practice had applied for admission.
There had been NOT a single classmate who chose willingly against his/her common sense to go to the Do-Teihen(exclusively bottom-leveled medical school, currently also known as Gachi'Ura),
which would have cost outrageous money and its graduates are destined to be called Uraguchi morons who bought thier way into the Do-Teihen, by thier colleagues and even by thier own clients.
Although people won't call them names to their face,
certain 80-90% people of about my age have been yet scorning and sneering at Uraguchi graduates, speaking in the back of our mind,
" Uraguchi morons shall not behave like somebody."
We never speak out face to face in real life.
398:卵の名無しさん
18/11/29 13:46:13.50 vdx9uljL.net
待ち行列理論の公式って
待ち行列の長さが変わらない定常状態での計算値だなぁ。
こういう設定に適応していいのか疑問があるな。
# Five clients comes every hour on average to the office,
# and the single clerk serves six clients every hour on average.
# n=40 ; lambda=5/60 ; mu=6/60
399:卵の名無しさん
18/11/29 13:47:25.88 vdx9uljL.net
シミュレーターを改良
MM1sim <- function(n=40,lambda=5/60,mu=6/60,
Lcount=FALSE,seed=FALSE,Brief=TRUE,Print=TRUE,Round=FALSE){
# n: how many clients, lambda: clients per hour, mu: service per hour
# Lcont: calculate clients in que, seed: ?set.seed
# Brief: ?show summary, Print: ?print graphs, Round: ?round result
# service starc clock time(ssct) since 9:00
ssct=numeric(n)
# waiting time in que(Wq)
Wq=numeric(n)
# waiting time from arrival to service end(W)
W=numeric(n)
# service end clock time(sect)
sect=numeric(n)
# arrival clock time(act)
if(seed) set.seed(1234)
act=cumsum(rexp(n,lambda)) ; if(Round) act=round(act)
# duration of service(ds)
if(seed) set.seed(5678)
ds=rexp(n,mu) ; if(Round) ds=round(ds)
# initial values
ssct[1]=act[1] # 9:15 service start clock time for 1st guest
sect[1]=act[1]+ds[1] # 9:25 sevice end clock time for 1st guest
Wq[1]=0
400:卵の名無しさん
18/11/29 13:47:48.53 vdx9uljL.net
for(i in 2:n){
Wq[i]=max(sect[i-1]-act[i],0)
ssct[i]=max(sect[i-1],act[i])
sect[i]=ssct[i]+ds[i]
}
W=Wq+ds
L=Lq=NA
if(Lcount){
ct2Lq <- function(ct){ # ct:clock time to Lq
sum(act<ct & ct<ssct)
}
Lq=mean(sapply(seq(0,max(ssct),len=1e4),ct2Lq)) # average clients in que
ct2L <- function(ct){ # ct:clock time to Lq
sum(act<ct & ct<sect)
}
L=mean(sapply(seq(0,max(ssct),len=1e4),ct2L)) # average clients in que
}
if(Brief){
cat("Lq = ",Lq,'\n',"summary of Waiting in que \n")
print(summary(Wq))
cat("L = ",L,'\n',"summary of total time since arrival \n")
print(summary(W))}
401:卵の名無しさん
18/11/29 13:48:05.65 vdx9uljL.net
if(Print){
par(mfrow=c(2,2))
hist(Wq,freq=FALSE,col="lightblue",main="Waiting time in que")
hist(W,freq=FALSE,col="lightgreen",main="Total time since arrival")
plot(sect,1:n,type='n',bty='l',ylab="client",xlab='clock time',
main=paste('average waiting time :',round(mean(Wq),2)))
segments(y0=1:n,x0=act,x1=ssct,col='gray')
points(act,1:n,pch=1)
points(ssct,1:n,pch=19)
points(sect,1:n,pch=3,cex=0.6)
legend('bottomright',bty='n',legend = c('arrival','service start','service end'),pch=c(1,19,3))
if(Lcount){ct=seq(0,max(ssct),len=1e4)
plot(ct,sapply(ct,ct2Lq),xlab="clock time",ylab="",main="clients in que",
type='s',bty='l')}
par(mfrow=c(1,1))
}
output=list(Wq=Wq,W=W,Lq=Lq,L=L,arrival=act,start=ssct,end=sect,duration=ds)
invisible(output)
}
MM1sim(n=40,Lcount=T,R=T,P=T,seed=F)
402:卵の名無しさん
18/11/29 14:01:23.60 vdx9uljL.net
来院数がポアソン分布（来院間隔は指数分布）、
診療時間はそれまでの患者の診療時間に影響されない（マルコフ性とか無記憶性と呼ばれる）ので指数分布
と仮定して、１時間に５人受診、診療時間は１０分を平均値として受診数を４０人としてシミュレーションすると
こんなにばらついた。
URLﾘﾝｸ(i.imgur.com)
URLﾘﾝｸ(i.imgur.com)
待ち時間行列理論でクリニックの待ち時間計算すると現実と大きく乖離すると思える。
403:卵の名無しさん
18/11/29 14:23:01.20 vdx9uljL.net
来院数がポアソン分布（来院間隔は指数分布）、
診療時間はそれまでの患者の診療時間に影響されない（マルコフ性とか無記憶性と呼ばれる）ので指数分布
と仮定して、１時間に５人受診、診療時間は１０分を平均値として受診数を４０人としてシミュレーション。
その結果
診療までの待ち時間
> summary(Wqm)
Min. 1st Qu. Median Mean 3rd Qu. Max.
1.793 11.828 19.204 26.041 34.621 164.905
診療終了までの時間
> summary(Wm)
Min. 1st Qu. Median Mean 3rd Qu. Max.
7.952 20.296 29.359 35.335 44.600 161.234
診療待ちの人数
> summary(Lqm)
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.1821 0.8501 1.5866 2.0976 2.7414 11.2506
404:卵の名無しさん
18/11/29 14:52:35.68 vdx9uljL.net
受診者数と平均待ち時間をシミュレーションしてみた。
受診者数が増えれば待ち行列時間の理論値５０分�
405:ﾉ収束していくようだ。 https://i.imgur.com/iFN6eAN.png
406:卵の名無しさん
18/11/29 17:16:02.63 pxHQyZHt.net
sim = function(){
x=cumsum(rexp(5,5/15))
x[4] < x[3]+1
}
mean(replicate(1e5,sim()))
pexp(1,5/15)
407:卵の名無しさん
18/11/29 19:04:59.01 vdx9uljL.net
>>384
定常状態での理論値
mms <- function(n,lambda,mu,s,t=0,Print=TRUE){
alpha=lambda/mu
rho=lambda/s/mu # alpha=s*rho
sig0=0
for(i in 0:(s-1)) sig0=sig0+alpha^i/factorial(i)
P0=1/( sig0 + alpha^s/factorial(s-1)/(s-alpha) )
Pn=ifelse(n >= s, alpha^n/factorial(s)/s^(n-s)*P0, alpha^n/factorial(n)*P0)
Lq=lambda*mu*alpha^s/factorial(s-1)/(s*mu-lambda)^2*P0
L=Lq+alpha
Wq=Lq/lambda
#=mu*alpha^s/factorial(s-1)/(s*mu-lambda)^2*P0
W=Wq+1/mu
Pc=mu*P0*alpha^s/factorial(s-1)/(s*mu-lambda)
#=s^s*P0/factorial(s)*rho^s/(1-rho)
PTt=Pc*exp(-(1-rho)*s*mu*t)
output=c(P0=P0,Pn=Pn,Lq=Lq,L=L,Wq=Wq,W=W,Pc=Pc,PTt=PTt)
# P0:0 in system, Pn:n in system, Lq:guests in que, Wq: waiting time in que
# L:quests in system, W:total waiting time, Pc:all windows occupied,
# P: waiting time in que greater than t
if(Print) print(output,digits=3)
invisible(output)
}
> mms(0,5/60,6/60,1)
P0 Pn Lq L Wq W Pc PTt
0.167 0.167 4.167 5.000 50.000 60.000 0.833 0.833
408:卵の名無しさん
18/11/29 21:16:08.05 W5xHj2Da.net
It is common knowledge among doctors and patients that Do-Teihen(exclusively bottom-leveled medical school) graduates mean morons who bought their way to Gachi'Ura(currently called by themselves)
According to the experience of entrance exam to medical school in the era of Showa, when the sense of discrimination against
privately-founded medical schools were more intense than it is now,
all such schools but for Keio had been so compared to some specialized institution for educable mentally retarded kids that nobody but imbecile successors of physicians in private practice had applied for admission.
There had been NOT a single classmate who chose willingly against his/her common sense to go to the Do-Teihen(exclusively bottom-leveled medical school, currently also known as Gachi'Ura),
which would have cost outrageous money and its graduates are destined to be called Uraguchi morons who bought thier way into the Do-Teihen, by thier colleagues and even by thier own clients.
Although people won't call them names to their face,
certain 80-90% people of about my age have been yet scorning and sneering at Uraguchi graduates, speaking in the back of our mind,
" Uraguchi morons shall not behave like somebody."
We never speak out face to face in real life.
409:卵の名無しさん
18/11/30 10:07:25.16 c4eruZjZ.net
rm(list=ls())
graphics.off()
par(mfrow=c(1,2))
a=360 ; b=1
R = function(t) ifelse(0<=t&t<=2*b,-a*t*(t-2*b),0)
N = integrate(R,0,2*b)$value ; (N=4*a*b^3/3)
A = function(t) ifelse(0<=t&t<=2*b,-a*t^3/3 +a*b*t^2,N)
curve(A(x),0,3,lwd=2,bty='l',xlab='t')
mu=100
n.win=2
c=n.win*mu
curve(R(x),0,3,lwd=2,bty='l',xlab='t') ; abline(h=2:3*mu,lty=1:2)
uniroot(function(t) R(t)-c,c(0,1))$root
d = sqrt(b^2-c/a)
t1 = b - d ; t1
Q <- function(t) A(t)-A(t1)-c*(t-t1)
curve(Q(x),0,3,bty='l') ; abline(h=0,col=8)
Q. <- function(t) -a*(t-t1)^3/3 + a*d*(t-t1)^2
curve(Q.(x),0,3,bty='l') ; abline(h=0,col=8)
optimize(Q,c(0,1))$minimum
uniroot(Q,c(1,3))$root ; t1+3*d ; (t4.1=b+2*d)
Q(2*b)/c +2*b; (t4.2=a/3/c*(b+d)^2*(2*d-b) +2*b)
par(mfrow=c(1,1))
curve(A(x),0,3,lwd=2,bty='l',xlab='t')
curve(x*N/t4.1,add=T)
integrate(Q.,t1,t4.1)$value ; 9/4*a*d^4
integrate(Q.,t1,2*b)$value + 1/2*(t4.2-2*b)*Q.(2*b) ; a/36*(b+d)^3/(b-d)*(4*b*d-b^2-d^2)
integrate(Q.,t1,t4.1)$value/N
(integrate(Q.,t1,2*b)$value + 1/2*(t4.2-2*b)*Q.(2*b))/N
min(9/4*a*d^4,a/36*(b+d)^3/(b-d)*(4*b*d-b^2-d^2))/N
410:卵の名無しさん
18/11/30 10:11:24.11 c4eruZjZ.net
c2Wq <- function(c,a=360,b=1){ #-> Wq:平均待ち時間
# R(t): 到着率関数 -at(t-2b)
# c:サービス率
R = function(t) ifelse(0<=t&t<=2*b,-a*t*(t-2*b),0)
N=4*a*b^3/3
d = sqrt(b^2-c/a)
min(case1=9/4*a*d^4/N,case2=a/36*(b+d)^3/(b-d)*(4*b*d-b^2-d^2)/N)
}
c2Wq(300)
411:卵の名無しさん
18/11/30 14:10:17.12 c4eruZjZ.net
rm(list=ls())
graphics.off()
par(mfrow=c(2,1))
a=360 ; b=1 # R(t) at(t-2b) 到着率関数[0,2b]
R = function(t) ifelse(0<=t&t<=2*b,-a*t*(t-2*b),0)
curve(R(x),0,3,bty='l',xlab='t')
N = integrate(R,0,2*b)$value ; 4*a*b^3/3 # 総人数
A = function(t) ifelse(t<=2*b,-a*t^3/3 +a*b*t^2,N) # 流入関数=∫Rdt
# = integerate(function(t) R(t),0,t) 0<t<2b
curve(A(x),0,3,bty='l',xlab='t')
mu=100 # 一窓口当たりのサービス率
n.win=2 # 窓口数
c=n.win*mu # 全サービス率
curve(R(x),0,3,bty='l',xlab='t') ; abline(h=2:3*mu,lty=1:2,col=8)
legend('center',bty='n',legend=c("２窓口","３窓口"),lty=c(1,2),col=8)
uniroot(function(t) R(t)-c,c(0,1))$root # 行列>0 : 流入率>サービス率
d = sqrt(b^2-c/a)
t1 = b - d ; t1 # 行列の始まる時刻(解析値) : 流入率=サービス率
Q <- function(t) A(t)-A(t1)-c*(t-t1) # 行列の人数 定義域無視
curve(Q(x),0,3,bty='l',xlab='t')
optimize(Q,c(0,1))$minimum
# 行列の終わる時刻
uniroot(Q,c(1,1e6))$root
t4 = ifelse(2*d<b,b+2*d,a/3/c*(b+d)^2*(2*d-b) +2*b) ; t4 #解析値
# 行列終了時刻 t4 < 2b : 入場締切前に行列0 (2*d<b)
if(2*d<b) c(t1+3*d, b+2*d)
# 行列終了時刻 t4 > 2b : 入場締切後に行列0 (2*d>b)
if(2*d>b) c(Q(2*b)/c +2*b, a/3/c*(b+d)^2*(2*d-b) +2*b)
Q <- function(t) ifelse(t1<=t & t<=t4 ,A(t)-A(t1)-c*(t-t1),0) # 行列の人数[t1,t4]
curve(Q(x),0,3,bty='l',type='h',xlab='t',ylab="Wq",col='navy')
412:卵の名無しさん
18/11/30 14:12:35.52 c4eruZjZ.net
Q.<- function(t){
if(t1<=t & t<= min(t4,2*b)) -a*(t-t1)^3/3 + a*d*(t-t1)^2}
# -a*(t-t1)^3/3 + a*d*(t-t1)^2 # 解析値[t1,min(t4,2b)]
tt=seq(t1,min(t4,2*b),len=1000)
lines(tt,sapply(tt,Q.),bty='l',type='l',xlab='t',ylab='Wq')
par(mfrow=c(1,1))
curve(A(x),0,3,bty='l',ylab='person',xlab='t',lwd=1,
main="到着率:at(t-2b) サービス率:200") # 累積入場者
curve(Q(x),0,3,col='navy',add=T,lwd=1,lty=3,type='h') # 待ち人数
tt=seq(0,3,len=1000)
lines(tt,sapply(tt,function(t)A(t)-Q(t)),lwd=2,col=4)
legend('right',bty='n',legend=c("流入総数","流出総数","待ち人数"),
col=c(1,4,1),lty=c(1,1,3),lwd=c(1,2,1))
integrate(Q,t1,t4)$value # 総待ち時間(＝縦軸方向積分面積Area
413: under curve) Wtotal=ifelse(2*d<b,9/4*a*d^4,a/36*(b+d)^3/(b-d)*(4*b*d-b^2-d^2)) ; Wtotal Wq=Wt/N ; Wq
414:卵の名無しさん
18/11/30 14:22:24.86 c4eruZjZ.net
数式を追うだけだと身につかないからプログラムに入力して自分でグラフを書いてみると理解が捗る。
自分がどこができていないもよく分かる。必要な計算ができないとグラフが完成できないから。
プログラムしておくとあとで数値を変えて再利用できるのが( ・∀・)ｲｲ!!
URLﾘﾝｸ(i.imgur.com)
415:卵の名無しさん
18/11/30 21:39:40.37 kXCX0lfh.net
Prudence, indeed, will dictate that "uraguchi" long established cannot be changed for light and transient causes;
and accordingly all experience has shown, that BMS are more disposed to suffer, while evils are sufferable, than to right themselves by abolishing the forms from which they can pursue profit.
But when a long train of misbehavior and misconduct , showing invariably the same Imbecility evinces a design to reveal themselves as absolute Bona Fide Moron ,
it is their right, it is their duty, to expel such "uraguchi", and to provide new guards for their future security.
416:卵の名無しさん
18/11/30 23:12:28.51 c4eruZjZ.net
#
source('tmp.tools.R') # 乱数発生にNeumann法
# 受付時間9:00-12:30,15:30-19:00
curve(10*(dgamma(x-9,2,1)+dgamma(x-16,8,5)),9,20,type='h') # 雛形
R <- function(x) ifelse((9<x&x<12.5)|(15.5<x&x<19),dgamma(x-9,2,1)+dgamma(x-16,8,5),0)
set.seed(123) ; data=vonNeumann2(function(x) R(x),9,19,Print=F)
N=100 # 来院患者数
n.win=1 # サービス窓口数
mu=8 # サービス率(１時間診察人数)
client=hist(data,freq=F,breaks=30,col='skyblue',main='',xlab='clock time')
breaks=client$breaks
y=client$counts/sum(client$counts)*N # 総数をN人に
# 到達率関数,離散量を連続関数に
R <- function(x) ifelse((9<x&x<12.5)|(15.5<x&x<19),y[which.max(x<=breaks)-1],0)
R=Vectorize(R)
curve(R(x),9,20,type='h',bty='l')
c=n.win*mu # 総サービス率
abline(h=c,col=8)
t1=uniroot(function(t)R(t)-c,c(9,10))$root ; t1 # 到達率＝サービス率で待ち時間開始
t2=uniroot(function(t)R(t)-c,c(16,17))$root ; t2 # 午後の部
417:卵の名無しさん
18/11/30 23:12:57.93 c4eruZjZ.net
tt=seq(9,24,len=1000)
Rtt=R(tt)
plot(tt,Rtt,type='s',bty='l')
cumR=cumsum(Rtt)/sum(Rtt)*N # cumsumで累積来院数をgrid化
plot(tt,cumR,type='l',bty='l')
A <- function(t) cumR[which.max(t<=tt)] # 離散量を連続関数に
A=Vectorize(A)
curve(A(x),9,24,bty='l')
Q <- function(t){ # 時刻tでの待ち人数
if(t<t1) return(0)
if(t1<t&t<t2) return(max(A(t)-A(t1)-c*(t-t1),0)) # 午前の部
else return(max(A(t)-A(t2)-c*(t-t2),0)) # 午後の部
}
Q=Vectorize(Q)
curve(Q(x),9,24,bty='l',type='h',col=2,ylab='persons',xlab='clock time')
# 待ちの発生と終了の時刻をグラフから読み取る
t15=seq(14,15,len=100) ; plot(t15,sapply(t15,Q)) # 14.6
t17=seq(16.9,17.2,len=100) ; plot(t17,sapply(t17,Q)) # 17.0
Q(22.7)
t22=seq(22.75,22.80,len=100) ; plot(t22,sapply(t22,Q)) # 22.8
curve(Q(x),9,24,bty='l',type='h',col=2,ylab='persons',xlab='clock time')
MASS::area(Q,9, 14.6,limit=20)/A(14.6) # 午前の待ち時間
MASS::area(Q,17,22.8,limit=20)/(A(22.8)-A(17)) # 午後の待ち時間
418:卵の名無しさん
18/11/30 23:51:07.01 c4eruZjZ.net
午前の受付９時から１２時３０分まで午後の受付１５時３０分から１９時までのクリニックに
図のような二峰性の分布で１００人が来院するとする。
URLﾘﾝｸ(i.imgur.com)
> breaks
[1] 9.0 9.5 10.0 10.5 11.0 11.5 12.0 12