[過去ログ] 臨床統計もおもしろいですよ、その2 (1002レス)
1-

このスレッドは過去ログ倉庫に格納されています。
次スレ検索 歴削→次スレ 栞削→次スレ 過去ログメニュー
38
(1): 2018/11/05(月)00:19 ID:NIiUrAnG(4/11) AAS
import Data.List
m = 69
sub x = do
let ijk = filter (<=70).nub $ sort [i+j+k| i<-x,j<-x,k<-x]
all (\y -> elem y ijk ) [0..70]
main = do
print $ [(b,c,d,e,f,g,h)| b<-[0..m],c<-[b..m],d<-[c..m],e<-[d..m],f<-[e..m],g<-[f..m],h<-[g..m],sub [0,b,c,d,e,f,g]]
39
(1): 2018/11/05(月)01:06 ID:NIiUrAnG(5/11) AAS
>>38
import Data.List
m = 69
sub x = do -- ans=[1,4,5,15,18,27,34]
let ijk = filter (<=70).nub $ sort [i+j+k| i<-x,j<-x,k<-x]
all (\y -> elem y ijk ) [0..70]
main = do
print $ [(1,4,5,e,f,g,h)| e<-[0..m],f<-[e..m],g<-[f..m],h<-[g..m],sub [0,1,4,5,e,f,g,h]] -- 動作確認用
print $ [(b,c,d,e,f,g,h)| b<-[0..m],c<-[b..m],d<-[c..m],e<-[d..m],f<-[e..m],g<-[f..m],h<-[g..m],sub [0,b,c,d,e,f,g,h]]
40
(1): 2018/11/05(月)01:20 ID:NIiUrAnG(6/11) AAS
数学板に超初心者のコードを書いたら、達人が高速化してくれた。
プログラム解を毛嫌いする向きもあるけど、初心者のコードを改善してくれたり、cに移植してくれたりする人の存在はとてもありがたい。

import Data.List

firstUnavailable x = let y = 0:x in head $([1..71] &#165;&#165;)$nub$sort$[a+b+c|a<-y,b<-y,c<-y]
next x = [n:x|n<-[head x+1..firstUnavailable x]]
xss = iterate (&#165;xs->concat [next x|x<-xs]) [[1]]
isGood x = let y = 0:x in (==70)$length $intersect [1..70]$nub$sort$[a+b+c|a<-y,b<-y,c<-y]

main = do
    print [x|x<-(xss !! 6),isGood x]
41: 2018/11/05(月)01:22 ID:NIiUrAnG(7/11) AAS
>>40
文字化けを修正

import Data.List

firstUnavailable x = let y = 0:x in head $([1..71] \\)$nub$sort$[a+b+c|a<-y,b<-y,c<-y]
next x = [n:x|n<-[head x+1..firstUnavailable x]]
xss = iterate (\xs->concat [next x|x<-xs]) [[1]]
isGood x = let y = 0:x in (==70)$length $intersect [1..70]$nub$sort$[a+b+c|a<-y,b<-y,c<-y]

main = do
print [x|x<-(xss !! 6),isGood x]
42: 2018/11/05(月)01:34 ID:NIiUrAnG(8/11) AAS
>>39
-- b=1は自明なので無駄な検索を削除

import Data.List
m = 69
sub x = do -- ans=[1,4,5,15,18,27,34]
let ijk = filter (<=70).nub $ sort [i+j+k| i<-x,j<-x,k<-x]
all (\y -> elem y ijk ) [0..70]
main = do
-- print $ [(1,4,5,e,f,g,h)| e<-[0..m],f<-[e..m],g<-[f..m],h<-[g..m],sub [0,1,4,5,e,f,g,h]] -- 動作確認用
print $ [(1,c,d,e,f,g,h)| c<-[1..m],d<-[c..m],e<-[d..m],f<-[e..m],g<-[f..m],h<-[g..m],sub [0,1,c,d,e,f,g,h]]
43: 2018/11/05(月)07:20 ID:NIiUrAnG(9/11) AAS
seqN <- function(N=100,K=5){
a=numeric(N)
for(i in 1:K) a[i]=2^(i-1)
for(i in K:(N-1)){
a[i+1]=0
for(j in 0:(K-1)){
a[i+1]=a[i+1]+a[i-j] # recursion formula
}
}

P0=numeric(N)
省16
44
(2): 2018/11/05(月)07:25 ID:NIiUrAnG(10/11) AAS
## p : probability of head at coin flip
seqNp <- function(N=100,K=5,p=0.5){
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])
省17
45: 2018/11/05(月)08:16 ID:NIiUrAnG(11/11) AAS
>>44
# 検算用のシミュレーションスクリプト

seqn<-function(n=10,N=1000,p=0.5){ # N回のうちn回以上続けて表がでるか?
rn=rbinom(N,1,p) # N個の0 or 1を発生させる
count=0 # 1連続カウンター
for(i in 1:N){
if(rn[i] & count<n){ # rn[i]が1でn個続かなければ
count=count+1
}
else{
省9
46: 2018/11/05(月)12:05 ID:+OxX3fom(1) AAS
事務員さん
47: 2018/11/05(月)12:14 ID:RNxpU/sa(1) AAS
いくらド底辺シリツ医大卒の裏口バカでも
これくらいは計算できるだろ?

ド底辺シリツ医大の裏口入学調査委員会が
裏口入学は高々10%と報告したとする。

その結果の検証に100人を調査したら4人続けて裏口入学生であった、という。
この検証から裏口入学率が10%であるか否かを有意水準5%で検定せよ。
48: 2018/11/05(月)14:38 ID:Lykd2+5F(1/2) AAS
>>44
seqNp(100,4,1/10)
fm = function(m=5){
f100_m = function(p) seqNp(100,m,p)
pp=seq(0,1,len=100)
plot(pp,sapply(pp,f100_m),type='l',lwd=2)
abline(h=0.05,lty=3)
(p005=uniroot(function(x,u0=0.05) f100_m(x)-u0,c(0.001,1))$root)
}
49: 2018/11/05(月)18:35 ID:Lykd2+5F(2/2) AAS
トランプのA〜10の10枚とジョーカー1枚の
合計11枚が机の上に裏向きに置いてある。
ランダムに1枚ずつ引いていった場合の、得られた数字の総和の期待値を求めよ。
ただし、ジョーカーを引いた時点で終了するものとし、
Aは数字扱いではなく、最終的に得られた数字の総和が2倍になるものとする。

x=sample(11)
f <- function(x){
i=1
y=numeric()
while(x[i]!=11){
省14
50: 2018/11/06(火)12:33 ID:jkx5i2bQ(1/5) AAS
n=3
r=8
str=paste(as.character(1:n),collapse='')
f <- function(x) grepl(str,paste(x,collapse=""))
# Brute-Force
library(gtools)
perm=permutations(n,r,rep=T)
sum(apply(perm,1,f))

# Monte-Carlo
k=100
省2
51
(1): 2018/11/06(火)15:40 ID:jkx5i2bQ(2/5) AAS
コインを1000回投げた。連続して表がでる確率が最も高いのは何回連続するときか?

seq_dice <- function(N=100,k=5,p=1/6){
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)
省16
52: 2018/11/06(火)17:00 ID:QApCAMmZ(1) AAS
f = function(x){
y=paste(x,collapse='')
str="1"
if(!grepl(str,y)) return(0)
else{
while(grepl(str,y)){
str=paste0(str,"1")
}
return(nchar(str)-1)
}
省2
53
(1): 2018/11/06(火)19:54 ID:jkx5i2bQ(3/5) AAS
>>51
# 有理数表示したかったのでPythonに移植

from fractions import Fraction

def seq_dice(N,k,p):
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):
省14
54: 2018/11/06(火)20:01 ID:jkx5i2bQ(4/5) AAS
seq_dice <- function(N=100,k=5,p=1/6){
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)
}
省18
55: 2018/11/06(火)20:43 ID:jkx5i2bQ(5/5) AAS
>>53
泥タブだと普通にみえるが、Win10のPCだと コードのインデントがなくなって左揃えされてしまうなぁ。
56: 2018/11/07(水)00:33 ID:J7bMbWmD(1/3) AAS
from fractions import Fraction

def dice126(N):
P=list()
for n in range(6):
P.append(1)
P.append(1-1/(6**6))
for n in range(7,N+1):
P.append(P[n-1]-P[n-6]/(6**6))
return(1-P[N])

def dice123456(N):
省3
57: 2018/11/07(水)03:24 ID:5r6Cuw34(1) AAS
愛の妖精ぷりんてぃん
1-
あと 945 レスあります
スレ情報 赤レス抽出 画像レス抽出 歴の未読スレ AAサムネイル

ぬこの手 ぬこTOP 0.285s*