底辺私立医大を卒業した医者って頭悪いよね? Part17at HOSP
底辺私立医大を卒業した医者って頭悪いよね? Part17 - 暇つぶし2ch51:卵の名無しさん
20/06/26 16:07:45.68 vSOmQn7C.net
# simulation of 2 alive to 1 alive
# Notice who has the right to shoot
f2 <- function(){
re3=f3() # simulation to 2 suvivors
a=re3$abc[1] # 1 1
b=re3$abc[2] # 1 0
c=re3$abc[3] # 0 1
while(a+b+c==2){ # while 2 alive
if(c==0){ # when C dead
if(re3$bshoot){ # when A killed C, B can shoot A
a=rbinom(1,1,qb)
if(a==0) return(c(a,b,c))
}
else{ # when B killed C
b=rbinom(1,1,qa) # A can shoot B
if(b==0) return(c(a,b,c))
}
}
else{ # when C alive (C killed B, C shot at superior B)
c=rbinom(1,1,qa) # A can shoot C
if(c==0) return(c(a,b,c)) # if A killed C
a=rbinom(1,1,qc) # when A missed C,C can shoot A
if(a==0) return(c(a,b,c)) # C can always kill A
}
}
}
k=1e5
re2=replicate(k,f2())
apply(re2,1,mean) # c(1/2,1/6,1/3)

52:卵の名無しさん
20/06/26 19:47:21 vSOmQn7C.net
# 乱射狙撃手
rm(list=ls())
RandomDuel <- function(
pa=1/3, # probability of death
pb=1/2,
pc=1,
k=1e5){
ps=c(1-pa,1-pb,1-pc) # probability of survival
f32 <- function(){
abc=c(1,1,1) # survival probability
shop=c(0,0,0) # shooting priority for A,B,C
while(sum(abc)==3){ # while 3 suviors
bc=c(2,3) # A shoots B or C
i=sample(1:2,1) # index of target bc
alive=abc[bc[i]]=rbinom(1,1,ps[1]) # target alive or dead
if(alive==0){ # if either killed
shop[bc[-i]]=1 # the survivor gets shooting priority
break
}
ca=c(3,1) # B shoots C or A
i=sample(1:2,1) # index of target ca
alive=abc[ca[i]]=rbinom(1,1,ps[2]) # target alive or dead
if(alive==0){ # if either killed
shop[ca[-i]]=1 # the survivor gets shooting priority
break
}

53:卵の名無しさん
20/06/26 19:47:32 vSOmQn7C.net
ab=c(1,2)
i=sample(1:2,1)
alive=abc[ab[i]]=rbinom(1,1,ps[3])
if(alive==0){
shop[ab[-i]]=1
break
}
}
return(list(abc=abc,shop=shop))
}

# verify
f32()
re32=replicate(1e4,f32()$abc)
apply(re32,1,mean)

f21 <- function(){ # two suvivors to 1 survivor
re32=f32() # which two survive and who has shooting priority
abc=re32$abc # alive or dead
shop=re32$shop # who has shooting priority
while(sum(abc)==2){ # while 2 survivors
shooter=which(abc==1 & shop==1) # shooter shoots
target =which(abc==1 & shop==0) # the target
alive=abc[target]=rbinom(1,1,ps[shooter]) # alive or dead
if(alive==0) break # break if someone killed
}
return(abc)
}

54:卵の名無しさん
20/06/26 19:47:37 vSOmQn7C.net
f21()
# k=1e5
re21=replicate(k,f21())
return(apply(re21,1,mean))
}
RandomDuel(1/3,1/2,1)
RandomDuel(1,1,1)

55:卵の名無しさん
20/06/27 00:10:12 aWO+D22+.net
本人は寄付金は払わずに合格したつもりだけど
親御さんは合格を喜んでる息子に本当のことを
言えないと言うのが私立医大合格者の実情らしい。

56:卵の名無しさん
20/06/27 06:11:18 Zi3cCzHj.net
ド底辺シリツ医入学というだけで、ド底辺シリツ医大の莫大な学費が払える経済環境にありながら教育投資しても
ド底辺シリツ医大にしか入れなかったアホとわかる。

57:卵の名無しさん
20/06/27 09:28:03.11 Zi3cCzHj.net
中国語になった和製漢語の例として、「意識」、「右翼」、「運動」、「階級」、「共産主義」、「共和」、「左翼」、「失恋」、「進化」、「接吻」、「唯物論」など種々の語がある。

58:卵の名無しさん
20/06/27 14:03:40.96 Zi3cCzHj.net
rm(list=ls()) # clear workspace
p=c(1/3,1/2,1) # killing probablity
q=1-p # survival probability
# Three survivors to two survivors
f32 <- function(init=1){
abc=c(1,1,1) # dead or alive
n=length(abc) # initial survivors 3
s=sum(abc) # current survivors
sh=init # initial shooter
while(s==n){ # while 3 survivors
tmp=p
tmp[sh]=0 # set shooter for 0 probability (could be negative)
target=which.max(tmp) # target : the superior sniper
abc[target]=rbinom(1,1,q[sh]) # target dead(0) or alive(1)
# next shooter : if next sniper alive next index, otherwise survived sniper
sh=ifelse(abc[sh%%n+1]==1,sh%%n+1,(1:n)[-c(sh,target)])
s=sum(abc) # how many surviors left
}
list(abc=abc,sh=sh)
}

59:卵の名無しさん
20/06/27 14:04:18.01 Zi3cCzHj.net
# demo
f32()
apply(replicate(1e5,f32()$abc),1,mean)
# Two survivors to one survivor
f21 <- function(){ # Three survivors to 2 survivor
re32=f32() # two surviors & next shooter
abc=re32$abc # two survivor
sh=re32$sh # shooter
sv=which(abc==1) # index of two suvivor
target=sv[sv!=sh] # index of target
s=sum(abc)
while(s==2){ # while two survivors, mutual shooting
abc[target]=rbinom(1,1,q[sh]) # target dead(0) or alive(1)
s=sum(abc) # how many surviors left
tmp=target # exhange shooter for target
target=sh
sh=tmp
}
abc
}
f21()
apply(replicate(1e5,f21()),1,mean)

60:卵の名無しさん
20/06/27 14:19:16 Zi3cCzHj.net
rm(list=ls()) # clear workspace

p=c(1/3,1/2,1) # killing probablity
q=1-p # survival probability

# Three survivors to two survivors
f32 <- function(init=1){
abc=c(1,1,1) # dead or alive
n=length(abc) # initial survivors 3
s=sum(abc) # current survivors
sh=init # initial shooter
while(s==n){ # while 3 survivors
tmp=p
tmp[sh]=0 # set shooter for 0 probability (could be negative)
target=which.max(tmp) # target : the superior sniper
abc[target]=rbinom(1,1,q[sh]) # target dead(0) or alive(1)
# next shooter : if next sniper alive next index, otherwise survived sniper
sh=ifelse(abc[sh%%n+1]==1,sh%%n+1,(1:n)[-c(sh,target)])
s=sum(abc) # how many surviors left
}
list(abc=abc,sh=sh)
}
# demo
f32()
apply(replicate(1e5,f32()$abc),1,mean)

61:卵の名無しさん
20/06/27 14:19:21 Zi3cCzHj.net
# Two survivors to one survivor
f21 <- function(){ # Three survivors to 2 survivor
re32=f32() # two surviors & next shooter
abc=re32$abc # two survivor
sh=re32$sh # shooter
sv=which(abc==1) # index of two suvivor
target=sv[sv!=sh] # index of target
s=sum(abc)
while(s==2){ # while two survivors, mutual shooting
abc[target]=rbinom(1,1,q[sh]) # target dead(0) or alive(1)
s=sum(abc) # how many surviors left
tmp=target # exhange shooter for target
target=sh
sh=tmp
}
abc
}
f21()
apply(replicate(1e5,f21()),1,mean)

62:卵の名無しさん
20/06/27 16:31:06.34 Zi3cCzHj.net
> apply(replicate(1e5,f21()),1,mean)
[1] 0.36255 0.41738 0.22007
ABCの生存確率の理論は
13/36,15/36,8/36
数学板の助けを借りでデバッグできた。

63:卵の名無しさん
20/06/27 20:31:29.15 Zi3cCzHj.net
数学板には珍しく暗算で答が出せる問題
URLリンク(i.imgur.com)

64:卵の名無しさん
20/06/28 06:17:15.51 SIGrmsx3.net
山梨県の20代の男性は、3月に新型コロナウイルスに感染した後に髄膜炎を発症、一時意識障害もあったが、回復し退院した。
だが、この1~2年間の記憶を失っていることが判明した。
URLリンク(news.livedoor.com)
感染したら医師生命が終わりかもしれんな。
失う記憶すらないド底辺シリツ医は最強かもしれん。
中学の数学すら記憶していないのがド底辺シリツ医。
症例報告
URLリンク(imagizer.imageshack.com)

65:卵の名無しさん
20/06/28 06:22:01.29 SIGrmsx3.net
(仮想事例)
ある開業医が新型コロナ肺炎に罹患したとする。
行動調査によって発症前にキャバクラに行っており接客したキャバ嬢が開業医発症の2日後に発症していたことがわかった。
キャバ嬢は開業医から移されたと主張して1億円の賠償を求めている。
潜伏期間には幅がありキャバ嬢から移された可能性もあると主張してその確率を計算して賠償金を値切りたい。
いくら値切れるか計算せよ。

発症順と感染順が逆転する確率密度を乱数発生させて作ったのがヒストグラム、
これに解析解(といっても数値積分での値)の曲線を重ねてみた。
URLリンク(i.imgur.com)
よく一致しているので
数値積分での結果を使って発症間隔と感染順が発症の逆の確率をグラフにしてみた。
URLリンク(i.imgur.com)
発症が2日間隔だと0.2955891なのでキャバクラ感染ネタでは2956万円値切ることができる。

66:卵の名無しさん
20/06/28 10:42:28.55 4raxPB4V.net
やはり、医師を蔑む常套句だね!
スレリンク(hosp板:745番)
745 卵の名無しさん sage 2020/06/26(金) 23:11:45.37 ID:Mwn80KUd
>>743
不勉強な底辺私大卒なんて相手にすんなや

67:卵の名無しさん
20/06/28 12:27:01.05 uqLusHpk.net
コロナが始まって日本人はマスクを買い増したが
アメリカ人が買い増したのはライフル銃の弾。

68:卵の名無しさん
20/06/28 13:55:39.38 uqLusHpk.net
rm(list=ls())
# while loop version for dec2n
dec2nw <- function(num, N, digit = 4){
r=num%%N
q=num%/%N
while(q > 0 | digit > 1){
r=append(q%%N,r)
q=q%/%N
digit=digit-1
}
return(r)
}

69:卵の名無しさん
20/06/28 13:55:44.70 uqLusHpk.net
price=c(200,200,300,300,400,400)
vec2mat<- function(x){ # binary vector -> matrix 5


70:人 × 6ネタ mat=matrix(x,ncol=6,nrow=5,byrow=T) rownames(mat)=LETTERS[1:5] colnames(mat)=c('いか赤','たこ赤','いくら黒','まぐろ黒','うに金','たい金') mat } (x=dec2nw(10^9,2,digit=30)) (y=vec2mat(x)) fn <- function(y){ pay=apply(y,1,function(x) sum(x*price)) all( all(apply(y,1,sum)>=3), sum(pay)==5000, which.max(pay)==1 & sum(y[1,]*price)==1600, all(y[,4]==1), all(y[1:3,3]==1), sum(y[4,1:2])==2 & sum(y[4,3:4])==1 & sum(y[4,5:6])==1 ) } fn(y) ans=NULL for(i in 1:(2^31-1)){ x=dec2nw(i,2,digit=30) y=vec2mat(y) z=fn(y) if(z==TRUE) ans=append(ans,i) }



71:卵の名無しさん
20/06/28 13:59:58.42 uqLusHpk.net
URLリンク(i.imgur.com)
一般職試験(高卒者試験)
URLリンク(www.jinji.go.jp)

72:卵の名無しさん
20/06/28 14:06:09.02 uqLusHpk.net
fn <- function(y){
pay=apply(y,1,function(x) sum(x*price))
all(
all(apply(y,1,sum)>=3), # 5人は,それぞれ3皿以上注文した。
sum(pay)==5000, # 人が注文した金額の合計は5,000円であった。
which.max(pay)==1 & sum(y[1,]*price)==1600, # 注文した金額が最も多かったのはAで,1,600円
all(y[,4]==1), # 5人とも,「まぐろ」を注文した。
all(y[1:3,3]==1), # A,B,Cは,「いくら」を注文した。
sum(y[4,1:2])==2 & sum(y[4,3:4])==1 & sum(y[4,5:6])==1 # D は,赤皿を2皿,黒皿を1皿,金皿を1皿の合計4皿を注文した。
# all(y<2) # 同じネタを2皿以上注文した者はいなかった。
)
}
fn(y)
ans=NULL
for(i in 1:(2^31-1)){
x=dec2nw(i,2,digit=30)
y=vec2mat(y)
z=fn(y)
if(z==TRUE) ans=append(ans,i)
}

73:卵の名無しさん
20/06/29 02:20:04.82 kaJIrJ2A.net
整数nを十進法表記したとき、どの桁の数も4,7,9のいずれかであり、かつ、4,7,9のいずれも少なくとも1回は現れるという。
このようなn全体からなる集合をSとしたとき、Sの要素で平方数となるものは存在するか。

library(gtools)
library(gmp)
v=c(4,7,9)
fn <- function(n){
pm=permutations(3,n,v,rep=T)
f <- function(x){
if(all(v %in% x)){
y=as.numeric(paste0(x,collapse = ''))
if(is.whole(sqrt(y))) return(y)
}
}
unlist(apply(pm,1,f))
}
i=1
flg=is.null(fn(i))
while(flg){
flg=is.null(fn(i))
i=i+1
print(i-1)
}
fn(i-1)

74:卵の名無しさん
20/06/29 06:29:09 0ZEcuQv3.net
でも底辺私立医大卒の医者が一番の勝ち組だよな。
だって親がお金持ちじゃなかったら本来は医者じゃ
なかったかもしれない連中なんだぜ。
まあ親御さんには一生頭が上がらないとは思うけど、
一番の勝ち組で あることは間違いないよ

75:卵の名無しさん
20/06/29 07:18:36.70 rBYPE8FD.net
こういうのの相手をする野党は忍耐強いね。
>>
山添「つまり趣旨は伝わってるんですよ、総理、いかがですか」
安倍
「ですが、しゅし、趣旨については伝わったという話をいたしましたが、こっ…こっ…チッ…
このですね、この、イワバッ、サァンギンの……………が、書いた、いるですね、この ォー
ギョウセイキカンノホユウスルジョウホウノコウカイニカンスルホウリツニモトヂュイテ、名簿全体を、公開されることもありますと
いうこと、では、キきていない、ということは申し上げた、わけで、あります
で、そもそもですね!えー、この…この、最初の、ないか、えー、れんらく、うー
事務連絡で、かいたあることもですね、えー、カイ請求の対象!とされることも、あります!
とこうかいて、ウェ、ある、わけぇ、で、アリマシテ、対象とされることもありますということとですね、
エ、カイジ、エ、アノム、名簿ジェンタイを公開される、ということとは、これ、エー、…f…fセ、請求の対象トセ!
対象ですから!対象とされたってこと、でありますから、そこが、マァ違うということだとオモマスガ
いずれぇいたしましてもですね、イズレェいたしましても、いわば、ア、そうい、う、方、をですね、
エー、選んでくださいと、いうことについては、ソレァ、当然、エキテイルということは
先ほども申し上げた趣旨、にチュイテハ、申し上げている通りであります」
山添「ちょっとはっきり趣旨が分かりませんけども」
<<
URLリンク(youtu.be)
2分20秒辺りから

76:卵の名無しさん
20/06/29 07:19:15.16 rBYPE8FD.net
人種や民族など本人が選択できないことを根拠とする区別は差別の批判を免れないが、
ド底辺シリツ医大進学は本人の選択だよなぁ。
これな!
不朽の名投稿
>>
私は昭和の時代に大学受験したけど、昔は今よりも差別感が凄く、特殊民のための特殊学校というイメージで開業医のバカ息子以外は誰も受験しようとすらしなかった。
常識的に考えて、数千万という法外な金を払って、しかも同業者からも患者からもバカだの裏口だのと散々罵られるのをわかって好き好んでド底辺医に行く同級生は一人もいませんでした。
本人には面と向かっては言わないけれど、俺くらいの年代の人間は、おそらくは8-9割はド底辺医卒を今でも「何偉そうなこと抜かしてるんだ、この裏口バカが」と心の底で軽蔑し、嘲笑しているよ。
当の本人には面と向かっては絶対にそんなことは言わないけどね。
<<
東京医大の事件は裏口入学が現在進行形であること如実にしめした事件だよね。
シリツ医の使命は裏口入学撲滅国民運動の先頭に立つことだよ。
裏口入学の学生を除籍処分にしないかぎり、信頼の回復はないね。つまり、いつまで経ってもシリツ医大卒=裏口バカと汚名は拭えない。シリツ出身者こそ、裏口入学に厳しい処分せよを訴えるべき。
裏口入学医師の免許剥奪を!の国民運動の先頭に立てばよいぞ。
僕も裏口入学とか、言ってたら信頼の回復はない。

77:卵の名無しさん
20/06/29 11:16:41.04 wl9ALaOg.net
a=2*pi/3
P=1+0*1i
Q=cos(a)+1i*sin(a)
R=cos(-a)+1i*sin(-a)
b=seq(-pi,pi,len=100)
X=cos(b)+1i*sin(b)
fn <- function(n){
y=abs(P-X)^n+abs(Q-X)^n+abs(R-X)^n
print(summary(y))
}
for(i in 1:50) fn(i)

78:卵の名無しさん
20/06/29 12:10:12.42 uLj4gkXU.net
頭悪い人は国試合格できないと思うけど…

79:卵の名無しさん
20/06/29 12:15:05.88 wl9ALaOg.net
>>76
いや、中学数学できないアホでも通るよ。

80:卵の名無しさん
20/06/29 12:33:37.71 wl9ALaOg.net
半径1の円Cに内接する正三角形△PQRと、C上を動く点Xを考える。
このとき自然数nの定め方によっては、a[n]=|XP|^n+|XQ|^n+|XR|^n
がnのみに依存する値をとることがある(すなわち、C上のどの位置にXがあってもa[n]の値は不変である)。
そのようなnを全て決定せよ。

81:卵の名無しさん
20/06/29 12:35:44.36 wl9ALaOg.net
昼御飯前に頭の体操
>>784
プログラム�


82:� > a=2*pi/3 > P=1+0*1i > Q=cos(a)+1i*sin(a) > R=cos(-a)+1i*sin(-a) > b=seq(-pi,pi,len=100) > X=cos(b)+1i*sin(b) > fn <- function(n){ + y=abs(P-X)^n+abs(Q-X)^n+abs(R-X)^n + if(round(min(y),1)==round(max(y),1)) print(n) + } > for(i in 1:1000) fn(i) [1] 2 [1] 4



83:卵の名無しさん
20/06/29 13:55:21.71 FTmo9j4R.net
いたがき

84:卵の名無しさん
20/06/29 19:27:52.86 Gd6JANC8.net
日本は最近、韓国やイタリアにも一人当たりのGDPが抜かれた。
一人当たりのGDPが高いとその国の国民は豊かになり、低いと貧しくなる。
つまり、日本の国民は韓国やイタリアの国民より貧しくなってしまった。

85:卵の名無しさん
20/06/30 06:43:28 ORfjVN68.net
中国はすごいな。
新型コロナ感染追及の矛先を黒人ヘイトにすり替えてしまった。
頭の悪い黒人白人見事に騙された。
ついでに言えば香港の民主化デモも新型コロナで潰しやがった
お見事!

86:卵の名無しさん
20/06/30 07:53:57.02 ORfjVN68.net
バイクの正しい乗り方として
 大怪我する前にやめること
というのが正しかったと納得。
URLリンク(youtu.be)

87:卵の名無しさん
20/06/30 08:29:53.84 ORfjVN68.net
切り取り印象操作だったんだな。

専門家からも出た「スピード世界一」への疑問
この仕分けの議論は一時間半ほどかかった。議論の後半の大部分は世界一を目指す意義についてだった。「なぜ2位じゃダメなのか」という趣旨の質問は、蓮舫議員だけではなく他の「仕分け人」からも同様の意見が出されていた。しかも、指摘をしていた仕分け人の中には、スパコンの利用者側の立場でもある金田康正氏(当時東大教授)や松井孝典氏(東大名誉教授)らもいた。決して「素人の思い付き」で進んでいたのではなく、専門的視点も含めての議論であった。
また、仕分け人側が言いっぱなしだったのではなく、文科省に回答を求めていたが、その時の文科省の答えは「最先端のスパコンがないと最先端の競争に勝てない」「世界一を取ることにより国民に夢を与える」など定性的、情緒的なものばかりでかみ合わなかった。スパコンという「道具」を使うことで、どのような研究成果を期待しているのか、スピードで世界一を取ると、具体的にどのような変化があるかについては、再三の質問の中でも答えは返ってこなかった。
URLリンク(news.yahoo.co.jp)

88:卵の名無しさん
20/06/30 09:00:37.83 ORfjVN68.net
3^(3^(3^(3^3))) の最上位の1桁を求めよ(計算機を用いてもよい)。

89:卵の名無しさん
20/06/30 09:15:12.54 ORfjVN68.net
安定のシリツだなぁ。

無届け再生医療 大阪医大元講師ら逮捕 府警
URLリンク(www.sankei.com)

90:卵の名無しさん
20/06/30 11:43:29.30 ORfjVN68.net
これが医師国家試験問題とは! 単なる比例計算。
中学入試より易しい。
URLリンク(i.imgur.com)
同じ比例計算でも公務員(一般職)の試験の方が複雑。
URLリンク(i.imgur.com)

思考力を問う問題は高卒者対象の試験の方が難しい
URLリンク(i.imgur.com)
追加の問題を考えてみた。
6つの○に書かれた条件をみたすような
5人の注文の仕方は何通りあるかを求めよ。

91:卵の名無しさん
20/06/30 14:19:22 ORfjVN68.net
dec2nw <- function(num, N, digit = 4){ # numをdigit桁のN進数に変換
r=num%%N
q=num%/%N
while(q > 0 | digit > 1){
r=append(q%%N,r)
q=q


92:%/%N digit=digit-1 } return(r) } price=c(200,200,300,300,400,400) A=c(NA,NA, 1, 1, 1, 1) B=c(NA,NA, 1, 1,NA,NA) C=c(NA,NA, 1, 1,NA,NA) D=c( 1, 1, 0, 1,NA,NA) E=c(NA,NA,NA, 1,NA,NA) ABCDE=rbind(A,B,C,D,E) colnames(ABCDE)=c('いか(赤)','たこ(赤)','いくら(黒)','まぐろ(黒)','うに(金)','たい(金)') ABCDE sum(is.na(ABCDE)) # 17個のNAを0,1で総当り 2^17=131072 i2y<- function(i){ # i -> binary -> matrix 5人 × 6ネタ x=dec2nw(i,2,digit=17) y=ABCDE y['A',c(1,2)]=x[1:2] y['B',c(1,2,5,6)]=x[3:6] y['C',c(1,2,5,6)]=x[7:10] y['D',c(5,6)]=x[11:12] y['E',c(1,2,3,5,6)]=x[13:17] y }



93:卵の名無しさん
20/06/30 14:19:39 ORfjVN68.net
fn <- function(y){
pay=apply(y,1,function(x) sum(x*price))
all(
all(apply(y,1,sum)>=3),# 5人は,それぞれ3皿以上注文した。
sum(pay)==5000,# 5人が注文した金額の合計は5,000円であった
which.max(pay)==1 & sum(y[1,]*price)==1600,# 注文した金額が最も多かったのはAで,1,600円であった。
all(y[,4]==1), # 5人とも,「まぐろ」を注文した。
all(y[1:3,3]==1), # A,B,Cは,「いくら」を注文した。
sum(y[4,1:2])==2 & sum(y[4,3:4])==1 & sum(y[4,5:6])==1, # Dは,赤皿を2皿,黒皿を1皿,金皿を1皿の合計4皿を注文した。
all(y<2) # 同じネタを2皿以上注文した者はいなかった。
)
}

94:卵の名無しさん
20/06/30 14:19:53 ORfjVN68.net
# brute force
ans=NULL
N=2^17-1
dec2nw(N,2)

for(i in 1:N){
y=i2y(i)
if(fn(y)){
ans=append(ans,i)
}
}
length(ans) # 可能な注文組み合わせ 16通り
re=lapply(ans,i2y)

TF=numeric()
# Aは「たこ」を注文した。
for(j in 1:16) TF[j]=re[[j]]['A','たこ(赤)']
all(TF==1)
# Bは赤皿を2皿注文した。
for(j in 1:16) TF[j]=sum(re[[j]]['B',c('いか(赤)', 'たこ(赤)')])
all(TF==2)
# Cが注文した金額は800円であった。
for(j in 1:16) TF[j]=sum(re[[j]]['C',]*price)
all(TF==800)
# Dは「うに」を注文した。
for(j in 1:16) TF[j]=re[[j]]['D','うに(金)']
all(TF==1)
for(j in 1:16) TF[j]=sum(re[[j]]['E',c('うに(金)','たい(金)')])
all(TF==1)

95:卵の名無しさん
20/07/01 13:33:18.54 4kSzXCeL.net
歴史は取り消しのきかない過去から未知の未来へと進む

96:卵の名無しさん
20/07/02 09:37:24.50 YjrX9sKV.net
資本・財・労働の国際移動を規制するためには、国境を管理できる主権国家が存在しなければならない。
安倍は真逆を志向している。

97:卵の名無しさん
20/07/03 03:57:04.04 Ginm/oIe.net
日本復活に必要なのは反グローバリズムなんだが
中韓と左翼をディスって悦にいっている国民が
日本の衰退を招いていることに気づかんのかね?

98:卵の名無しさん
20/07/03 10:49:01 Ginm/oIe.net
共産党が自民党の提案を推奨している

URLリンク(www.youtube.com)
10分10秒辺りから

99:卵の名無しさん
20/07/03 16:13:56.09 Ginm/oIe.net
安倍晋三はやってる政策、言動と、どこからどう見てもバリバリのグローバリストで保守とは真逆だからな。
安倍晋三「もはや国境や国籍にこだわる時代は過ぎ去りました。
国を開くことは私の中に流れる一貫した哲学。」 平成25年9月25日NY証券取引所でのスピーチ
URLリンク(ameblo.jp)
安倍晋三「(外資と移民の国である)シンガポールに追いつき、できれば追い越したい。
真剣に、そう思っています」 平成25年7月26日 シンガポール・レクチャー)
URLリンク(www.kantei.go.jp)
安倍晋三「外国の企業・人が、最も仕事をしやすい国に、日本は変わっていきます。
ではいかにして、成長を図るのか。国を開くこと、日本の市場を、オープンにすることです。
これは、政治家となって以来、私の中に流れる一貫した哲学でした。」( 平成26年1月22日ダボス講演)
URLリンク(mamo)


100:renihon.wordpress.com/2018/05/21/gaikoku-kigyo-hito-shigoto-shiyasui/ 安倍晋三 桜井誠のヘイトスピーチ「決してあってはならないと強く感じた。日本国の品格にかかわること。 人権侵害が認められる時には当該人物に勧告を行っているものと承知をしている」平成26年3月18参院・予算委員会 01. https://yaplog.jp/wasavi2016511/archive/42 へイトスピーチ法が成立 「不当な差別的言動は許されない」 02. http://www.sankei.com/politics/news/160524/plt1605240020-n1.html 安倍首相「志の高いアジアの若者を積極的に受け入れられるようにしていきたいと思います」国家戦略特別区域諮問会議 平成29年1月20日 03. http://www.kantei.go.jp/jp/97_abe/actions/201701/20kokkasenryaku.html 安倍首相は「我が国がTPPを承認すれば、保護主義の蔓延(まんえん)を食い止める力になる」と述べ 04. http://headlines.yahoo.co.jp/hl?a=20161111-00050077-yom-pol 安倍総理大臣の「グローバル市民賞」受賞 05. http://www.mofa.go.jp/mofaj/na/na1/us/page3_001824.html 安倍晋三 総理復帰直後の平成CSISでの政策スピーチ ジャパンハンドラーズに忠誠を誓う安倍晋三 06. https://www.kantei.go.jp/jp/96_abe/statement/2013/0223speech.html



101:卵の名無しさん
20/07/03 21:19:14 Ginm/oIe.net
数学板から

"
サンドウィッチの詰め方

「縦12センチ(3センチ×4)、横20センチ(10センチ×2)の大きさの容器に、パン屋の店員が、縦×横=3センチ×10センチの大きさの4種類
(ツナ、タマゴ、ハム、チーズ)のサンドウィッチを各2個ずつ、計8個、隙間なく詰めるとする。このとき、サンドウィッチの詰め方は何通りあるか?

1. サンドウィッチの短い辺同士が隣り合う場合は、互いに異なる種類のサンドウィッチ同士でなければならないとし、また、
2. 各縦の列にサンドウィッチを詰める際は、4種類すべてのサンドウィッチを詰めなければならないとする。
容器を回転して同じ配列の場合は、同じ詰め方とする

(今回は容器なので、裏返しにすると、載せることは出来ても、詰めることは出来ないので注意。店長は飽くまで、パンパンに詰めて販売したいのである。店長なりのサービス精神である。)。
ちなみに、同じ種類のサンドウィッチ同士は区別がつかないものとする。」
"

102:卵の名無しさん
20/07/03 21:19:49 Ginm/oIe.net
library(gtools)
pm=unique(permutations(8,8,v=rep(1:4,2),set=FALSE))
x2mat <- function(x) matrix(x,ncol=4,byrow=T) # vector-> matrix
x2mat(c(2,1,3,4,1,3,4,2)) # demo
fn <- function(x){
y=x2mat(x)
all(
all(1:4 %in% y[1,]), # 1st row includes all of 1:4
all(1:4 %in% y[2,]), # 2nd row includes all of 1:4
all(apply(y,2,diff)!=0) # difference in each column is not zero
)
}
idx=which(apply(pm,1,fn))
length(idx)
x2mat(pm[idx[100],]) # demo

pm1=pm[idx,]
x2mat(pm1[216,]) # demo
fn1 <- function(x){
(y=x2mat(x))
(z=matrix(c(rev(y[2,]),rev(y[1,])),ncol=4,byrow=T)) # after rotation
all(y==z)
}
idx1=which(apply(pm1,1,fn1))
x2mat(pm1[idx1[24],])

s_as=length(idx) # symmetric + asymmetric
sym =length(idx1) # symmetric

(s_as-sym)/2 + sym

103:卵の名無しさん
20/07/03 21:52:01.32 Ginm/oIe.net
rm(list=ls())
graphics.off()
# 円を描く
circle <- function(z,r,...){
if(is.complex(z)){ a=Re(z) ; b=Im(z)
}else{ a=z[1] ; b=z[2] }
x=seq(a-r,a+r,length=100)
y=b+sqrt(r^2-(x-a)^2)
plot(x,y,ylim=c(b-r,b+r),type='l',bty='l',...)
lines(x,2*b-y,...)
}
circle(c(0,0),1,col='gray',lty=3,ann=F)
n=7
x=cos(2*pi/n*0:n)
y=sin(2*pi/n*0:n)
polygon(x,y,border=4)
n=9
x=cos(2*pi/n*0:n)
y=sin(2*pi/n*0:n)
polygon(x,y,border=2)

104:卵の名無しさん
20/07/04 08:00:41.75 Sxvv6yAr.net
まあおそらくは出来レースというかお芝居なんだろうけどね。
党でこういう事があったとなれば、
香港情勢に対して国民や他の民主主義国に対しても面目が立つし。
どうせ経団連がらみで来日を許す事になるだろうが、
それでも議論の末に決めた事だと言い訳が立つ。
まあ中国も不快感を示すだろうが、その辺はかけ引きだね。
ま、中国の広報は己らの出世のためにもでかい口を叩きたがるだろうがw

105:卵の名無しさん
20/07/04 17:02:52.67 Sxvv6yAr.net
URLリンク(hash-kotoba.thyme.jp)

106:卵の名無しさん
20/07/04 22:46:53.71 Sxvv6yAr.net
「新型コロナウイルス」(33) 児玉龍彦・東京大学先端科学技術研究センターがん・代謝プロジェクト プロジェクト リーダー(東京大学名誉教授)/ 村上世彰・一般財団法人村上財団創設者
://youtu.be/8qW7rkFsvvM

107:卵の名無しさん
20/07/05 10:35:38.74 fzoDXMpz.net
西浦先生の予測
何も対策しない場合(5月)
URLリンク(www.ntv.co.jp)
こういう数量モデルは必要なんじゃないの
経済優先でするにしても、そのときの感染者がどうなるか
ある程度の判断材料になるわけだしね

108:卵の名無しさん
20/07/05 14:37:12.59 T+5emEsp.net
抗体陽性率が0.1%の今で約1000人死亡だから
40%が抗体持つくらい広まれば40万人死んでも不思議じゃないね。

109:卵の名無しさん
20/07/05 15:11:36 T+5emEsp.net
>>
京都市は先月市内の飲食店で開かれた小規模のパーティーで新型コロナウイルスの集団感染=クラスターが発生したと発表しました。これまでに男女12人の感染が確認され、市が濃厚接触者などの調査を進めています。
クラスターが発生したのは先月27日に京都市内の飲食店で開かれたパーティで参加した14人のうち今月2日から4日にかけて男女10人の感染が確認されたということです。
また、二次会が開かれたバーの従業員2人の感染も確認され、関係する感染者は合わせて12人に上っています。
京都市は、目安となる「同一の場所で5人以上の感染」が確認されたとして、二次会での感染も含めて新たなクラスターが発生したとしています。
市は濃厚接触者などの調査を進めています。
<<
URLリンク(www3.nhk.or.jp)


rm(list=ls())

mu=0.58 # mean of reproductive number
size=0.45 # dispersion parameter
(prob = size/(size+mu)) # its probability
Rt=rnbinom(1e5,size=size,mu=mu) # random number of negative binomial distribution
hist(Rt,breaks = 'scott',freq=F,ann=F) # show its hist


110:gram sim <- function(n=10){ # simulation infectee=0 # initial value while(infectee!=n){ # while infectee is unequal to n infector=sample(1:n,1) # prior discrete uniform distribution of infector number infectee=sum(sample(Rt,infector)) # total number of infectee } return(infector) # when n infectee, return infector number } s=replicate(1e5,sim()) # simulation & calculation hist(spreader,freq=F,ylab='',axes=F,breaks='scott') ; axis(1) HDInterval::hdi(spreader) BEST::plotPost(spreader)



111:卵の名無しさん
20/07/05 15:35:39.29 T+5emEsp.net
while loopで改良

rm(list=ls())
mu=0.58 # mean of reproductive number
size=0.45 # dispersion parameter
(prob = size/(size+mu)) # its probability
Rt=rnbinom(1e5,size=size,mu=mu) # random number of negative binomial distribution
hist(Rt,breaks = 'scott',freq=F,ann=F) # show its histgram
sim <- function(n=10){ # simulation
infectee=0 # initial value
while(infectee!=n){ # while infectee is unequal to n
infector=sample(1:n,1) # prior discrete uniform distribution of infector number
infectee=sum(sample(Rt,infector)) # total number of infectee
}
return(infector) # when n infectee, return infector number
}
spreader=replicate(1e5,sim()) # simulation & calculation
hist(spreader,freq=F,ylab='',axes=F,breaks='scott') ; axis(1)
HDInterval::hdi(spreader)
BEST::plotPost(spreader)
sum(spreader==1)/length(spreader)

112:卵の名無しさん
20/07/05 15:57:34.63 T+5emEsp.net
実効再生産数は一定ではなくて、時期や個々の例で変わる。
実効再生産数は負の二項分布に従うらしくそのパラメータを検討した論文がこれ。
URLリンク(www.researchsquare.com)
From the empirical offspring distribution and
fitted negative binomial distribution shown in Figure 2B,
we estimated an observed reproductive number (R) of 0.58 (95% CI: 0.45 ? 0.71)
and dispersion parameter (k) of 0.45 (95% CI: 0.31 ? 0.76).

上記、パラメータを使って
> クラスターが発生したのは先月27日に京都市内の飲食店で開かれたパーティで参加した
> 14人のうち今月2日から4日にかけて男女10人の感染が確認されたということです。
から、
(1) 参加者のうちパーティ前に感染した人数の期待値と95%信頼区間を計算せよ。
(2) 1人のスーパースプレッダーから広まった確率も併せて求めよ。

113:卵の名無しさん
20/07/05 16:35:51.63 T+5emEsp.net
1年前の記事
「新型インフルエンザから10年 いまパンデミックが起きたら」
URLリンク(www.nhk.or.jp)
被害想定(日本)17万~64万人
これ新型コロナじゃなく新型インフルエンザな
42万は別に突飛な数字を言ったわけじゃない

114:卵の名無しさん
20/07/05 16:38:56.24 T+5emEsp.net
A「カギかけないと泥棒きちゃうから外出時はカギかけなきゃ」
B「カギかけなくても泥棒こないのに」
→カギかけて外出
→泥棒はこなかった
B「ほら! 泥棒に入られなかった!」
A「それはカギをかけてたから…」
B「カギなんかかける必要なかったね! おまえはウソつきだ!」
A「」
B「Aはウソつき! 煽りすぎ!」

115:卵の名無しさん
20/07/05 17:42:29.66 T+5emEsp.net
K値
・X=累計感染者数
・Y=1週間前の累計感染者数
とおき、“画期的な”指標である「K値」を
・K=(X-Y)/X=1-Y/X

116:卵の名無しさん
20/07/05 18:36:47.53 T+5emEsp.net
rm(list=ls())
mu=0.58 # mean of reproductive number
size=0.45 # dispersion parameter
(prob = size/(size+mu)) # its probability
Rt=rnbinom(1e5,size=size,mu=mu) # random numbers of negative binomial distribution
hist(Rt,breaks = 'scott',freq=F,ann=F) # show its histgram
sim <- function(n=10){ # simulation
infectee=0 # initial value
while(infectee!=n){ # while infectee is unequal to n
infector=sample(n,1) # prior discrete uniform distribution of infector number
infectee=sum(sample(Rt,infector)) # total number of infectee
}
return(infector) # when n infectee, return infector number
}
spreader=replicate(1e5,sim()) # simulation & calculation
hist(spreader,freq=F,ylab='',axes=F,breaks='scott') ; axis(1)
HDInterval::hdi(spreader)[1:2] # 95% credibility interval
BEST::plotPost(spreader) # graph with 95%CI & mean
sum(spreader==1)/length(spreader) # the probability of single super-spreader

117:卵の名無しさん
20/07/05 19:42:39 zhxaSd/7.net
>>110
バグ修正


rm(list=ls())

mu=0.58 # mean of reproductive number
size=0.45 # dispersion parameter
(prob = size/(size+mu)) # its probability
Rt=rnbinom(1e5,size=size,mu=mu) # random numbers of negative binomial distribution
hist(Rt,breaks = 'scott',freq=F,ann=F) # show its histgram
sim <- function(n=10){ # simulation
infected=0 # initial value
while(infected!=n){ # while infected is unequal to n
infector=sample(n,1) # prior discrete uniform distribution of infector number
infectee=sum(sample(Rt,infector)) # number of infectee
infected=infectee+infector # number of infected
}
return(infector) # when n infectee, return infector number
}
spreader=replicate(1e5,sim()) # simulation & calculation
hist(spreader,freq=F,ylab='',axes=F,breaks='scott') ; axis(1)
HDInterval::hdi(spreader)[1:2] # 95% credibility interval
BEST::plotPost(spreader) # graph with 95%CI & mean
sum(spreader==1)/length(spreader) # the probability of single super-spreader

118:卵の名無しさん
20/07/05 20:18:33 T+5emEsp.net
これは、いいたとえだな。

西浦は別に間違ったこと�


119:ヘ言ってない。 「ナイフで人を刺したら死ぬかも」と言ったようなもので、まあ本当にいう必要あったか?とは思うが。



120:卵の名無しさん
20/07/05 22:17:23 T+5emEsp.net
# 有病率pでn人のクラスター発生時の再生産数の期待値
R0 <- function(n,p){
i=1:n
w=dbinom(i,n,p)
r0=(n-i)/i
sum(r0*w)/sum(w)
}
R0(10,0.005)

121:卵の名無しさん
20/07/06 00:00:56.66 nKQCQwoY.net
R0 <- function(n,p){
i=1:n
w=dbinom(i,n,p)
r0=(n-i)/i
sum(r0*w)/sum(w)
}
n=12
uniroot(function(x) R0(n,x)-1 ,c(0.001,1),tol=1e-15)

122:卵の名無しさん
20/07/06 00:01:13.71 nKQCQwoY.net
R0 <- function(n,p){
i=1:n
w=dbinom(i,n,p)
r0=(n-i)/i
sum(r0*w)/sum(w)
}
n=12
uniroot(function(x) R0(n,x)-1 ,c(0.001,1),tol=1e-15)

123:卵の名無しさん
20/07/06 00:27:48.88 nKQCQwoY.net
有病率の低い伝染病の患者が多発していれば他人に移しやすいのは直観でわかる。
12人のクラスタが発生したときに有病率がいくらであれば再生産数が1になるか?

124:卵の名無しさん
20/07/06 00:57:13 nKQCQwoY.net
>>116
R0 <- function(n,p){
i=1:n
w=dbinom(i,n,p)
r0=(n-i)/i
sum(r0*w)/sum(w)
}
R0=Vectorize(R0)
p=seq(1e-4,1,le=1000)
n=1:1000
plot(n,R0(n,0.05),bty='l',type='l')
plot(p,R0(12,p),bty='l',type='l') ; abline(h=1,lty=3)
uniroot(function(x) R0(12,x)-1 ,c(1e-5,1),tol=1e-15)$root

125:卵の名無しさん
20/07/06 06:46:11 nKQCQwoY.net
分からない問題はここに書いてね460
スレリンク(math板:879番)

879 名前:132人目の素数さん[sage] 投稿日:2020/07/05(日) 23:34:34.60 ID:6pnuWzuz
A君が坂の途中のP地点に立っている。
A君がP地点から東に歩いたときの勾配は3/4であり、南に歩いた時の勾配は2/3であった。
この坂の勾配が最もきついのはP地点から見てどの方角か。

126:卵の名無しさん
20/07/06 06:46:29 nKQCQwoY.net
>>118
library(pracma)
east=c(4,0,3)
south=c(0,-3,2)
(nv=pracma::cross(east,south)) # c(9,-8,-12) 外積=法線ベクトル
"
dot(c(x,y,z),nv)==0
9x-8y-12z=0 平面の式
z=(9x-8y)/12
fn <- function(x,y) 9*x - 8*y # 最大値でいいので/12は無視
x=cosθ, y=sinθとおいて
"
fn <- function(theta) 9*cos(theta) - 8*sin(theta)
curve(fn(x),-pi,pi)
(th=optimise(fn,c(-pi,pi),maximum = TRUE)$max)
th*180/pi

127:卵の名無しさん
20/07/06 07:58:35.79 nKQCQwoY.net
p=0.1/100
R=0.58 # mean of reproductive number
k=0.45 # dispersion parameter
k/(k+R) # its probability
n=10 # maximum number of infector
m=12 # combined infected
Rt=rnbinom(1e5,k,mu=R) # random numbers of negative binomial distribution
hist(Rt,breaks = 'scott',freq=F,ann=F) # show its histgram
sim <- function(){ # simulation
infected=0 # initial value
while(infected!=m){ # while infected is unequal to m
infector=sample(1:n,1) # prior discrete uniform distribution of infector number
infectee=sum(sample(Rt,infector)) # number of infectee
infected=infectee+infector # number of infected
}
return(infector) # when n infected, return infector number
}
spreader=replicate(1e5,sim()) # simulation & calculation
hist(spreader,freq=F,ylab='',axes=F,breaks='scott') ; axis(1)
HDInterval::hdi(spreader)[1:2] # 95% credibility interval
BEST::plotPost(spreader,xlim=c(1,10)) # graph with 95%CI & mean
summary(spreader)
sum(spreader==1)/length(spreader) # the probability of single super-spreader

128:卵の名無しさん
20/07/06 07:58:45.62 nKQCQwoY.net
> HDInterval::hdi(spreader)[1:2] # 95% credibility interval
lower upper
5 10
> BEST::plotPost(spreader,xlim=c(1,10)) # graph with 95%CI & mean
> summary(spreader)
Min. 1st Qu. Median Mean 3rd Qu. Max.
1.000 7.000 8.000 7.806 9.000 10.000
> sum(spreader==1)/length(spreader) # the probability of single super-spreader
[1] 0.00021

129:卵の名無しさん
20/07/06 16:07:12.53 RBXc/6V3.net
シリツの裏口が話題になってますなぁ!
【朝日新聞デジタル】文科省汚職、元局長が無罪を主張「息子に加点、知らず」 [爆笑ゴリラ★]
スレリンク(newsplus板)

130:卵の名無しさん
20/07/06 16:09:27.66 RBXc/6V3.net
周りも裏口だらけとか?
スレリンク(newsplus板:41番)

131:卵の名無しさん
20/07/06 18:28:45.70 RBXc/6V3.net
10人のなかにスーパースプレッダーがいて合計12人に感染させた可能性
rm(list=ls())
p=0.1/100
R=0.58 # mean of reproductive number
k=0.45 # dispersion parameter
k/(k+R) # its probability
n=10 # maximum number of infector
m=12 # combined infected
Rt=rnbinom(1e5,k,mu=R) # random numbers of negative binomial distribution
hist(Rt,breaks = 'scott',freq=F,ann=F) # show its histgram
sim <- function(){ # simulation
infected=0 # initial value
while(infected!=m){ # while infected is unequal to m
infector=sample(1:n,1) # prior discrete uniform distribution of infector number
infectee=sum(sample(Rt,infector)) # number of infectee
infected=infectee+infector # number of infected
}
return(infector) # when n infected, return infector number
}
spreader=replicate(1e5,sim()) # simulation & calculation
hist(spreader,freq=F,ylab='',axes=F,breaks='scott') ; axis(1)
HDInterval::hdi(spreader)[1:2] # 95% credibility interval
BEST::plotPost(spreader,xlim=c(1,10)) # graph with 95%CI & mean
summary(spreader)
sum(spreader==1)/length(spreader) # the probability of single super-spreader

132:卵の名無しさん
20/07/06 18:29:03.10 RBXc/6V3.net
> HDInterval::hdi(spreader)[1:2] # 95% credibility interval
lower upper
5 10
> BEST::plotPost(spreader,xlim=c(1,10)) # graph with 95%CI & mean
> summary(spreader)
Min. 1st Qu. Median Mean 3rd Qu. Max.
1.000 7.000 8.000 7.837 9.000 10.000
> sum(spreader==1)/length(spreader) # the probability of single super-spreader
[1] 0.00033

133:卵の名無しさん
20/07/07 11:35:2


134:6.75 ID:8nEdlkS9.net



135:卵の名無しさん
20/07/08 06:48:28 DzricCbv.net
C:y=x^2+1
D:x=2y^2+2

PQ2 <- function(xy){
x=xy[1]
y=xy[2]
P=c(x,x^2+1)
Q=c(2*y^2+2,y)
(P-Q)^2
}

optim(c(0,0),PQ2,method='Ne')

136:卵の名無しさん
20/07/08 07:37:02.96 DzricCbv.net
PQ <- function(xy){
x=xy[1]
y=xy[2]
P=c(x,x^2+1)
Q=c(2*y^2+2,y)
sqrt(sum((P-Q)^2))
}
opt=optim(par=c(0,0),fn=PQ,method='Nelder')
x=opt$par[1]
(P=c(x,x^2+1))
y=opt$par[2]
(Q=c(2*y^2+2,y))
PQ(opt$par)
f <- function(x,y) PQ(c(x,y))
vf <- Vectorize(f)
x=seq(0.615,0.630,length=100)
y=seq(0.2,0.205, length=100)
z=outer(x,y,vf)
contour(x,y,z)

137:卵の名無しさん
20/07/08 09:25:17 looQjzP9.net
↑あほ

138:卵の名無しさん
20/07/08 18:36:23.80 ZTu6jETl.net
東京医科大】過去に不正合格させた、受験生や親の名前が書かれた
「裏口入学リスト」を作成 特捜部、大学側からリスト入手
2018年07月13日08:55
文部科学省の私立大学支援事業を巡る汚職事件に絡み、受託収賄容疑で逮捕された
同省前局長の佐野太容疑者(58)の息子を不正に合格させたとされる
東京医科大学(東京)が、過去に不正合格させた受験生やその親の名前などが
書かれた「裏口入学リスト」を作成していたことが関係者の話でわかった。
東京地検特捜部は、同大側から複数のリストを入手しており、
同大が不正入試を繰り返していたとみて調べている。

裏口佐野の公判が始まったようだなw

139:卵の名無しさん
20/07/08 19:09:04.69 DzricCbv.net
From the empirical offspring distribution and
fitted negative binomial distribution shown in Figure 2B,
we estimated an observed reproductive number (R) of 0.58 (95% CI: 0.45 - 0.71)
and dispersion parameter (k) of 0.45 (95% CI: 0.31 - 0.76).
library(HDInterval)
m=0.58
f <- function(x) hdi(qnorm,mean=m,sd=x)[1:2]
f1 <- function(x) (f(x)[1]-0.45)^2 + (f(x)[2]-0.71)^2
(sd=optimize(f1,c(0,1))$min)
qnorm(0.025,m,sd)
qnorm(0.025,m,sd,lower=F)
pnorm(0.71,m,sd)-pnorm(0.45,m,sd)
# 期待値 m = shape*scale
m=0.45
f0 <- function(x,m=0.45){
sh=x
sc=m/x
pgamma(0.76, shape=sh,scale=sc) -
pgamma(0.31,shape=sh,scale=sc) - 0.95
}
f0=Vectorize(f0)
curve(f0(x),1,100)
abline(h=0,lty=3)
(sh=uniroot(f0,c(0,100),tol=1e-15)$root)
(sc=0.45/sh)
curve(dgamma(x,shape=24.38466,scale=0.01845),ann=F)
pgamma(0.76,sh,scale=sc)-pgamma(0.31,sh,scale=sc)

140:卵の名無しさん
20/07/09 23:20:47 N2v3KqqG.net
library(randtests)
data=c(2808,5857,1913,9958,9209,0978,4752,8713,8836,0335,
8687,9217,2207,1775,0425,0773,9447,5706,3983,4477,
4097,7214,5351,3012,6240,2973,5141,2598,4906,9561,
4717,4489,8864,7838,7034,1092,7573,2175,4803,4017,
2861,7072,5078,9836,0426,2402,2929,1429,8886,4893,
7278,8472,3775,0029,0828,1149,0491,3417,4430,2116,
9011,7471,6531,6845,2369,4996,3752,1598,7886,5859,
7709,4767,1447,2739,7732,8473,3036,0517,8183,3061,
8609,3730,0881,8475,9617,0722,8256,1944,8970,6754,
8139,7


141:206,6079,4370,9421,1341,9147,0386,9856,7437) bartels.rank.test(data) cox.stuart.test(data) difference.sign.test(data) rank.test(data)



142:卵の名無しさん
20/07/09 23:40:01 WLGoT3ZZ.net
2ヶ月前の予測が恐ろしいほどハマってる。
URLリンク(i.imgur.com)

143:卵の名無しさん
20/07/10 05:05:17.10 uIx5PDyl.net
脳症の報告もあがってきている。
URLリンク(academic.oup.com)

144:卵の名無しさん
20/07/10 10:08:23.60 uIx5PDyl.net
いや底辺ほど感染リスク高いから緊急事態宣言を望んでいるのだが
レジ打ちやウエイトレスや掃除やゴミ収集などは
いつ感染してもおかしくないからね
経済回せと叫んでいるのはリモートワークなどで余裕のホワイトカラー

145:卵の名無しさん
20/07/10 10:20:46 uIx5PDyl.net
COVID-19のアウトなところ

・空気感染する→湿度が低下するとより伝播しやすくなるので秋冬大変!
・免疫が数週間でなくなる→常に防御する必要性がある
・物質の表面上で不活性化するまでの時間が長い→ツルツルのプラスティックで最長9日間
・精液/排泄物/体液にも存在する→セックスでも感染する。トイレで糞尿の匂いを嗅いだだけでもアウト
・感染者と1M以内に15分以上、喋らずただ息をしているだけで感染する
・NIAIDによると季節性が全くない、なので暑くなろうが湿度が高くなろうが流行が収まらない。尚、湿度が下がると飛散距離が延びるので感染する機会が多くなる
・CDCによると容認できる最低の人と人の安全距離は1.8M、尚日本は1Mとしている池沼っぷり

国内から根絶するまでロックダウンしないとダメな感染症
西村と安倍、事の重大性を認識できてない

146:卵の名無しさん
20/07/10 12:20:36 vzOjmNtZ.net
あのーお仕事はされてないんでしょうか?

147:卵の名無しさん
20/07/10 14:39:47.68 HSKMYqwj.net
おまえのことだろクソニート朝鮮人

148:卵の名無しさん
20/07/10 14:50:50.41 uIx5PDyl.net
アビガン
URLリンク(www.yakugai.gr.jp)

149:卵の名無しさん
20/07/10 16:59:45.99 uIx5PDyl.net
>>138
人種や民族など本人が選択できないことを根拠とする区別は差別の批判を免れないが、
ド底辺シリツ医大進学は本人の選択だよなぁ。
これな!
不朽の名投稿
>>
私は昭和の時代に大学受験したけど、昔は今よりも差別感が凄く、特殊民のための特殊学校というイメージで開業医のバカ息子以外は誰も受験しようとすらしなかった。
常識的に考えて、数千万という法外な金を払って、しかも同業者からも患者からもバカだの裏口だのと散々罵られるのをわかって好き好んでド底辺医に行く同級生は一人もいませんでした。
本人には面と向かっては言わないけれど、俺くらいの年代の人間は、おそらくは8


150:-9割はド底辺医卒を今でも「何偉そうなこと抜かしてるんだ、この裏口バカが」と心の底で軽蔑し、嘲笑しているよ。 当の本人には面と向かっては絶対にそんなことは言わないけどね。 <<



151:卵の名無しさん
20/07/11 07:09:08.74 aDDXoU7O.net
傘をさしててもしぶきで濡れるし
大雨だったら役に立たないこともあるし
だから普段から傘をさすことは無意味であるということになる?

152:卵の名無しさん
20/07/11 07:12:28.80 aDDXoU7O.net
民主党政権が取り上げて使用不能にした総連ビルをトリモロして北朝鮮に再び引き渡したのは誰でしょう?

ホニャララ内角の北兆戦への最大の貢ぎ物はホニャララビルの特別配慮
URLリンク(www.news-postseven.com)

153:卵の名無しさん
20/07/11 07:58:16.62 aDDXoU7O.net
そもそも中国人ウェルカムやってコロナ爆発させて
金づるの中国人が来なくなったから
日本人に金使わせようとする魂胆しかも感染対策は何もなしで罹るのは自己責任。

154:卵の名無しさん
20/07/11 12:43:21.42 GlB5Fub6.net
# URLリンク(stackoverflow.com)
library(gmp)
library(plyr)
get_all_factors <- function(n)
{
prime_factor_tables <- lapply(
setNames(n, n),
function(i)
{
if(i == 1) return(data.frame(x = 1L, freq = 1L))
plyr::count(as.integer(gmp::factorize(i)))
}
)
lapply(
prime_factor_tables,
function(pft)
{
powers <- plyr::alply(pft, 1, function(row) row$x ^ seq.int(0L, row$freq))
power_grid <- do.call(expand.grid, powers)
sort(unique(apply(power_grid, 1, prod)))
}
)
}
get_all_factors(c(1, 7, 60, 663, 2520, 75600, 15876000, 174636000, 403409))
get_all_factors(factorial(10))

155:卵の名無しさん
20/07/11 12:43:54.00 GlB5Fub6.net
dividers <- function(n){
m=seq_len(n)
m[n%%m==0]
}
dividers(factorial(10))

156:卵の名無しさん
20/07/11 13:36:09 GlB5Fub6.net
"
異なる6(=n)個の自然数の配列a[1],a[2],...,a[n](a[1]<a[2]<...<a[n]は,最大公約数が1で、
最小公倍数は6!(=720=m)である。このようなaの配列は何通りあるか。
"

rm(list=ls())
dividers <- function(n){
m=seq_len(n)
m[n%%m==0]
}
# demo
dividers(factorial(10))

library(numbers)
# demo
divisors(factorial(10))
library(gtools)
fn <- function(n=3,m=12){
(dv=divisors(m))
(l=length(dv))
f <- function(i){ # i:index
y=dv[i] # dividers of index
mGCD(y)==1 & mLCM(y)==m
}
comb=combinations(l,n)# (270,10) ->cannot allocate vector of size 129.6 Mb
sum(apply(comb,1,f)) # sum(combn(l,n,f))
}

fn(3,12)
fn(5,factorial(5))
x=6
fn(x,factorial(x)) # 290104

157:卵の名無しさん
20/07/11 15:17:20 aRaMDGCL.net
表が出る確率が1/2のコインを1000回投げたときに表がちょうど10回連続してでる確率を求めよ。

158:卵の名無しさん
20/07/11 16:37:49.32 GlB5Fub6.net
# simulation for N coin flips with n(+) sequentical heads
sim <- function(N=1000,n=10,p=0.5,greater=TRUE){ # n+ sequential heads after N flips (greater=T)
x=rbinom(N,1,p)
(y=rle(x))
i=which(y$values==1)
ifelse(greater,max(y$lengths[i])>=n,max(y$lengths[i])==n


159:) } mean(replicate(1e6,sim())) # n+ sequential heads mean(replicate(1e6,sim(greater = FALSE))) # maximum sequential heads = n



160:卵の名無しさん
20/07/11 17:07:24 GlB5Fub6.net
"
あるタクシー会社のタクシーには1から通し番号がふられている。
タクシー会社の規模から保有タクシー台数は100台以下とわかっている。
この会社のタクシーを5台みかけた。最大の番号が60であった。
この会社の保有するタクシー台数の期待値を求めよ。
"
# 可読性無視のone-liner
sum((60:100)*(choose(60-1,5-1)/choose(60:100,5))/(sum(choose(60-1,5-1)/choose(60:100,5))))

161:卵の名無しさん
20/07/11 19:05:02 GlB5Fub6.net
>>149
分数の答を計算させる

library(gmp)
n=as.bigq(60:100)
pmf=chooseZ(60-1,5-1)/chooseZ(n,5) #Pr(max=60|n)
plot(n,pmf,ylab='probability')
pdf=pmf/sum (pmf)
plot(n,pdf,ylab='density')
(E=sum(n*pdf)) #E(n)
as.numeric(E)

# シミュレーション解
sim <- function(){
M=0 # M:5台のうちの最大番号(初期値0))
while(M!=60){  # Mが60でないなら
N=sample(60:100,1) # タクシー総数Nを60~100から選んで
M=max(sample(1:N,5)) # N台から5台選択して最大値をMにいれる
}
return(N) # タクシー総数を返す
}
mean(replicate(1e5,sim())) # 10万回繰り返して平均値(期待値)を算出

162:卵の名無しさん
20/07/12 08:34:44 UrFsdd6z.net
"
マラソン大会で1000枚のゼッケンを準備したという。
スタート地点のピンぼけ写真を確認したら77人の番号が読み取れて最小値は111で最大値は777であったという。
マラソン参加人数の期待値と95%信頼区間(信用区間)を求めよ
"
z=1000
legible=77
max=777

n=as.bigq(max:z)
layout(matrix(1:2),2)
plot(n,rep(1/length(n),length(n)),bty='l',type='h',ylab='density',main='prior',col='gray')
pmf0 = 1/chooseZ(n,legible) # ∝ pmf
pdf=pmf0/sum (pmf0)
plot(n,pdf,ylab='density',type='h',bty='l',main='posterior',col=2)
(E=sum(n*pdf)) #E(n)
as.numeric(E)
sum((max:z)*(1/choose(max:z,legible))/sum(1/choose(max:z,legible)))
layout(1)
cdf=asNumeric(cumsum(pdf))
plot(n,cdf,type='l',bty='l')
abline(h=0.95,lty=3)
plot(n,pdf,ylab='density',type='h',bty='l',main='posterior',col=2)
(idx=which(0.945<cdf & cdf<0.955))
cdf[idx]
n[idx]

163:卵の名無しさん
20/07/12 21:40:52 UrFsdd6z.net
library(ibm)

?localLotkaVolterra
set.seed(880820)
par = list(alpha=5e-4, beta=5e-4, r=0.1, m=0.05, D=list(N=8e-5, P=8e-5),
L=list(N=0.2, P=0.2))
N0 = with(par, m/(2*beta*L$P))
P0 = with(par, r/(2*alpha*L$N))
par$initial = list(N=round(N0), P=round(P0))
sim = localLotkaVolterra(par, T=240, replicates=100, dim=1, maxpop = 1e4,verbose=FALSE)
plot(sim)

164:卵の名無しさん
20/07/13 07:39:11.49 0kEbxjUg.net
"
試射させたところ
ゴルゴ13は100発100中
ゴルゴ14は10発10中
ゴルゴ15は1発1中
であったとする。
各ゴルゴの狙撃成功率の期待値と95%信頼区間はいくらか?
"
# 試射前の狙撃成功率の分布をbeta(a,b)に想定、試射データから成功率の分布を求める
a=b=1
# 事前分布
curve(dbeta(x,a,b),bty='l',xlab='probability',ylab='density',lty=3,ylim=c(0,10))
# 事後分布
for(hit in c(1,10,100)) curve(dbeta(x,a+hit,b),bty='l',ann=F,add=TRUE,col=hit)
# 期待値
for(hit in c(1,10,100)) print(integrate(function(x) x*dbeta(x,a+hit,b),0,1)$value)
# 95%Credibility Interval下限(上限は1)
for(hit in c(1,10,100)) print(qbeta(0.95,a+hit,b))

165:卵の名無しさん
20/07/13 23:10:37.76 CDSirGZ5.net
今の内閣が史上最低学歴の内閣
やっぱ学歴って大事なんだなと


166:痛感したわ



167:卵の名無しさん
20/07/14 00:27:33.91 7+6JkGeO.net
[シシ]\s*[りりリ]\s*[ツツ]

168:卵の名無しさん
20/07/14 10:25:50.78 bf2JlY+k.net
>>154
羽田も成城大学だったなぁ。
最短と最長が底辺シリツ卒

169:卵の名無しさん
20/07/14 16:12:58 5CzX8ch/.net
ほーか
でんでんノータリンにホーセー禿げ
学歴詐称不正選挙エジプトユダ公工作員股ユル子
アホばっかしじゃのお

170:卵の名無しさん
20/07/14 16:52:33.92 bf2JlY+k.net
あるタクシー会社のタクシーには1から通し番号がふられている。
タクシー会社の規模から保有タクシー台数は100台以下とわかっている。
何台観察したかは不明だが最大の番号が60であった。
この会社の保有するタクシー台数の期待値を求めよ。
尚、計算には数値の分布が不明な場合は一様分布を仮定する。
保有タクシーの台数は60~100の一様分布
観察した台数は1~60の一様分布
と仮定して
f(j)= (1/60)Σ[i=1,60] C[59,i-1]/C[j,i]
Σ[k=60,100] k * f(j) / (Σ[j=60,100] f(j))
を求めて
期待値は 77453110029594251294/1232675015146841933 = 62.83336
95%信頼区間は60~75

171:卵の名無しさん
20/07/14 16:54:04.59 bf2JlY+k.net
# 分数表示
library(gmp)
pmf <- function(n.taxi,Max=60){
p=list() # 確率の配列
for(n.obs in 1:Max){ # n.obs : 観察台数1 ~ 60
# 総台数n.taxiで観察数がn.obsのとき最大番号がMaxになる確率
p[[n.obs]]=chooseZ(Max-1,n.obs-1)/chooseZ(n.taxi,n.obs) 
}
s=as.bigq(0)
for(i in 1:Max) s = s + p[[i]] # sに分数加算
s/Max # 平均値(期待値)
}
n=60:100 # 総台数の候補
pdf=pmf(n)/sum.bigq(pmf(n)) # pmfをpdf化
(E=sum(n*pdf)) # 期待値
asNumeric(E)
# 観察された台数が不明なときのシミュレーション
sim <- function(){
M=m=0 # m:観察台数 M:最大番号 (初期値0)
while(M!=60){  # M=60でないなら
N=sample(60:100,1) # タクシー総数Nを60 ~ 100から選ぶ
m=sample(1:min(N,60),1)# 観察する台数mを1 ~ min(N,60)から選ぶ
M=max(sample(1:N,m)) # N台からm台選択して最大値をMにいれる
}
return(N) # タクシー総数を返す
}
re=replicate(1e4,sim()) # 1万回繰り返して平均値(期待値)を算出
mean(re)
BEST::plotPost(re,xlab='N',cex.lab=1)

172:卵の名無しさん
20/07/14 16:54:27.47 bf2JlY+k.net
# 95% CI
fn <- function(n.taxi,Max=60){
p=numeric() # 確率の配列
for(n.obs in 1:Max){ # n.obs : 観察台数1 ~ 60
# 総台数n.taxiで観察数がn.obsのとき最大番号がMaxになる確率
p[n.obs]=choose(Max-1,n.obs-1)/choose(n.taxi,n.obs) 
}
mean(p) # その期待値
}
pmf=Vectorize(fn)
n=60:100 # 総台数の候補
pdf=pmf(n)/sum(pmf(n)) # pmfをpdf化
sum(n*pdf) # 期待値
plot(n,pdf,axes=F,type='h',col=2,ylab='',xlab='N',lwd=5) ; axis(1)
cdf=cumsum(pdf)
idx=which(0.945<cdf & cdf<0.955)
cdf[idx]
n[idx]

173:''
20/07/14 17:14:45.92 V6RZOqwd.net
2020**2020

174:卵の名無しさん
20/07/14 18:27:26 bf2JlY+k.net
>>158
"
f(j)= (1/60)Σ[i=1,60] C[59,i-1]/C[j,i]
Σ[k=60,100] k * f(k) / (Σ[j=60,100] f(j))
"
i=1:60
f <- function(j)(1/60)*sum(choose(59,i-1)/choose(j,i))
f=Vectorize(f)
k=60:100
j=60:100
sum(k*f(k))/sum(f(j))

175:卵の名無しさん
20/07/14 20:06:57.13 bf2JlY+k.net
f <- function(x,y){
A=c(1,0)
B=c(cos(x),sin(x))
C=c(cos(y),sin(y))
pracma::dot(A-B,A-C)
}
(opt=optim(par=c(1,1),fn=function(xy)f(xy[1],xy[2])))
round(opt$par*180/pi,1)
source('tools.R')
f=Vectorize(f)
x=y=seq(-pi,pi,length=50)
z=outer(x,y,f)
contour(x,y,z)
rgl::persp3d(x,y,z,col=2)
Persp(x,y,z)
library(pracma)
fn <- function(x,y,z,p=0.5){
A=c(1,0)
B=c(cos(x),sin(x))
C=c(cos(y),sin(y))
P=c(p*cos(z),p*sin(z))
dot(P-B,P-C)+dot(P-C,P-A)+dot(P-A,P-B)
}
g <- function(p){
optim(par=c(1,1,1),
fn=function(w) fn(w[1],w[2],w[3],p),method='L')$value
}
g=Vectorize(g)
optimize(g,c(0,1))

176:卵の名無しさん
20/07/14 20:57:44.76 bf2JlY+k.net
library(pracma)
fn <- function(x,y,z,p){
A=c(1,0)
B=c(cos(x),sin(x))
C=c(cos(y),sin(y))
P=c(p*cos(z),p*sin(z))
dot(P-B,P-C)+dot(P-C,P-A)+dot(P-A,P-B)
}
g <- function(p){
optim(par=c(1,1,1),
fn=function(w) fn(w[1],w[2],w[3],p),method='L')$value
}
g=Vectorize(g)
optimize(g,c(0,1))

177:卵の名無しさん
20/07/14 20:58:01.78 bf2JlY+k.net
点Oを中心とする半径1の円Kの周上を3点A,B,Cが動く。
(1)内積↑AB・↑ACの最小値を求めよ。
(2)円の周上または内部の点Pが固定されており、OP=p(0≦p≦1)である。(↑PB・↑


178:PC)+(↑PC・↑PA)+(↑PA・↑PB)の最初うちを求めよ。



179:卵の名無しさん
20/07/14 20:58:37.90 bf2JlY+k.net
rm(list=ls())
cab <- function(M,N=100){
i=1:M
f <- function(j)(1/M)*sum(choose(M-1,i-1)/choose(j,i))
f=Vectorize(f)
k=j=M:N
sum(k*f(k))/sum(f(j))
}
cab=Vectorize(cab)
plot(1:100,cab(1:100),bty='l',type='l')
which.min(cab(1:100))
cab(5)

180:卵の名無しさん
20/07/14 22:00:34 g3eNSQhk.net
コピペ荒らしじゃないなら時間の無駄だアホしね

181:卵の名無しさん
20/07/15 05:42:29.48 HEINqbZ7.net
新宿を放置した安倍と小池の失政
コロナが蔓延してる地域には強い規制が必要
全くコロナが発生してない地域には規制をかけずに経済最優先
それなのに全国一斉に緊急事態宣言出したりして、経済ガタガタにして
緊急事態宣言終われば、まだ終息してない新宿あたりも自由に営業させた
小池が一番悪いが、それを放置した安倍も同罪
国民は、今回の判断力と指導力には完全に失望した

182:卵の名無しさん
20/07/15 06:46:52.14 HEINqbZ7.net
# 観察された台数が不明なときのシミュレーション
sim <- function(max=60){
M=m=0 # m:観察台数 M:最大番号 (初期値0)
while(M!=max){  # M=maxでないなら
N=sample(max:100,1) # タクシー総数Nをmax ~ 100から選ぶ
m=sample(1:100,1) # 観察する台数mを1 ~ 100から選ぶ
if(m<=N) M=max(sample(1:N,m)) # N台からm台選択して最大値をMにいれる
}
return(c(N=N,m=m)) # タクシー総数Nと観察台数mを返す
}
replicate(20,sim())
> replicate(20,sim())
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
N 72 100 60 64 62 62 61 60 60 61 73 62 60
m 9 3 38 7 24 4 19 7 60 49 16 5 54
[,14] [,15] [,16] [,17] [,18] [,19] [,20]
N 63 61 95 60 60 65 60
m 13 59 5 20 43 14 51

183:''
20/07/15 10:12:26.43 uSeyg7dZ.net
>>167
Rは理系ならばできて当然。

184:卵の名無しさん
20/07/15 12:26:33.94 5TbXEwcN.net
なにをぬかす
超理系だ
若い頃、世界は物理数学で全て記述出来ると考えてた
間違いだった
貴重な時間を無駄にした

185:卵の名無しさん
20/07/15 13:09:21.87 uSeyg7dZ.net
0,1,2,3,4,5,6,7,8,9の数字を並べかえて10桁の数字をつくる。
ただし0で始まる数字は10桁の数字とはみなさない。
小さい順に並べたときに100万個目の数字はいくつになるか?
n=gtools::permutations(10,10,0:9)
cat(paste0(n[n[,1]!=0,][1e6,],collapse=''),'\n')

186:卵の名無しさん
20/07/15 13:17:38.43 uSeyg7dZ.net
>>171
この答もだせないなら裏口シリツ医と同じレベルになるわけだが。
前々スレからのド底辺シリツ医への宿題
若い女性研修医(嘘つきかどうかは不明)から
「あなたのいうことが正しければ手コキかフェラをしてあげる、そうでなければセンズリを命じる」と言われた。
フェラをしてもらうには何と言えばいいか?

187:卵の名無しさん
20/07/15 14:12:01.48 uSeyg7dZ.net
rm(list=ls())
library(gtools)
n=gtools::permutations(10,10,0:9)
cat(paste0(n[n[,1]!=0,][1e6,],collapse=''),'\n')
cat(paste0(n[n[,1]!=0,][2e6,],collapse=''),'\n')
cat(paste0(n[n[,1]!=0,][3e6,],collapse=''),'\n')
百マンコめ
3782915460
2百マンコめ
6458731092
三百マンコめ
9241687530

188:卵の名無しさん
20/07/15 18:42:28.48 HEINqbZ7.net
# demo
(s1=paste0(rep("0:9",3),collapse=','))
(s2=paste0("1:9,",s1))
(s3=paste0("expand.grid(",s2,')'))
(lang=str2lang(s3))
eval(lang)

189:卵の名無しさん
20/07/15 18:43:37.82 HEINqbZ7.net
>>174
ソートして確認
library(gtools)
n=gtools::permutations(10,10,0:9)
n10=n[n[,1]!=0,]
v2d <- function(x){ # c(1,2,3) -> 123
as.numeric(paste0(as.character(x),collapse=''))
}
N10=apply(n10,1,v2d)
sN10=sort(N10)
N10[1e6]
sN10[1e6]

190:卵の名無しさん
20/07/15 18:4


191:4:27.14 ID:HEINqbZ7.net



192:卵の名無しさん
20/07/16 04:53:24 VPoZ/5q3.net
感染拡大防止、医療体制
6000億円

全国コロナお届けキャンペーン
1兆6000億円

URLリンク(imgur.com)

193:卵の名無しさん
20/07/16 06:37:51.07 VPoZ/5q3.net
df <- function(x) 2*x # pdf
pf <- function(x) x^2 # cdf = ∫pdf
qf <- function(x) sqrt(x) # cdf=f(qf)
rf <- function(n) qf(runif(n))# random ~ pdf
(E=integrate(function(x) x*df(x),0,1)$value) ; 2/3
(V=integrate(function(x) (x-2/3)^2*df(x),0,1)$value) ; 1/18
sd=sqrt(1/18)
hist(rf(1e5))
fun=rf
sim <- function(n=100){
re=replicate(1e4,mean(replicate(n,fun(1))))
hist(re,freq=F)
lines(density(re),lty=3,col=8)
library(fitdistrplus)
fitdist(re,"norm")
}
n=100
sim(n) ; curve(dnorm(x,2/3,sd/sqrt(n)),add=TRUE)

194:卵の名無しさん
20/07/16 06:38:16.13 VPoZ/5q3.net
問題文↓
URLリンク(i.imgur.com)

195:卵の名無しさん
20/07/16 07:46:55.32 VPoZ/5q3.net
rm(list=ls())
# 三辺の和が3のときに面積が最大になる三角形は?
H3 <- function(a,b,c){
if(a<=b & b<=c & a+b>c & c<3){
s=(a+b+c)/2
S=sqrt(s*(s-a)*(s-b)*(s-c))
return(S)
}else{return(0)}
}
f3 <- function(a,b){
c=3-a-b
H3(a,b,c)
}
f3=Vectorize(f3)
a=b=seq(0,3,le=100)
S=outer(a,b,f3)
image(a,b,S,xlim=c(0,1.5),ylim=c(0,1.5),col = hcl.colors(length(a), "YlOrRd", rev = F))
contour(a,b,S,xlim=c(0,1.5),ylim=c(0,1.5),nlevels=5,add=TRUE)
opt=optim(par=c(0.5,1.2),fn=function(x) f3(x[1],x[2]),control = list(fnscale=-1))
opt$par
opt$value ; 1*sin(pi/3)/2

196:卵の名無しさん
20/07/16 07:54:31.46 VPoZ/5q3.net
rm(list=ls())
# 三辺の和が3のときに面積が最大になる三角形は?
H3 <- function(a,b,c){
if(a<=b & b<=c & a+b>c & c<3){
s=(a+b+c)/2
S=sqrt(s*(s-a)*(s-b)*(s-c))
return(S)
}else{return(0)}
}
f3 <- function(a,b){
c=3-a-b
H3(a,b,c)
}
f3=Vectorize(f3)
a=b=seq(0,3,le=100)
S=outer(a,b,f3)
image(a,b,S,xlim=c(0,1.5),ylim=c(0,1.5))
contour(a,b,S,xlim=c(0,1.5),ylim=c(0,1.5),nlevels=5,add=TRUE)
opt=optim(par=c(0.5,1.2),fn=function(x) f3(x[1],x[2]),
method='Nelder-Mead',control = list(fnscale=-1))
opt$par
opt$value ; 1*sin(pi/3)/2

197:卵の名無しさん
20/07/16 15:53:49.99 VPoZ/5q3.net
RSA暗号は要点だけ書けば次のような仕組みです。
1.素数a,bを決める
2.c=abとおく
3.d=(a-1)(b-1)とおく
4.dと互いに素な自然数eを一つ決める
5.feをdで割った余りが1となる自然数fを求める
6.ペア(c,e)を公開鍵、ペア(c,f)を秘密鍵とする
7.平文(を自然数列に変換した項の一つ)をmとすると、暗号文はm^eをcで割った余りnである
8.暗号文がnのとき、n^fをcで割った余りはmであるので復号できる(∵数論のオイラーの定理)

198:卵の名無しさん
20/07/16 17:00:44 VPoZ/5q3.net
>>183
面白そうなので、ちょっと実験してみた。
暗号文mは123

> library(numbers)
> library(gmp)
> options(digits=22)
> k=1e3
> (ab=sample(Primes(k),2))
[1] 911 47
> # 1
> a=ab[1] ; b=ab[2] ; GCD(a,b)
[1] 1
> # 2
> (c=a*b)
[1] 42817
> # 3
> (d=(a-1)*(b-1))
[1] 41860
> # 4
> flg=FALSE
> while(!flg){
+ e=sample(k,1)
+ flg <- GCD(d,e)==1
+ }
> e ; GCD(d,e)
[1] 361
[1] 1

199:卵の名無しさん
20/07/16 17:00:50 VPoZ/5q3.net
> # 5
> flg=FALSE
> f=0
> while(!flg){
+ f=f+1
+ flg <- (f*e)%%d==1
+ }
> f ; (f*e)%%d
[1] 18321
[1] 1
> # 6
> (public=c(c,e))
[1] 42817 361
> (secret=c(c,f))
[1] 42817 18321
> # 7
> m=as.bigz(123)
> (n=m^e%%c)
Big Integer ('bigz') :
[1] 3047
> #8
> n^f%%c
Big Integer ('bigz') :
[1] 123

復号されていて面白い。

200:卵の名無しさん
20/07/16 18:28:04.10 VPoZ/5q3.net
angle <- function(x,y){
dot.prod <- x%*%y
norm.x <- norm(x,type="2")
norm.y <- norm(y,type="2")
theta <- acos(dot.prod / (n


201:orm.x * norm.y)) as.numeric(theta) } theta <- acos( sum(a*b) / ( sqrt(sum(a * a)) * sqrt(sum(b * b)) ) )



202:卵の名無しさん
20/07/16 18:28:54.82 VPoZ/5q3.net
こういうのどうやるのが速い? と思ったら
stackoverflowで検索が速いや。
URLリンク(stackoverflow.com)

203:卵の名無しさん
20/07/16 20:36:58.43 VPoZ/5q3.net
#####
rm(list=ls())
# 複素数ベクトルのなす角
z2angle <- function(z1,z2) abs(Arg(z1)-Arg(z2))
# draw segment of complex a to complex b
seg <- function(a,b,...){
segments(Re(a),Im(a),Re(b),Im(b),col=2,...)
}
# draw text y at complex x
pt <- function(x,y=NULL,...){
text(Re(x),Im(x), ifelse(is.null(y),'+',y), ...)
}
TAB2S <- function(TAB,print=TRUE){ # c(T,a1,a2,b1,b2)
T =TAB[1]
a1=TAB[2]
a2=TAB[3]
b1=TAB[4]
b2=TAB[5]
D=0+0i
A=a1+a2*1i
B=b1+b2*1i
s=abs(A-D)
p=abs(B-A)
qr=2*T-s-p # destined length of q+r
r2qr<-function(r){ # r -> q+r
C=r+0i
q=abs(B-C)
q+r
}

204:卵の名無しさん
20/07/16 20:37:18.12 VPoZ/5q3.net
# find r as destined
r=uniroot(function(x) r2qr(x)-qr,c(0,T))$root
C=r+0i
q=qr-r
A_=z2angle(D-A,B-A)
C_=z2angle(B-C,D-C)
S=sqrt((T-p)*(T-q)*(T-r)*(T-s)-p*q*r*s*(cos(A_/2+C_/2))^2)
(res=list(A=A,B=B,C=C,D=D,S=S))
if(print==TRUE){
xlim=c(0,1.25*max(Re(A),Re(B),Re(C),Re(D)))
ylim=c(0,1.25*max(Im(A),Im(B),Im(C),Im(D)))
plot(NULL,type='n',xlim=xlim,ylim=ylim,bty='l',ann=F)
seg(A,B) ; seg(B,C) ; seg(C,D) ; seg(D,A)
pt(A,'A') ; pt(B,'B') ; pt(C,'C') ; pt(D,'D')
legend('center',bty='n',legend=paste('S =',round(S,2)))
}
return(res)
}
# DEMO
TAB=c(10,1,2,3,4) ; TAB2S(TAB)
TAB=c(10,2,3,4,5) ; TAB2S(TAB)
quad <- function(x,T=10){
tab=c(T,x)
TAB2S(tab,p=F)$S
}
quad(c(1,2,3,4))
(opt=optim(par=c(1,2,3,4),fn=quad,control=list(fnscale=-1)))
TAB2S(c(10,opt$par))

205:卵の名無しさん
20/07/17 03:46:42.94 k5RESdc+.net
URLリンク(katekyo.mynavi.jp)
16Lの容器いっぱいに油が入っています。7Lの容器と9Lの容器を使って、この油を8Lずつに分けます。最も少ない回数で分けるとすると、何回で分けられますか。
> pitcher(7,9,8)
7L 9L
[1,] 0 0
[2,] 7 0
[3,] 0 7
[4,] 7 7
[5,] 5 9
[6,] 5 0
[7,] 0 5
[8,] 7 5
[9,] 3 9
[10,] 3 0
[11,] 0 3
[12,] 7 3
[13,] 1 9
[14,] 1 0
[15,] 0 1
[16,] 7 1
[17,] 0 8

206:卵の名無しさん
20/07/17 04:18:09.39 k5RESdc+.net
>>183
URLリンク(sites.google.com)
URLリンク(1ae3a02d-a-62cb3a1a-s-sites.googlegroups.com)


207:2gWKl9ZeSFPdML2giLT_-Fx3j01NWOmJNDHi1J9omPsSenZbDqkmgj0gMoU-VbnSMHjZP52m2y1wqx26vLfNBCyEpV8ZSvoQciHaA3naSppVBt6-byjsyiMxhADASBgVtvSa7G7Go67jFiPKv10pVzsTQqXqZGHIpEmzd6QKd6b35WPfFXbgUDHoELXQSHvzV6fGtYNunKCXCRTbchOl_RE8LjyDTktCfI_lPnLk4NzuEDotnnjfdc90G6vgQbB4qayOVW2_A%3D%3D&attredirects=0



208:卵の名無しさん
20/07/17 06:21:26.04 aHrIu0jV.net
%E5%A4%A7%E5%AD%A6%E5%85%A5%E8%A9%A6%E5%95%8F%E9%A1%8C%E3%81%A7%E8%AA%9E%E3%82%8B%E6%95%B0%E8%AB%96%E3%81%AE%E4%B8%96%E7%95%8C%E2%80%95%E7%B4%A0%E6%95%B0%E3%80%81%E5%AE%8C%E5%85%A8%E6%95%B0%E3%81%8B%E3%82%89%E3%82%BC%E3%83%BC%E3%82%BF%E9%96%A2%E6%95%B0%E3%81%BE%E3%81%A7-%E3%83%96%E3%83%AB%E3%83%BC%E3%83%90%E3%83%83%E3%82%AF%E3%82%B9-%E6%B8%85%E6%B0%B4-%E5%81%A5%E4%B8%80/dp/4062577437

209:卵の名無しさん
20/07/17 07:53:38.08 k5RESdc+.net
# number to chacter
n2c <- function(n){ # 11 -> 'A', 12 -> 'B',..., 37 -> 'Z'
  if(10<n & n<38){
    LETTERS[n-10]
    }else return('?') # 55 -> ?

# digits to string
d2s <- function(d){
  s=as.character(d)
  nc=nchar(s)
  if(nc%%2==0){
    ch=character()
    for(i in 1:(nc%/%2)){
      ch[i]=n2c(as.integer(substr(s,2*i-1,2*i)))
    }
  }else return(0)
  re=paste0(ch,collapse='')
  cat(re,'\n')
  invisible(re)


210:卵の名無しさん
20/07/17 07:53:49.02 k5RESdc+.net
c2n <- function(c){ # 'A' -> 11,'B'->12,...,'Z'->36
  x=(LETTERS[1:26]==c)
  if(any(x)) 10+which(x)
  else 0

s2d <- function(s){ # "OH" -> 2518
  nc=nchar(s)
  dc=character()
  for(i in 1:nc){
    x=c2n(substring(s,i,i))
    dc[i]=ifelse(x!=0,as.character(x),"00")
  }
  re=paste0(dc,collapse='')
  cat(re,'\n')
  invisible(re)

s2d("SHINE")
d2s(2918192415)
s2d("URAGUCHI")

211:卵の名無しさん
20/07/17 07:54:37.95 k5RESdc+.net
> s2d("URAGUCHI")
3128111731131819
> s2d('DOTEIHENSHIRITSU')
14253015191815242918192819302931

212:卵の名無しさん
20/07/17 08:05:08.49 k5RESdc+.net
online OCR
URLリンク(ocr.space)

213:卵の名無しさん
20/07/17 11:21:38.31 ugAPa8+J.net
香川と奈良は今でも裏口やってんじゃないの?
ま、推薦という名の裏口がまかり通ってるけどね。
昔は無かった。
正真正銘の実力試験のみ。
シリツは別、発想からして裏口開業医養成学校。

214:卵の名無しさん
20/07/17 21:58:41.17 k5RESdc+.net
国会ダイジェスト字幕付き】児玉龍彦教授


215:、渾身の訴え「このままでは来月は目を覆うような惨状になる・・・」コロナ対策とGoToについて言及【参議院新型コロナ閉会中審査】 1:15~ 現在の日本の現状 6:54~ 検査数増加に伴う陽性率増加について 14:56~ GoToキャンペーンについて ://youtu.be/a-AlGLO8YNc



216:''
20/07/18 08:58:50.60 EXxQ7xor.net
c=42817
d=41860
e=361
f1=18321
fmax=1e6
f=0
flg=F
while(!flg | f<fmax){
f=f+1
flg <- (f*e)%%d==1
if(flg & f<fmax) print(f)
}

217:''
20/07/18 09:38:33.02 O/N4isUA.net
> c=42817
> d=41860
> e=361
> f1=18321
> fmax=1e6
> f=0
> flg=F
> e
[1] 361
> re=NULL
> while(!flg | f<fmax){
+ f=f+1
+ flg <- (f*e)%%d==1
+ if(flg & f<fmax) re=c(re,f)
+ }
> re
[1] 18321 60181 102041 143901 185761 227621 269481 311341 353201 395061
[11] 436921 478781 520641 562501 604361 646221 688081 729941 771801 813661
[21] 855521 897381 939241 981101
>

218:''
20/07/18 09:44:56.69 O/N4isUA.net
c=42817
d=41860
e=361
f1=18321
fmax=1e6
f=0
flg=F
e
re=NULL
while(!flg | f<fmax){
f=f+1
flg <- (f*e)%%d==1
if(flg & f<fmax) re=c(re,f)
}
n=as.bigz(3047)
for(f in re){
print( n^f%%c )
}

219:''
20/07/18 09:46:34.48 O/N4isUA.net
c=42817
d=41860
e=361
f1=18321
fmax=1e6
f=0
flg=F
re=NULL
while(!flg | f<fmax){
f=f+1
flg <- (f*e)%%d==1
if(flg & f<fmax) re=c(re,f)
}
n=as.bigz(3047)
for(f in re){
print( n^f%%c )
}

220:卵の名無しさん
20/07/18 10:52:24.86 e0H2uXza.net
>>197
北の方が酷いと思う
そもそも医者が残らないし
旭川と弘前は黒だわ

221:卵の名無しさん
20/07/18 12:01:28.82 wCmNWJI0.net
最底辺グループですな

222:卵の名無しさん
20/07/18 13:37:01.16 4YqdABa6.net
### 暗号解読 ###
rm(list=ls())
# 公開鍵 (c,e)
c=42817
e=361
# 暗号
n=3047
# 素因数分解してdを決定
library(gmp)
(c1=gmp::factorize(c)) # 計算機にcを素因数分解させて
(d=prod((c1-1)))    # 素因数-1の積dを求める
# fを虱潰しに探す
fmax=1e6 # 探索させる秘密鍵 (c,f)のfの上限=10^6
f=0 # 初期値
flg=FALSE # 条件をみたすか否かのフラッグ
re.f=NULL # fの候補を容れる数列
# fmax以下でf*eをdで割った余りが1となるfの値を数をre.fに追加する
while(!flg | f<=fmax){
f=f+1 # 1増やして
flg <- (f*e)%%d==1 # f*e (mod d)が1に等しいか?
if(flg & f<=fmax) re.f=c(re.f,f) # 等しければre.fに追加
}
re.f # 秘密鍵(c,f)のfの候補
decode=NULL # 秘密鍵(c,f)を使っての復号
for(f in re.f){
decode=append(decode,asNumeric(mod.bigz(pow.bigz(n,f),c)))
}
decode

223:卵の名無しさん
20/07/18 13:37:39.37 4YqdABa6.net
> # 素因数分解してdを決定
> library(gmp)
> (c1=gmp::factorize(c)) # 計算機にcを素因数分解させて
Big Integer ('bigz') object of length 2:
[1] 47 911
> (d=prod((c1-1)))    # 素因数-1の積dを求める
Big Integer ('bigz') :
[1] 41860
>
> # fを虱潰しに探す
> fmax=1e6 # 探索させる秘密鍵 (c,f)のfの上限=10^6
> f=0 # 初期値
> flg=FALSE # 条件をみたすか否かのフラッグ
> re.f=NULL # fの候補を容れる数列
> # fmax以下でf*eをdで割った余りが1となるfの値を数をre.fに追加する
> while(!flg | f<=fmax){
+ f=f+1 # 1増やして
+ flg <- (f*e)%%d==1 # f*e (mod d)が1に等しいか?
+ if(flg & f<=fmax) re.f=c(re.f,f) # 等しければre.fに追加
+ }
> re.f # 秘密鍵(c,f)のfの候補
[1] 18321 60181 102041 143901 185761 227621 269481 311341 353201 395061 436921
[12] 478781 520641 562501 604361 646221 688081 729941 771801 813661 855521 897381
[23] 939241 981101
> decode=NULL # 秘密鍵(c,f)を使っての復号
> for(f in re.f){
+ decode=append(decode,asNumeric(mod.bigz(pow.bigz(n,f),c)))
+ }
> decode
[1] 123 123 123 123 123 123 123 123 123 123 123 123 123 123 123 123 123 123 123 123
[21] 123 123 123 123

224:卵の名無しさん
20/07/18 14:55:41.14 4YqdABa6.net
rm(list=ls())
## 暗号化 by RSA  "AHO" -> cipher, public_key, secret_key
Encode <- function(x="AHO",k=1e4){ # 設定素数の上限
## -- 文字列を数値化  --
  # charactor to number
  c2n <- function(c){ # 'A' -> 11,'B'->12,...,'Z'->37,'0'->70, '1'-> 71
    symbo=c(' ','_','!','+','-','*','/')
    LET=c(LETTERS,letters,symbo,0:9)
    x=(LET[1:69]==c)
    if(any(x)) 10+which(x)
    else 0
  }
  # string to digits
  s2d <- function(s){ # "OH" -> 2518
    nc=nchar(s)
    dc=character()
    for(i in 1:nc){
      x=c2n(substr(s,i,i))
      dc[i]=ifelse(x!=0,as.character(x),"00")
    }
    re=paste0(dc,collapse='')
    cat(s,'->',re,'\n')
    invisible(as.numeric(re))
  }

225:卵の名無しさん
20/07/18 14:56:15.39 4YqdABa6.net
## -- RSA アルゴリズム  
  library(numbers)
  library(gmp)
  options(digits=22)
  # 1.素数a,bを決める(上限=k)
  (ab=sample(Primes(k),2))
  a=ab[1] ; b=ab[2]
  # 2.c=abとおく
  (c=a*b)
  # 3.d=(a-1)(b-1)とおく
  (d=(a-1)*(b-1))
  # 4.dと互いに素な自然数eを一つ決める
  flg=FALSE
  while(!flg){
    e=sample(k,1)
    flg <- GCD(d,e)==1
  }
  # 5.feをdで割った余りが1となる自然数fを求める
  flg=FALSE
  f=0
  while(!flg){ # could be lengthy process ....
    f=f+1
    flg <- (f*e)%%d==1
  }

226:卵の名無しさん
20/07/18 14:56:41.28 4YqdABa6.net
  # 6.ペア(c,e)を公開鍵、ペア(c,f)を秘密鍵とする
  (public_key=c(c,e))
  (secret_key=c(c,f))
  # 7.平文(を自然数に変換)をmとすると暗号文はm^eをcで割った余りnである
  m=as.bigz(s2d(x))
  if(m<c){ # m < c の時のみ暗号化 
    n=m^e%%c
  }else{
    n=NULL
  }
  list(cipher=n,public_key=public_key,secret_key=secret_key)

Encode("AHO")

227:卵の名無しさん
20/07/18 14:57:11.91 4YqdABa6.net
### Decode  復号化 ###
Decode <- function(cipher,secret_key1,secret_key2){
  # number to chacter
  n2c <- function(n){ # 11 -> 'A', 12 -> 'B',..., 73 -> '3'
    symbo=c(' ','_','!','+','-','*','/')
    LET=c(LETTERS,letters,symbo,0:9)
    if(10<n & n<79){
      LET[n-10]
    }else return('?') # 99 -> ?
  }
  
  # digits to string
  d2s <- function(d){ # 123456 -> BXt
    s=as.character(d)
    nc=nchar(s)
    if(nc%%2==0){
      ch=character()
      for(i in 1:(nc%/%2)){
        ch[i]=n2c(as.integer(substr(s,2*i-1,2*i)))
      }
    }else return(0)
    re=paste0(ch,collapse='')
    cat(re,'\n')
    invisible(re)
  }
  library(gmp)
  m=mod.bigz(pow.bigz(cipher,secret_key2),secret_key1)
  d2s(asNumeric(m))

Encode("BAKA")
Decode(9905384,90876911,77957407)

228:卵の名無しさん
20/07/18 17:25:36.17 Dqjsvzt7.net
どあほ

229:卵の名無しさん
20/07/18 18:04:18.44 4YqdABa6.net
10Lの容器いっぱいに油が入っています。7Lの容器と3Lの容器を使って、この油を5Lずつに分けます。どのような分け方がありますか。
move7 <- function(xy){
x=xy[1] ; y=xy[2]
# x==7
if(x==7) re=c(7-(3-y),3)
# x==0
if(x==0) re=c(7,y)
# y==3
if(y==3) re=c(x,0)
# y==0
if(y==0 & x!=7){
if(x>=3) re=c(x-3,3)
else re=c(0,x)
}
if(0<=re[1] & re[1]<=7 & 0<=re[2] & re[2]<=3) return(re)
else return(FALSE)
}
move7(c(7,0))
move7(move7(c(7,0)))
move7(move7(move7(c(7,0))))
move7(move7(move7(move7(c(7,0)))))
move7(move7(move7(move7(move7(c(7,0))))))
move7(move7(move7(move7(move7(move7(c(7,0)))))))
move7(move7(move7(move7(move7(move7(move7(c(7,0))))))))
move7(move7(move7(move7(move7(move7(move7(move7(c(7,0)))))))))

230:卵の名無しさん
20/07/18 18:05:00.73 4YqdABa6.net
status=c(7,0)
cat('1 : ',status,'\n')
i=1
while(!identical(status,c(0,0))){
i=i+1
status=move7(status)
cat(i,' : ',status,'\n')
}
> status=c(7,0)
> cat('1 : ',status,'\n')
1 : 7 0
> i=1
> while(!identical(status,c(0,0))){
+ i=i+1
+ status=move7(status)
+ cat(i,' : ',status,'\n')
+ }
2 : 4 3
3 : 4 0
4 : 1 3
5 : 1 0
6 : 0 1
7 : 7 1
8 : 5 3
9 : 5 0

231:卵の名無しさん
20/07/18 18:05:05.25 4YqdABa6.net
10 : 2 3
11 : 2 0
12 : 0 2
13 : 7 2
14 : 6 3
15 : 6 0
16 : 3 3
17 : 3 0
18 : 0 3
19 : 0 0

232:卵の名無しさん
20/07/18 18:39:15.05 4YqdABa6.net
move3 <- function(xy){ # start from c(0,3)
x=xy[1] ; y=xy[2]
if(y==3){
if(x<=(7-3)) re=c(x+3,0)
else re=c(7, 3-(7-x))
}
if(y==0) re=c(x,3)
if(x==7) re=c(0,y)



233:if(x==0) re=c(y,0) return(re) } status=c(0,3) cat('1 : ',status,'\n') i=1 while(!identical(status,c(0,0))){ # stop at c(5,0) for solution i=i+1 status=move3(status) cat(i,' : ',status,'\n') } > cat('1 : ',status,'\n') 1 : 0 3 > while(!identical(status,c(0,0))){ # stop at c(5,0) for solution + i=i+1 + status=move3(status) + cat(i,' : ',status,'\n') + }



234:卵の名無しさん
20/07/18 18:40:32.08 4YqdABa6.net
2 : 3 0
3 : 3 3
4 : 6 0
5 : 6 3
6 : 7 2
7 : 0 2
8 : 2 0
9 : 2 3
10 : 5 0
11 : 5 3
12 : 7 1
13 : 0 1
14 : 1 0
15 : 1 3
16 : 4 0
17 : 4 3
18 : 7 0
19 : 0 0
7リットルから開始で9回の移動、3リットルから開始で10回の移動で5リットルが測れる

235:卵の名無しさん
20/07/18 18:55:31.30 pMfDhNh8.net
ボケ

236:卵の名無しさん
20/07/18 20:25:32.47 4YqdABa6.net
>>190
9から始めた方がステップがすくないな
> a7=9 ; b3=7
1 : 9 0
2 : 2 7
3 : 2 0
4 : 0 2
5 : 9 2
6 : 4 7
7 : 4 0
8 : 0 4
9 : 9 4
10 : 6 7
11 : 6 0
12 : 0 6
13 : 9 6
14 : 8 7
15 : 8 0

237:卵の名無しさん
20/07/18 21:51:09.00 ZK4CJMhK.net
カス

238:卵の名無しさん
20/07/18 22:33:34.04 4YqdABa6.net
6を法として+1に合同な素数と、-1に合同な素数が、p以下に同数あるような素数pを「均衡素数」と呼ぶことにする。
(例えば2,3,7,13は均衡素数だが、5,11はそうでない)
このとき、 均衡素数を20個見つけよ
F <- function(N){
library(numbers)
prime=Primes(N)
n_p=length(prime)
f1 <- function(x) x%%6==1
f5 <- function(x) x%%6==5
p1=prime[sapply(prime,f1)]
p5=prime[sapply(prime,f5)]
f <- function(p) sum(p1<=p)==sum(p5<=p)
p=NULL
i=1
lp=length(p)
while(i <= n_p){
x=prime[i]
if(f(x)==TRUE) p=c(p,x)
lp=length(p)
i=i+1
}
p
}
F(1e3)
F(1e4)
F(1e5)
F(1e6)

239:卵の名無しさん
20/07/18 22:34:04.03 4YqdABa6.net
"
容量8Lの袋と容量5Lの袋を使って池の水を丁度4L集めたい。
袋に目盛りはついていません。
袋から袋への移し替えは全量で行います。
池からとる水の量や池に捨てる水の量には制限はありません。
最初に片方に満たした作業を1回目として
丁度4Lを集めるのに最低何回の移動が必要か?
"
a7=8 ; b3=5
# starting from the bigger pitcher
movea7 <- function(xy){ # start from c(a7,0)
x=xy[1] ; y=xy[2]
# x==a7
if(x==a7) re=c(a7-(b3-y),b3)
# x==0
if(x==0) re=c(a7,y)
# y==b3
if(y==b3) re=c(x,0)
# y==0
if(y==0 & x!=a7){
if(x>=b3) re=c(x-b3,b3)
else re=c(0,x)
}
return(re)
}

240:卵の名無しさん
20/07/18 22:34:20.69 4YqdABa6.net
STATUS=status=c(a7,0)
i=1
while(!identical(status,c(0,0))){#
i=i+1
status=movea7(status)
STATUS=rbind(STATUS,status)
}
rownames(STATUS)=1:nrow(STATUS)
colnames(STATUS)=c(paste0(a7,'L'),paste0(b3,'L'))
STATUS

241:卵の名無しさん
20/07/18 22:34:29.67 4YqdABa6.net
# starting from the smaller pitcher
moveb3 <- function(xy){ # start from c(0,b3)
x=xy[1] ; y=xy[2]
if(y==b3){
if(x<=(a7-b3)) re=c(x+b3,0)
else re=c(a7, b3-(a7-x))
}
if(y==0) re=c(x,b3)
if(x==a7) re=c(0,y)
if(x==0) re=c(y,0)
return(re)
}
STATUS=status=c(0,b3)
i=1
while(!identical(status,c(0,0))){ # stop at c(5,0) for solution
i=i+1
status=moveb3(status)
STATUS=rbind(STATUS,status)
}
rownames(STATUS)=1:nrow(STATUS)
colnames(STATUS)=c(paste0(a7,'L'),paste0(b3,'L'))
STATUS

242:卵の名無しさん
20/07/18 22:35:49.09 4YqdABa6.net
> STATUS
8L 5L
1 0 5
2 5 0
3 5 5
4 8 2
5 0 2
6 2 0
7 2 5
8 7 0
9 7 5
10 8 4
11 0 4
12 4 0
13 4 5
14 8 1
15 0 1
16 1 0
17 1 5
18 6 0
19 6 5
20 8 3
21 0 3
22 3 0
23 3 5
24 8 0
25 0 0

243:卵の名無しさん
20/07/18 22:36:11.58 4YqdABa6.net
> STATUS
8L 5L
1 8 0
2 3 5
3 3 0
4 0 3
5 8 3
6 6 5
7 6 0
8 1 5
9 1 0
10 0 1
11 8 1
12 4 5
13 4 0
14 0 4
15 8 4
16 7 5
17 7 0
18 2 5
19 2 0
20 0 2
21 8 2
22 5 5
23 5 0
24 0 5
25 0 0

244:卵の名無しさん
20/07/19 07:47:44.51 ZhvraOW0.net
SEIRモデルにK値という指標を重ねてこんなグラフを作って遊んでみた。
URLリンク(i.imgur.com)
K値の評価を検査していたら
URLリンク(tatsuharug.com)
ページにあたった。
獣医にも賢い人がいるなぁ、と思って経歴をみたら、
URLリンク(tatsuharug.com)
納得した。

245:卵の名無しさん
20/07/19 11:40:45.82 ZhvraOW0.net
abc2ABC <- function(a,b,c,axis=FALSE,...){ # 三辺の長さを与えて角度を計算して三角形を描画する
abc=c(a,b,c)
if((0<a & 0<b & 0<c) & ( max(abc) < sum(abc[-which.max(abc)]))){
A=acos((b^2+c^2-a^2)/(2*b*c))
B=acos((c^2+a^2-b^2)/(2*c*a))
C=acos((a^2+b^2-c^2)/(2*a*b))
ABC=c(A,B,C)
plot(NULL,asp=1,xlim=c(0,max(abc)),ylim=c(0,max(abc)),bty='n',
ann=F,axes=axis)
segments(0,0,c,0,...)
segments(0,0,b*cos(A),b*sin(A),...)
segments(c,0,b*cos(A),b*sin(A),...)
return(list(ABCrad=ABC,ABCdeg=ABC*180/pi))
}else return(0)
}
abc2ABC(12,13,5,col=2)
abc2ABC(3,3,3,T,col=2)

246:卵の名無しさん
20/07/19 15:22:15.54 xIzaGZqM.net
↑あほシリツ

247:卵の名無しさん
20/07/19 21:04:42.06 ZhvraOW0.net
# 放物線y=x^2 0<=x<=1の回転体の容器に水を入れて45度傾ける
par(bty='l')
source('tools.R')
x=seq(-1,1,0.01)
curve(x^2,-1,1,asp=1,ann=F)
x=seq(0,1,0.01)
segments(x,x^2,x,x,col='blue')
integrate(function(z) pi*sqrt(z)^2, 0,1)
seg(0+0i,0+0.6i,col=8) ; pt(0+0.3i,'z')
seg(0+0.6i,sqrt(0.6)+0.6i,col=8) ; pt(0.3+0.6i,'√z')
integrate(function(y) pi*sqrt(y)^2, 0,1)$value ; pi/2
integrate(function(x)x-x^2,0,1)$value ; 1/6
# x^2+y^2=z
x=y=seq(-1,1,0.1)
f <- function(x,y) x^2+y^2
z=outer(x,y,f)
rgl::persp3d(x,y,z,zlim=c(0,1),asp=1,col=rgb(0.99,0.99,0.99,0.99))
z[z>1]=1
persp(x,y,z, theta=35, lty=3,col='lightgreen',xlab='x',ylab='y',zlab='z',
ticktype='detailed',shade=0.4,phi=30,ltheta=-10,border=TRUE)

248:卵の名無しさん
20/07/19 21:08:45.08 ZhvraOW0.net
URLリンク(i.imgur.com)

249:卵の名無しさん
20/07/19 21:46:36 ZhvraOW0.net
放物線y=x^2 (0<= x <=1)をy軸を中心に回転させてできる面からなる容器に水を満たして45°傾けたときに残る水の体積はいくらか?

URLリンク(i.imgur.com)
URLリンク(i.imgur.com)
URLリンク(i.imgur.com)

250:''
20/07/19 23:16:48.49 ZhvraOW0.net
>>231
x=x^2+t^2
α=1/2 (1 - sqrt(1 - 4 t^2))
β=1/2 (1 + sqrt(1 - 4 t^2))
t=[-1/2,1/2]
β-α=2*sqrt(1-4*t^2)
f=function(x) (2*sqrt(1-4*x^2))^3/6
integrate(f, -1/2,1/2)

251:''
20/07/19 23:35:23.16 ZhvraOW0.net
x=x^2+t^2
α=1/2 (1 - sqrt(1 - 4 t^2))
β=1/2 (1 + sqrt(1 - 4 t^2))
t=[-1/2,1/2]
β-α=sqrt(1-4*t^2)
f=function(x) (sqrt(1-4*x^2))^3/6
integrate(f, -1/2,1/2)$value/pi

252:''
20/07/19 23:35:42.09 ZhvraOW0.net
x=x^2+t^2
α=1/2 (1 - sqrt(1 - 4 t^2))
β=1/2 (1 + sqrt(1 - 4 t^2))
t=[-1/2,1/2]
β-α=sqrt(1-4*t^2)
f=function(x) (sqrt(1-4*x^2))^3/6
integrate(f, -1/2,1/2)$value

253:''
20/07/19 23:46:20.75 ZhvraOW0.net
k*x=a*x^2+t^2
α=1/2 (1 - sqrt(1 - 4 t^2))
β=1/2 (1 + sqrt(1 - 4 t^2))
t=[-1/2,1/2]
β-α=sqrt(1-4*t^2)
f=function(x) (sqrt(1-4*x^2))^3/6
integrate(f, -1/2,1/2)$value/pi
(β-α)^2=(α+β)^2-4αβ=(k/a)^2-4t^2/a

254:卵の名無しさん
20/07/20 06:50:14 mdlQ7W67.net
# y=ax^2の放物線回転体で上縁の半径がrである器をdeg度傾けて残る液体の量
Tilt <- function(deg=45,a=1,r=1){
θ=deg*pi/180
max=atan(2*a*r)
if(θ>max) return(0)
f <- function(x){
(a/6)* ((1/a)*sqrt(4*a^2*r^2 - 4*a^2*x^2 - 4*a*r*tan(θ) + tan(θ)^2))^3
}
abs(integrate(f,-(tan(θ)/(2*a)-r),tan(θ)/(2*a)-r)$value)
}

degs=seq(0,atan(2)*180/pi,length=500)
Volume=sapply(degs,Tilt)
plot(degs,Volume,xlab='傾き',ylab='残像量',type='l',lwd=2)

# 残りの液量割合から傾ける角度を算出
uniroot(function(x) Tilt(x)-Tilt(0)/2, c(0,60))$root
Vol2deg <- function(vol=0.5,A=1,R=1){ # proportion of the full-filled volume
uniroot(function(x) Tilt(x,A,R) - vol


255:*Tilt(0,A,R),c(0,atan(2*A*R)*180/pi))$root } Vol2deg(0.5) vol=1:20/20 data.frame(残量割合=vol,傾斜角度=sapply(vol,Vol2deg)) vols=seq(0,1,0.01) plot(vols,sapply(vols,Vol2deg),type='l',col='navy',lwd=2, xlab='残存割合',ylab='傾斜角度')



256:卵の名無しさん
20/07/20 06:58:13.09 mdlQ7W67.net
>>231
これ類題が東大入試の過去問にあるんだよなぁ。
俺が受験した頃でも、とても試験時間内に解けるとは思えん。

257:卵の名無しさん
20/07/20 08:26:25.26 mdlQ7W67.net
(draft)
" y=f(x)
y=sqrt(r^2-x^2)
f(sqrt(x^2+y^2))
= sqrt(r^2-x^2-y^2)
"
fc = function(x,r=1) 1-sqrt(r^2-x^2)
fc=Vectorize(fc)
curve(fc(x),asp=1)
f = function(x,y,r=1){
if(r^2-(x^2+y^2) > 0) 1-sqrt(r^2-(x^2+y^2))
else 0
}
f=Vectorize(f)
x=y=seq(-1,1,0.01)
z=outer(x,y,f1)
rgl::persp3d(x,y,z,zlim=c(0,1),col=2)

258:''
20/07/20 12:36:11.83 2KPrymDE.net
(draft)
" y=f(x)
y=sqrt(r^2-x^2)
f(sqrt(x^2+y^2))
= sqrt(r^2-x^2-y^2)
"
fc = function(x,r=1) 1-sqrt(r^2-x^2)
fc=Vectorize(fc)
curve(fc(x),asp=1)
f = function(x,y,r=1){
if(r^2-(x^2+y^2) > 0) 1-sqrt(r^2-(x^2+y^2))
else NA
}
f=Vectorize(f)
x=y=seq(-1,1,0.01)
z=outer(x,y,f)
idx=which(z!=NA)
z=z[idx]
x=x[idx]
y=y[idx]
rgl::persp3d(x,y,z,zlim=c(0,1),col=2)

259:'\n'
20/07/20 12:36:57.99 2KPrymDE.net
(draft)
" y=f(x)
y=sqrt(r^2-x^2)
f(sqrt(x^2+y^2))
= sqrt(r^2-x^2-y^2)
"
fc = function(x,r=1) 1-sqrt(r^2-x^2)
fc=Vectorize(fc)
curve(fc(x),asp=1)
f = function(x,y,r=1){
if(r^2-(x^2+y^2) > 0) 1-sqrt(r^2-(x^2+y^2))
else NA
}
f=Vectorize(f)
x=y=seq(-1,1,0.01)
z=outer(x,y,f)
idx=which(z!=NA)
z=z[idx]
x=x[idx]
y=y[idx]
rgl::persp3d(x,y,z,zlim=c(0,1),col=2)

260:卵の名無しさん
20/07/20 17:46:44 6Z+kbl12.net
URLリンク(cse.naro.affrc.go.jp)

関数 polyroot() で多項式の解(根)を求めることが出来る.例えば,p(x) = 5 + 4x + x2 の根を求める場合は c(5, 4, 1) を与える.

261:卵の名無しさん
20/07/20 19:44:08.15 6Z+kbl12.net
"
25枚の山札があり内1枚がレアカードだとします。
25枚の山札から10枚を引いて手札にし、
更に手札の10枚のうち2枚を山札から交換できる場合
(交換は、交換したいカードを山札でない場所に捨てたあとに山札から引きます)
"
# exchange n cards
exch <- function(x,y,n){
nx=length(x)
ny=length(y)
ix=sample(nx,n) # index of x exchanged
iy=sample(ny,n)
X=c(y[iy],x[-ix])
Y=c(x[ix],y[-iy])
list(X,Y)
}
#
sim <- function(
r=1, # レアカードの枚数
n25=25, # 最初の山札の枚数
n10=10, # 最初に引く手札の枚数
e2=2){ # 交換する枚数
t10=sample(n25,n10) # 交換前の手札10枚
y15=(1:n25)[-t10] # 交換前の山札15枚
te=exch(t10,y15,e2)[[2]] # 交換後の手札
any(1:r %in% te) # 1枚でもレアカードを含むか?
}
mean(replicate(1e6,sim(1))) # レアカード1枚
mean(replicate(1e6,sim(2))) # レアカード2枚

262:卵の名無しさん
20/07/21 00:02:50.07 1tv7qVWN.net
半球状のお椀をθ傾けたときの残量
y1=r+tanθ(x-r)
y2=r-sqrt(r^2-(x^2+t^2))
α = r sin^2(θ) - cos^2(θ) sqrt(r^2 - t^2 - t^2 tan^2(θ))
β = r sin^2(θ) + cos^2(θ) sqrt(r^2 - t^2 - t^2 tan^2(θ))
y1-y2=tanθ(x-r) + sqrt(r^2-(x^2+t^2))
S(t)=integrate[α,β] (y1-y2)dx
integrate[-rcosθ,rcosθ] S(t)dt

263:卵の名無しさん
20/07/21 01:39:25.34 1tv7qVWN.net
Volume <- function(deg,r=1){
θ=deg*pi/180
g <- function(t){
f <- function(x){
tan(θ)*(x-r) + sqrt(r^2-(x^2+t^2))
}
integrate(f,
r*sin(θ)^2 - cos(θ)^2*sqrt(r^2-t^2-t^2*tan(θ)^2),
r*sin(θ)^2 + cos(θ)^2*sqrt(r^2-t^2-t^2*tan(θ)^2))$value
}
integrate(Vectorize(g),-r*cos(θ),r*cos(θ))$value
}
Volume(0) ; (4/3)*pi/2
degs=0:90
vol=sapply(degs,Volume)/Volume(0)
plot(degs,vol,type='l') ; abline(h=0.5,lty=3)
uniroot(function(x) Volume(x)/Volume(0)-0.5,c(15,30))$root


次ページ
最新レス表示
レスジャンプ
類似スレ一覧
スレッドの検索
話題のニュース
おまかせリスト
オプション
しおりを挟む
スレッドに書込
スレッドの一覧
暇つぶし2ch