底辺私立医大を卒業した医者って頭悪いよね？ Part19
レス数が950を超えています。1000を超えると書き込みができなくなります。
a=runif(1,0,pi)
b=runif(1,-a,a)
A=cos(a)+1i*sin(a)
B=cos(b)+1i*sin(b)
C=cos(a)-1i*sin(a) source('toolmini.R')
Do <- function(){
a=runif(1,0,pi/2)
b=runif(1,-a,a)
A=cos(2*a)+1i*sin(2*a)
B=cos(2*b)+1i*sin(2*b)
C=cos(2*a)-1i*sin(2*a)
H=Orthocenter(A,B,C)
G=sum(A,B,C)/3
I=incircle(A,B,C)[1]
Plot(min(Re(H),-1),max(Re(H),1),axes=FALSE)
Polygon(A,B,C,Col=8)
# pt(A,'A') ; pt(B,'B') ; pt(C,'C')
pt(H,'H') ; pt(G,'G') ; pt(I,'I')
seg(H,G,col=8,lty=3)
Cir(H/2+G/2,abs(H-G)/2,col=2)
}
for(i in 1:15){
Do()
Sys.sleep(2)
} # n個のサイコロを同に投げる。出ための和n+3になる確率は?
rm(list=ls())
calc <- function(n){
gr=expand.grid(replicate(n,1:6,simpl=FALSE))
sum(apply(gr,1,function(x) sum(x)==n+3))
}
n=1:10
y=sapply(n,calc)
plot(n,y,bty='l',pch=19)
lm(y~n+I(n^3)+I(n^2)+I(n^3)+0)
lm(y~n+I(n^3)+I(n^2)+I(n^3)+I(n^4)+0)
fy = function(n) (1/3)*n + (1/2)*n^2 + (1/6)*n^3
curve(fy(x),add=T)
P = function(n) (1/6)*(n^3+3*n^2+2*n)/6^n # n*(n+1)*(n+2)/6^n
plot(n,y/6^n,bty='l')
curve(P(x),add=T) # 一般化
calc <- function(
ntc=53, # number of total cards
nht=13, # number of hearts in total cards
pht=3, # picked hearts
pot=2){ # picked other suits
# P[B|A]
PB_A=choose(nht-1,pht)*choose(ntc-nht,pot)/choose(ntc-1,pht+pot)
# P[A]
PA=nht/ntc
# P[B|!A]
PB_nA=choose(nht,pht)*choose(ntc-nht-1,pot)/choose(ntc-1,pht+pot)
# P[!A]
P_nA=1-nht/ntc
# P[A|B]
PB_A*PA/(PB_A*PA+PB_nA*P_nA)
}
calc(53,13,3,2)
calc(53,13,3,2) 基礎研究に全くカネを出さず（先進国最低レベル）本物の技術を持っていた中小の企業を守らず
観光立国（爆笑）なんか目指せばそりゃあこうなる pick<-function(x,one=1){
i=sample(length(x),one)
picked=x[i]
rest=x[-i]
list(picked=picked,rest=rest)
}
card=rep(1:0,c(13,40))
pht=3 # picked hearts
pot=2 # picked others
sim <- function(){
p1=pick(card)
p3=pick(p1$rest,pht+pot)$picked
c(p1$picked,sum(p3))
}
re=t(replicate(1e6,sim()))
re3=re[re[,2]==pht,]
sum(re3[,1])/nrow(re3) “筋肉関数M(n)を以下のように定義する。
M(0)=1
M(n+1)=M(n)+m(n)+i*fat(n)
m(n)=1（筋トレをした場合）,-1（筋トレをしなかった場合）
fat(n)=-1（筋トレをした場合）,1（筋トレをしなかった場合）
いま各時刻t=0,1,2,...で筋トレをする確率は3/5とする。
M(31)の期待値を求めよ。“
sim <- function(n=31){
M=complex()
M[1]=1+ifelse(rbinom(1,1,3/5),1-1i,-1+1i)
for(j in 1:(n-1)){
M[j+1]=M[j]+ifelse(rbinom(1,1,3/5),1-1i,-1+1i)
}
M[n]
}
sim()
mean(replicate(1e2,sim())) sim <- function(n=31){
M=complex()
M[1]=1+ifelse(rbinom(1,1,3/5),1-1i,-1+1i)
for(j in 1:(n-1)){
M[j+1]=M[j]+ifelse(rbinom(1,1,3/5),1-1i,-1+1i)
}
M[n]
}
sim()
re=replicate(1e4,sim())
plot(re)
mf=NULL
mean(replicate(1e3,sim()))
for(k in 1:1e3) mf=append(mf,sim())
plot(mf) >>858
100万シミュレーション。
sim <- function(n=31){
M=complex()
M[1]=1+ifelse(rbinom(1,1,3/5),1-1i,-1+1i)
for(j in 1:(n-1)){
M[j+1]=M[j]+ifelse(rbinom(1,1,3/5),1-1i,-1+1i)
}
M[n]
}
re=replicate(1e6,sim())
結果
> summary(cbind(m=Re(re),fat=Im(re)))
m fat
Min. :-18.000 Min. :-29.000
1st Qu.: 4.000 1st Qu.: -9.000
Median : 8.000 Median : -7.000
Mean : 7.196 Mean : -6.196
3rd Qu.: 10.000 3rd Qu.: -3.000
Max. : 30.000 Max. : 19.000
> sim <- function(n=31){
M=complex()
M[1]=1+ifelse(rbinom(1,1,3/5),1-1i,-1+1i)
for(j in 1:(n-1)){
M[j+1]=M[j]+ifelse(rbinom(1,1,3/5),1-1i,-1+1i)
}
M[n]
}
re=replicate(1e6,sim())
mus=Re(re) ; fat=Im(re)
summary(cbind(mus,fat))
plot(mus,fat) P <- function(N=100,p=1/5,k=4){
if(N<k) return(0)
R=numeric(N)
R[k] = p^k
R[k+1]=R[k]+(1-p)*p^k
if(N>k+1){
for(n in (k+2):N) {
R[n] <- R[n-1] + (1-R[n-k-1])*(1-p)*p^k
}
}
R[N]
}
p <- function(n) P(n) - P(n-1)
p=Vectorize(p)
i=1:100
sum(1000*(100-i)*p(i)) library(numbers)
f <- function(a,b){
c=as.numeric(paste0(as.character(a),as.character(b)))
a^2+b^2==c & GCD(a,b)==1
}
f(588,2353) library(numbers)
f <- function(a,b){
c=as.numeric(paste0(as.character(a),as.character(b)))
a^2+b^2==c & GCD(a,b)==1
}
re=NULL
for(i in 1:9999){
for(j in 1:9999){
if(f(i,j)) re=rbind(re,c(i,j))
}
}
re library(numbers)
f <- function(a,b){
c=as.numeric(paste0(as.character(a),as.character(b)))
a^2+b^2==c & GCD(a,b)==1
}
m=9999
n=9999
re=NULL
for(i in 1:m){
for(j in 1:n){
if(f(i,j)) re=rbind(re,c(i,j))
}
}
re > re
[,1] [,2]
[1,] 10 1
[2,] 588 2353 # solve a^2-b^2=x, 2*a*b=y for a,b
f <- function(xy){
x=xy[1];y=xy[2]
a1 = -sqrt(x - sqrt(x^2 + y^2))/sqrt(2)
b1 = -y/(sqrt(2)*sqrt(x - sqrt(x^2 + y^2)))
a2 = sqrt(x - sqrt(x^2 + y^2))/sqrt(2)
b2 = y/(sqrt(2)*sqrt(x - sqrt(x^2 + y^2)))
a3 = -sqrt(sqrt(x^2 + y^2) + x)/sqrt(2)
b3 = -y/(sqrt(2)*sqrt(sqrt(x^2 + y^2) + x))
a4 = sqrt(sqrt(x^2 + y^2) + x)/sqrt(2)
b4 = y/(sqrt(2)*sqrt(sqrt(x^2 + y^2) + x))
ab=c(a1,b1,a2,b2,a3,b3,a4,b4)
c=ab[1<=ab&ab<=2&!is.na(ab)]
length(c)>1
}
f(c(1,10))
f(c(1,4))
N=1e4
moca=cbind(runif(N,-4,4),runif(N,1,9))
mean(apply(moca,1,f))*8^2 領域D={(a^2-b^2,2ab)|1≦a≦2,1≦b≦2}の面積を求めよ
a=1
x=1-b^2
y=2b
f1=function(x) -2*sqrt(1-x)
a=2
x=4-b^2
y=8b
y=8*sqrt(
b=1
x=a^2-1
y=2a
b=2
x=a^2-4
y=4a # 領域D={(a^2-b^2,2ab)|1≦a≦2,1≦b≦2}の面積を求めよ
a=b=seq(1,2,le=300)
x=outer(a,b,function(a,b) a^2-b^2)
y=outer(a,b,function(a,b) 2*a*b)
plot(x,y,asp=1,col=2,bty='n',xlab='a^2-b^2',ylab='2ab',
xlim=c(-3,3),ylim=c(0,8))
# a=1
# x=1-b^2 ,b=sqrt(1-x)
# y=2b
f1=function(x) 2*sqrt(1-x)
curve(f1(x),add=TRUE,lty=1)
# a=2
# x=4-b^2 ,b=sqrt(4-x)
# y=4b
f2=function(x) 4*sqrt(4-x)
curve(f2(x),add=TRUE,lty=2)
# b=1
# x=a^2-1 ,a=sqrt(1+x)
# y=2a
f3=function(x) 2*sqrt(1+x)
curve(f3(x),add=TRUE,lty=3)
# b=2
# x=a^2-4 ,a=sqrt(4+x)
# y=4a
f4=function(x) 4*sqrt(4+x)
curve(f4(x),add=TRUE,lty=4)
2*integrate(function(x) f2(x)-f3(x), 0,3)$value 現状では臨床医に必要な外国語は英語、臨床医に必要なプログラム言語はR。 # 交点の座標を返す
intsect <- function(a,b,c,d){
a1=Re(a) ; a2=Im(a)
b1=Re(b) ; b2=Im(b)
c1=Re(c) ; c2=Im(c)
d1=Re(d) ; d2=Im(d)
if((a2-b2)*(c1-d1)==(a1-b1)*(c2-d2) | (a-b)*(c-d)==0) return(NULL)
if(a1==b1 & c1!=d1) return( a1+1i*((d2-c2)/(d1-c1)*(a1-c1)+c2) )
if(a1!=b1 & c1==d1) return( c1+1i*((a2-b2)/(a1-b1)*(c1-a1)+a2) )
p=(a2-b2)/(a1-b1)
q=(c2-d2)/(c1-d1)
if(p==q) return(NULL)
else{
x= ((p*a1 - a2) - (q*c1 - c2))/ (p-q)
y= p*x - (p*a1 - a2)
return( x + 1i*y )
}
} intsect <- function(a,b,c,d){
a1=Re(a) ; a2=Im(a)
b1=Re(b) ; b2=Im(b)
c1=Re(c) ; c2=Im(c)
d1=Re(d) ; d2=Im(d)
if((a2-b2)*(c1-d1)==(a1-b1)*(c2-d2) | (a-b)*(c-d)==0) return(NULL)
if(a1==b1 & c1!=d1) return( a1+1i*((d2-c2)/(d1-c1)*(a1-c1)+c2) )
if(a1!=b1 & c1==d1) return( c1+1i*((a2-b2)/(a1-b1)*(c1-a1)+a2) )
p=(a2-b2)/(a1-b1)
q=(c2-d2)/(c1-d1)
x= ((p*a1 - a2) - (q*c1 - c2))/ (p-q)
y= p*x - (p*a1 - a2)
return( x + 1i*y )
} # 複素平面で円の中心の座標と半径から交点の座標を返す
intcir <- function(A,ra,B,rb){
a1=Re(A) ; a2=Im(A)
b1=Re(B) ; b2=Im(B)
r=ra ; s=rb
x1=(a1^3-a1^2*b1-sqrt(-(a2-b2)^2*(a1^4-4*a1^3*b1+2*a1^2*a2^2-4*a1^2*a2*b2+6*a1^2*b1^2+2*a1^2*b2^2-2*a1^2*r^2-2*a1^2*s^2-4*a1*a2^2*b1+8*a1*a2*b1*b2-4*a1*b1^3-4*a1*b1*b2^2+4*a1*b1*r^2+4*a1*b1*s^2+a2^4-4*a2^3*b2+2*a2^2*b1^2+6*a2^2*b2^2-2*a2^2*r^2-2*a2^2*s^2-4*a2*b1^2*b2-4*a2*b2^3+4*a2*b2*r^2+4*a2*b2*s^2+b1^4+2*b1^2*b2^2-2*b1^2*r^2-2*b1^2*s^2+b2^4-2*b2^2*r^2-2*b2^2*s^2+r^4-2*r^2*s^2+s^4))+a1*a2^2-2*a1*a2*b2-a1*b1^2+a1*b2^2-a1*r^2+a1*s^2+a2^2*b1-2*a2*b1*b2+b1^3+b1*b2^2+b1*r^2-b1*s^2)/(2*(a1^2-2*a1*b1+a2^2-2*a2*b2+b1^2+b2^2))
y1=(a1^2*a2^2-a1^2*b2^2+a1*sqrt(-(a2-b2)^2*(a1^4-4*a1^3*b1+2*a1^2*a2^2-4*a1^2*a2*b2+6*a1^2*b1^2+2*a1^2*b2^2-2*a1^2*r^2-2*a1^2*s^2-4*a1*a2^2*b1+8*a1*a2*b1*b2-4*a1*b1^3-4*a1*b1*b2^2+4*a1*b1*r^2+4*a1*b1*s^2+a2^4-4*a2^3*b2+2*a2^2*b1^2+6*a2^2*b2^2-2*a2^2*r^2-2*a2^2*s^2-4*a2*b1^2*b2-4*a2*b2^3+4*a2*b2*r^2+4*a2*b2*s^2+b1^4+2*b1^2*b2^2-2*b1^2*r^2-2*b1^2*s^2+b2^4-2*b2^2*r^2-2*b2^2*s^2+r^4-2*r^2*s^2+s^4))-b1*sqrt(-(a2-b2)^2*(a1^4-4*a1^3*b1+2*a1^2*a2^2-4*a1^2*a2*b2+6*a1^2*b1^2+2*a1^2*b2^2-2*a1^2*r^2-2*a1^2*s^2-4*a1*a2^2*b1+8*a1*a2*b1*b2-4*a1*b1^3-4*a1*b1*b2^2+4*a1*b1*r^2+4*a1*b1*s^2+a2^4-4*a2^3*b2+2*a2^2*b1^2+6*a2^2*b2^2-2*a2^2*r^2-2*a2^2*s^2-4*a2*b1^2*b2-4*a2*b2^3+4*a2*b2*r^2+4*a2*b2*s^2+b1^4+2*b1^2*b2^2-2*b1^2*r^2-2*b1^2*s^2+b2^4-2*b2^2*r^2-2*b2^2*s^2+r^4-2*r^2*s^2+s^4))-2*a1*a2^2*b1+2*a1*b1*b2^2+a2^4-2*a2^3*b2+a2^2*b1^2-a2^2*r^2+a2^2*s^2+2*a2*b2^3+2*a2*b2*r^2-2*a2*b2*s^2-b1^2*b2^2-b2^4-b2^2*r^2+b2^2*s^2)/(2*(a2-b2)*(a1^2-2*a1*b1+a2^2-2*a2*b2+b1^2+b2^2)) x2=(a1^3-a1^2*b1+sqrt(-(a2-b2)^2*(a1^4-4*a1^3*b1+2*a1^2*a2^2-4*a1^2*a2*b2+6*a1^2*b1^2+2*a1^2*b2^2-2*a1^2*r^2-2*a1^2*s^2-4*a1*a2^2*b1+8*a1*a2*b1*b2-4*a1*b1^3-4*a1*b1*b2^2+4*a1*b1*r^2+4*a1*b1*s^2+a2^4-4*a2^3*b2+2*a2^2*b1^2+6*a2^2*b2^2-2*a2^2*r^2-2*a2^2*s^2-4*a2*b1^2*b2-4*a2*b2^3+4*a2*b2*r^2+4*a2*b2*s^2+b1^4+2*b1^2*b2^2-2*b1^2*r^2-2*b1^2*s^2+b2^4-2*b2^2*r^2-2*b2^2*s^2+r^4-2*r^2*s^2+s^4))+a1*a2^2-2*a1*a2*b2-a1*b1^2+a1*b2^2-a1*r^2+a1*s^2+a2^2*b1-2*a2*b1*b2+b1^3+b1*b2^2+b1*r^2-b1*s^2)/(2*(a1^2-2*a1*b1+a2^2-2*a2*b2+b1^2+b2^2))
y2=(a1^2*a2^2-a1^2*b2^2-a1*sqrt(-(a2-b2)^2*(a1^4-4*a1^3*b1+2*a1^2*a2^2-4*a1^2*a2*b2+6*a1^2*b1^2+2*a1^2*b2^2-2*a1^2*r^2-2*a1^2*s^2-4*a1*a2^2*b1+8*a1*a2*b1*b2-4*a1*b1^3-4*a1*b1*b2^2+4*a1*b1*r^2+4*a1*b1*s^2+a2^4-4*a2^3*b2+2*a2^2*b1^2+6*a2^2*b2^2-2*a2^2*r^2-2*a2^2*s^2-4*a2*b1^2*b2-4*a2*b2^3+4*a2*b2*r^2+4*a2*b2*s^2+b1^4+2*b1^2*b2^2-2*b1^2*r^2-2*b1^2*s^2+b2^4-2*b2^2*r^2-2*b2^2*s^2+r^4-2*r^2*s^2+s^4))+b1*sqrt(-(a2-b2)^2*(a1^4-4*a1^3*b1+2*a1^2*a2^2-4*a1^2*a2*b2+6*a1^2*b1^2+2*a1^2*b2^2-2*a1^2*r^2-2*a1^2*s^2-4*a1*a2^2*b1+8*a1*a2*b1*b2-4*a1*b1^3-4*a1*b1*b2^2+4*a1*b1*r^2+4*a1*b1*s^2+a2^4-4*a2^3*b2+2*a2^2*b1^2+6*a2^2*b2^2-2*a2^2*r^2-2*a2^2*s^2-4*a2*b1^2*b2-4*a2*b2^3+4*a2*b2*r^2+4*a2*b2*s^2+b1^4+2*b1^2*b2^2-2*b1^2*r^2-2*b1^2*s^2+b2^4-2*b2^2*r^2-2*b2^2*s^2+r^4-2*r^2*s^2+s^4))-2*a1*a2^2*b1+2*a1*b1*b2^2+a2^4-2*a2^3*b2+a2^2*b1^2-a2^2*r^2+a2^2*s^2+2*a2*b2^3+2*a2*b2*r^2-2*a2*b2*s^2-b1^2*b2^2-b2^4-b2^2*r^2+b2^2*s^2)/(2*(a2-b2)*(a1^2-2*a1*b1+a2^2-2*a2*b2+b1^2+b2^2))
P1=x1+1i*y1
P2=x2+1i*y2
c(P1,P2)
} 近大医学部
初年度 年間納入金 680万円
2年次以降 年間納入金 580万円
計3580万円 # BCが最長辺となる三角形をランダムに描出する。
rtriangle <- function(print=TRUE,...){ # 最長辺：BC＝１
B=0i
C=1+0i
flg=TRUE
while(flg){
b=runif(1,0,pi/2)
c=runif(1,0,pi-b)
A=intsect(B,C+1i*tan(b),C,1i*(tan(c)))
flg <- abs(A-C)>=1 | abs(A-B)>=1
}
if(print){
Plot(0,max(1,Re(A)),0,max(1,Im(A)),asp=1,...)
Polygon(A,B,C)
pt(A,'A') ; pt(B,'B') ; pt(C,'C')
}
return(A)
}
rtriangle(axes=FALSE) 臨床医に必要な外国語は英語、臨床医に必要なプログラム言語はR.
職種を言えない医療従事者はまず習得していないと思う。 >>879
俺のころは1年で14万4千円だったな。 # BCが最長辺となる∠B,∠Cの組み合わせ
plot(0:90,0:90,type='n',asp=1,ann=F)
sim <- function(b,c,...){
do=pi/180
B=0i
C=1+0i
A=intsect(B,C+1i*tan(b*do),C,1i*(tan(c*do)))
if(abs(A-C)<=1 | abs(A-B)<=1){
points(b,c,...)
}
}
sim=Vectorize(sim)
DEL=replicate(1e4,sim(runif(1,0,90),runif(1,0,90),col=3) source('toolmini.R')
b2c <- function(b){ # AB==BC
do=pi/180
B=0i
C=1+0i
f <- function(c){
A=intsect(B,C+1i*tan(b*do),C,1i*(tan(c*do)))
(abs(A-B)-abs(B-C))^2
}
optimise(f,c(1,90))$minimum
}
b2c=Vectorize(b2c)
b1=seq(0,60,len=101)
c1=b2c(b1)
lines(b1,c1,lwd=2)
lm(c1~b1) # C=90-B/2
b2c2 <- function(b){ # AC==BC
do=pi/180
B=0i
C=1+0i
f <- function(c){
A=intsect(B,C+1i*tan(b*do),C,1i*(tan(c*do)))
(abs(A-C)-abs(B-C))^2
}
optimise(f,c(1,90))$minimum
}
b2c2=Vectorize(b2c2)
b2=seq(60,89,len=1001)
c2=b2c2(b2)
lines(b2,c2,col=2,lwd=2)
lm(c2~b2) # C=180-2*B がん再発の高須克弥院長を応援する「タカスカジャン」が8月発売へ(3万2780円 中国製)
1和三盆 ★2021/04/04(日) 14:29:05.54
東スポ
「高須クリニック」の院長で「高須病院」理事長・高須克弥氏（７６）のスカジャン、
その名も「タカスカジャン」（税込み３万２７８０円）が８月に発売される。
高須氏の刺しゅうが施された表面と高須氏の写真がプリントされた裏面のリバーシブルとなった同スカジャンは、
派手で人目を引くアイテムだ。
「高須クリニック 学習帳 しんさつちょう／れんしゅうちょう」などのグッズを制作している「株式会社グレイ・パーカー・サービス」が
手がける。
高須氏といえば、２０１８年に自身のツイッターでがんであることを公表し、闘病生活を送ってきた。
１月２９日に復帰を宣言し、翌日から患者の治療を再開していたが、２月にがんの再発が明らかとなった。
「タカスカジャン」は、そんな高須氏を応援するために作られた。 "
(a+1/a+b+2/b+c+3/c+d+4/d+e+5/e)^21
a*b^2*c^3*d^4*e^5
"
# x^x1*(1/x)^x2
a1=a2+1
b1=b2+2
c1=c2+3
d1=d2+4
e1=e2+5
a1+b1+...+e1 + a2+b2+...+e2=21
2*(a2+b2+c2+d2+e2)+1+2+3+4+5=21
a2+b2+c2+d2+e2=3
p+q+r+s+t=8
1*1*11*111*1 = 11231
1@1@1@1@1@1@1@1
choose(7,4) # n1+n2+n3+n4+n5=3の非負整数解を列挙
f <- function(x) c(x[1],diff(x),8-rev(x)[1]) - 1
t(combn(7,4,f)) # n1+n2+...+nk=mの非負整数解を列挙
f <- function(x) c(x[1],diff(x),m+k-rev(x)[1]) - 1
t(combn(m+k-1,k-1,f))
# n1+n2+...+nk=mの非負整数解を列挙
fn <- function(k,m) t(combn(m+k-1,k-1,function(x) c(x[1],diff(x),m+k-rev(x)[1]) - 1)) (a+1/a+b+2/b+c+3/c+d+4/d+e+5/e)^21
a*b^2*c^3*d^4*e^5
# n1+n2+...+nk=mの非負整数解を列挙
fn <- function(k,m) t(combn(m+k-1,k-1,function(x) c(x[1],diff(x),m+k-rev(x)[1]) - 1))
re=fn(5,3)
fn(5,3)
fc <- function(x) prod((2:5)^x[2:5])
sum(apply(re,1,fc)) 数学板でも相手にされずここでクソするしかないなんて哀れだね。 俺の出題にちゃんとレスがついてたな。
275 １３２人目の素数さん sage 2021/04/05(月) 22:59:32.54 ID:OnVw7r5N
x1+x2+x3+...+x9=9を満たす非負整数で
x1,x2,...,x9を並べて
000000009から900000000までの数字を作るとき12345番目の数字は何か？ 御告げ
fn <- function(k,m) t(combn(m+k-1,k-1,function(x) c(x[1],diff(x),m+k-rev(x)[1]) - 1))
fn(9,9)[12345,]
tail(fn(9,9)) options(scipen = 5)
fn <- function(k,m) t(combn(m+k-1,k-1,function(x) c(x[1],diff(x),m+k-rev(x)[1]) - 1))
r53=fn(5,3)
s53=t(apply(r53,1,function(x) c(x+(1:5),x)))
f <- function(x,m=21){
n=length(x)
re=1
N=m
for(i in 1:n){
re=re*choose(N,x[i])
N=N-x[i]
}
re
}
sum(apply(s53,1,f))
https://ideone.com/1RbPBa 個人的にはとっくの昔に実現できている。
https://this.kiji.is/751649069700825088?c=39550187727945729
加藤勝信官房長官は5日の記者会見で、「選択的週休3日制」導入を巡り、
自民党の1億総活躍推進本部が月内にまとめる中間提言を踏まえ、検討する考えを示した。
「育児や介護、闘病など生活と仕事の両立を図る観点から多様な働き方の推進は重要だ」と述べた。 a <- function(t) (4*(2+2*t-2)^3*(-1+t+1)^7) * 2 + (7*(2+2*t-2)^4*(-1+t+1)^6) * 1
b <- function(t) 176*t^10
c <- function(t) 30*t^10
t=seq(0,1,le=101)
plot(t,a(t),bty='l',type='l')
points(t,b(t),pch=19)
points(t,c(t),col=2,pch=19) rm(list=ls())
source('toolmini.R')
Do <- function(){
Plot(0,1,axes=FALSE)
B=0i
C=1+0i
A=rtriangle(print=FALSE)
Polygon(A,B,C)
H=Orthocenter(A,B,C)
agA=Angle(B,A,C)[2]
pt(H)
text(Re(A),Im(A),round(agA,2))
}
for(i in 1:30){
Do()
Sys.sleep(0.75)
} https://hoxo-m.hatena
blog.com/entry/20151222/p1 options(scipen = 100)
fn <- function(k,m) t(combn(m+k-1,k-1,function(x) c(x[1],diff(x),m+k-rev(x)[1]) - 1))
r53=fn(5,3)
s53=t(apply(r53,1,function(x) c(x+(1:5),x)))
f <- function(x,m=21){
n=length(x)
re=1
N=m
for(i in 1:n){
re=re*choose(N,x[i])*prod((1:(n/2))^(x[(n/2+1):n]))
N=N-x[i]
}
re
}
sum(apply(s53,1,f)) 俺の出題
分からない問題はここに書いてね 466
https://rio2016.5ch.net/test/read.cgi/math/1613490127/617
617 名前：１３２人目の素数さん[sage] 投稿日：2021/04/05(月) 06:18:18.37 ID:wZxNVsMt
>>595
発展問題
(a+1/a+b+2/b+c+3/c+d+4/d+e+5/e)^21の
a*b^2*c^3*d^4*e^5の係数を求めよ。
にもレスが付いたな。
俺自身が誤答していることも指摘された。
場合分けが面倒だからプログラムできないと正解には至らないだろうな。 浮いてるからすぐわかるよ笑
別人のフリしてるんだろうけど >>908
いや、誤答含めてレスつけてくれたのは別人だが。 >>904
Haskell使いくらいが、これであっているか検証してくれるといいんだけどな。 厚労省「非正規の時給が上昇しました」 変更申請せずに、医師や大学教授を入れていたことが判明 終わりだよ [452836546]
https://leia.5ch.net/test/read.cgi/poverty/1617751147/
厚労省、また統計トリックで非正規の時給を上がったように見せかける 従来の統計は公表せず [412864614]
https://leia.5ch.net/test/read.cgi/poverty/1617780837/ GDPもそのままだと下がるから余計な「その他」いれまくってかさまし
平成の賃金統計もそのままだと下がったのバレるから捏造
非正規時給も下がったのバレたくないから高給のをこそっと追加して爆上がり
もう自民党しぐさ、安倍晋三しぐさに汚染されすぎ 半径1、中心Oの円周上の二点A,Bを、∠AOBが直角になるように取る
短い方の弧AB上に点Pを
長い方の弧AB上に点Qをおくとき、
P,Qの中点がとりうる領域の面積を求めよ.
p=seq(0,pi/2,0.01)
q=seq(pi/2,2*pi,0.01)
fx <- function(p,q) c(cos(p)/2+cos(q)/2)
fy <- function(p,q) c(sin(p)/2+sin(q)/2)
x=outer(p,q,fx)
y=outer(p,q,fy)
plot(x,y,col=2,bty='l') # (1,0,0),(0,1,0),(0,0,1)を頂点とする三角形の周および内部をTとする。
# T上の点Pに対し、Pからxy平面に下した垂線の足をQとし、
# Pからz軸に下した垂線の足をRとする。
# PがT上を動くとき、線分QRが通過する領域の体積を求めよ。
rm(list=ls())
options(scipen=3)
library(rgl)
library(pracma)
source('toolmini.R')
A=c(1,0,0)
B=c(0,1,0)
C=c(0,0,1)
cross(B-A,C-B)
# x+y+z=1
plot3d(c(1,0,0),c(0,1,0),c(0,0,1),asp=1,col=rainbow(3),type='n',xlab='x',ylab='y',zlab='z')
segments3d(rbind(A,B),col=8,lty=3)
segments3d(rbind(B,C),col=8,lty=3)
segments3d(rbind(C,A),col=8,lty=3) x=y=seq(0,1,0.025)
# P(x,y,1-x-y)
# Q(x,y,0)
# R(0,0,1-x-y)
gr=as.matrix(expand.grid(x,y))
fQ <- function(x,y) c(x,y,0)
Q=t(mapply(fQ,gr[,1],gr[,2]))
fR <- function(x,y){
z=1-x-y
z=ifelse(0<=z&z<=1,z,NA)
c(0,0,z)
}
R=t(mapply(fR,gr[,1],gr[,2]))
n=nrow(gr)
for(i in 1:n) segments3d(rbind(Q[i,],R[i,]),col=c(1,7))
Play3d <-function(sec=30){
library(rgl)
M <- par3d("userMatrix")
play3d(par3dinterp(time=(0:2)*3,
userMatrix=list(M,rotate3d(M,pi/2,1,0,0),rotate3d(M,pi/2,0,1,0))),
duration = sec)
}
Play3d(30) もうここしか居場所なくなってしまいましたか。ご愁傷様。 内視鏡スレで胃瘻交換業界ネタで議論しているけどね。
業界ネタを投稿できないクズが紛れているみたいだな 議論できてると思ってるんだ？まるで相手にされてないみたいだけど >>920
業界ネタの書けない部外者にはわからないだろね。
医師会からの配布資料による議論だし。 Q=c(x,y,0)
R=c(0,0,1-x-y)
S=c(t*x,t*y,(1-t)*(1-x-y)) # t*Q+(1-t)*R
solve a=t*x,b=t*y,c=(1-t)*(1-x-y) for t,x,y
t = 1/2 (-sqrt((a + b - c + 1)^2 + 4 (-a - b)) + a + b - c + 1)
x = (a (sqrt((a + b - c + 1)^2 + 4 (-a - b)) + a + b - c + 1))/(2 (a + b))
y = (b (sqrt((a + b - c + 1)^2 + 4 (-a - b)) + a + b - c + 1))/(2 (a + b))
t = 1/2 (sqrt((a + b - c + 1)^2 + 4 (-a - b)) + a + b - c + 1)
x = (a (-sqrt((a + b - c + 1)^2 + 4 (-a - b)) + a + b - c + 1))/(2 (a + b))
y = (b (-sqrt((a + b - c + 1)^2 + 4 (-a - b)) + a + b - c + 1))/(2 (a + b)) f <- function(a,b,c){
if((a+b-c+1)^2-4*(a+b)<0) return(FALSE)
else
t1=1/2*(-sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1)
x1=(a*(sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1))/(2*(a+b))
y1=(b*(sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1))/(2*(a+b))
t2=1/2*(sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1)
x2=(a*(-sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1))/(2*(a+b))
y2=(b*(-sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1))/(2*(a+b))
(0<=t1&t1<=1 & 0<=x1&x1<=1 & 0<=y1&y1<=1) | (0<=t2&t2<=1 & 0<=x2&x2<=1 & 0<=y2&y2<=1)
}
N=1e7
a=runif(N)
b=runif(N)
c=runif(N)
f=Vectorize(f)
mean(f(a,b,c)) f <- function(a,b,c){
if((a+b-c+1)^2-4*(a+b)<0) return(FALSE)
else
t1=1/2*(-sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1)
x1=(a*(sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1))/(2*(a+b))
y1=(b*(sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1))/(2*(a+b))
z1=1-x1-y1
t2=1/2*(sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1)
x2=(a*(-sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1))/(2*(a+b))
y2=(b*(-sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1))/(2*(a+b))
z2=1-x2-y2
(0<=t1&t1<=1 & 0<=x1&x1<=1 & 0<=y1&y1<=1 & 0<=z1&z1<=1) | (0<=t2&t2<=1 & 0<=x2&x2<=1 & 0<=y2&y2<=1 & 0<=z2&z2<=1)
} f <- function(a,b,c){
if((a+b-c+1)^2-4*(a+b)<0) return(FALSE)
else
t1=1/2*(-sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1)
x1=(a*(sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1))/(2*(a+b))
y1=(b*(sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1))/(2*(a+b))
z1=1-x1-y1
t2=1/2*(sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1)
x2=(a*(-sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1))/(2*(a+b))
y2=(b*(-sqrt((a+b-c+1)^2+4*(-a-b))+a+b-c+1))/(2*(a+b))
z2=1-x2-y2
(0<=t1&t1<=1 & 0<=x1&x1<=1 & 0<=y1&y1<=1 & 0<=z1&z1<=1) | (0<=t2&t2<=1 & 0<=x2&x2<=1 & 0<=y2&y2<=1 & 0<=z2&z2<=1)
}
N=1e6
a=runif(N)
b=runif(N)
c=runif(N)
f=Vectorize(f)
mean(f(a,b,c))
> mean(f(a,b,c))
[1] 0.03341 >>921
配布資料？
臨床で起きたことを議論するならまだしも
発想が非医のそれ library(rgl)
source('toolmini.R')
seg2dot <- function(x,y,by=0.01){
t=seq(0,1,by)
t
re=NULL
for(i in t){
re=rbind(re, i*x+(1-i)*y)
}
re
}
# demot
seg2dot(c(0.3,0.2,0),c(0,0,0.5))
A=c(1,0,0)
B=c(0,1,0)
C=c(0,0,1) # x+y+z=1
do <- function(){
plot3d(c(1,0,0),c(0,1,0),c(0,0,1),asp=1,col=rainbow(3),type='n',xlab='x',ylab='y',zlab='z')
segments3d(rbind(A,B),col=8,lty=3)
segments3d(rbind(B,C),col=8,lty=3)
segments3d(rbind(C,A),col=8,lty=3)
} x=y=seq(0,1,0.025)
# P(x,y,1-x-y)
# Q(x,y,0)
# R(0,0,1-x-y)
gr=as.matrix(expand.grid(x,y))
fQ <- function(x,y) c(x,y,0)
Q=t(mapply(fQ,gr[,1],gr[,2]))
fR <- function(x,y){
z=1-x-y
z=ifelse(0<=z&z<=1,z,NA)
c(0,0,z)
}
R=t(mapply(fR,gr[,1],gr[,2]))
n=nrow(gr)
xyz=NULL
for(i in 1:n) xyz=rbind(xyz,seg2dot(Q[i,],R[i,]))
fz <- function(z=0.5,d=0.01){
z-d <= xyz[,3] & xyz[,3] <= z+d
}
do()
points3d(xyz[fz(0.5,0.005),])
for(i in 1:n) segments3d(rbind(Q[i,],R[i,]),col='lightgreen')
Play3d <-function(sec=30){
library(rgl)
M <- par3d("userMatrix")
play3d(par3dinterp(time=(0:2)*3,
userMatrix=list(M,rotate3d(M,pi/2,1,0,0),rotate3d(M,pi/2,0,1,0))),
duration = sec)
}
Play3d(15) 401 １３２人目の素数さん[sage] 2021/04/08(木) 11:44:43.70 ID:++QvVOVc
期待値すら知らなかったバカが医者とか有り得ないわ
不労所得の意味も知らなかったしなwww 498 １３２人目の素数さん[sage] 2021/04/12(月) 03:22:09.67 ID:bijzplaq
解析的な話だと無言になるプロおじwww 哀れだね
リアルでも掲示板でも誰にも相手にされずゴミ扱いなんて Plot <- function(x0,x1,y0=NULL,y1=NULL,asp=NULL,ann=NULL,...){
y0=ifelse(is.null(y0),x0,y0)
y1=ifelse(is.null(y1),x1,y1)
plot(0,0,xlim=c(x0,x1),ylim=c(y0,y1),
asp=ifelse(is.null(asp),1,asp),
ann=ifelse(is.null(ann),FALSE,TRUE),
col='white',...)
}
cir <- function(x, y, r, ...){
theta <- seq(-pi, pi, length=100)
lines(x + r*cos(theta), y + r*sin(theta), ...)
}
Cir <- function(z,r,...){
cir(Re(z),Im(z),r,...)
}
pt <- function(x,y=NULL,...){
if(is.complex(x)) {a=Re(x) ; b=Im(x)}
else{a=x[1] ; b=x[2]}
text(a,b, ifelse(is.null(y),'+',y), ...)
} seg <- function(a,b,...){
if(is.complex(a)|is.complex(b)){
segments(Re(a),Im(a),Re(b),Im(b),...)
}else{
segments(a[1],a[2],b[1],b[2],...)
}
}
Polygon <- function(...,Col=1,Lwd=1,Lty=1){
p=c(...)
n=length(p)
for(i in 2:n){
seg(p[i-1],p[i],col=Col,lwd=Lwd,lty=Lty)
}
seg(p[1],p[n],col=Col,lwd=Lwd,lty=Lty)
} rm(list=ls())
source('toolmini.R')
Plot(-1,1)
Cir(0i,1,col=8)
n=7
th=seq(0,2*pi,length=n+1)
p=cos(th)+1i*sin(th)
P=complex(n)
do <- function(){
for(i in 1:n){
t=runif(1,th[i],th[i+1])
P[i]=cos(t)+1i*sin(t)
}
Polygon(P,Col=8,Lty=3)
pt(mean(P),'G',col=2)
}
for (i in 1:15){
do()
Sys.sleep(1)
} rm(list=ls())
source('toolmini.R')
Plot(-1,1,axes=FALSE)
Cir(0i,1,col=8)
n=7
th=seq(0,2*pi,length=n+1)
p=cos(th)+1i*sin(th)
P=complex(n)
do <- function(verbose=TRUE,...){
for(i in 1:n){
t=runif(1,th[i],th[i+1])
P[i]=cos(t)+1i*sin(t)
}
if(verbose) Polygon(P,Col=8,Lty=3)
P_=mean(P)
points(Re(P_),Im(P_),...)
}
do(col=2)
for (i in 1:10){
do(col=2)
Sys.sleep(0.1)
}
Plot(-1,1,axes=FALSE)
Cir(0i,1,col=8)
DEL=replicate(1e6,do(verbose = FALSE,pch='.',col=2)) 批判が的を得てないんだよな。
まず業務で高校数学が応用として使える時点で、世の中の上側1%以上なのよ。
アク界隈はお受験からのエリート教育で育ってるから、世の平均以下がちゃんと認識できていない。
残念ながら需要が存在してしまうわけですわ。高校数学の範囲だろうが何だろうが知らんがな。
あと、純粋な高等な数学になればなるほど、応用が狭まっていく。平たく言うと役に立たない。
なんでそんなものと比較するのか意味が分からない。好きなら勝手に博士課程でも行ってろ。
そして、哀れにもアク候補生として入社して、想像以上に日本社会の企業文化に揉まれ疲弊し、
自分は東京一工のエリートなのにこんな試験にも受からないクヤシイ！！みたいな人が、
5chで見えない敵をたたいて必死にもがいているんだな。憎むべきはその選択の損切りができない自分自身なのに。
だから、嫌ならやめろよと。クソ試験と思うなら今すぐやめて転職なりしろ。何事も中途半端が一番良くない。 補助線も引けない分際で高校数学を語るなんて笑止千万だね 高齢者接種を自治体でチンタラやってる前に絶対に医療従事者の接種を先にやるべきだったよね
八王子なんて接種する医師が誰もワクチン打ってないんだよ
受付とかもだろ
何やってんだか、あきれる 定義通り計算できるのに補助線や公式を使わないと答が出せないのは恥ずかしい。
こういうのは補助線も公式も無効。
この期待値と９５％信頼区間を出せる？
白45個、赤55個の玉を無作為に1個ずつ取り出す。
どちらかの色が全て取り出されたら終了。
白が取り出されて終了した場合に取り出した玉の総数の期待値と95%信頼区間を求めよ。 レス数が950を超えています。1000を超えると書き込みができなくなります。
