TOP カテ一覧 スレ一覧 100～終まで 2ch元 削除依頼
自然対数ｅっていったい何者なの？
【数セミ】エレガントな解答をもとむ2【2016．11】
0.999…＝1か！？無限小数激論スレ★1
東京理科大学理学部数学科・数理情報学科
数学博士中退後就職できません。ご意見ください。
現代数学の系譜 カントル 超限集合論2
惑星ニビルの衝突
「コホモロジー」
統計ソフトSTATAの部屋 Ver.2
【万年】黒木玄を語ろう【助教】
「安倍がRば、日本は幸せになる」という命題があるとき、安倍が死んでないならこの命題は必ず真
- 1 ：2017/03/29 ～ 最終レス ：2020/01/25
- これマジ？
- 2 ：
- 【緊急拡散】森友学園問題のヤバすぎる真相を一発で理解できるコピペを拡散しよう！！！ 籠池泰典と辻元清美と在日ヤクザの真っ黒な繋がりが露わに！！！
http://www.news-us.jp/article/20170328-000007z.html
●●【辻本清美】 行状・素行 ・疑問&蛸の擬態となりすまし●●
https://www.youtube.com/watch?v=_ayYS_HQ2eg
民進・辻元清美氏に新たな「３つの疑惑」 民進党「拡散やめて」メディアに忖度要求
http://www.sankei.com/politics/news/170328/plt1703280002-n1.html
辻元清美（動画）← 検索してみる
https://www.youtube.com/results?search_query=%E8%BE%BB%E5%85%83%E6%B8%85%E7%BE%8E
マスコミ芸能界をパチンコマネーとヤクザの暴力で制圧した韓国人の恐るべし日本支配の手口を在日が実名で告白！？
https://www.youtube.com/watch?v=4NitS2eO6GY
在日議員
https://www.youtube.com/results?search_query=%E5%9C%A8%E6%97%A5%E8%AD%B0%E5%93%A1
【在日】鴨池氏（通名）について。
https://www.youtube.com/watch?v=H5FmrSDSgYc
【駆除 反日裁判官】 日本の異常なメディアと司法制度
https://www.youtube.com/watch?v=st0SlR3UriE
在日公務員
https://www.youtube.com/results?sp=SADqAwA%253D&q=%E5%9C%A8%E6%97%A5%E5%85%AC%E5%8B%99%E5%93%A1
公務員に在日韓国人の帰化人が多い理由 ← ●必見
http://ai.2ch.sc/test/read.cgi/koumu/1393060989/
反日害国人、反日帰化人の公務員採用完全撤廃デモin日本橋 1～5
https://www.youtube.com/watch?v=1hndyMuIDb8
- 3 ：
- 在日朝鮮人の未来のために
- 4 ：
- 悪魔の証明に関する記述はすべて間違い
これは何を言いたかったのかというと
悪魔＝犯罪者
そして自分が悪魔ではないことを証明するのは不可能
ようするに裁判とか司法は無意味ということであり
彼らが悪魔を作っている張本人である
- 5 ：
- 待ってりゃ、いつかは死ぬだろ。
- 6 ：
- 辻元清美議員おもしろいねえ
- 7 ：
- 晋太郎さんは1991/05/15 にお亡くなりです。合掌。
- 8 ：
- 晴明さんは寛弘2年9月26日（1005/10/31）にお亡くなりです。合掌。
晴明神社
京都市 上京区 堀川通一条上ル晴明町806
墓所
京都市 右京区 角倉町 嵯峨天竜寺12
アベノ晴明神社
大阪市 阿倍野区 阿倍野元町5-16
- 9 ：
- 仲麻呂さんは宝亀元年１月（770/01/ ）にお亡くなりです。合掌。
http://ja.wikipedia.org/wiki/%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB:Hyakuninisshu_007.jpg
- 10 ：
- 数学板、論理もできない頭弱いやつしかおらんのな
- 11 ：
- 糞スレ立てるまえに義務教育やり直せ
- 12 ：
- >>1はダメだね。
「安倍が死んでいれば、日本は幸せになる」という命題があるとき、安倍が死んでないならこの命題は必ず真
これなら正しいよ。
- 13 ：
- 「安倍が死んでいれば、日本は不幸になる」という命題があるとき、安倍が死んでないならこの命題は必ず真
これなら正しいよ。
- 14 ：
- >>12
「安倍が死んでいれば、日本は幸せになる」という命題が真であるとき、安倍が死んでないならこの命題は必ず真
ではないか？
- 15 ：
- >>14
なんで最初から真なのに、更に真偽を判断するんだ？ｗ
- 16 ：
- ￥
- 17 ：
- ￥
- 18 ：
- ￥
- 19 ：
- ￥
- 20 ：
- ￥
- 21 ：
- ￥
- 22 ：
- ￥
- 23 ：
- ￥
- 24 ：
- ￥
- 25 ：
- ￥
- 26 ：
- ／⌒~ヽノ~⌒＼ ＿／￣Ｚ＿
`/ ⌒ヾヾｿﾉﾉ⌒ヽヽ ／ ＿__ ＜
｜i /￣ヾノ￣ヽi | / ／ ＼＿＿ヽ
ﾉノ|ノ＼ ／ヽ |ヽし ﾚ｜ ＼ ／ ｜Ｎ
彡ノ-･- ii -･-ヽミｲ (｜-･-∧-･- ｜彡
ヽ( ー || ー )_ノ彡 .ﾋ | | ｿ
｜ ヽノ ｜彡 ｜ ‥ ｜
＼ ー― ＼／ ＼ ― ) ／
＼＿__／ ＼＿_／ル
／Ｖ▽ Ｖ＼ ／Ｖ>< Ｖ＼
売 国 罪 親 子
- 27 ：
- ★★★数学徒は馬鹿板をしない生活を送るべき。大脳が腐るのでサッサとヤメレ。★★★
￥
- 28 ：
- ￥
- 29 ：
- ￥
- 30 ：
- ￥
- 31 ：
- ￥
- 32 ：
- ￥
- 33 ：
- ￥
- 34 ：
- ￥
- 35 ：
- ￥
- 36 ：
- ￥
- 37 ：
- ￥
- 38 ：
- そのときは蓮舫は日本人であるか？
- 39 ：
- ★★★数学徒は馬鹿板をしない生活を送るべき。大脳が腐るのでサッサとヤメレ。★★★
￥
- 40 ：
- ￥
- 41 ：
- ￥
- 42 ：
- ￥
- 43 ：
- ￥
- 44 ：
- ￥
- 45 ：
- ￥
- 46 ：
- ￥
- 47 ：
- ￥
- 48 ：
- ￥
- 49 ：
- ￥
- 50 ：
- 「安倍がRば、日本は幸せになる」
「蓮舫がRば、日本人がひとりへる」
この命題の信義を投う
- 51 ：
- ★★★数学徒は馬鹿板をしない生活を送るべき。大脳が腐るのでサッサとヤメレ。★★★
￥
- 52 ：
- ￥
- 53 ：
- ￥
- 54 ：
- ￥
- 55 ：
- ￥
- 56 ：
- ￥
- 57 ：
- ￥
- 58 ：
- ￥
- 59 ：
- ￥
- 60 ：
- ￥
- 61 ：
- ￥
- 62 ：
- _／::::::::ソ:::::::::::::゛'ヽ、
/:::::-:::i´i|::|/:::::::::::::::::ヽ _,-=vィ彡ミﾐﾐヽ,
/:::::::,,ヽ"｀ "ヽﾐﾐ:::::::::::ヽ ﾐミ彡＝ミミﾐミミﾐﾐ,,
/::::::= `-:::::::ヽ ミ彡 ミミミﾐミミﾐミ
|::::::/ .,,,=≡, ,≡=、 l:::::l 売 彡! ＿_ ミミミﾐミミミ
／＼ i::::l゛ ／･＼,!.／･＼、l:::! /´| ミ! ＼_ _／~ ミミﾐ彡
＼／⌒ゝ' " ノ/ i＼ |:i 国 | | /´}!| ｀-=・=‐∧'-=・=‐' 川ﾐ
ノ ノ⌒,- ),､ ,ィ_____.iヽ i/ | | / / !| _ !!ﾐ
/´ ´ ' , ^ ヽ / l i ) 奴 rｰﾄ､ l' / ゞ|ヽ､ 人・ ・人 ﾉゞ
/ ヽ ﾉ"＼ノ`'''｀''''´ヽ _/ { ! {､ヽ. l ヽ| ､ ＿＿__ ル
人 ノ ＼／ `ー'´ ／ ﾊ_>Jﾉ l | .＼ `ヽｴｴノ ｿ
／::::＼__／:::::::ヽ ｀ "ーイ＿＿ 〉 ／ ト-_＿__-ノ 入
:::::::::::::::: |::::::::::＼＼__ ／ |:::::::::::＼ / / . ゝ-＿__..| ト ノﾉ ヽ＿
- 63 ：
- ★★★数学徒は馬鹿板をしない生活を送り、日頃から真面目に学問に精進すべき。★★★
￥
- 64 ：
- ￥
- 65 ：
- ￥
- 66 ：
- ￥
- 67 ：
- ￥
- 68 ：
- ￥
- 69 ：
- ￥
- 70 ：
- ￥
- 71 ：
- ￥
- 72 ：
- ￥
- 73 ：
- ￥
- 74 ：
- ■ 自民党戦略特区廃止法案提出へ
http://carpenter.2ch.sc/test/read.cgi/liveplus/1496420542/
【農業特区】 小泉進次郎 【モンサント外資へ売国】
http://egg.2ch.sc/test/read.cgi/sisou/1285092910/
【神奈川区】 石川たくみ 【アグリビジネスへの詐欺】
http://mint.2ch.sc/test/read.cgi/giin/1491719947/
【三浦市区】 吉田 英男 【公用車でソープランドに】
http://rio2016.2ch.sc/test/read.cgi/koumu/1489670675/
- 75 ：
- http://www.xvideos.com/video1795513/couple_fuck_at_xmas
- 76 ：
- またネトエラが暴れてんのか。
- 77 ：
- ★★★数学徒は馬鹿板をしない生活を送り、日頃から真面目に学問に精進すべき。★★★
￥
- 78 ：
- ￥
- 79 ：
- ￥
- 80 ：
- ￥
- 81 ：
- ￥
- 82 ：
- ￥
- 83 ：
- ￥
- 84 ：
- ￥
- 85 ：
- ￥
- 86 ：
- ￥
- 87 ：
- ￥
- 88 ：
- 耳栓をしたら世界が変わってワロタ
- 89 ：
- 次の演繹が正しいことを証明せよ。
すべての患者はすべての頭のよい医者を好む。
幾人かの患者はいかなるド底辺特殊シリツ医大卒をも好まない。
ゆえにすべてのド底辺特殊シリツ医大卒は頭がよくない。
(証明)
Dx : xは医者である
Wx : xは頭がよい
Sx : xはド底辺特殊シリツ医大卒である
Lpx : pはxを好む
P1 : ∀p∀x(Dx∧Wx→Lpx)
P2 : ∃p∀x(Dx∧Sx→￢Lpx)
Q : ∀x(Dx∧Sx→￢Wx)
￢Qを仮定すれば∃x(Dx∧Sx∧Wx)
これを満たすxをaとするとDa∧Sa∧Wa (1)
(1)からDa∧Wa (2)
P1と(2)から ∀p(Da∧Wa→Lpa)
∀p(Lpa) (3)
(1)からDa∧Sa (4)
P2と(4)から ∃p(Da∧Sa→￢Lpa)
これを満たすpをbとすると
Da∧Sa→￢Lba
￢Lba (5)
(3)はp=bでも成立するから
Lba (6)
(5)(6)は矛盾するから仮定の￢Qは誤り。
ゆえにQは真
- 90 ：
- # Lukasiewicz
library('gtools')
pm2=permutations(2,2,v=c(T,F),re=TRUE) ; pm2
pm3=permutations(2,3,v=c(T,F),re=TRUE) ; pm3
imply <- function(x,y) !x || y
eqv <- function(x,y) (!x||y)&&(!y||x)
for(i in 1:4) print(f1(pm2[i,]))
for(i in 1:8) print(f1(pm3[i,]))
# L1 : A->(B->A)
f <- function(A,B) imply(A,imply(B,A))
f1 <- function(pm) f(pm[1],pm[2])
for(i in 1:4) print(f1(pm2[i,]))
# L2 : (A->(B->C))->((A->B)->(A->C))
f <- function(A,B,C) imply(imply(A,imply(B,C)),imply(imply(A,B),imply(A,C)))
f1 <- function(pm) f(pm[1],pm[2],pm[3])
for(i in 1:8) print(f1(pm3[i,]))
# L3 : (!B->!A) -> (A->B)
f <- function(A,B,C) imply(imply(!B,!A),imply(A,B))
f1 <- function(pm) f(pm[1],pm[2],pm[3])
for(i in 1:8) print(f1(pm3[i,]))
# modus ponens A & (A->B) -> B
f <- function(A,B) imply(A && imply(A,B),B)
f1 <- function(pm) f(pm[1],pm[2])
for(i in 1:4) print(f1(pm2[i,]))
- 91 ：
- A∨B ⇔ ￢A→B
Bを￢Aとすれば
排中律 A∨￢Aは￢A→￢Aと同値。
公理L1 : p→(q→p)
公理L2 : (p→(q→r))→((p→q)→(p→r))
公理L3 : (￢q→￢p) → (p→q)
modus ponens(推論規則) A, A->B ⇒ B
(1)x→xの証明
L1,L2でp=x,q=x→x,r=xとすれば
x→((x→x)→x)
(x→((x→x)→x)) → ((x→(x→x))→(x→x))
ゆえに
((x→(x→x))→(x→x))
L1によりx→(x→x)は常に成り立つからx→x (1*)
(1*)でx=￢Aとすれば ￢A→￢A
即ち、排中律が演繹できる。
- 92 ：
- 二重否定律￢￢A→Aの証明
L1にp=￢a,q=￢bとして
￢a→(￢b→￢a)
￢aを仮定して
￢b→￢a
L3によりこれはa→b
ゆえに￢a→(a→b) (2*)
(2*)に a=￢A, b=￢￢￢Aとすると
￢￢A→(￢A→￢￢￢A)
L3にp=￢￢A, q=Aとすると
(￢A→￢￢￢A)→(￢￢A→A)
ゆえに
￢￢A→(￢￢A→A)
L2でp=￢￢A,q=￢￢A,r=Aとすれば
(￢￢A→(￢￢A→A))→((￢￢A→￢￢A)→(￢￢A→A))
なので
(￢￢A→￢￢A)→(￢￢A→A)
￢￢A→￢￢A ∵ (1*) x=￢￢A
￢￢A→A
- 93 ：
- 耳栓をしたら世界が変わってワロタ
- 94 ：
- ￥
- 95 ：
- ￥
- 96 ：
- ￥
- 97 ：
- ￥
- 98 ：
- ￥
- 99 ：
- ￥
- 100 ：
- ￥
- 101 ：
- ￥
- 102 ：
- ￥
- 103 ：
- ￥
- 104 ：
- 耳栓をしたら世界が変わってワロタ
- 105 ：
- ￥
- 106 ：
- 1000億円あれば 俺は幸福だ
この命題は正しいか？
- 107 ：
- ￥
- 108 ：
- ￥
- 109 ：
- ￥
- 110 ：
- ￥
- 111 ：
- ￥
- 112 ：
- ￥
- 113 ：
- ￥
- 114 ：
- ￥
- 115 ：
- ￥
- 116 ：
- ￥
- 117 ：
- 耳栓をしたら世界が変わってワロタ
- 118 ：
- ￥
- 119 ：
- 耳栓をしたら世界が変わってワロタ
- 120 ：
- ￥
- 121 ：
- >>106
前提が偽だから正しくなる という論理が正しいかというのがこのスレの趣旨。
- 122 ：
- ￥
- 123 ：
- ￥
- 124 ：
- ￥
- 125 ：
- ￥
- 126 ：
- ￥
- 127 ：
- ￥
- 128 ：
- ￥
- 129 ：
- ￥
- 130 ：
- ￥
- 131 ：
- ￥
- 132 ：
- 耳栓をしたら世界が変わってワロタ
- 133 ：
- ￥
- 134 ：
- 1億円あれば 俺は幸福だ
この命題は正しいか？
- 135 ：
- ￥
- 136 ：
- ￥
- 137 ：
- ￥
- 138 ：
- ￥
- 139 ：
- ￥
- 140 ：
- ￥
- 141 ：
- ￥
- 142 ：
- ￥
- 143 ：
- ￥
- 144 ：
- ￥
- 145 ：
- 耳栓をしたら世界が変わってワロタ
- 146 ：
- ￥
- 147 ：
- 小学レベルとバカプロ固定、
サイコパス
High level people、
低脳幼稚園児のAAお絵かき、
お断り！
小学生がたまにいますので、18金よろしくね！（＾＾
- 148 ：
- （A→￢A)→￢Aも恒真式
- 149 ：
- ￥
- 150 ：
- ￥
- 151 ：
- ￥
- 152 ：
- ￥
- 153 ：
- ￥
- 154 ：
- ￥
- 155 ：
- ￥
- 156 ：
- ￥
- 157 ：
- ￥
- 158 ：
- ￥
- 159 ：
- 証明でこの恒真式(もしくは公理）が出てくるといつも詐欺にあったような気になる。
P→(Q→P)
馬鹿ならば（シリツならば馬鹿である）
馬鹿ならば（裏口ならば馬鹿である）
￢P→(P→Q)
馬鹿でないなら（馬鹿であればシリツである）
馬鹿でないならば（馬鹿であれば裏口である）
Qとして天才とか変態とかを選んでも恒真式、というのは日常言語感覚からは乖離しているな。
ド底辺特殊シリツ医大を最高学府と呼ぶような気持ち悪さを覚える。
- 160 ：
- ￥
- 161 ：
- ￥
- 162 ：
- ￥
- 163 ：
- ￥
- 164 ：
- ￥
- 165 ：
- ￥
- 166 ：
- ￥
- 167 ：
- ￥
- 168 ：
- ￥
- 169 ：
- ￥
- 170 ：
- 耳栓をしたら世界が変わってワロタ
- 171 ：
- ￥
- 172 ：
- ￥
- 173 ：
- ￥
- 174 ：
- ￥
- 175 ：
- ￥
- 176 ：
- ￥
- 177 ：
- ￥
- 178 ：
- ￥
- 179 ：
- ￥
- 180 ：
- ￥
- 181 ：
- 耳栓をしたら世界が変わってワロタ
- 182 ：
- ￥
- 183 ：
- ￥
- 184 ：
- ￥
- 185 ：
- ￥
- 186 ：
- ￥
- 187 ：
- ￥
- 188 ：
- ￥
- 189 ：
- ￥
- 190 ：
- ￥
- 191 ：
- ￥
- 192 ：
- jags4prop <- function(r1,r2,n1,n2,
ROPEdiff=c(-0.025,0.025),ROPErate=c(0.80,1.25),
NNT=FALSE){
library(rjags)
y=c(rep(1,r1),rep(0,n1-r1),rep(1,r2),rep(0,n2-r2))
s=as.numeric(factor(c(rep('D',n1),rep('U',n2))))
a=1 ; b=1 # JAGS prior : beta(a,b)
myData=data.frame(y=y,s=s)
Ntotal = length(y)
Nsubj = length(unique(s))
dataList = list(
y = y ,
s = s ,
Ntotal = Ntotal ,
Nsubj = Nsubj
)
# JAGS model
modelString = paste0("
model {
for ( i in 1:Ntotal ) {
y[i] ~ dbern( theta[s[i]] )
}
for ( sIdx in 1:Nsubj ) {
theta[sIdx] ~ dbeta(", a,',' , b," )
}
}
")
writeLines( modelString , con="TEMPmodel.txt" )
jagsModel = jags.model( file="TEMPmodel.txt" , data=dataList, quiet=TRUE)
update(jagsModel)
codaSamples = coda.samples( jagsModel , variable="theta", n.iter=10000 )
mcmcMat=as.matrix(codaSamples)
risk1=mcmcMat[,1]
risk2=mcmcMat[,2]
x11()
par(mfrow=c(2,2))
BEST::plotPost(risk1,col='gray')
if(NNT){
BEST::plotPost(abs(1/(risk1-risk2)), xlab ='NNT(NNH)',col='pink')}
else{
BEST::plotPost(risk1-risk2,compVal=0,ROPE=ROPEdiff,cex=1,col='pink')
}
BEST::plotPost(risk2,col='gray')
BEST::plotPost(risk1/risk2,compVal=1,ROPE=ROPErate,col='skyblue')
invisible(codaSamples)
}
jags4prop(r1=1,n1=1,r2=0,n2=1,ROPEdiff=NULL,NNT=TRUE)
jags4prop(r1=1,n1=1,r2=0,n2=1,ROPEdiff=NULL)
- 193 ：
- f<- function(d=1,beta=.80,alpha=.05) 2*(abs((qnorm(1-alpha/2))+abs(qnorm(1-beta)))/d)^2
f(5/10)
power.t.test(delta=0.5,power=0.80)$n
# power 50%->82%
dd=seq(0.01,0.99,by=0.01)
g<- function(x) f(x,.50)/f(x,.80)
summary (sapply(dd,g))
(2*(abs(1.96+abs(qnorm(1-0.80))))^2)/(2*(abs(1.96+abs(qnorm(1-0.50))))^2)
(1.96+0.84)^2/(1.96+0)^2
dd=seq(0.01,0.99,by=0.01)
h<-function (x,pow1=0.80,pow2=0.50){
power.t.test(d=x, power=pow1)$n/power.t.test(d=x, power=pow2)$n
}
res=sapply (dd,h)
plot(dd,res)
summary (res)
# power 80%->92%
f(beta=0.90)
f(beta=0.80)
(2*(abs(1.96+abs(qnorm(1-0.90))))^2)/(2*(abs(1.96+abs(qnorm(1-0.80))))^2)
res1=sapply (dd, function (x) h(x,0.90,0.80))
plot (dd,res1)
# power 80%->101%
f(beta=0.99)
f(beta=0.80)
(2*(abs(1.96+abs(qnorm(1-0.99))))^2)/(2*(abs(1.96+abs(qnorm(1-0.80))))^2)
res2=sapply (dd, function (x) h(x,0.99,0.80))
plot (dd,res2)
##
f<- function(d=1,beta=.80,alpha=.05) 2*(abs((qnorm(1-alpha/2))+abs(qnorm(1-beta)))/d)^2
f()
sample.size <- function (d=1,beta=0.80,alpha=0.05){
f<- function(n) 2*((abs(qt(1-alpha/2,n-1))+abs(qt(1-beta,n-1)))/d)^2 - n
uniroot (f, c(3,10000))$root
}
sample.size()
power.t.test(d=1, power=0.80)$n 👀
Rock54: Caution(BBR-MD5:0be15ced7fbdb9fdb4d0ce1929c1b82f)
- 194 ：
- 慶應義塾学医学部 2051 70
順天堂大学医学部 2090 66
昭和大学医学部 2200 65
東京慈恵会医科大学医学部 2250 69
自治医科大学医学部 2260 66
産業医科大学医学部 2749 65
日本医科大学医学部 2813 66
東京医科大学医学部 2995 64
関西医科大学医学部 3014 65
大阪医科大学医学部 3141 66
東邦大学医学部 3180 62
久留米大学医学部 3237 61
東京女子医科大学医学部 3284 60
日本大学医学部 3310 61
岩手医科大学医学部 3400 60
聖マリアンナ医科大学医学部 3440 58
近畿大学医学部 3580 62
藤田保健衛生大学医学部 3650 60
獨協医科大学医学部 3660 59
帝京大学医学部 3750 59
杏林大学医学部 3755 61
東海大学医学部 3760 61
福岡大学医学部 3770 60
愛知医科大学医学部 3800 59
埼玉医科大学医学部 3800 57
兵庫医科大学医学部 3880 60
北里大学医学部 3890 60
金沢医科大学医学部 3950 58
川崎医科大学医学部 4565 57
dat=read.table("clipboard")
colnames(dat)=c("school","tuition","hensa")
head(dat)
xi=dat$hensa
yi=dat$tuition
re=lm(yi~xi) ; re
beta1.hat=re$coef[1]
beta10=0
n=length(xi)
Sxx=var(xi)*(n-1)
Syy=var(yi)*(n-1)
Sxy=cov(xi,yi)*(n-1)
beta1.hat=Sxy/Sxx
Se=Syy - Sxy^2/Sxx
phie=n-2
Ve=Se/phie
t0=(beta1.hat-beta10)/sqrt(Ve/Sxx) ; t0
curve(dt(x,n-2),-5,5,bty='l')
pt(t0,n-2)
> t0=(beta1.hat-beta10)/sqrt(Ve/Sxx) ; t0
[1] -10.17626
> pt(t0,n-2)
[1] 4.873385e-11
- 195 ：
- # Lindner Center data on 996 PCI patients analyzed by Kereiakes et al. (2000)
library(MatchLinReg)
data("lindner")
head(lindner)
attach(lindner)
(tbl=table(stent,sixMonthSurvive))
Epi::twoby2(tbl)
formula.stent = stent ~ abcix + height + female + diabetic + acutemi +
ejecfrac + ves1proc - 1
formula.6month = sixMonthSurvive ~ stent+ abcix + height + female + diabetic + acutemi +
ejecfrac + ves1proc - 1
rms::lrm( stent ~ abcix + height + female + diabetic + acutemi +
ejecfrac + ves1proc-1, data=lindner)$stat['C']
ps=re.glm$fitted.values
Y=lindner$sixMonthSurvive
Tr=lindner$stent
# IPWE
weighted.mean(Y,Tr/ps) - weighted.mean(Y,(1-Tr)/(1-ps))
## (Doubly Robust: DR)
dre <- function(data, target, treat, ps, formula) {
n <- nrow(data)
y <- data[target]
z <- data[treat]
data1 <- data[data[treat]==1,]
data0 <- data[data[treat]==0,]
model1 <- lm(formula=formula, data=data1)
model0 <- lm(formula=formula, data=data0)
fitted1 <- predict(model1, data)
fitted0 <- predict(model0, data)
dre1 <- (1/n)*sum(y+((z-ps)/ps)*(y-fitted1))
dre0 <- (1/n)*sum(((1-z)*y)/(1-ps)+(1-(1-z)/(1-ps))*fitted0)
c(treated=dre1,control=dre0,ATE=dre1-dre0)
}
dre(data=lindner,target='sixMonthSurvive',treat='stent', ps=ps, formula=sixMonthSurvive ~ abcix + height
+ female + diabetic + acutemi +ejecfrac + ves1proc -1)
- 196 ：
- # http://www1.udel.edu/educ/gottfredson/reprints/2009semen.pdf
cor2ci<- function(cor,n,conf.level=0.95){
lower=tanh(atanh(cor) + qnorm((1-conf.level)/2)/sqrt(n-3))
upper=tanh(atanh(cor) - qnorm((1-conf.level)/2)/sqrt(n-3))
data.frame(lower,cor,upper)
}
cor2p <- function(cor,n,alternative='two.sided'){
r=cor
t.stat=r*sqrt(n-2)/sqrt(1-r^2)
if(alternative=='two.sided'){
p.value=pt(-abs(t.stat),n-2)*2
}else{
p.value=pt(-abs(t.stat),n-2)
}
return(p.value)
}
cor2p(0.14,425)
rs=c(conc=0.15,count=0.19,Motility=0.14)
n=425
cor2ci(rs,n)
sapply(rs,function(cor)cor2p(cor,n=425))
#
r2p <- function(r,n){
2*pt(-abs(r)*sqrt(n-2)/sqrt(1-r^2),n-2)
}
# 0.002=r2p(0.15,n)
curve(r2p(rs[1],x),300,600)
abline(h=0.002,lty=3)
uniroot(function(n,p0=0.0015)r2p(rs[1],n)-p0,c(100,1000))$root # 445
uniroot(function(n,p0=0.0020)r2p(rs[1],n)-p0,c(100,1000))$root # 422
uniroot(function(n,p0=0.0025)r2p(rs[1],n)-p0,c(100,1000))$root # 404
r2p(rs[1],425)
# 0.002=r2p(0.14,n)
curve(r2p(rs[3],x),300,600)
abline(h=0.002,lty=3)
uniroot(function(n,p0=0.0015)r2p(rs[3],n)-p0,c(100,1000))$root # 511
uniroot(function(n,p0=0.0020)r2p(rs[3],n)-p0,c(100,1000))$root # 484
uniroot(function(n,p0=0.0025)r2p(rs[3],n)-p0,c(100,1000))$root # 464
r2p(rs[3],425)
r2p(rs[3],c(445,422,404))
r2p(0.19,425)
- 197 ：
- ｎｏｉｓｅ２ｓｉｇ ＜－ ｆｕｎｃｔｉｏｎ（ｓｅｅｄ，ｓｅｑｕｅｎｔｉａｌ＝ＦＡＬＳＥ）｛
ｓｅｔ．ｓｅｅｄ（ｓｅｅｄ）
Ｎｏｉｓｅ＝ｍａｔｒｉｘ（ｒｎｏｒｍ（１００＊５１），ｎｃｏｌ＝５１，ｎｒｏｗ＝１００）
＃ ｆｉｒｓｔ ｐａｓｓ
ｌｍ１＝ｌｍ（Ｎｏｉｓｅ［，５１］ ～ Ｎｏｉｓｅ［，－５１］） ＃ Ｎｏｉｓｅ［，５１］ ： 目的変数Ｙ
ｃａｔ（＇\ｎＲ２ （１ｓｔ） ＝ ＇，ｓｕｍｍａｒｙ（ｌｍ１）＄ｒ．ｓｑｕａｒｅｄ）
ｃａｔ（＇\ｎｐ．ｖａｌｕｅ （１ｓｔ） ＝ ＇，ａｎｏｖａ（ｌｍ１）＄Ｐｒ［１］）
ｃｏｅｆｓ１＝ｓｕｍｍａｒｙ（ｌｍ１）＄ｃｏｅｆ［，＇Ｐｒ（＞｜ｔ｜）＇］
ｌｅｎｇｔｈ（ｃｏｅｆｓ１）
ｃｏｅｆｓ１［１］
ｃｏｅｆｆｓ１＝ｃｏｅｆｓ１［－１］
ｃａｔ（＇\ｎｃｏｅｆ ＜ ０．２５ ＝＇，ｓｕｍ（ｃｏｅｆｆｓ１＜０．２５））
ｃａｔ（＇\ｎｃｏｅｆ ＜ ０．０５ ＝＇，ｓｕｍ（ｃｏｅｆｆｓ１＜０．０５））
ｉｎｄｘ２５＝ｗｈｉｃｈ（ｃｏｅｆｆｓ１＜０．２５）
＃ ｓｅｃｏｎｄ ｐａｓｓ
ｌｍ２＝ｌｍ（Ｎｏｉｓｅ［，５１］ ～ Ｎｏｉｓｅ［，ｉｎｄｘ２５］）
ｃａｔ（＇\ｎ\ｎＲ２ （２ｎｄ） ＝ ＇，ｓｕｍｍａｒｙ（ｌｍ２）＄ｒ．ｓｑｕａｒｅｄ）
ｃａｔ（＇\ｎｐ．ｖａｌｕｅ（２ｎｄ） ＝ ＇，ａｎｏｖａ（ｌｍ２）＄Ｐｒ［１］）
ｃｏｅｆｓ２＝ｓｕｍｍａｒｙ（ｌｍ２）＄ｃｏｅｆ［，＇Ｐｒ（＞｜ｔ｜）＇］
ｌｅｎｇｔｈ（ｃｏｅｆｓ２）
ｃｏｅｆｓ２［１］
ｃｏｅｆｆｓ２＝ｃｏｅｆｓ２［－１］
ｃａｔ（＇\ｎｃｏｅｆ ＜ ０．２５ （２ｎｄ） ＝＇，ｓｕｍ（ｃｏｅｆｆｓ２＜０．２５））
ｃａｔ（＇\ｎｃｏｅｆ ＜ ０．０５ （２ｎｄ） ＝＇，ｓｕｍ（ｃｏｅｆｆｓ２＜０．０５））
ｃａｔ（＇\ｎ\ｎ＇）
ｉｆ（ｓｅｑｕｅｎｔｉａｌ）｛
ｃａｔ（＇Ｈｉｔ Ｒｅｔｕｒｎ Ｋｅｙ ｉｎ ｃｏｎｓｏｌｅ ｗｉｎｄｏｗ＇）
ｎｏ＿ｓａｖｅ ＜－ ｓｃａｎ（ｎ＝１， ｗｈａｔ＝ｃｈａｒａｃｔｅｒ（）， ｑｕｉｅｔ＝ＴＲＵＥ）
｝
｝
ｎｏｉｓｅ２ｓｉｇ（１）
ｆｏｒ（ｉ ｉｎ ２：５） ｎｏｉｓｅ２ｓｉｇ（ｉ，ｓｅｑ＝ＴＲＵＥ）
- 198 ：
- > UG
1年度 2年度 3年度 4年度 5年度 6年度
学生1 30 45 42 31 47 35
学生2 42 18 46 42 42 52
学生3 51 39 23 45 44 41
学生4 28 56 26 49 41 33
学生5 51 48 31 48 42 37
学生6 41 58 27 37 38 30
学生7 20 31 42 16 31 29
学生8 45 42 54 55 46 50
学生9 61 35 34 38 47 34
学生10 44 32 23 30 29 56
> mUG=reshape2::melt(UG) ; colnames(mUG)=c('学生','年度','成績')
> Tk=TukeyHSD(aov(成績~学生,mUG))
> p.Tk=Tk[[1]][,'p adj']
> n9=nrow(UG)-1
> mat.Tk=matrix(rep(NA,n9*n9),n9)
> for(k in 1:9) mat.Tk[,k]=c(rep(NA,k-1), p.Tk[((k-1)*(n9+1-k/2)+1):((k-1)*(n9+1-k/2)+1+n9-k)])
> colnames(mat.Tk)=paste0('学生',1:9)
> rownames(mat.Tk)=paste0('学生',2:10)
> d=round(mat.Tk,3)
> d[is.na(d)]='-'
> print(d,quote=FALSE)
学生1 学生2 学生3 学生4 学生5 学生6 学生7 学生8 学生9
学生2 1 - - - - - - - -
学生3 1 1 - - - - - - -
学生4 1 1 1 - - - - - -
学生5 0.998 1 1 0.999 - - - - -
学生6 1 1 1 1 0.999 - - - -
学生7 0.742 0.513 0.493 0.687 0.257 0.724 - - -
学生8 0.724 0.9 0.911 0.776 0.989 0.742 0.023 - -
学生9 1 1 1 1 1 1 0.383 0.958 -
学生10 1 0.998 0.997 1 0.958 1 0.945 0.418 0.989
>
- 199 ：
- > REDWHITECOLOR(perm[indx,])
RED = 5 8 7 WHITE = 3 9 6 1 8 COLOR = 4 0 2 0 5
- 200 ：
- # ド底辺＋シリツ＝裏口馬鹿
x=LETTERS[1:10]
uraguchi <- function(A,B,C,D,E,F,G,H,I,J){
doteihen=10^(2:0)
siritsu=10^(2:0)
uraguchibaka=10^(3:0)
sum(doteihen*c(A,B,C))+sum(siritsu*c(D,E,F))-sum(uraguchibaka*c(G,H,I,J))
}
x=unique(x)
URAGUCHI <- function(x){
A=x[1]
B=x[2]
C=x[3]
D=x[4]
E=x[5]
F=x[6]
G=x[7]
H=x[8]
I=x[9]
J=x[10]
cat(paste('ド底辺 = ',A,B,C,
' シリツ = ',D,E,F,
' 裏口馬鹿 = ',G,H,I,J),'\n')
}
URAGUCHI(unique(x))
library(gtools)
perm=permutations(n=10,r=10,v=0:9)
perm=perm[perm[,1]!=0&perm[,4]!=0&perm[,7]!=0,] # A!=0,D!=0,G!=0
head(perm) ; tail(perm)
n=nrow(perm)
re=numeric(n)
for(i in 1:n){
re[i]=uraguchi(perm[i,1],perm[i,2],perm[i,3],perm[i,4],perm[i,5],perm[i,6],perm[i,7],perm[i,8],perm[i,9],perm[i,10])
}
hist(re)
indx=which(re==0)
(n.indx=length(indx))
for(i in 1:n.indx) URAGUCHI(perm[indx[i],])
- 201 ：
- /*
底辺私立
× ５
------------
裏口馬鹿
各々の漢字は１～８までの数字を表します。
同じ数字は使われません。
底辺私立・裏口馬鹿に数字をいれて筆算を２通り完成させてください。
*/
#include<stdio.h>
int compare_int(const void *a, const void *b){
return *(int*)a - *(int*)b;
}
int unique(int num[]){
int i,j,n=8;
qsort(num,n,sizeof(int),compare_int);
for(i=0;i<n;i++){
for(j=0;j<i;j++){
if(num[j]==num[j+1]){
return 0;
}}}
return 1;
}
main(){
int A,B,C,D,E,F,G,H;
for(A = 1; A < 9; A++){
for(B = 1; B < 9; B++){
for(C = 1; C < 9; C++){
for(D = 1; D < 9; D++){
for(E = 1; E < 9; E++){
for(F = 1; F < 9; F++){
for(G = 1; G < 9; G++){
for(H = 1; H < 9; H++){
if((A*1000+B*100+C*10+D)*5==E*1000+F*100+G*10+H){
int num[]={A,B,C,D,E,F,G,H};
if(unique(num)==1){
printf("底辺私立 = %2d%2d%2d%2d 裏口馬鹿 = %2d%2d%2d%2d\n", A,B,C,E,F,G,H);
}}
}}} }}} }}
}
- 202 ：
- attack <- function(x){ # TRUE if on attack
n=length(x)
for(i in 1:(n-1)){
for(j in 1:(n-i)){
if(x[i+j]==x[i]+j | x[i+j]==x[i]-j) return(TRUE)
}
}
return(FALSE)
}
N_Queen<-function(n){
perm=gtools::permutations(n,n)
ret=apply(perm,1,attack)
perm[which(ret==FALSE),]
}
N_Queen(8)
- 203 ：
- rot <- function(row,col,n=8){ # position after 90 degree rotation
c(col,n-row+1)
}
rota <- function(x){ # 90 degree rotation
n=length(x)
re=numeric(n)
for(i in 1:n){
tmp=rot(i,x[i],n)
re[tmp[1]]=tmp[2]
}
re
}
# ratete 90 degree four times
rotate <- function(x){
r1=rota(x)
r2=rota(r1)
r3=rota(r2)
rx=rbind(x,r1,r2,r3)
rownames(rx)=NULL
return(rx)
}
b2v <- function(x){
ret=unique.matrix(rbind(x,rotate(x),rotate(rev(x))))
rownames(ret)=NULL
ret
}
is.var <- function(x,y){ # x: base, y : variation of x ?
v=b2v(x)
nv=nrow(v)
for(i in 1:nv){
if(all(v[i,]==y)) return(TRUE)
}
return(FALSE)
}
uniQ <- function(M){ # check firt row vs the others
n=nrow(M)
uniq=numeric(n)
for(i in 1:n){
uniq[i]=!is.var(M[1,],M[i,]) # is no variant?
}
M=rbind(M[which(uniq==1),],M[1,]) # append 1st row at last
return(M) # not the final answer
}
M=N_Queen(9)
while(nrow(M)!=nrow(uniQ(M))){
M=uniQ(M)
}
M
- 204 ：
- basic_Queen <- function(N){
M=m=N_Queen(N)
while(nrow(M)!=nrow(uniQ(M))) M=uniQ(M)
return(list(variant=m,basic=M))
}
basic_Queen(5)
drawQ <- function(n){#
M=basic_Queen(n)$basic
nr=nrow(M)
for(i in 1:nr){
cat('(',i,')\n')
for(j in 1:n){
cat(rep('＿',M[i,j]-1),'●',rep('＿',n-M[i,j]),'\n')
}
cat('\n')
}
}
drawQ(5)
drawQ(6)
drawQ(8)
- 205 ：
- /* ウカウカ＋ウサギ＋ノソノソ＋カメ＋キヨウソウ＝ウサギトカメ */
#include<stdio.h>
int compare_int(const void *a, const void *b){
return *(int*)a - *(int*)b;
}
int unique(int num[]){
int i,j,n=10;
qsort(num,n,sizeof(int),compare_int);
for(i=0;i<n;i++){
for(j=0;j<i;j++){
if(num[j]==num[j+1]){
return 0;
}}}
return 1;
}
main(){
int u,ka,sa,gi,no,so,me,ki,yo,to;
for(u = 1; u < 10; u++){
for(ka = 1; ka < 10; ka++){
for(sa = 0; sa < 10; sa++){
for(gi = 0; gi < 10; gi++){
for(no = 1; no < 10; no++){
for(so = 0; so < 10; so++){
for(me = 0; me < 10; me++){
for(ki = 1; ki < 10; ki++){
for(yo = 0; yo < 10; yo++){
for(to = 0; to < 10; to++){
/* ウカウカ＋ウサギ＋ノソノソ＋カメ＋キヨウソウ＝ウサギトカメ */
if(u*1000+ka*100+u*10+ka +u*100+sa*10+gi +no*1000+so*100+no*10+so +ka*10+me +ki*10000+yo*1000+u*100+so*10+u == u*100000+sa*10000+gi*1000+to*100+ka*10+me){
int num[]={u,ka,sa,gi,no,so,me,ki,yo,to};
if(unique(num)==1){
printf("%d%d%d%d + %d%d%d + %d%d%d%d + %d%d + %d%d%d%d%d = %d%d%d%d%d%d\n",u,ka,u,ka,u,sa,gi,no,so,no,so,ka,me,ki,yo,u,so,u,u,sa,gi,to,ka,me);
}}
}}}}}}}}}}
} 👀
Rock54: Caution(BBR-MD5:1341adc37120578f18dba9451e6c8c3b)
- 206 ：
- # 7個の a と3個の b を一列に並べてできる順列のうち
# 次の簡約律のもとで文字を消していくと最終的に何も残らなくなる順列は何通りありますか。
# ・aa が現れると消える。
# ・bb が現れると消える。
# ・ababab が現れると消える。
# ・bababa が現れると消える。
# all permutation
reperm <- function(n, r, v) {
# if(n!=length(v) | n < r) return('ERROR')
if(r==1) return(matrix(v))
else {
re <- NULL
for(i in 1:n) re=rbind(re, cbind(v[i], reperm(n-1,r-1,v[-i])))
return(unique(re))
}
}
perm=reperm(n=10,r=10,v=c(rep(0,7),rep(1,3)))
# ababab|bababa
rm_ababab <- function(v){
if(length(v)<6) return(v)
for(i in 1:5)
if(all(v[i:(i+5)]==c(0,1,0,1,0,1))|all(v[i:(i+5)]==c(1,0,1,0,1,0))){
return(v[-i:-(i+5)])
}
return(v)
}
# aa|bb
rm_aa <- function(v){ # remove 1st two aa or bb
if(length(v)<2) return(v)
n=length(v)
for(i in 1:(n-1))
if(all(v[i:(i+1)]==c(0,0))|all(v[i:(i+1)]==c(1,1))){
return(v[-i:-(i+1)])
}
return(v)
}
rm_aaR <- function(v){ # recursively remove aa or bb while checking abababa or bababa
if(length(v)==6){
if(all(v==c(1,0,1,0,1,0))|all(v==c(0,1,0,1,0,1))) return(c(0,0))
}
if(length(v)==2) return(v)
else{
v1=rm_aa(v)
Recall(v1)
}
}
res=apply(perm,1,rm_aaR)
res=t(res)
sum(res[,1]==0 & res[,2]==0)
idx=which(res[,1]==0 & res[,2]==0)
perm[idx,]
- 207 ：
- combnを使って改訂
# all permutations
ones=t(combn(10,3))
indx2ten <- function(x){
y=numeric(10)
y[x[1]]=1
y[x[2]]=1
y[x[3]]=1
return(y)
}
perm=NULL
for(i in 1:nrow(ones)) perm=rbind(perm,indx2ten(ones[i,]))
# ababab|bababa
rm_ababab <- function(v){
if(length(v)<6) return(v)
for(i in 1:5)
if(all(v[i:(i+5)]==c(0,1,0,1,0,1))|all(v[i:(i+5)]==c(1,0,1,0,1,0))){
return(v[-i:-(i+5)])
}
return(v)
}
# aa|bb
rm_aa <- function(v){ # remove 1st two aa or bb
if(length(v)<2) return(v)
n=length(v)
for(i in 1:(n-1))
if(all(v[i:(i+1)]==c(0,0))|all(v[i:(i+1)]==c(1,1))){
return(v[-i:-(i+1)])
}
return(v)
}
rm_aaR <- function(v){ # recursively remove aa or bb while checking abababa or bababa
if(length(v)==6){
if(all(v==c(1,0,1,0,1,0))|all(v==c(0,1,0,1,0,1))) return(c(0,0))
}
if(length(v)==2) return(v)
else{
v1=rm_aa(v)
Recall(v1)
}
}
res=apply(perm,1,rm_aaR)
res=t(res)
sum(res[,1]==0 & res[,2]==0)
idx=which(res[,1]==0 & res[,2]==0)
Ans=perm[idx,]
AB=Ans+1
rownames(AB)=NULL
.ab=c('a','b')
indx2char <- function(x,ab=.ab){
n=length(x)
re=NULL
for(i in 1:n) re[i]=ab[x[i]]
re
}
print(t(apply(AB,1,indx2char)),quote = FALSE)
- 208 ：
- A：安倍が死ぬ
B：日本は幸せ
A∧（A→B））
↓
A∧（￢A∨B）
↓
￢（A∧￢A）
↓
B
- 209 ：
- Gacha.fm <- function(p,write=FALSE){
n=length(p)
par=letters[1:n]
fm <- function(v){
nv=length(v)
re=character(nv)
for(j in 1:nv) re[j]=par[v[j]]
s=paste(re,collapse='+')
if(nv==1) paste0('1/',s)
else paste0('1/(',s,')')
}
fm1 <- function(mat){
paste(apply(mat,2,fm),collapse='+')
}
re=list()
for(i in 1:n) re[[i]]=fm1(combn(n,i))
re1=re[[1]]
for(i in 2:(n-1)){
re1=c(re1,ifelse(i%%2,' + ',' - '),'{',re[[i]],'}')
}
output=paste(paste(re1,collapse=""),ifelse(n%%2,'+','-'), re[[n]])
cat(output,'\n')
if(write) write(output,'output.txt')
invisible(output)
}
- 210 ：
- jags4prop <- function(r1,r2,n1,n2,
ROPEdiff=c(-0.025,0.025),ROPErate=c(0.80,1.25),
NNT=FALSE){
library(rjags)
y=c(rep(1,r1),rep(0,n1-r1),rep(1,r2),rep(0,n2-r2))
s=as.numeric(factor(c(rep('D',n1),rep('U',n2))))
a=1 ; b=1 # JAGS prior : beta(a,b)
myData=data.frame(y=y,s=s)
Ntotal = length(y)
Nsubj = length(unique(s))
dataList = list(
y = y ,
s = s ,
Ntotal = Ntotal ,
Nsubj = Nsubj
)
# JAGS model
modelString = paste0("
model {
for ( i in 1:Ntotal ) {
y[i] ~ dbern( theta[s[i]] )
}
for ( sIdx in 1:Nsubj ) {
theta[sIdx] ~ dbeta(", a,',' , b," )
}
}
")
writeLines( modelString , con="TEMPmodel.txt" )
jagsModel = jags.model( file="TEMPmodel.txt" , data=dataList, quiet=TRUE)
update(jagsModel)
codaSamples = coda.samples( jagsModel , variable="theta", n.iter=10000 )
mcmcMat=as.matrix(codaSamples)
rate1=mcmcMat[,1]
rate2=mcmcMat[,2]
x11()
par(mfrow=c(2,2))
BEST::plotPost(rate1,col='gray')
if(NNT){
BEST::plotPost(abs(1/(rate1-rate2)), xlab ='NNT(NNH)',col='pink')}
else{
BEST::plotPost(rate1-rate2,compVal=0,ROPE=ROPEdiff,cex=1,col='pink')
}
BEST::plotPost(rate2,col='gray')
BEST::plotPost(rate1/rate2,compVal=1,ROPE=ROPErate,col='skyblue')
invisible(codaSamples)
}
jags4prop(50,19,133,113)
- 211 ：
- --コンパイルしてコマンドラインから実行できるように改変（但し、エラー処理皆無）
import System.Environment
import Data.List
import Data.List.Split
combinations :: Int -> [a] -> [[a]]
combinations 0 _ = [ [] ]
combinations n xs = [ y:ys | y:xs' <- tails xs, ys <- combinations (n-1) xs']
main = do
argList <- getArgs -- m : 縦マス(短軸） n : 横マス(長軸) k : 宝の数
let m = read (argList !! 0)
n = read (argList !! 1)
k = read (argList !! 2)
q = [0..m*n-1]
matQ = chunksOf n q
matP = transpose matQ --行列を転置して
p = concat matP -- 配列に変換
treasure = combinations k q -- 宝の組み合わせ
ip y = minimum $ map(\x -> elemIndices x p!!0) y -- 宝の、配列ｐでのindex列を求めて最小値を返す
iq y = minimum $ map(\x -> elemIndices x q!!0) y
idxp = map ip treasure -- 宝の組み合せで実行して
idxq = map iq treasure
p_q = zipWith (-) idxp idxq -- 差をとって大小判別
p1st =
「安倍がRば、日本は幸せになる」という命題があるとき、安倍が死んでないならこの命題は必ず真
「安倍がRば、日本は幸せになる」という命題があるとき、安倍が死んでないならこの命題は必ず真
- 1 ：
- これマジ？
- 2 ：
- 【緊急拡散】森友学園問題のヤバすぎる真相を一発で理解できるコピペを拡散しよう！！！ 籠池泰典と辻元清美と在日ヤクザの真っ黒な繋がりが露わに！！！
http://www.news-us.jp/article/20170328-000007z.html
●●【辻本清美】 行状・素行 ・疑問&蛸の擬態となりすまし●●
https://www.youtube.com/watch?v=_ayYS_HQ2eg
民進・辻元清美氏に新たな「３つの疑惑」 民進党「拡散やめて」メディアに忖度要求
http://www.sankei.com/politics/news/170328/plt1703280002-n1.html
辻元清美（動画）← 検索してみる
https://www.youtube.com/results?search_query=%E8%BE%BB%E5%85%83%E6%B8%85%E7%BE%8E
マスコミ芸能界をパチンコマネーとヤクザの暴力で制圧した韓国人の恐るべし日本支配の手口を在日が実名で告白！？
https://www.youtube.com/watch?v=4NitS2eO6GY
在日議員
https://www.youtube.com/results?search_query=%E5%9C%A8%E6%97%A5%E8%AD%B0%E5%93%A1
【在日】鴨池氏（通名）について。
https://www.youtube.com/watch?v=H5FmrSDSgYc
【駆除 反日裁判官】 日本の異常なメディアと司法制度
https://www.youtube.com/watch?v=st0SlR3UriE
在日公務員
https://www.youtube.com/results?sp=SADqAwA%253D&q=%E5%9C%A8%E6%97%A5%E5%85%AC%E5%8B%99%E5%93%A1
公務員に在日韓国人の帰化人が多い理由 ← ●必見
http://ai.2ch.sc/test/read.cgi/koumu/1393060989/
反日害国人、反日帰化人の公務員採用完全撤廃デモin日本橋 1～5
https://www.youtube.com/watch?v=1hndyMuIDb8
- 3 ：
- 在日朝鮮人の未来のために
- 4 ：
- 悪魔の証明に関する記述はすべて間違い
これは何を言いたかったのかというと
悪魔＝犯罪者
そして自分が悪魔ではないことを証明するのは不可能
ようするに裁判とか司法は無意味ということであり
彼らが悪魔を作っている張本人である
- 5 ：
- 待ってりゃ、いつかは死ぬだろ。
- 6 ：
- 辻元清美議員おもしろいねえ
- 7 ：
- 晋太郎さんは1991/05/15 にお亡くなりです。合掌。
- 8 ：
- 晴明さんは寛弘2年9月26日（1005/10/31）にお亡くなりです。合掌。
晴明神社
京都市 上京区 堀川通一条上ル晴明町806
墓所
京都市 右京区 角倉町 嵯峨天竜寺12
アベノ晴明神社
大阪市 阿倍野区 阿倍野元町5-16
- 9 ：
- 仲麻呂さんは宝亀元年１月（770/01/ ）にお亡くなりです。合掌。
http://ja.wikipedia.org/wiki/%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB:Hyakuninisshu_007.jpg
- 10 ：
- 数学板、論理もできない頭弱いやつしかおらんのな
- 11 ：
- 糞スレ立てるまえに義務教育やり直せ
- 12 ：
- >>1はダメだね。
「安倍が死んでいれば、日本は幸せになる」という命題があるとき、安倍が死んでないならこの命題は必ず真
これなら正しいよ。
- 13 ：
- 「安倍が死んでいれば、日本は不幸になる」という命題があるとき、安倍が死んでないならこの命題は必ず真
これなら正しいよ。
- 14 ：
- >>12
「安倍が死んでいれば、日本は幸せになる」という命題が真であるとき、安倍が死んでないならこの命題は必ず真
ではないか？
- 15 ：
- >>14
なんで最初から真なのに、更に真偽を判断するんだ？ｗ
- 16 ：
- ￥
- 17 ：
- ￥
- 18 ：
- ￥
- 19 ：
- ￥
- 20 ：
- ￥
- 21 ：
- ￥
- 22 ：
- ￥
- 23 ：
- ￥
- 24 ：
- ￥
- 25 ：
- ￥
- 26 ：
- ／⌒~ヽノ~⌒＼ ＿／￣Ｚ＿
`/ ⌒ヾヾｿﾉﾉ⌒ヽヽ ／ ＿__ ＜
｜i /￣ヾノ￣ヽi | / ／ ＼＿＿ヽ
ﾉノ|ノ＼ ／ヽ |ヽし ﾚ｜ ＼ ／ ｜Ｎ
彡ノ-･- ii -･-ヽミｲ (｜-･-∧-･- ｜彡
ヽ( ー || ー )_ノ彡 .ﾋ | | ｿ
｜ ヽノ ｜彡 ｜ ‥ ｜
＼ ー― ＼／ ＼ ― ) ／
＼＿__／ ＼＿_／ル
／Ｖ▽ Ｖ＼ ／Ｖ>< Ｖ＼
売 国 罪 親 子
- 27 ：
- ★★★数学徒は馬鹿板をしない生活を送るべき。大脳が腐るのでサッサとヤメレ。★★★
￥
- 28 ：
- ￥
- 29 ：
- ￥
- 30 ：
- ￥
- 31 ：
- ￥
- 32 ：
- ￥
- 33 ：
- ￥
- 34 ：
- ￥
- 35 ：
- ￥
- 36 ：
- ￥
- 37 ：
- ￥
- 38 ：
- そのときは蓮舫は日本人であるか？
- 39 ：
- ★★★数学徒は馬鹿板をしない生活を送るべき。大脳が腐るのでサッサとヤメレ。★★★
￥
- 40 ：
- ￥
- 41 ：
- ￥
- 42 ：
- ￥
- 43 ：
- ￥
- 44 ：
- ￥
- 45 ：
- ￥
- 46 ：
- ￥
- 47 ：
- ￥
- 48 ：
- ￥
- 49 ：
- ￥
- 50 ：
- 「安倍がRば、日本は幸せになる」
「蓮舫がRば、日本人がひとりへる」
この命題の信義を投う
- 51 ：
- ★★★数学徒は馬鹿板をしない生活を送るべき。大脳が腐るのでサッサとヤメレ。★★★
￥
- 52 ：
- ￥
- 53 ：
- ￥
- 54 ：
- ￥
- 55 ：
- ￥
- 56 ：
- ￥
- 57 ：
- ￥
- 58 ：
- ￥
- 59 ：
- ￥
- 60 ：
- ￥
- 61 ：
- ￥
- 62 ：
- _／::::::::ソ:::::::::::::゛'ヽ、
/:::::-:::i´i|::|/:::::::::::::::::ヽ _,-=vィ彡ミﾐﾐヽ,
/:::::::,,ヽ"｀ "ヽﾐﾐ:::::::::::ヽ ﾐミ彡＝ミミﾐミミﾐﾐ,,
/::::::= `-:::::::ヽ ミ彡 ミミミﾐミミﾐミ
|::::::/ .,,,=≡, ,≡=、 l:::::l 売 彡! ＿_ ミミミﾐミミミ
／＼ i::::l゛ ／･＼,!.／･＼、l:::! /´| ミ! ＼_ _／~ ミミﾐ彡
＼／⌒ゝ' " ノ/ i＼ |:i 国 | | /´}!| ｀-=・=‐∧'-=・=‐' 川ﾐ
ノ ノ⌒,- ),､ ,ィ_____.iヽ i/ | | / / !| _ !!ﾐ
/´ ´ ' , ^ ヽ / l i ) 奴 rｰﾄ､ l' / ゞ|ヽ､ 人・ ・人 ﾉゞ
/ ヽ ﾉ"＼ノ`'''｀''''´ヽ _/ { ! {､ヽ. l ヽ| ､ ＿＿__ ル
人 ノ ＼／ `ー'´ ／ ﾊ_>Jﾉ l | .＼ `ヽｴｴノ ｿ
／::::＼__／:::::::ヽ ｀ "ーイ＿＿ 〉 ／ ト-_＿__-ノ 入
:::::::::::::::: |::::::::::＼＼__ ／ |:::::::::::＼ / / . ゝ-＿__..| ト ノﾉ ヽ＿
- 63 ：
- ★★★数学徒は馬鹿板をしない生活を送り、日頃から真面目に学問に精進すべき。★★★
￥
- 64 ：
- ￥
- 65 ：
- ￥
- 66 ：
- ￥
- 67 ：
- ￥
- 68 ：
- ￥
- 69 ：
- ￥
- 70 ：
- ￥
- 71 ：
- ￥
- 72 ：
- ￥
- 73 ：
- ￥
- 74 ：
- ■ 自民党戦略特区廃止法案提出へ
http://carpenter.2ch.sc/test/read.cgi/liveplus/1496420542/
【農業特区】 小泉進次郎 【モンサント外資へ売国】
http://egg.2ch.sc/test/read.cgi/sisou/1285092910/
【神奈川区】 石川たくみ 【アグリビジネスへの詐欺】
http://mint.2ch.sc/test/read.cgi/giin/1491719947/
【三浦市区】 吉田 英男 【公用車でソープランドに】
http://rio2016.2ch.sc/test/read.cgi/koumu/1489670675/
- 75 ：
- http://www.xvideos.com/video1795513/couple_fuck_at_xmas
- 76 ：
- またネトエラが暴れてんのか。
- 77 ：
- ★★★数学徒は馬鹿板をしない生活を送り、日頃から真面目に学問に精進すべき。★★★
￥
- 78 ：
- ￥
- 79 ：
- ￥
- 80 ：
- ￥
- 81 ：
- ￥
- 82 ：
- ￥
- 83 ：
- ￥
- 84 ：
- ￥
- 85 ：
- ￥
- 86 ：
- ￥
- 87 ：
- ￥
- 88 ：
- 耳栓をしたら世界が変わってワロタ
- 89 ：
- 次の演繹が正しいことを証明せよ。
すべての患者はすべての頭のよい医者を好む。
幾人かの患者はいかなるド底辺特殊シリツ医大卒をも好まない。
ゆえにすべてのド底辺特殊シリツ医大卒は頭がよくない。
(証明)
Dx : xは医者である
Wx : xは頭がよい
Sx : xはド底辺特殊シリツ医大卒である
Lpx : pはxを好む
P1 : ∀p∀x(Dx∧Wx→Lpx)
P2 : ∃p∀x(Dx∧Sx→￢Lpx)
Q : ∀x(Dx∧Sx→￢Wx)
￢Qを仮定すれば∃x(Dx∧Sx∧Wx)
これを満たすxをaとするとDa∧Sa∧Wa (1)
(1)からDa∧Wa (2)
P1と(2)から ∀p(Da∧Wa→Lpa)
∀p(Lpa) (3)
(1)からDa∧Sa (4)
P2と(4)から ∃p(Da∧Sa→￢Lpa)
これを満たすpをbとすると
Da∧Sa→￢Lba
￢Lba (5)
(3)はp=bでも成立するから
Lba (6)
(5)(6)は矛盾するから仮定の￢Qは誤り。
ゆえにQは真
- 90 ：
- # Lukasiewicz
library('gtools')
pm2=permutations(2,2,v=c(T,F),re=TRUE) ; pm2
pm3=permutations(2,3,v=c(T,F),re=TRUE) ; pm3
imply <- function(x,y) !x || y
eqv <- function(x,y) (!x||y)&&(!y||x)
for(i in 1:4) print(f1(pm2[i,]))
for(i in 1:8) print(f1(pm3[i,]))
# L1 : A->(B->A)
f <- function(A,B) imply(A,imply(B,A))
f1 <- function(pm) f(pm[1],pm[2])
for(i in 1:4) print(f1(pm2[i,]))
# L2 : (A->(B->C))->((A->B)->(A->C))
f <- function(A,B,C) imply(imply(A,imply(B,C)),imply(imply(A,B),imply(A,C)))
f1 <- function(pm) f(pm[1],pm[2],pm[3])
for(i in 1:8) print(f1(pm3[i,]))
# L3 : (!B->!A) -> (A->B)
f <- function(A,B,C) imply(imply(!B,!A),imply(A,B))
f1 <- function(pm) f(pm[1],pm[2],pm[3])
for(i in 1:8) print(f1(pm3[i,]))
# modus ponens A & (A->B) -> B
f <- function(A,B) imply(A && imply(A,B),B)
f1 <- function(pm) f(pm[1],pm[2])
for(i in 1:4) print(f1(pm2[i,]))
- 91 ：
- A∨B ⇔ ￢A→B
Bを￢Aとすれば
排中律 A∨￢Aは￢A→￢Aと同値。
公理L1 : p→(q→p)
公理L2 : (p→(q→r))→((p→q)→(p→r))
公理L3 : (￢q→￢p) → (p→q)
modus ponens(推論規則) A, A->B ⇒ B
(1)x→xの証明
L1,L2でp=x,q=x→x,r=xとすれば
x→((x→x)→x)
(x→((x→x)→x)) → ((x→(x→x))→(x→x))
ゆえに
((x→(x→x))→(x→x))
L1によりx→(x→x)は常に成り立つからx→x (1*)
(1*)でx=￢Aとすれば ￢A→￢A
即ち、排中律が演繹できる。
- 92 ：
- 二重否定律￢￢A→Aの証明
L1にp=￢a,q=￢bとして
￢a→(￢b→￢a)
￢aを仮定して
￢b→￢a
L3によりこれはa→b
ゆえに￢a→(a→b) (2*)
(2*)に a=￢A, b=￢￢￢Aとすると
￢￢A→(￢A→￢￢￢A)
L3にp=￢￢A, q=Aとすると
(￢A→￢￢￢A)→(￢￢A→A)
ゆえに
￢￢A→(￢￢A→A)
L2でp=￢￢A,q=￢￢A,r=Aとすれば
(￢￢A→(￢￢A→A))→((￢￢A→￢￢A)→(￢￢A→A))
なので
(￢￢A→￢￢A)→(￢￢A→A)
￢￢A→￢￢A ∵ (1*) x=￢￢A
￢￢A→A
- 93 ：
- 耳栓をしたら世界が変わってワロタ
- 94 ：
- ￥
- 95 ：
- ￥
- 96 ：
- ￥
- 97 ：
- ￥
- 98 ：
- ￥
- 99 ：
- ￥
- 100 ：
- ￥
- 101 ：
- ￥
- 102 ：
- ￥
- 103 ：
- ￥
- 104 ：
- 耳栓をしたら世界が変わってワロタ
- 105 ：
- ￥
- 106 ：
- 1000億円あれば 俺は幸福だ
この命題は正しいか？
- 107 ：
- ￥
- 108 ：
- ￥
- 109 ：
- ￥
- 110 ：
- ￥
- 111 ：
- ￥
- 112 ：
- ￥
- 113 ：
- ￥
- 114 ：
- ￥
- 115 ：
- ￥
- 116 ：
- ￥
- 117 ：
- 耳栓をしたら世界が変わってワロタ
- 118 ：
- ￥
- 119 ：
- 耳栓をしたら世界が変わってワロタ
- 120 ：
- ￥
- 121 ：
- >>106
前提が偽だから正しくなる という論理が正しいかというのがこのスレの趣旨。
- 122 ：
- ￥
- 123 ：
- ￥
- 124 ：
- ￥
- 125 ：
- ￥
- 126 ：
- ￥
- 127 ：
- ￥
- 128 ：
- ￥
- 129 ：
- ￥
- 130 ：
- ￥
- 131 ：
- ￥
- 132 ：
- 耳栓をしたら世界が変わってワロタ
- 133 ：
- ￥
- 134 ：
- 1億円あれば 俺は幸福だ
この命題は正しいか？
- 135 ：
- ￥
- 136 ：
- ￥
- 137 ：
- ￥
- 138 ：
- ￥
- 139 ：
- ￥
- 140 ：
- ￥
- 141 ：
- ￥
- 142 ：
- ￥
- 143 ：
- ￥
- 144 ：
- ￥
- 145 ：
- 耳栓をしたら世界が変わってワロタ
- 146 ：
- ￥
- 147 ：
- 小学レベルとバカプロ固定、
サイコパス
High level people、
低脳幼稚園児のAAお絵かき、
お断り！
小学生がたまにいますので、18金よろしくね！（＾＾
- 148 ：
- （A→￢A)→￢Aも恒真式
- 149 ：
- ￥
- 150 ：
- ￥
- 151 ：
- ￥
- 152 ：
- ￥
- 153 ：
- ￥
- 154 ：
- ￥
- 155 ：
- ￥
- 156 ：
- ￥
- 157 ：
- ￥
- 158 ：
- ￥
- 159 ：
- 証明でこの恒真式(もしくは公理）が出てくるといつも詐欺にあったような気になる。
P→(Q→P)
馬鹿ならば（シリツならば馬鹿である）
馬鹿ならば（裏口ならば馬鹿である）
￢P→(P→Q)
馬鹿でないなら（馬鹿であればシリツである）
馬鹿でないならば（馬鹿であれば裏口である）
Qとして天才とか変態とかを選んでも恒真式、というのは日常言語感覚からは乖離しているな。
ド底辺特殊シリツ医大を最高学府と呼ぶような気持ち悪さを覚える。
- 160 ：
- ￥
- 161 ：
- ￥
- 162 ：
- ￥
- 163 ：
- ￥
- 164 ：
- ￥
- 165 ：
- ￥
- 166 ：
- ￥
- 167 ：
- ￥
- 168 ：
- ￥
- 169 ：
- ￥
- 170 ：
- 耳栓をしたら世界が変わってワロタ
- 171 ：
- ￥
- 172 ：
- ￥
- 173 ：
- ￥
- 174 ：
- ￥
- 175 ：
- ￥
- 176 ：
- ￥
- 177 ：
- ￥
- 178 ：
- ￥
- 179 ：
- ￥
- 180 ：
- ￥
- 181 ：
- 耳栓をしたら世界が変わってワロタ
- 182 ：
- ￥
- 183 ：
- ￥
- 184 ：
- ￥
- 185 ：
- ￥
- 186 ：
- ￥
- 187 ：
- ￥
- 188 ：
- ￥
- 189 ：
- ￥
- 190 ：
- ￥
- 191 ：
- ￥
- 192 ：
- jags4prop <- function(r1,r2,n1,n2,
ROPEdiff=c(-0.025,0.025),ROPErate=c(0.80,1.25),
NNT=FALSE){
library(rjags)
y=c(rep(1,r1),rep(0,n1-r1),rep(1,r2),rep(0,n2-r2))
s=as.numeric(factor(c(rep('D',n1),rep('U',n2))))
a=1 ; b=1 # JAGS prior : beta(a,b)
myData=data.frame(y=y,s=s)
Ntotal = length(y)
Nsubj = length(unique(s))
dataList = list(
y = y ,
s = s ,
Ntotal = Ntotal ,
Nsubj = Nsubj
)
# JAGS model
modelString = paste0("
model {
for ( i in 1:Ntotal ) {
y[i] ~ dbern( theta[s[i]] )
}
for ( sIdx in 1:Nsubj ) {
theta[sIdx] ~ dbeta(", a,',' , b," )
}
}
")
writeLines( modelString , con="TEMPmodel.txt" )
jagsModel = jags.model( file="TEMPmodel.txt" , data=dataList, quiet=TRUE)
update(jagsModel)
codaSamples = coda.samples( jagsModel , variable="theta", n.iter=10000 )
mcmcMat=as.matrix(codaSamples)
risk1=mcmcMat[,1]
risk2=mcmcMat[,2]
x11()
par(mfrow=c(2,2))
BEST::plotPost(risk1,col='gray')
if(NNT){
BEST::plotPost(abs(1/(risk1-risk2)), xlab ='NNT(NNH)',col='pink')}
else{
BEST::plotPost(risk1-risk2,compVal=0,ROPE=ROPEdiff,cex=1,col='pink')
}
BEST::plotPost(risk2,col='gray')
BEST::plotPost(risk1/risk2,compVal=1,ROPE=ROPErate,col='skyblue')
invisible(codaSamples)
}
jags4prop(r1=1,n1=1,r2=0,n2=1,ROPEdiff=NULL,NNT=TRUE)
jags4prop(r1=1,n1=1,r2=0,n2=1,ROPEdiff=NULL)
- 193 ：
- f<- function(d=1,beta=.80,alpha=.05) 2*(abs((qnorm(1-alpha/2))+abs(qnorm(1-beta)))/d)^2
f(5/10)
power.t.test(delta=0.5,power=0.80)$n
# power 50%->82%
dd=seq(0.01,0.99,by=0.01)
g<- function(x) f(x,.50)/f(x,.80)
summary (sapply(dd,g))
(2*(abs(1.96+abs(qnorm(1-0.80))))^2)/(2*(abs(1.96+abs(qnorm(1-0.50))))^2)
(1.96+0.84)^2/(1.96+0)^2
dd=seq(0.01,0.99,by=0.01)
h<-function (x,pow1=0.80,pow2=0.50){
power.t.test(d=x, power=pow1)$n/power.t.test(d=x, power=pow2)$n
}
res=sapply (dd,h)
plot(dd,res)
summary (res)
# power 80%->92%
f(beta=0.90)
f(beta=0.80)
(2*(abs(1.96+abs(qnorm(1-0.90))))^2)/(2*(abs(1.96+abs(qnorm(1-0.80))))^2)
res1=sapply (dd, function (x) h(x,0.90,0.80))
plot (dd,res1)
# power 80%->101%
f(beta=0.99)
f(beta=0.80)
(2*(abs(1.96+abs(qnorm(1-0.99))))^2)/(2*(abs(1.96+abs(qnorm(1-0.80))))^2)
res2=sapply (dd, function (x) h(x,0.99,0.80))
plot (dd,res2)
##
f<- function(d=1,beta=.80,alpha=.05) 2*(abs((qnorm(1-alpha/2))+abs(qnorm(1-beta)))/d)^2
f()
sample.size <- function (d=1,beta=0.80,alpha=0.05){
f<- function(n) 2*((abs(qt(1-alpha/2,n-1))+abs(qt(1-beta,n-1)))/d)^2 - n
uniroot (f, c(3,10000))$root
}
sample.size()
power.t.test(d=1, power=0.80)$n 👀
Rock54: Caution(BBR-MD5:0be15ced7fbdb9fdb4d0ce1929c1b82f)
- 194 ：
- 慶應義塾学医学部 2051 70
順天堂大学医学部 2090 66
昭和大学医学部 2200 65
東京慈恵会医科大学医学部 2250 69
自治医科大学医学部 2260 66
産業医科大学医学部 2749 65
日本医科大学医学部 2813 66
東京医科大学医学部 2995 64
関西医科大学医学部 3014 65
大阪医科大学医学部 3141 66
東邦大学医学部 3180 62
久留米大学医学部 3237 61
東京女子医科大学医学部 3284 60
日本大学医学部 3310 61
岩手医科大学医学部 3400 60
聖マリアンナ医科大学医学部 3440 58
近畿大学医学部 3580 62
藤田保健衛生大学医学部 3650 60
獨協医科大学医学部 3660 59
帝京大学医学部 3750 59
杏林大学医学部 3755 61
東海大学医学部 3760 61
福岡大学医学部 3770 60
愛知医科大学医学部 3800 59
埼玉医科大学医学部 3800 57
兵庫医科大学医学部 3880 60
北里大学医学部 3890 60
金沢医科大学医学部 3950 58
川崎医科大学医学部 4565 57
dat=read.table("clipboard")
colnames(dat)=c("school","tuition","hensa")
head(dat)
xi=dat$hensa
yi=dat$tuition
re=lm(yi~xi) ; re
beta1.hat=re$coef[1]
beta10=0
n=length(xi)
Sxx=var(xi)*(n-1)
Syy=var(yi)*(n-1)
Sxy=cov(xi,yi)*(n-1)
beta1.hat=Sxy/Sxx
Se=Syy - Sxy^2/Sxx
phie=n-2
Ve=Se/phie
t0=(beta1.hat-beta10)/sqrt(Ve/Sxx) ; t0
curve(dt(x,n-2),-5,5,bty='l')
pt(t0,n-2)
> t0=(beta1.hat-beta10)/sqrt(Ve/Sxx) ; t0
[1] -10.17626
> pt(t0,n-2)
[1] 4.873385e-11
- 195 ：
- # Lindner Center data on 996 PCI patients analyzed by Kereiakes et al. (2000)
library(MatchLinReg)
data("lindner")
head(lindner)
attach(lindner)
(tbl=table(stent,sixMonthSurvive))
Epi::twoby2(tbl)
formula.stent = stent ~ abcix + height + female + diabetic + acutemi +
ejecfrac + ves1proc - 1
formula.6month = sixMonthSurvive ~ stent+ abcix + height + female + diabetic + acutemi +
ejecfrac + ves1proc - 1
rms::lrm( stent ~ abcix + height + female + diabetic + acutemi +
ejecfrac + ves1proc-1, data=lindner)$stat['C']
ps=re.glm$fitted.values
Y=lindner$sixMonthSurvive
Tr=lindner$stent
# IPWE
weighted.mean(Y,Tr/ps) - weighted.mean(Y,(1-Tr)/(1-ps))
## (Doubly Robust: DR)
dre <- function(data, target, treat, ps, formula) {
n <- nrow(data)
y <- data[target]
z <- data[treat]
data1 <- data[data[treat]==1,]
data0 <- data[data[treat]==0,]
model1 <- lm(formula=formula, data=data1)
model0 <- lm(formula=formula, data=data0)
fitted1 <- predict(model1, data)
fitted0 <- predict(model0, data)
dre1 <- (1/n)*sum(y+((z-ps)/ps)*(y-fitted1))
dre0 <- (1/n)*sum(((1-z)*y)/(1-ps)+(1-(1-z)/(1-ps))*fitted0)
c(treated=dre1,control=dre0,ATE=dre1-dre0)
}
dre(data=lindner,target='sixMonthSurvive',treat='stent', ps=ps, formula=sixMonthSurvive ~ abcix + height
+ female + diabetic + acutemi +ejecfrac + ves1proc -1)
- 196 ：
- # http://www1.udel.edu/educ/gottfredson/reprints/2009semen.pdf
cor2ci<- function(cor,n,conf.level=0.95){
lower=tanh(atanh(cor) + qnorm((1-conf.level)/2)/sqrt(n-3))
upper=tanh(atanh(cor) - qnorm((1-conf.level)/2)/sqrt(n-3))
data.frame(lower,cor,upper)
}
cor2p <- function(cor,n,alternative='two.sided'){
r=cor
t.stat=r*sqrt(n-2)/sqrt(1-r^2)
if(alternative=='two.sided'){
p.value=pt(-abs(t.stat),n-2)*2
}else{
p.value=pt(-abs(t.stat),n-2)
}
return(p.value)
}
cor2p(0.14,425)
rs=c(conc=0.15,count=0.19,Motility=0.14)
n=425
cor2ci(rs,n)
sapply(rs,function(cor)cor2p(cor,n=425))
#
r2p <- function(r,n){
2*pt(-abs(r)*sqrt(n-2)/sqrt(1-r^2),n-2)
}
# 0.002=r2p(0.15,n)
curve(r2p(rs[1],x),300,600)
abline(h=0.002,lty=3)
uniroot(function(n,p0=0.0015)r2p(rs[1],n)-p0,c(100,1000))$root # 445
uniroot(function(n,p0=0.0020)r2p(rs[1],n)-p0,c(100,1000))$root # 422
uniroot(function(n,p0=0.0025)r2p(rs[1],n)-p0,c(100,1000))$root # 404
r2p(rs[1],425)
# 0.002=r2p(0.14,n)
curve(r2p(rs[3],x),300,600)
abline(h=0.002,lty=3)
uniroot(function(n,p0=0.0015)r2p(rs[3],n)-p0,c(100,1000))$root # 511
uniroot(function(n,p0=0.0020)r2p(rs[3],n)-p0,c(100,1000))$root # 484
uniroot(function(n,p0=0.0025)r2p(rs[3],n)-p0,c(100,1000))$root # 464
r2p(rs[3],425)
r2p(rs[3],c(445,422,404))
r2p(0.19,425)
- 197 ：
- ｎｏｉｓｅ２ｓｉｇ ＜－ ｆｕｎｃｔｉｏｎ（ｓｅｅｄ，ｓｅｑｕｅｎｔｉａｌ＝ＦＡＬＳＥ）｛
ｓｅｔ．ｓｅｅｄ（ｓｅｅｄ）
Ｎｏｉｓｅ＝ｍａｔｒｉｘ（ｒｎｏｒｍ（１００＊５１），ｎｃｏｌ＝５１，ｎｒｏｗ＝１００）
＃ ｆｉｒｓｔ ｐａｓｓ
ｌｍ１＝ｌｍ（Ｎｏｉｓｅ［，５１］ ～ Ｎｏｉｓｅ［，－５１］） ＃ Ｎｏｉｓｅ［，５１］ ： 目的変数Ｙ
ｃａｔ（＇\ｎＲ２ （１ｓｔ） ＝ ＇，ｓｕｍｍａｒｙ（ｌｍ１）＄ｒ．ｓｑｕａｒｅｄ）
ｃａｔ（＇\ｎｐ．ｖａｌｕｅ （１ｓｔ） ＝ ＇，ａｎｏｖａ（ｌｍ１）＄Ｐｒ［１］）
ｃｏｅｆｓ１＝ｓｕｍｍａｒｙ（ｌｍ１）＄ｃｏｅｆ［，＇Ｐｒ（＞｜ｔ｜）＇］
ｌｅｎｇｔｈ（ｃｏｅｆｓ１）
ｃｏｅｆｓ１［１］
ｃｏｅｆｆｓ１＝ｃｏｅｆｓ１［－１］
ｃａｔ（＇\ｎｃｏｅｆ ＜ ０．２５ ＝＇，ｓｕｍ（ｃｏｅｆｆｓ１＜０．２５））
ｃａｔ（＇\ｎｃｏｅｆ ＜ ０．０５ ＝＇，ｓｕｍ（ｃｏｅｆｆｓ１＜０．０５））
ｉｎｄｘ２５＝ｗｈｉｃｈ（ｃｏｅｆｆｓ１＜０．２５）
＃ ｓｅｃｏｎｄ ｐａｓｓ
ｌｍ２＝ｌｍ（Ｎｏｉｓｅ［，５１］ ～ Ｎｏｉｓｅ［，ｉｎｄｘ２５］）
ｃａｔ（＇\ｎ\ｎＲ２ （２ｎｄ） ＝ ＇，ｓｕｍｍａｒｙ（ｌｍ２）＄ｒ．ｓｑｕａｒｅｄ）
ｃａｔ（＇\ｎｐ．ｖａｌｕｅ（２ｎｄ） ＝ ＇，ａｎｏｖａ（ｌｍ２）＄Ｐｒ［１］）
ｃｏｅｆｓ２＝ｓｕｍｍａｒｙ（ｌｍ２）＄ｃｏｅｆ［，＇Ｐｒ（＞｜ｔ｜）＇］
ｌｅｎｇｔｈ（ｃｏｅｆｓ２）
ｃｏｅｆｓ２［１］
ｃｏｅｆｆｓ２＝ｃｏｅｆｓ２［－１］
ｃａｔ（＇\ｎｃｏｅｆ ＜ ０．２５ （２ｎｄ） ＝＇，ｓｕｍ（ｃｏｅｆｆｓ２＜０．２５））
ｃａｔ（＇\ｎｃｏｅｆ ＜ ０．０５ （２ｎｄ） ＝＇，ｓｕｍ（ｃｏｅｆｆｓ２＜０．０５））
ｃａｔ（＇\ｎ\ｎ＇）
ｉｆ（ｓｅｑｕｅｎｔｉａｌ）｛
ｃａｔ（＇Ｈｉｔ Ｒｅｔｕｒｎ Ｋｅｙ ｉｎ ｃｏｎｓｏｌｅ ｗｉｎｄｏｗ＇）
ｎｏ＿ｓａｖｅ ＜－ ｓｃａｎ（ｎ＝１， ｗｈａｔ＝ｃｈａｒａｃｔｅｒ（）， ｑｕｉｅｔ＝ＴＲＵＥ）
｝
｝
ｎｏｉｓｅ２ｓｉｇ（１）
ｆｏｒ（ｉ ｉｎ ２：５） ｎｏｉｓｅ２ｓｉｇ（ｉ，ｓｅｑ＝ＴＲＵＥ）
- 198 ：
- > UG
1年度 2年度 3年度 4年度 5年度 6年度
学生1 30 45 42 31 47 35
学生2 42 18 46 42 42 52
学生3 51 39 23 45 44 41
学生4 28 56 26 49 41 33
学生5 51 48 31 48 42 37
学生6 41 58 27 37 38 30
学生7 20 31 42 16 31 29
学生8 45 42 54 55 46 50
学生9 61 35 34 38 47 34
学生10 44 32 23 30 29 56
> mUG=reshape2::melt(UG) ; colnames(mUG)=c('学生','年度','成績')
> Tk=TukeyHSD(aov(成績~学生,mUG))
> p.Tk=Tk[[1]][,'p adj']
> n9=nrow(UG)-1
> mat.Tk=matrix(rep(NA,n9*n9),n9)
> for(k in 1:9) mat.Tk[,k]=c(rep(NA,k-1), p.Tk[((k-1)*(n9+1-k/2)+1):((k-1)*(n9+1-k/2)+1+n9-k)])
> colnames(mat.Tk)=paste0('学生',1:9)
> rownames(mat.Tk)=paste0('学生',2:10)
> d=round(mat.Tk,3)
> d[is.na(d)]='-'
> print(d,quote=FALSE)
学生1 学生2 学生3 学生4 学生5 学生6 学生7 学生8 学生9
学生2 1 - - - - - - - -
学生3 1 1 - - - - - - -
学生4 1 1 1 - - - - - -
学生5 0.998 1 1 0.999 - - - - -
学生6 1 1 1 1 0.999 - - - -
学生7 0.742 0.513 0.493 0.687 0.257 0.724 - - -
学生8 0.724 0.9 0.911 0.776 0.989 0.742 0.023 - -
学生9 1 1 1 1 1 1 0.383 0.958 -
学生10 1 0.998 0.997 1 0.958 1 0.945 0.418 0.989
>
- 199 ：
- > REDWHITECOLOR(perm[indx,])
RED = 5 8 7 WHITE = 3 9 6 1 8 COLOR = 4 0 2 0 5
- 200 ：
- # ド底辺＋シリツ＝裏口馬鹿
x=LETTERS[1:10]
uraguchi <- function(A,B,C,D,E,F,G,H,I,J){
doteihen=10^(2:0)
siritsu=10^(2:0)
uraguchibaka=10^(3:0)
sum(doteihen*c(A,B,C))+sum(siritsu*c(D,E,F))-sum(uraguchibaka*c(G,H,I,J))
}
x=unique(x)
URAGUCHI <- function(x){
A=x[1]
B=x[2]
C=x[3]
D=x[4]
E=x[5]
F=x[6]
G=x[7]
H=x[8]
I=x[9]
J=x[10]
cat(paste('ド底辺 = ',A,B,C,
' シリツ = ',D,E,F,
' 裏口馬鹿 = ',G,H,I,J),'\n')
}
URAGUCHI(unique(x))
library(gtools)
perm=permutations(n=10,r=10,v=0:9)
perm=perm[perm[,1]!=0&perm[,4]!=0&perm[,7]!=0,] # A!=0,D!=0,G!=0
head(perm) ; tail(perm)
n=nrow(perm)
re=numeric(n)
for(i in 1:n){
re[i]=uraguchi(perm[i,1],perm[i,2],perm[i,3],perm[i,4],perm[i,5],perm[i,6],perm[i,7],perm[i,8],perm[i,9],perm[i,10])
}
hist(re)
indx=which(re==0)
(n.indx=length(indx))
for(i in 1:n.indx) URAGUCHI(perm[indx[i],])
- 201 ：
- /*
底辺私立
× ５
------------
裏口馬鹿
各々の漢字は１～８までの数字を表します。
同じ数字は使われません。
底辺私立・裏口馬鹿に数字をいれて筆算を２通り完成させてください。
*/
#include<stdio.h>
int compare_int(const void *a, const void *b){
return *(int*)a - *(int*)b;
}
int unique(int num[]){
int i,j,n=8;
qsort(num,n,sizeof(int),compare_int);
for(i=0;i<n;i++){
for(j=0;j<i;j++){
if(num[j]==num[j+1]){
return 0;
}}}
return 1;
}
main(){
int A,B,C,D,E,F,G,H;
for(A = 1; A < 9; A++){
for(B = 1; B < 9; B++){
for(C = 1; C < 9; C++){
for(D = 1; D < 9; D++){
for(E = 1; E < 9; E++){
for(F = 1; F < 9; F++){
for(G = 1; G < 9; G++){
for(H = 1; H < 9; H++){
if((A*1000+B*100+C*10+D)*5==E*1000+F*100+G*10+H){
int num[]={A,B,C,D,E,F,G,H};
if(unique(num)==1){
printf("底辺私立 = %2d%2d%2d%2d 裏口馬鹿 = %2d%2d%2d%2d\n", A,B,C,E,F,G,H);
}}
}}} }}} }}
}
- 202 ：
- attack <- function(x){ # TRUE if on attack
n=length(x)
for(i in 1:(n-1)){
for(j in 1:(n-i)){
if(x[i+j]==x[i]+j | x[i+j]==x[i]-j) return(TRUE)
}
}
return(FALSE)
}
N_Queen<-function(n){
perm=gtools::permutations(n,n)
ret=apply(perm,1,attack)
perm[which(ret==FALSE),]
}
N_Queen(8)
- 203 ：
- rot <- function(row,col,n=8){ # position after 90 degree rotation
c(col,n-row+1)
}
rota <- function(x){ # 90 degree rotation
n=length(x)
re=numeric(n)
for(i in 1:n){
tmp=rot(i,x[i],n)
re[tmp[1]]=tmp[2]
}
re
}
# ratete 90 degree four times
rotate <- function(x){
r1=rota(x)
r2=rota(r1)
r3=rota(r2)
rx=rbind(x,r1,r2,r3)
rownames(rx)=NULL
return(rx)
}
b2v <- function(x){
ret=unique.matrix(rbind(x,rotate(x),rotate(rev(x))))
rownames(ret)=NULL
ret
}
is.var <- function(x,y){ # x: base, y : variation of x ?
v=b2v(x)
nv=nrow(v)
for(i in 1:nv){
if(all(v[i,]==y)) return(TRUE)
}
return(FALSE)
}
uniQ <- function(M){ # check firt row vs the others
n=nrow(M)
uniq=numeric(n)
for(i in 1:n){
uniq[i]=!is.var(M[1,],M[i,]) # is no variant?
}
M=rbind(M[which(uniq==1),],M[1,]) # append 1st row at last
return(M) # not the final answer
}
M=N_Queen(9)
while(nrow(M)!=nrow(uniQ(M))){
M=uniQ(M)
}
M
- 204 ：
- basic_Queen <- function(N){
M=m=N_Queen(N)
while(nrow(M)!=nrow(uniQ(M))) M=uniQ(M)
return(list(variant=m,basic=M))
}
basic_Queen(5)
drawQ <- function(n){#
M=basic_Queen(n)$basic
nr=nrow(M)
for(i in 1:nr){
cat('(',i,')\n')
for(j in 1:n){
cat(rep('＿',M[i,j]-1),'●',rep('＿',n-M[i,j]),'\n')
}
cat('\n')
}
}
drawQ(5)
drawQ(6)
drawQ(8)
- 205 ：
- /* ウカウカ＋ウサギ＋ノソノソ＋カメ＋キヨウソウ＝ウサギトカメ */
#include<stdio.h>
int compare_int(const void *a, const void *b){
return *(int*)a - *(int*)b;
}
int unique(int num[]){
int i,j,n=10;
qsort(num,n,sizeof(int),compare_int);
for(i=0;i<n;i++){
for(j=0;j<i;j++){
if(num[j]==num[j+1]){
return 0;
}}}
return 1;
}
main(){
int u,ka,sa,gi,no,so,me,ki,yo,to;
for(u = 1; u < 10; u++){
for(ka = 1; ka < 10; ka++){
for(sa = 0; sa < 10; sa++){
for(gi = 0; gi < 10; gi++){
for(no = 1; no < 10; no++){
for(so = 0; so < 10; so++){
for(me = 0; me < 10; me++){
for(ki = 1; ki < 10; ki++){
for(yo = 0; yo < 10; yo++){
for(to = 0; to < 10; to++){
/* ウカウカ＋ウサギ＋ノソノソ＋カメ＋キヨウソウ＝ウサギトカメ */
if(u*1000+ka*100+u*10+ka +u*100+sa*10+gi +no*1000+so*100+no*10+so +ka*10+me +ki*10000+yo*1000+u*100+so*10+u == u*100000+sa*10000+gi*1000+to*100+ka*10+me){
int num[]={u,ka,sa,gi,no,so,me,ki,yo,to};
if(unique(num)==1){
printf("%d%d%d%d + %d%d%d + %d%d%d%d + %d%d + %d%d%d%d%d = %d%d%d%d%d%d\n",u,ka,u,ka,u,sa,gi,no,so,no,so,ka,me,ki,yo,u,so,u,u,sa,gi,to,ka,me);
}}
}}}}}}}}}}
} 👀
Rock54: Caution(BBR-MD5:1341adc37120578f18dba9451e6c8c3b)
- 206 ：
- # 7個の a と3個の b を一列に並べてできる順列のうち
# 次の簡約律のもとで文字を消していくと最終的に何も残らなくなる順列は何通りありますか。
# ・aa が現れると消える。
# ・bb が現れると消える。
# ・ababab が現れると消える。
# ・bababa が現れると消える。
# all permutation
reperm <- function(n, r, v) {
# if(n!=length(v) | n < r) return('ERROR')
if(r==1) return(matrix(v))
else {
re <- NULL
for(i in 1:n) re=rbind(re, cbind(v[i], reperm(n-1,r-1,v[-i])))
return(unique(re))
}
}
perm=reperm(n=10,r=10,v=c(rep(0,7),rep(1,3)))
# ababab|bababa
rm_ababab <- function(v){
if(length(v)<6) return(v)
for(i in 1:5)
if(all(v[i:(i+5)]==c(0,1,0,1,0,1))|all(v[i:(i+5)]==c(1,0,1,0,1,0))){
return(v[-i:-(i+5)])
}
return(v)
}
# aa|bb
rm_aa <- function(v){ # remove 1st two aa or bb
if(length(v)<2) return(v)
n=length(v)
for(i in 1:(n-1))
if(all(v[i:(i+1)]==c(0,0))|all(v[i:(i+1)]==c(1,1))){
return(v[-i:-(i+1)])
}
return(v)
}
rm_aaR <- function(v){ # recursively remove aa or bb while checking abababa or bababa
if(length(v)==6){
if(all(v==c(1,0,1,0,1,0))|all(v==c(0,1,0,1,0,1))) return(c(0,0))
}
if(length(v)==2) return(v)
else{
v1=rm_aa(v)
Recall(v1)
}
}
res=apply(perm,1,rm_aaR)
res=t(res)
sum(res[,1]==0 & res[,2]==0)
idx=which(res[,1]==0 & res[,2]==0)
perm[idx,]
- 207 ：
- combnを使って改訂
# all permutations
ones=t(combn(10,3))
indx2ten <- function(x){
y=numeric(10)
y[x[1]]=1
y[x[2]]=1
y[x[3]]=1
return(y)
}
perm=NULL
for(i in 1:nrow(ones)) perm=rbind(perm,indx2ten(ones[i,]))
# ababab|bababa
rm_ababab <- function(v){
if(length(v)<6) return(v)
for(i in 1:5)
if(all(v[i:(i+5)]==c(0,1,0,1,0,1))|all(v[i:(i+5)]==c(1,0,1,0,1,0))){
return(v[-i:-(i+5)])
}
return(v)
}
# aa|bb
rm_aa <- function(v){ # remove 1st two aa or bb
if(length(v)<2) return(v)
n=length(v)
for(i in 1:(n-1))
if(all(v[i:(i+1)]==c(0,0))|all(v[i:(i+1)]==c(1,1))){
return(v[-i:-(i+1)])
}
return(v)
}
rm_aaR <- function(v){ # recursively remove aa or bb while checking abababa or bababa
if(length(v)==6){
if(all(v==c(1,0,1,0,1,0))|all(v==c(0,1,0,1,0,1))) return(c(0,0))
}
if(length(v)==2) return(v)
else{
v1=rm_aa(v)
Recall(v1)
}
}
res=apply(perm,1,rm_aaR)
res=t(res)
sum(res[,1]==0 & res[,2]==0)
idx=which(res[,1]==0 & res[,2]==0)
Ans=perm[idx,]
AB=Ans+1
rownames(AB)=NULL
.ab=c('a','b')
indx2char <- function(x,ab=.ab){
n=length(x)
re=NULL
for(i in 1:n) re[i]=ab[x[i]]
re
}
print(t(apply(AB,1,indx2char)),quote = FALSE)
- 208 ：
- A：安倍が死ぬ
B：日本は幸せ
A∧（A→B））
↓
A∧（￢A∨B）
↓
￢（A∧￢A）
↓
B
- 209 ：
- Gacha.fm <- function(p,write=FALSE){
n=length(p)
par=letters[1:n]
fm <- function(v){
nv=length(v)
re=character(nv)
for(j in 1:nv) re[j]=par[v[j]]
s=paste(re,collapse='+')
if(nv==1) paste0('1/',s)
else paste0('1/(',s,')')
}
fm1 <- function(mat){
paste(apply(mat,2,fm),collapse='+')
}
re=list()
for(i in 1:n) re[[i]]=fm1(combn(n,i))
re1=re[[1]]
for(i in 2:(n-1)){
re1=c(re1,ifelse(i%%2,' + ',' - '),'{',re[[i]],'}')
}
output=paste(paste(re1,collapse=""),ifelse(n%%2,'+','-'), re[[n]])
cat(output,'\n')
if(write) write(output,'output.txt')
invisible(output)
}
- 210 ：
- jags4prop <- function(r1,r2,n1,n2,
ROPEdiff=c(-0.025,0.025),ROPErate=c(0.80,1.25),
NNT=FALSE){
library(rjags)
y=c(rep(1,r1),rep(0,n1-r1),rep(1,r2),rep(0,n2-r2))
s=as.numeric(factor(c(rep('D',n1),rep('U',n2))))
a=1 ; b=1 # JAGS prior : beta(a,b)
myData=data.frame(y=y,s=s)
Ntotal = length(y)
Nsubj = length(unique(s))
dataList = list(
y = y ,
s = s ,
Ntotal = Ntotal ,
Nsubj = Nsubj
)
# JAGS model
modelString = paste0("
model {
for ( i in 1:Ntotal ) {
y[i] ~ dbern( theta[s[i]] )
}
for ( sIdx in 1:Nsubj ) {
theta[sIdx] ~ dbeta(", a,',' , b," )
}
}
")
writeLines( modelString , con="TEMPmodel.txt" )
jagsModel = jags.model( file="TEMPmodel.txt" , data=dataList, quiet=TRUE)
update(jagsModel)
codaSamples = coda.samples( jagsModel , variable="theta", n.iter=10000 )
mcmcMat=as.matrix(codaSamples)
rate1=mcmcMat[,1]
rate2=mcmcMat[,2]
x11()
par(mfrow=c(2,2))
BEST::plotPost(rate1,col='gray')
if(NNT){
BEST::plotPost(abs(1/(rate1-rate2)), xlab ='NNT(NNH)',col='pink')}
else{
BEST::plotPost(rate1-rate2,compVal=0,ROPE=ROPEdiff,cex=1,col='pink')
}
BEST::plotPost(rate2,col='gray')
BEST::plotPost(rate1/rate2,compVal=1,ROPE=ROPErate,col='skyblue')
invisible(codaSamples)
}
jags4prop(50,19,133,113)
- 211 ：
- --コンパイルしてコマンドラインから実行できるように改変（但し、エラー処理皆無）
import System.Environment
import Data.List
import Data.List.Split
combinations :: Int -> [a] -> [[a]]
combinations 0 _ = [ [] ]
combinations n xs = [ y:ys | y:xs' <- tails xs, ys <- combinations (n-1) xs']
main = do
argList <- getArgs -- m : 縦マス(短軸） n : 横マス(長軸) k : 宝の数
let m = read (argList !! 0)
n = read (argList !! 1)
k = read (argList !! 2)
q = [0..m*n-1]
matQ = chunksOf n q
matP = transpose matQ --行列を転置して
p = concat matP -- 配列に変換
treasure = combinations k q -- 宝の組み合わせ
ip y = minimum $ map(\x -> elemIndices x p!!0) y -- 宝の、配列ｐでのindex列を求めて最小値を返す
iq y = minimum $ map(\x -> elemIndices x q!!0) y
idxp = map ip treasure -- 宝の組み合せで実行して
idxq = map iq treasure
p_q = zipWith (-) idxp idxq -- 差をとって大小判別
p1st = length $ filter (<0) p_q -- 短軸方向探索ｐが先に宝をみつける
q1st = length $ filter (>0) p_q
draw = length $ filter (==0) p_q
putStrLn $ "p1st = " ++ show p1st ++ ", q1st = " ++ show q1st ++ ", draw = " ++ show draw
- 212 ：
- pdf2hdi <- function(pdf,xMIN=0,xMAX=1,cred=0.95){
nxx=1001
xx=seq(xMIN,xMAX,length=nxx)
xx=xx[-nxx]
xx=xx[-1]
xmin=xx[1]
xmax=xx[nxx-2]
AUC=integrate(pdf,xmin,xmax)$value
PDF=function(x)pdf(x)/AUC
cdf <- function(x) integrate(PDF,xmin,x)$value
ICDF <- function(x) uniroot(function(y) cdf(y)-x,c(xmin,xmax))$root
hdi=HDInterval::hdi(ICDF,credMass=cred)
print(c(hdi[1],hdi[2]),digits=5)
invisible(ICDF)
}
# N個のクジでr個めで初めてあたった時のN個内の当たり数の推測
Atari <- function(N,r){
pmf <- function(x) ifelse(x>N-r+1,0,(1-x/N)^(r-1)*x/N) # dnbinom(r-1,1,x/N) ; dgeom(r-1,x/N)
# curve((1-x/N)^(r-1)*x/N,0,N)
AUC=integrate(pmf,0,N)$value
pdf <- function(x) pmf(x)/AUC
mode=optimise(pdf,c(0,N),maximum=TRUE)$maximum
mean=integrate(function(x)x*pdf(x),0,N)$value
cdf <- function(x) integrate(pdf,0,x)$value
median=uniroot(function(x)cdf(x)-0.5,c(0,N))$root
print(c(mode=mode,median=median,mean=mean))
pdf2hdi(pdf,0,N,cred=0.95)
}
Atari(100,3)
# 全体N個中当たりS個、1個ずつ籤を引いて当たったらやめる.
# r個めが初めて当たりであったときSの信頼区間を推定するシミュレーション。
atari <- function(N,r,k=1e3){ # k: simlation times
f <- function(S,n=N){which.max(sample(c(rep(1,S),rep(0,n-S))))}
vf=Vectorize(f)
sim=replicate(k,vf(1:(N-r)))
s=which(sim==r)%%(N-r)
s[which(s==0)]=N-r
hist(s,freq=T,col='skyblue')
print(quantile(s,c(.025,.05,.50,.95,.975)))
print(HDInterval::hdi(s))
}
atari(100,3,1e3)
- 213 ：
- from fractions import Fraction
def seq_dice(N,k,p=1/2):
P=list()
for n in range(k-1):
P.append(0)
P.append(p**k)
P.append(p**k + (1-p)*p**k)
for n in range (k,N):
P.append(P[n]+(1-P[n-k])*p**(k+1))
return(P[N])
def seq_diceJ(N,k,p=1/2):
return(seq_dice(N,k,p) - seq_dice(N,k+1,p))
def dice(N,k,p=1/2):
print("Over " + str(k))
print(Fraction(seq_dice(N,k,p)))
print(" = " + str(seq_dice(N,k,p)))
print("Just " + str(k))
print(Fraction(seq_diceJ(N,k,p)))
print(" = " + str(seq_diceJ(N,k,p)))
dice(100000000,25)
- 214 ：
- Over 25
6977459029519597/9007199254740992
= 0.7746535667951356
Just 25
2246038053550679/9007199254740992
= 0.24936031612362342
- 215 ：
- seqNp <- function(N=100,K=5,p=0.5){
if(p==0) return(0)
if(N==K) return(p^K)
q=1-p
a=numeric(N) # a(n)=P0(n)/p^n , P0(n)=a(n)*p^n
for(i in 1:K) a[i]=q/p^i # P0(i)=q
for(i in K:(N-1)){ # recursive formula
a[i+1]=0
for(j in 0:(K-1)){
a[i+1]=(a[i+1]+a[i-j])
}
a[i+1]=q/p*a[i+1]
}
P0=numeric(N)
for(i in 1:N) P0[i]=a[i]*p^i # P0(n)=a(n)*p^n
MP=matrix(rep(NA,N*K),ncol=K)
colnames(MP)=paste0('P',0:(K-1))
MP[,'P0']=P0
MP[1,'P1']=p
for(i in (K-2):K) MP[1,i]=0
for(k in 2:K){
for(i in 1:(N-1)) MP[i+1,k]=p*MP[i,k-1]
} # Pk(n+1)=p*P(k-1)(n)
ret=1-apply(MP,1,sum)
ret[N]
}
seqNpJ <- function(N,K,p) seqNp(N,K,p)-seqNp(N,K+1,p)
seqNpJ(100,5,0.5)
- 216 ：
- seq2pCI <- function(N,K,alpha=0.05,Print=T){
vp=Vectorize(function(p)seqNp(N,K,p)-seqNp(N,K+1,p))
if(Print){curve(vp(x),lwd=2,bty='l',xlab='Pr[head]',ylab=paste('Pr[max',K,'-head repetition]'))
abline(h=alpha,lty=3)}
peak=optimize(vp,c(0,1),maximum=TRUE)$maximum
mean=integrate(function(x)x*vp(x),0,1)$value/integrate(function(x)vp(x),0,1)$value
lwr=uniroot(function(x,u0=alpha) vp(x)-u0,c(0.01,peak))$root
upr=uniroot(function(x,u0=alpha) vp(x)-u0,c(peak,0.99))$root
c(lower=lwr,mean=mean,mode=peak,upper=upr)
}
seq2pCI(100,5,0.05,T) # pmfからの計算で正しいか？
vs=Vectorize(function(K)seq2pCI(N=100,K,alpha=0.05,Print=F))
x=2:23
y=vs(x)
head(y)
y=y*100
plot(x,y['mean',],bty='l',pch=19,ylim=c(0,100),
xlab="最大連続数",ylab="推定裏口入学者数")
points(2:23,y['mode',],bty='l')
segments(x,y['lower',],x,y['upper',])
legend('right',bty='n',pch=c(19,1),legend=c("期待値","最頻値"))
- 217 ：
- # pdfからcdfの逆関数を作ってhdiを表示させて逆関数を返す
# 0,1での演算を回避 ∫[1/nxxx,1-1/nxx]dxで計算
pdf2HDI <- function(pdf,xMIN=0,xMAX=1,cred=0.95,nxx=1001){
xx=seq(xMIN,xMAX,length=nxx)
xx=xx[-nxx]
xx=xx[-1]
xmin=xx[1]
xmax=xx[nxx-2]
AUC=integrate(pdf,xmin,xmax)$value
PDF=function(x)pdf(x)/AUC
cdf <- function(x) integrate(PDF,xmin,x)$value
ICDF <- function(x) uniroot(function(y) cdf(y)-x,c(xmin,xmax))$root
hdi=HDInterval::hdi(ICDF,credMass=cred)
c(hdi[1],hdi[2])
}
# N試行で最大K回連続成功→成功確率ｐの期待値、最頻値と95%HDI
# max K out of N-trial to probability & CI
mKoN2pCI <- function(N=100 , K=4 , conf.level=0.95){
pmf=Vectorize(function(p)seqNp(N,K,p)-seqNp(N,K+1,p))
mode=optimize(pmf,c(0,1),maximum=TRUE)$maximum
auc=integrate(pmf,0,1)$value
pdf=function(x) pmf(x)/auc
mean=integrate(function(x)x*pdf(x),0,1)$value
curve(pdf(x),lwd=3,bty='l',xlab='Pr[head]',ylab='density')
lu=pdf2HDI(pdf,cred=conf.level)
curve(pdf(x),lu[1],lu[2],type='h',col='lightblue',add=T)
c(lu[1],mean=mean,mode=mode,lu[2])
}
mKoN2pCI(100,4) # one minute plz
mKoN2pCI(100,5)
- 218 ：
- # N試行で最大K回連続成功→成功確率ｐの期待値、最頻値と95% Quantile
# max K out of N-trial to probability & CI_quantile
mKoN2pCIq <- function(N=100 , K=4 , alpha=0.05){
pmf=Vectorize(function(p)seqNp(N,K,p)-seqNp(N,K+1,p))
mode=optimize(pmf,c(0,1),maximum=TRUE)$maximum
auc=integrate(pmf,0,1)$value
pdf=function(x) pmf(x)/auc
curve(pdf(x),bty='l')
mean=integrate(function(x)x*pdf(x),0,1)$value
cdf=function(x) MASS::area(pdf,0,x)
vcdf=Vectorize(cdf)
lwr=uniroot(function(x)vcdf(x)-alpha/2,c(0,mode))$root
upr=uniroot(function(x)vcdf(x)-(1-alpha/2),c(mode,1))$root
c(lower=lwr,mean=mean,mode=mode,upper=upr)
}
mKoN2pCIq(100,4)
mKoN2pCIq(100,5)
## simulation
mKoN2pCIga<-function(N=100,K=4,Print=T){
pmf=Vectorize(function(p)seqNp(N,K,p)-seqNp(N,K+1,p))
auc=integrate(pmf,0,1)$value
pdf=function(x) pmf(x)/auc
(mode=optimize(pmf,c(0,1),maximum=TRUE)$maximum)
(mean=integrate(function(x)x*pdf(x),0,1)$value)
(var=integrate(function(x)(x-mean)^2*pdf(x),0,1)$value)
(sd=sqrt(var))
#正規分布で近似してみる
if(Print){
curve(pdf,bty='l',col='red')
curve(dnorm(x,mean,sd),add=T,col='blue')}
c(lower=qnorm(0.025,mean,sd),mode=mode,mean=mean,upper=qnorm(0.975,mean,sd))
}
mKoN2pCIga(100,5)
vmK=Vectorize(function(K) mKoN2pCIga(100,K))
(y=cbind(0,vmK(2:30)))
plot(1:30,y['mean',],pch=19)
points(1:30,y['mode',])
- 219 ：
- # random numbers following PDF by John von Neuman's method
vonNeumann <- function(PDF,xmin=0,xmax=1,N=10000,Print=TRUE,...){
xx=seq(xmin,xmax,length=N+1)
ymax=max(PDF(xx))
Ux=runif(N,xmin,xmax)
Uy=runif(N,0,ymax)
Rand=Ux[which(Uy<=PDF(Ux))]
if(Print){
hist(Rand,xlim=c(xmin,xmax),freq=FALSE,col=sample(colors(),1),main='',...)
AUC=integrate(PDF,xmin,xmax)$value
lines(xx,sapply(xx,function(x)PDF(x)/AUC))
}
hdi=HDInterval::hdi(Rand)
print(c(hdi[1],hdi[2]),digits=4)
invisible(Rand)
}
vonNeumann2 <- function(PDF,xmin=0,xmax=1,N=10000,Print=TRUE,...){
xx=seq(xmin,xmax,length=N+1)
xx=xx[-(N+1)]
xx=xx[-1]
ymax=max(PDF(xx))
Ux=runif(N,xmin,xmax)
Uy=runif(N,0,ymax)
Rand=Ux[which(Uy<=PDF(Ux))]
if(Print){
hist(Rand,xlim=c(xmin,xmax),freq=FALSE,col=sample(colors(),1),main='',...)
AUC=integrate(PDF,xmin,xmax)$value
lines(xx,sapply(xx,function(x)PDF(x)/AUC))
}
hdi=HDInterval::hdi(Rand)
print(c(hdi[1],hdi[2]),digits=5)
invisible(Rand)
}
- 220 ：
- seq_dice <- function(N=100,k=5,p=1/2){
P=numeric(N)
for(n in 1:(k-1)){
P[n]=0
}
P[k]=p^k
P[k+1]=p^k+(1-p)*p^k
for(n in (k+1):(N-1)){
P[n+1] = P[n] + (1-P[n-k])* p^(k+1)
}
return(P[N])
}
seq_dice()
seq_diceJ <- function(N=100,k=5,p=1/2){ # Just k sequence
seq_dice(N,k,p)-seq_dice(N,k+1,p)
}
seq_diceJ()
seq_diceJ(100,5,1/2)
seq_diceJ(1000000,18,1/2)
#
vsdJ=Vectorize(seq_diceJ)
N=1e5
kk=1:30
p=0.5
y=vsdJ(N,kk,0.5)
which.max(y) # 1e2:5 1e3:9 1e4:12 1e5:15 1e6:18 1e7:22 1e8:25
plot(kk,y,bty='l',pch=19,xlab='sequence',ylab='probability')
cbind(kk,y)
max(y)
Nd2mps <- function(N){ # N dice to most probable sequence
vsdJ=Vectorize(seq_diceJ)
k=min(N/2,30)
kk=1:min(k)
y=vsdJ(N,kk,0.5)
# c(seq=which.max(y),prob=max(y))
return(which.max(y))
}
Nd2mps(777)
vN2s=Vectorize(Nd2mps)
nn=seq(200,600,by=1)
y=vN2s(nn)
range(nn[y==7])
plot(nn,y,bty='l')
- 221 ：
- abura <- function(Amax=10,Bmax=7,Cmax=3,a=10,b=0,c=0,A=5,B=5,C=0){
# http://tpcg.io/rvz4qS
# Amax=10 ; Bmax=7 ; Cmax=3 # capacity
# t0 = c(10,0,0) # initial state
# goal = c(5,5,0) # goal
t0=c(a,b,c)
goal=c(A,B,C)
.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)
}
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
- 222 ：
- 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)
}
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)
}
state=NULL
while(!is.goal(.stack[1,])){
push(transfer(pop()))
state=rbind(state,.stack[1,])
}
return(state)
}
- 223 ：
- / / ,, ―― 、
/ / .|;:::: ::::|
⊂二(⌒)二二二|;:::: ::::|⊃ /', ', ¨
，.･,-:'ヾ|!|!,i,,!;,,,!l,･∵･， ゴーン !!
::::::”从;i,i:;'／从‘,:::::::::
../::::::== `-::::::::ヽ
|:::::::／.,,,=≡, ,≡=、l::::::l
i::::::l .,／ﾟ＼三／ﾟ＼ l:::::!
.|:::| :⌒ ﾉ.. i＼: ⌒ |:::i
(6″ ,ィ____.i i i:/
ヽ u / l .i i ぎゃああ
ヽ_ ノ `ﾄｪｪｪｲヽ、 _/ イクぅうう～
ヽ、ヽ | |ー'´／ '
｀"ーU－´ﾉ "' ・
∴ " ' " _i;i____ , ' ｽﾎﾟｯ
": " ヾ .／ 从 人 ´: ": "
＿人＿＿ノ ヽ＼＿_
| ＼
.| i u |
| | | |
{ ＼ | |
,/ ＼ ＼___ | | ﾞ ﾋﾟｭﾂ ﾟ
/ ＼ ヽ-┐ ┐,-=,, ﾟ。 ＿,,,,,.....,,,
/ ＼ ( ￣U ＼_..ノ. .・――-==-=::::..... ...)
/ u / LLLL-nnnn-= 。 ￣`'
/ /(:,,,.人.,,.) ＼
/ ／ ＼ 〉
- 224 ：
- 「阿部が死ぬ」の否定は「阿部は死なない」でしょ。
決して「阿部が死んでいない」ではないよ。
- 225 ：
- /::::::::== - ~ `-::::::ヽ
|:::::::／ _,=ノ ヽ =~､ l:::::i
i::::::l ﾉ（｡ ）三（ ﾟ ）u :::! ＼ ヽ／ ＿＿ ＿|＿
|:::| ⌒ ﾉ/ i丶⌒ |::i ￣ヽ ∠ｰｰ ヽ ―|―
(::| ィ＿__） ) __ノ (＿ ＿ノ ＼＿
ヽ u /::::/::::ﾉ / ＿＿＿ ＿＿＿
ヽ ノ::|ｴlｴI::ヽ _ﾉ ／|ヽ |
.＿＿＿人 ｀:～:´ 人＿＿ ／ .| ＼ | .|￣
／ ／ ｀ "―´´ ＼ ＼ | ＿|___|＿_
| ＞ ＼▼ / く ＼
| ＼ ＼ ヽ◆／ ／＿つ/￣ヽ
| ＼ // ／< ＿__)（ ニニ)
- 226 ：
- 【超悪質！盗聴盗撮・つきまとい嫌がらせ犯罪者の実名と住所を公開】
①井口・千明（東京都葛飾区青戸６－２３－１６）
※盗聴盗撮・嫌がらせつきまとい犯罪者のリーダー的存在／犯罪組織の一員で様々な犯罪行為に手を染めている
低学歴で醜いほどの学歴コンプレックスの塊／超変態で食糞愛好家である／醜悪で不気味な顔つきが特徴的である
②宇野壽倫（東京都葛飾区青戸６－２３－２１ハイツニュー青戸２０２）
※色黒で醜く太っている醜悪黒豚宇野壽倫／低学歴で人間性が醜いだけでなく今後の人生でもう二度と女とセックスをすることができないほど容姿が醜悪である
③色川高志（東京都葛飾区青戸６－２３－２１ハイツニュー青戸１０３）
※色川高志はyoutubeの視聴回数を勝手に短時間に何百何千時には何万回と増やしたり高評価・低評価の数字を一人でいくつも増やしたり減らしたりなどの
youtubeの正常な運営を脅かし信頼性を損なわせるような犯罪的業務妨害行為を行っています
※色川高志は現在、生活保護を不正に受給している犯罪者です／どんどん警察や役所に通報・密告してやってください
【通報先】
◎葛飾区福祉事務所（西生活課）
〒１２４－８５５５
東京都葛飾区立石５－１３－１
℡０３－３６９５－１１１１
④清水（東京都葛飾区青戸６－２３－１９）
※低学歴脱糞老女：清水婆婆 ☆☆低学歴脱糞老女・清水婆婆は高学歴家系を一方的に憎悪している☆☆
清水婆婆はコンプレックスの塊でとにかく底意地が悪い／醜悪な形相で嫌がらせを楽しんでいるまさに悪魔のような老婆である
⑤高添・沼田（東京都葛飾区青戸６－２６－６）
※犯罪首謀者井口・千明の子分／いつも逆らえずに言いなりになっている金魚のフン／親子孫一族そろって低能
⑥高橋（東京都葛飾区青戸６－２３－２３）
※高橋母は夫婦の夜の営み亀甲縛り食い込み緊縛プレイの最中に高橋親父にどさくさに紛れて首を絞められて殺されそうになったことがある
⑦長木義明（東京都葛飾区青戸６－２３－２０） ※日曜日になると風俗店に行っている
- 227 ：
- 譲治さんは令和元年9月2日 (2019/09/02) にお亡くなりです。合掌。
- 228 ：
- 譲二さんは令和元年9月2日 (2019/09/02) にお亡くなりです。合掌。
ジョージは偉い男だった。
彼の偉さは数学者として一生大人にならなかった、ということなんだ。
ところが息子のギャレットはおそろしく早く大人になってしまった。
それが彼の最大の欠点さ。
でも、それがもしジョージのせいだとしたら、
それこそジョージの最大の欠点ということになるんだろうなぁ。
数セミ増刊「100人の数学者」 日本評論社 (1989) p.193
- 229 ：
- しばしば漢字を読み間違える人のために、閣議議事録の副本として
「まんが 閣議議事録」
というのを作成したらいいと思うよ。
- 230 ：
- アベベ・ビキラ さんは 1973/10/25 にお亡くなりです。合掌。
エチオピア出身の陸上競技 (長距離走)選手で、オリンピックのマラソン種目で史上初の2大会連続優勝を果たし、2個の金メダルを獲得した。
(1960年 ローマ、1964年 東京)
サハラ以南のアフリカ出身者としては初のオリンピック金メダル獲得者でもある。オモロイ人だった。
- 231 ：
- A生氏はF岡市長選挙の応援演説で、F岡市の人口増加の実績に触れながら、
「K九州市と比べると分かりやすい。人の税金を使って学校に行った。」
と国立大学出身のK九州市長を批判した。
さて、A生氏はこれをどう読むか？
正： 「こくりつだいがく」
誤： 「くにたちだいがく」
- 232 ：
- 3930
かずきち@dy_dt_dt_dx 8月28日
学コン8月号Sコース1等賞1位とれました！
マジで嬉しいです！
来月からも理系に負けず頑張りたいと思います！
https://twitter.com/dy_dt_dt_dx
(deleted an unsolicited ad)
- 233 ：
- 安倍首相が居なくても幸せ出なかった時がある以上対偶は反例を持ち偽、よって命題は偽
なに騙されてんだアホwww
- 234 ：
- >>1
Stomachache freaks Don't miss it!
HERE IT COMES!━━━━(ﾟ∀ﾟ)━━━━!!
FOR SALE : Scarcity value！
Poison contain Protein Powder
Poison contain EAA Powder
Poison contain BCAA Powder
Poison contain Glutamine Powder
Effect : To be able to experience fantastic Stomachache World!
Medicine half-life 12hours : Let`s enjoy spectacular Stomachache Night!!
PRICE : 1Bllion Dollars Each
Sample $500 (10g) quantity of stock 6packs
★New products have arrived！!
Poison contain BCAA Powder Mild Type (smell bad)
×5quarter size bags(Include 3unread bags) 75%Discount!!
First come, First served！
BRAND NAME COMING SOON!!!!!
- 235 ：
- >>1
" MURPHY'S HOTEL "
Welcome to MURPHY'S HOTEL!! HERE IT COMES!━━━━(ﾟ∀ﾟ)━━━━!!
``Optional tour``〈Today's activity〉
★Fanny Street Watching tour $40 (bring you by shuttle bus)
This town has so fanny street that the Car races are held every day.
Participating cars are ambulances, police cars, electric patrol cars,
gas patrol cars, and motorcycles with various sirens.
This is a race like the Monaco Grand Prix or Tom and Jerry.
It's Amazing!
The audience is chaotic too. A dog barks, a child cries,
and an adult cheers while moving a big wheeled suitcase.
Please join us as a memory of your trip!
~Features of MURPHY'S HOTEL~
1. The TV remote control in the room suddenly disappears.
2. The water pressure becomes weak only when you use the shower.
3. There are many parents who make their children cry and cry on purpose.
4. There are many owners who make their dogs cry and cry on purpose.
5. The boasting of the sound of motorcycles often appears to hear the sound.
6.There may be foreign matter like a piece of plastic in sushi at a sushi bar.
7. You're the only one in the room, but there's a roll of toilet paper on the toilet seat.
8. Fake Usain Bolt, who overtakes you with a dash all of a sudden, comes out.
9. The road construction starts when you check in, and it ends when you check out.
10. When you boot up your laptop, hackers from all over the country visit you.
11. When you check in, the train passing by turns into Miles Davis.
But don't worry. So here is MURPHY!! Thank you!━━━━(ﾟ∀ﾟ)━━━━!!
- 236 ：
- >>1
New Store Openings!! Funny BABER Freaks Don't miss it!!
" MURPHY'S BARBERSHOP "
HERE IT COMES!━━━━(ﾟ∀ﾟ)━━━━!!
We will keep three important promises.
①We are going to artificially shorten one side and unbalance it.
②We will make your hair shorten if you want to long it.
③We promise that it will never happen as you wish.
PRICE
Hair cut: 1Bllion Dollars
Hair cut & Shave: 1.5 Bllion Dollars
Eyebrow cut: Harf Bllion Dollars (We confident that it will be asymmetrical)
THANK YOU!!━━━━(ﾟ∀ﾟ)━━━━!!!
- 237 ：
- Ave Maria (??/09/08誕生 ～ ??/08/15被昇天) 聖母(イエス・キリストの母)
- 238 ：2020/01/25
- アベ一族の運命は↓
http://www.aozora.gr.jp/cards/000129/files/673_23255.html
森鴎外：中央公論 (1913/Jan)
「阿部茶事談」
角の三等分は可能なのだそうだ
点の長さは0である。しかし点の集まりである線には長さが存在する。
微分幾何学スレ
東京理科大学理学部数学科・数理情報学科
（・∀・）ﾔｺﾋﾞﾔｰﾝ! ２
大学学部レベル質問スレ 11単位目
ピタゴラス数をなんと ～荒らされたので立て直しました～
現代数学の系譜 工学物理雑談 古典ガロア理論も読む41
分からない問題はここに書いてね446
数学板の住民は全員、東大数学解けるんだよね？
--------------------
鮫島事件
電気通信工事施工管理技士 part3
【新型肺炎感染者】「国内で400人超」報道はミスリード 350人超が船内感染[2/17]
三菱鉛筆 JETSTREAM/ジェットストリーム 8
和歌山県内の温泉、銭湯スレ
レオパードゲッコー・ヒョウモントカゲモドキ71匹目
◆結局今まで何人暗殺されたの？２◆
東方キャラ＋タイツ★7足目
【超最強】PM-G８２０スレpart1【G800粗大ゴミ】
小腹がすいた時のお手軽パスタソース
【エコノミークラス正規料金】新型肺炎 現地邦人ら「帰国便8万円」戸惑い 「高過ぎる」公費支出求める声 ★3
井上雄彦 『リアル』 part11
世代別対抗駅伝をしたらどこが優勝するのか？
台湾の美麗的女性が大好きです！
【タガタメ】 誰ガ為のアルケミスト Part.989【技術もセンスも無い無能運営】
正直これ以上乃木坂が上に行く要素が見つからないんだが
【海外ドラマ】『#ゲームオブスローンズ 最終章』 いよいよ本日最終回！！ 本日AM10時 スターチャンネル にて世界同時放送
【Hey以外の】 秋葉原のゲーセン事情 58
【札幌すすきの】●● だるま ●●【ジンギスカン】
■【ﾘﾝﾀﾞ･ﾊﾐﾙﾄﾝ】 ターミネーター：ニュー・フェイト 【ｼﾘｰｽﾞ復帰作】
TOP カテ一覧 スレ一覧 100～終まで 2ch元 削除依頼
