Rの勉強２

> DD
function (expr,name,order=1)
{
if(order<1){
stop("order' must be >= 1")}else if(order==1){
D(expr,name)}else{DD(D(expr,name),name,order -1)}

}
> f<- function(x) x^2-2*x
> uniroot(f,c(1,3))
$root
[1] 2.000000

$f.root
[1] -5.356504e-07

$iter
[1] 6

$estim.prec
[1] 6.535148e-05

> result<-uniroot(f,c(1,3))
> result$root
[1] 2.000000
> polyroot(c(-2,5,-4,1))
[1] 1-0i 1+0i 2+0i
> help(expression)
starting httpd help server ... done
> length(ex1 <- expression(1+ 0:9))
[1] 1
> ex1
expression(1 + 0:9)
> f<- function(x) x^2
> integrate(f,0,1)
0.3333333 with absolute error < 3.7e-15
> integrate(sin,0,pi)
2 with absolute error < 2.2e-14
> integrate(dnorm,-Inf,1.96)
0.9750021 with absolute error < 1.3e-06

ここから多次元の式をを解くためにpackage(adapt)を探すが、それはいまはもうなくなっているようで、hitしなかった。そのため、個々の部分は保留。本でとりあえず確認して次へ。

> f<-x^2+sin(x)
> f
[1] 1.841471 4.909297 NA 24.041076 64.989358 NA 49.656987
[8] 49.656987 49.656987 49.656987 49.656987 49.656987 49.656987 49.656987
[15] NA
> f<-expression(x^2+sin(x))
> f
expression(x^2 + sin(x))
> deriv(f,"x")
expression({
.value <- x^2 + sin(x)
.grad <- array(0, c(length(.value), 1L), list(NULL, c("x")))
.grad[, "x"] <- 2 * x + cos(x)
attr(.value, "gradient") <- .grad
.value
})
> D(f,"x")
2 * x + cos(x)
> ff<-deriv(f,"x")
> ff<-deriv(f,"x",func=T)
> ff
function (x)
{
.value <- x^2 + sin(x)
.grad <- array(0, c(length(.value), 1L), list(NULL, c("x")))
.grad[, "x"] <- 2 * x + cos(x)
attr(.value, "gradient") <- .grad
.value
}
> ff(0)
[1] 0
attr(,"gradient")
x
[1,] 1
> f<- function(x) exp(-x^2)
> f
function(x) exp(-x^2)

> integrate(f,0,1)
0.7468241 with absolute error < 8.3e-15
> integrate(f,0,Inf)
0.886227 with absolute error < 2.2e-06
> matrix(1:6,nrow=2,ncol=3)
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
> matrix(1:6,nrow=2,ncol=3,byrow=T)
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 4 5 6
> x<-matrix(1:6,nrow=2,ncol=3,byrow=T)
> x
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 4 5 6
> x[1,2]
[1] 2
> x<-matrix(1:6,nrow=2,ncol=3,)
> x
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
> x[1,2]
[1] 3
> x[c(1,2),2]
[1] 3 4
>
> x[-1,c(T,F,T)]
[1] 2 6
> x[-2,c(T,F,T)]
[1] 1 5
> x[2,c(T,F,T)]
[1] 2 6
> x[1,c(T,F,T)]
[1] 1 5
> x[0,c(T,F,T)]
[,1] [,2]
> x[0,c(T,F,T),drop=F]
[,1] [,2]
> x[1,c(T,F,T),drop=F]
[,1] [,2]
[1,] 1 5
> x[c(T,F),drop=F]
[1] 1 3 5
> x[c(T,F)]
[1] 1 3 5
> x[c(T,F),1,drop=F]
[,1]
[1,] 1
> x[,1,drop=F]
[,1]
[1,] 1
[2,] 2
> a<-matrix(1:4,2,2)
> a
[,1] [,2]
[1,] 1 3
[2,] 2 4
> b<-matrix(0:3,2,2)
> b
[,1] [,2]
[1,] 0 2
[2,] 1 3
> a+b
[,1] [,2]
[1,] 1 5
[2,] 3 7
> a*b
[,1] [,2]
[1,] 0 6
[2,] 2 12
> a%*%b
[,1] [,2]
[1,] 3 11
[2,] 4 16
> 1/a
[,1] [,2]
[1,] 1.0 0.3333333
[2,] 0.5 0.2500000
> a
[,1] [,2]
[1,] 1 3
[2,] 2 4
> a*(1:2)
[,1] [,2]
[1,] 1 3
[2,] 4 8
> matrix(0,2,3)
[,1] [,2] [,3]
[1,] 0 0 0
[2,] 0 0 0
> diag(0,3)
[,1] [,2] [,3]
[1,] 0 0 0
[2,] 0 0 0
[3,] 0 0 0
> x<-matrix(1:4,2,2)
> x
[,1] [,2]
[1,] 1 3
[2,] 2 4
> t(x)
[,1] [,2]
[1,] 1 2
[2,] 3 4
> x<-diag(2)
> x
[,1] [,2]
[1,] 1 0
[2,] 0 1
> diag(1,3
+ )
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 1 0
[3,] 0 0 1
> diag(1,2,2,)
以下にエラー diag(1, 2, 2, ) : 使われていない引数 ()
> diag(1,2,2)
[,1] [,2]
[1,] 1 0
[2,] 0 1
> rep(1,3)
[1] 1 1 1
> diag(1:3)
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 2 0
[3,] 0 0 3
> x<-matrix(1:9,3)
> x
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
> x[upper.tri(x)]
[1] 4 7 8
> x[upper.tri(x)]<-0
> x
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 2 5 0
[3,] 3 6 9
> x
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 2 5 0
[3,] 3 6 9
> y<- x+t(x)
> y
[,1] [,2] [,3]
[1,] 2 2 3
[2,] 2 10 6
[3,] 3 6 18
> diag(y)<-diag(y)/2
> y
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 2 5 6
[3,] 3 6 9
> runif(8)
[1] 0.2102961 0.5498479 0.1946713 0.4265509 0.7986963 0.9163540 0.4940985
[8] 0.3358213

> x 以下にエラー x < array(runif(8), c(2, 4)) : 適切な配列ではありません
> x<-array(runif(8),c(2,4))
> x
[,1] [,2] [,3] [,4]
[1,] 0.3524423 0.3709228 0.8152475 0.646365478
[2,] 0.8233227 0.3436113 0.2020325 0.008344393
> x<-matrix(runif(8),c(2,4))
> x
[,1] [,2] [,3] [,4]
[1,] 0.02009867 0.06521131 0.789769377 0.8694130
[2,] 0.28265013 0.68312891 0.003968216 0.7271877
> sum(x^2)
[1] 2.459645
> sum(diag(t(x) %*% x)
+ )
[1] 2.459645
> a<-matrix(1:9,3,3)
> b<-matrix(c(1,0,-2))
> solve(a,b)
以下にエラー solve.default(a, b) :
Lapack routine dgesv: 線形方程式系は正確に特異です
> a
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
> a<-matrix(0:9,3,3)
警告メッセージ：
In matrix(0:9, 3, 3) :
データ長 [10] が行数 [3] を整数で割った、もしくは掛けた値ではありません
> a<-matrix(c(0,1,2,3,4,5,6,7,9,),3,3)
以下にエラー c(0, 1, 2, 3, 4, 5, 6, 7, 9, ) : 引数 10 が空です
> a<-matrix(c(0,1,2,3,4,5,6,7,9),3,3)
> solve(a,b)
[,1]
[1,] -2.333333
[2,] 2.333333
[3,] -1.000000
> r<- rbind(c(1,2,3),
+
+ c(1,1,1,)
+ c(1,1,2)
エラー： 予想外の シンボル です 以下の部分:
"c(1,1,1,)
c"
> r<- rbind(c(1,2,3),
+ c(1,1,1)
+ c(1,1,2)
エラー： 予想外の シンボル です 以下の部分:
"c(1,1,1)
c"
> r<- rbind(c(1,2,3),
+ c(1,1,1)
+ c(1,1,2))
エラー： 予想外の シンボル です 以下の部分:
"c(1,1,1)
c"
> r<- rbind(c(1,2,3),c(1,1,1),c(1,1,2))
> r
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 1 1 1
[3,] 1 1 2
> y<- backsolve(r,x<-c(8,4,2))
> y
[1] -1 3 1
> r %*% y
[,1]
[1,] 8
[2,] 3
[3,] 4
> r
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 1 1 1
[3,] 1 1 2
> y
[1] -1 3 1
> r %*% y
[,1]
[1,] 8
[2,] 3
[3,] 4
> y2<-backsolve(r,x,transpose=T))
エラー： 予想外の ')' です ( "y2<-backsolve(r,x,transpose=T))" の)
> y2<-backsolve(r,x,transpose=T)
> y2
[1] 8 -12 -5
> all(t(r) %*% y2 ==x)
[1] FALSE
> t(r)
[,1] [,2] [,3]
[1,] 1 1 1
[2,] 2 1 1
[3,] 3 1 2
> x
[1] 8 4 2
> t(r) %*% y2
[,1]
[1,] -9
[2,] -1
[3,] 2
> y2
[1] 8 -12 -5
> t(r) %*% y2
[,1]
[1,] -9
[2,] -1
[3,] 2
> all(y == backsolve(t(r),x,upper=F,transpase=T)
+
+ )
以下にエラー backsolve(t(r), x, upper = F, transpase = T) :
使われていない引数 (transpase = T)
> all(y == backsolve(t(r),x,upper=F,transpose=T)
+ )
[1] TRUE
> all(y2 == backsolve(t(r),x,upper=F,transpose=T)
+ )
[1] FALSE
> A<-array(runif(9),3)
> A
[1] 0.1308231 0.8341508 0.7267654
> A<-array(runif(9),3,3)
> A
[1] 0.6929881 0.7566792 0.7246731
> A<-array(runif(9),C(3,3))
以下にエラー C(3, 3) : object not interpretable as a factor
> A<-array(runif(9),c(3,3))
> A
[,1] [,2] [,3]
[1,] 0.89858561 0.1711188 0.2555592
[2,] 0.51269440 0.8835462 0.3082611
[3,] 0.04353683 0.6940356 0.6764354
> B<-solve(A)
> B
[,1] [,2] [,3]
[1,] 1.0402813 0.1670456 -0.4691462
[2,] -0.9038233 1.6177126 -0.3957473
[3,] 0.8603851 -1.6705552 1.9145772
> A%*%B
[,1] [,2] [,3]
[1,] 1.000000e+00 -5.393906e-18 -3.987153e-17
[2,] 2.474691e-17 1.000000e+00 4.656648e-17
[3,] -9.763241e-17 2.677979e-16 1.000000e+00
> A<-matrix(c(1,2,3,4,5,6,7,8,9),c(3,3))
> S
エラー： オブジェクト 'S' がありません
> A
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
> B<- solve(A)
以下にエラー solve.default(A) :
Lapack routine dgesv: 線形方程式系は正確に特異です
> library(MASS)
> B<-ginv(A)
> B
[,1] [,2] [,3]
[1,] -0.6388889 -5.555556e-02 0.5277778
[2,] -0.1666667 -9.384786e-17 0.1666667
[3,] 0.3055556 5.555556e-02 -0.1944444
> A
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
> crossprod(A)
[,1] [,2] [,3]
[1,] 14 32 50
[2,] 32 77 122
[3,] 50 122 194
> crossprod(A,B)
[,1] [,2] [,3]
[1,] -0.05555556 0.1111111 0.2777778
[2,] -1.55555556 0.1111111 1.7777778
[3,] -3.05555556 0.1111111 3.2777778
> crossprod(B,A)
[,1] [,2] [,3]
[1,] -0.05555556 -1.5555556 -3.0555556
[2,] 0.11111111 0.1111111 0.1111111
[3,] 0.27777778 1.7777778 3.2777778
>
> a
[,1] [,2] [,3]
[1,] 0 3 6
[2,] 1 4 7
[3,] 2 5 9
> eigen(a)
$values
[1] 13.985686 -1.169156 0.183470

$vectors
[,1] [,2] [,3]
[1,] -0.4263524 -0.9366202 0.2264150
[2,] -0.5474684 -0.2042614 -0.8684128
[3,] -0.7200708 0.2846399 0.4411298

> qr(a)
$qr
[,1] [,2] [,3]
[1,] -2.2360680 -6.2609903 -11.1803399
[2,] 0.4472136 3.2863353 6.3900965
[3,] 0.8944272 0.9990708 0.4082483

$rank
[1] 3

$qraux
[1] 1.0000000 1.0430999 0.4082483

$pivot
[1] 1 2 3

attr(,"class")
[1] "qr"
> help(qr)
> a
[,1] [,2] [,3]
[1,] 0 3 6
[2,] 1 4 7
[3,] 2 5 9
> svd(a)
$d
[1] 14.8234620 1.1098292 0.1823541

$u
[,1] [,2] [,3]
[1,] -0.4482373 0.82968720 0.3327199
[2,] -0.5479485 0.03906245 -0.8355995
[3,] -0.7062831 -0.55686020 0.4371166

$v
[,1] [,2] [,3]
[1,] -0.1322575 -0.9683093 0.2118607
[2,] -0.4768064 -0.1252351 -0.8700413
[3,] -0.8690015 0.2160861 0.4451328

> A<-matrix(c(2,1,1,1,2,1,1,1,2),3
+ 3)
エラー： 予想外の 数値定数 です 以下の部分:
"A<-matrix(c(2,1,1,1,2,1,1,1,2),3
3"
> A<-matrix(c(2,1,1,1,2,1,1,1,2),3,3)
> A
[,1] [,2] [,3]
[1,] 2 1 1
[2,] 1 2 1
[3,] 1 1 2
> svd(A)$u ->U
> V<- svd(A)$v
> D<-diag(svd(A)$d))
エラー： 予想外の ')' です ( "D<-diag(svd(A)$d))" の)
> D<-diag(svd(A)$d)
> B<-U%*% D %*% t(v)
以下にエラー t(v) : オブジェクト 'v' がありません
> B<-U%*% D %*% t(V)
> A
[,1] [,2] [,3]
[1,] 2 1 1
[2,] 1 2 1
[3,] 1 1 2
> B
[,1] [,2] [,3]
[1,] 2 1 1
[2,] 1 2 1
[3,] 1 1 2
> B%*%B
[,1] [,2] [,3]
[1,] 6 5 5
[2,] 5 6 5
[3,] 5 5 6
> A
[,1] [,2] [,3]
[1,] 2 1 1
[2,] 1 2 1
[3,] 1 1 2
> U
[,1] [,2] [,3]
[1,] -0.5773503 0.8164966 -4.534658e-17
[2,] -0.5773503 -0.4082483 -7.071068e-01
[3,] -0.5773503 -0.4082483 7.071068e-01
> svd(A)
$d
[1] 4 1 1

$u
[,1] [,2] [,3]
[1,] -0.5773503 0.8164966 -4.534658e-17
[2,] -0.5773503 -0.4082483 -7.071068e-01
[3,] -0.5773503 -0.4082483 7.071068e-01

$v
[,1] [,2] [,3]
[1,] -0.5773503 0.8164966 0.0000000
[2,] -0.5773503 -0.4082483 -0.7071068
[3,] -0.5773503 -0.4082483 0.7071068

> V
[,1] [,2] [,3]
[1,] -0.5773503 0.8164966 0.0000000
[2,] -0.5773503 -0.4082483 -0.7071068
[3,] -0.5773503 -0.4082483 0.7071068
> D
[,1] [,2] [,3]
[1,] 4 0 0
[2,] 0 1 0
[3,] 0 0 1
> D<-diag(sqrt(svd(A)$d))
> B<-U%*% D %*% t(V)
> A
[,1] [,2] [,3]
[1,] 2 1 1
[2,] 1 2 1
[3,] 1 1 2
> B
[,1] [,2] [,3]
[1,] 1.3333333 0.3333333 0.3333333
[2,] 0.3333333 1.3333333 0.3333333
[3,] 0.3333333 0.3333333 1.3333333
> B%*%B
[,1] [,2] [,3]
[1,] 2 1 1
[2,] 1 2 1
[3,] 1 1 2
> x<-matrix(rep(0:1,81)9,9)
エラー： 予想外の 数値定数 です ( "x<-matrix(rep(0:1,81)9" の)
> x<-matrix(rep(0:1,81),9,9)
> image(x)
> image(a)
> runif(1)
[1] 0.01557919
> runif(1)
[1] 0.4673159
> runif(1)
[1] 0.01364200
> runif(1)
[1] 0.6551826
> runif(1)
[1] 0.6137373
> runif(1)
[1] 0.8678323
> runif(1)
[1] 0.09098834
> runif(1)
[1] 0.2472403
> runif(1)
[1] 0.1474482
> runif(10)
[1] 0.8207151 0.3485508 0.7243420 0.3453443 0.9215907 0.8703834 0.7705085
[8] 0.4919202 0.1120248 0.4600092
> skin(coin)
エラー： 関数 "skin" を見つけることができませんでした
> skincoin<-function(){(coin)
+ x<- runif(1)
+ if(x<= 1/2) men<- 1
+ else men<- 0
+ return(men)
+ }
> coin()
エラー： 関数 "coin" を見つけることができませんでした
> coin
エラー： オブジェクト 'coin' がありません
> coin<-function(){
+ x<- runif(1)
+ if(x<= 1/2) men<- 1
+ else men<- 0
+ return(men)
+ }
> coin
function(){
x<- runif(1)
if(x<= 1/2) men<- 1
else men<- 0
return(men)
}
> coin()
[1] 0
> coin()
[1] 1
> coin()
[1] 1
> coin()
[1] 0
> coin()
[1] 1
> coin()
[1] 0
> coin()
[1] 1
> coin()
[1] 0
> coin()
[1] 1
> coin()
[1] 1
> skin(coin)
エラー： 関数 "skin" を見つけることができませんでした
> fix(coin)
> saikoro()<-function(){
+ x<- runif(1)
+ if (x<= 1/6) men<- 1
+ if else(x<= 2/6) men<- 2
エラー： 予想外の 'else' です 以下の部分:
"if (x<= 1/6) men<- 1
if else"
> if else(x<= 3/6) men<- 3
エラー： 予想外の 'else' です ( "if else" の)
> if else(x<= 4/6) men<- 4
エラー： 予想外の 'else' です ( "if else" の)
> if else(x<= 5/6) men<- 5
エラー： 予想外の 'else' です ( "if else" の)
> else men<- 6
エラー： 予想外の 'else' です ( " else" の)
> return(men)
エラー： オブジェクト 'men' がありません
> saikoro<-function(){
+ x<- runif(1)
+ if (x<= 1/6) men<- 1
+ if else(1/6 エラー： 予想外の 'else' です 以下の部分:
"if (x<= 1/6) men<- 1
if else"
> if else(2/6 エラー： 予想外の 'else' です ( "if else" の)
> if else(3/6 エラー： 予想外の 'else' です ( "if else" の)
> if else(4/6 エラー： 予想外の 'else' です ( "if else" の)
> else men<- 6
エラー： 予想外の 'else' です ( " else" の)
> return(men)
エラー： オブジェクト 'men' がありません
> saikoro<-function(){
+ x<- runif(1)
+ if (x<= 1/6) men<- 1
+ else if(1/6 エラー： 予想外の '<=' です 以下の部分:
"if (x<= 1/6) men<- 1
else if(1/6> else if(2/6 エラー： 予想外の 'else' です ( "else" の)
> else if(3/6 エラー： 予想外の 'else' です ( "else" の)
> else if(4/6 エラー： 予想外の 'else' です ( "else" の)
> else men<- 6
エラー： 予想外の 'else' です ( "else" の)
> return(men)
エラー： オブジェクト 'men' がありません
> }
エラー： 予想外の '}' です ( "}" の)
> saikoro<-function(){
+ x<- runif(1)
+ if (x<= 1/6) men<- 1
+ else if(1/6 エラー： 予想外の '<=' です 以下の部分:
"if (x<= 1/6) men<- 1
else if(1/6> else if(2/6 エラー： 予想外の 'else' です ( "else" の)
> else if(3/6 エラー： 予想外の 'else' です ( "else" の)
> else if(4/6 エラー： 予想外の 'else' です ( "else" の)
> else men<- 6
エラー： 予想外の 'else' です ( "else" の)
> return(men)
エラー： オブジェクト 'men' がありません
> }
エラー： 予想外の '}' です ( "}" の)
> saikoro<-function(){
+ x<- runif(1)
+ if (x<= 1/6) men<- 1
+ else if(1/6 < x <= 2/6) men<- 2
エラー： 予想外の '<=' です 以下の部分:
"if (x<= 1/6) men<- 1
else if(1/6 < x <="
> else if(2/6 < x <= 3/6) men<- 3
エラー： 予想外の 'else' です ( "else" の)
> else if(3/6 < x <= 4/6) men<- 4
エラー： 予想外の 'else' です ( "else" の)
> else if(4/6 < x <= 5/6) men<- 5
エラー： 予想外の 'else' です ( "else" の)
> else men<- 6
エラー： 予想外の 'else' です ( "else" の)
> return(men)
エラー： オブジェクト 'men' がありません
> }
エラー： 予想外の '}' です ( "}" の)
> saikoro<-function(){
+ x<- runif(1)
+ if (x<= 1/6) men<- 1
+ else if(x <= 2/6) men<- 2
+ else if(x <= 3/6) men<- 3
+ else if(x <= 4/6) men<- 4
+ else if(x <= 5/6) men<- 5
+ else men<- 6
+ return(men)
+ }
> saikoro()
[1] 6
> saikoro()
[1] 3
> saikoro()
[1] 6
> saikoro()
[1] 6
> saikoro()
[1] 4
> saikoro()
[1] 3
> saikoro()
[1] 6
> saikoro()
[1] 4
> saikoro()
[1] 3
> saikoro()
[1] 1
> saikoro()
[1] 2
> saikoro()
[1] 2
> saikoro()
[1] 3
> saikoro()
[1] 1
> saikoro()
[1] 5
> tenki<-function(){
+ x<- runif(1)
+ if (x<= 7/10) men<- "hare"
+ else if(x <= 9/10) men<- "kumori"
+ else men<- "ame"
+ return(men)
+ }
> tenki()
[1] "ame"
> tenki()
[1] "ame"
> tenki()
[1] "hare"
> tenki()
[1] "hare"
> tenki()
[1] "kumori"
> tenki()
[1] "kumori"
> tenki()
[1] "hare"
> tenki()
[1] "hare"
> tenki()
[1] "hare"
> tenki()
[1] "hare"
> tenki()
[1] "hare"
> tenki()
[1] "hare"
> tenki()
[1] "hare"
> tenki()
[1] "kumori"
> tenki()
[1] "hare"
> tenki()
[1] "kumori"
> tenki()
[1] "kumori"
> mycointoss<-function(n){
+ count<-0
+ for(i 1:n){
エラー： 予想外の 数値定数 です 以下の部分:
"count<-0
for(i 1"
> x<-coin()
> if(x==1) count<- count+1
> }
エラー： 予想外の '}' です ( "}" の)
> return(count)
エラー： オブジェクト 'count' がありません
> }mycointoss<-function(n){
エラー： 予想外の '}' です ( "}" の)
> count<-0
> for(i 1:n){
エラー： 予想外の 数値定数 です ( "for(i 1" の)
> x<-coin()
> if(x==1) count<- count+1
> }
エラー： 予想外の '}' です ( "}" の)
> return(count)
エラー： 戻るための関数がありません，トップレベルへジャンプします
> }
エラー： 予想外の '}' です ( "}" の)
> mycointoss<-function(n){
+ count<-0
+ for(i 1:n){
エラー： 予想外の 数値定数 です 以下の部分:
"count<-0
for(i 1"
> x<-coin()
> if(x==1) count<- count+1
> }
エラー： 予想外の '}' です ( "}" の)
> return(count)
エラー： 戻るための関数がありません，トップレベルへジャンプします
> }
エラー： 予想外の '}' です ( "}" の)
> }
エラー： 予想外の '}' です ( "}" の)
> mycointoss<-function(n){
+ count<-0
+ for(i 1:n){
エラー： 予想外の 数値定数 です 以下の部分:
"count<-0
for(i 1"
> x<-coin()
> if(x==1) count <- count+1
> }
エラー： 予想外の '}' です ( " }" の)
> return(count)
エラー： 戻るための関数がありません，トップレベルへジャンプします
> mycointoss <- function(n) {
+ count<-0
+ for(i 1:n){
エラー： 予想外の 数値定数 です 以下の部分:
"count<-0
for(i 1"
> x<-coin()
> if(x==1) count <- count+1
> }
エラー： 予想外の '}' です ( " }" の)
> return(count)
エラー： 戻るための関数がありません，トップレベルへジャンプします
> mycointoss <- function(n) {
+ count<- 0
+ for(i 1:n){
エラー： 予想外の 数値定数 です 以下の部分:
"count<- 0
for(i 1"
> x<-coin()
> if(x==1) count <- count+1
> }
エラー： 予想外の '}' です ( " }" の)
> return(count)
エラー： 戻るための関数がありません，トップレベルへジャンプします
> mycointoss <- function(n) {
+ count<- 0
+ for(i in 1:n){
+ x<-coin()
+ if(x==1) count <- count+1
+ }
+ return(count)
+ }
> mycointoss(10)
[1] 6
> mycointoss(100)
[1] 52
> mycointoss(1000)
[1] 489
> mycointoss(10000)
[1] 4963
> mycointoss(100000)
[1] 50030
> mycointoss <- function(n) {
+ count<- 0
+ for(i in 1:n){
+ x<-coin()
+ if(x==1) count <- count+1
+ }
+ return(count)
+ }
> fit(saikoro)
エラー： 関数 "fit" を見つけることができませんでした
> saikoro
function(){
x<- runif(1)
if (x<= 1/6) men<- 1
else if(x <= 2/6) men<- 2
else if(x <= 3/6) men<- 3
else if(x <= 4/6) men<- 4
else if(x <= 5/6) men<- 5
else men<- 6
return(men)
}
> saikoro2<-function(n){
+ count<-0
+ for (i in 1:n){
+ x<- runif(1)
+ if (x<= 1/6) count<- count+1
+ else
+ }
エラー： 予想外の '}' です 以下の部分:
"else
}"
> return(count)
エラー： 戻るための関数がありません，トップレベルへジャンプします
> }
エラー： 予想外の '}' です ( "}" の)
> saikoro2<-function(n){
+ count<-0
+ for (i in 1:n){
+ x<- runif(1)
+ if (x <= 1/6) count<- count+1
+ else count<-count
+ }
+ return(count)
+ }
> saikoro2(10)
[1] 1
> saikoro2(100)
[1] 11
> saikoro2(1000)
[1] 156
> saikoro2(10000)
[1] 1598
> saikoro2(100000)
[1] 16642
> saikoro2(1000000)
[1] 166749
> saikoro2<-function(n){
+ count<-0
+ for (i in 1:n){
+ x<- runif(1)
+ if (x <= 1/6) count<- count+1
+ else
+ }
エラー： 予想外の '}' です 以下の部分:
"else
}"
> return(count)
エラー： 戻るための関数がありません，トップレベルへジャンプします
> }
エラー： 予想外の '}' です ( "}" の)
> saikoro2<-function(n){
+ count<-0
+ for (i in 1:n){
+ x<- runif(1)
+ if (x <= 1/6) count<- count+1
+ else count<-count
+ }
+ return(count)
+ }
> tenki
function(){
x<- runif(1)
if (x<= 7/10) men<- "hare"
else if(x <= 9/10) men<- "kumori"
else men<- "ame"
return(men)
}
> tenki2<-function(n){
+ count <- 0
+ for(i in 1:n){
+ x<- runif(1)
+ if (x<= 7/10) count<- count+1
+ else count<- count
+ }
+ return(count)
+ }
> tenki2(10)
[1] 9
> tenki2(100)
[1] 65
> tenki2(1000)
[1] 697
> tenki2(10000)
[1] 7073
> tenki2(100000)
[1] 70067
> tenki2(1000000)
[1] 700737
> tenki2(30)
[1] 20
> tenki2(30)
[1] 21
> tenki2(30)
[1] 18
> tenki2(30)
[1] 22
> tenki2(30)
[1] 24
> tenki2(30)
[1] 21
> tenki2(30)
[1] 20
> tenki2(30)
[1] 20
> tenki2(30)
[1] 23
> tenki2(30)
[1] 20
> tenki2(30)
[1] 18
> tenki2(30)
[1] 20
> saikoro
function(){
x<- runif(1)
if (x<= 1/6) men<- 1
else if(x <= 2/6) men<- 2
else if(x <= 3/6) men<- 3
else if(x <= 4/6) men<- 4
else if(x <= 5/6) men<- 5
else men<- 6
return(men)
}
> saikoro2
function(n){
count<-0
for (i in 1:n){
x<- runif(1)
if (x <= 1/6) count<- count+1
else count<-count
}
return(count)
}
> saikoro3<-function(){
+ function(n){
+ count<-c()
+ for (i in 1:n){
+ x<- runif(1)
+ if (x <= 1/6) count<- c(count,1)
+ else if(x <= 2/6) count<- c(count,2)
+ else if(x <= 3/6) count<- c(count,3)
+ else if(x <= 4/6) count<- c(count,4)
+ else if(x <= 5/6) count<- c(count,5)
+ else count<- c(count,6)
+ return(count)
+ }
+ saikoro3(10)

+ > saikoro3<-function(){
+ function(n){
+ count<-c()
+ for (i in 1:n){
+ x<- runif(1)
+ if (x <= 1/6) count<- c(count,1)
+ else if(x <= 2/6) count<- c(count,2)
+ else if(x <= 3/6) count<- c(count,3)
+ else if(x <= 4/6) count<- c(count,4)
+ else if(x <= 5/6) count<- c(count,5)
+ else count<- c(count,6)
+ }
+ return(count)
+ }
+ }
> saikoro3(10)
以下にエラー saikoro3(10) : 使われていない引数 (10)
> saikoro3<-function(n){
+ count<-c()
+ for (i in 1:n){
+ x<- runif(1)
+ if (x <= 1/6) count<- c(count,1)
+ else if(x <= 2/6) count<- c(count,2)
+ else if(x <= 3/6) count<- c(count,3)
+ else if(x <= 4/6) count<- c(count,4)
+ else if(x <= 5/6) count<- c(count,5)
+ else count<- c(count,6)
+ }
+ return(count)
+ }
> saikoro3(10)
[1] 6 3 3 5 3 6 6 1 6 1
> saikoro3(100)
[1] 6 2 2 6 2 3 4 6 1 3 4 4 5 2 1 1 5 6 4 1 1 2 2 5 3 4 6 6 5 4 6 5 3 4 6 2
[37] 3 3 1 5 2 1 1 3 4 4 1 5 5 6 5 6 1 1 6 5 4 3 6 6 1 2 2 2 3 5 1 5 1 3 6 4
[73] 5 4 1 4 6 1 5 3 4 1 4 3 4 6 2 1 4 4 3 5 1 6 1 6 4 4 5 4
> saikoro3(1000)
[1] 6 1 2 6 5 5 5 3 5 1 1 3 5 2 3 1 3 6 6 5 2 1 2 5 4 5 5 6 3 6 6 6 4 4 5
[36] 6 3 2 1 3 2 2 2 5 6 5 6 3 2 5 5 4 4 1 3 5 2 5 2 5 6 4 1 6 1 4 3 5 6 6
[71] 4 5 6 5 2 6 4 4 6 2 4 5 2 4 2 2 4 6 5 6 6 1 6 3 5 1 4 2 3 4 6 6 4 1 6
[106] 5 6 2 6 3 2 4 1 1 2 6 2 6 3 1 1 1 6 2 4 4 4 2 3 5 1 3 3 3 1 2 5 1 5 3
[141] 4 6 3 3 2 2 1 3 1 6 1 3 2 5 6 1 2 3 6 2 3 6 1 1 6 2 4 2 5 1 2 4 1 2 4
[176] 3 4 3 1 2 6 3 4 4 5 5 5 2 1 1 6 5 3 3 3 4 3 5 1 1 5 2 1 2 2 2 5 1 1 5
[211] 3 5 2 2 1 2 1 6 1 4 5 2 5 6 5 2 4 2 6 1 3 4 5 4 2 4 1 3 6 5 1 4 6 1 2
[246] 3 5 2 5 5 4 3 3 1 1 1 3 1 4 3 6 1 4 5 4 5 4 1 6 4 6 2 4 3 4 6 4 4 2 2
[281] 4 5 3 4 3 2 4 6 4 5 6 6 4 6 2 5 4 1 1 5 3 5 5 3 3 5 1 4 2 1 5 2 2 5 1
[316] 4 4 3 1 2 2 6 3 1 1 3 3 1 2 1 6 3 2 2 6 3 2 4 1 5 5 6 1 1 2 3 6 5 4 1
[351] 3 1 2 1 4 1 5 1 6 4 3 3 3 5 3 3 5 6 6 3 3 6 5 1 5 4 6 3 3 4 3 6 6 5 4
[386] 1 4 5 2 1 3 6 6 2 3 5 2 3 1 5 6 3 1 1 1 5 1 3 1 4 1 3 1 6 1 2 5 3 4 4
[421] 3 3 5 2 4 4 5 4 3 4 4 2 5 4 2 3 4 3 6 1 5 2 3 6 4 6 3 5 6 4 5 4 6 4 2
[456] 5 2 2 4 1 5 4 6 6 4 3 1 6 1 2 3 4 6 4 6 6 4 3 5 1 4 2 4 1 2 2 4 4 2 3
[491] 4 2 5 6 6 6 1 4 4 1 4 5 1 2 2 5 6 3 6 6 2 4 3 2 1 5 4 4 1 4 3 4 2 3 3
[526] 4 4 4 3 5 3 2 1 4 3 1 3 4 5 1 5 4 3 3 2 6 1 3 2 2 6 4 3 6 5 4 5 5 3 1
[561] 3 4 3 3 4 2 2 4 3 1 5 3 4 6 4 1 4 4 4 1 4 3 2 6 4 1 5 2 4 3 4 6 2 5 2
[596] 2 4 3 3 5 6 2 2 3 6 5 4 5 3 4 6 5 2 4 4 5 4 4 6 1 1 4 6 2 1 3 5 6 4 3
[631] 6 3 6 3 3 1 2 1 4 1 3 4 6 4 1 5 3 2 5 3 5 4 1 4 4 1 2 5 6 3 1 1 4 1 3
[666] 1 4 3 2 6 5 4 4 2 4 1 5 6 1 6 1 1 6 1 4 4 2 1 5 6 6 4 6 4 3 5 1 5 1 3
[701] 1 2 4 5 1 3 6 3 4 1 6 1 4 3 6 1 6 4 5 4 3 2 1 1 2 4 5 6 4 2 5 3 4 3 5
[736] 6 6 3 2 5 3 3 4 3 6 2 4 4 3 5 3 2 3 4 5 2 5 1 6 4 4 6 1 3 2 1 2 2 5 4
[771] 4 4 3 1 3 1 6 6 1 5 6 4 1 4 3 1 4 3 3 1 1 2 6 1 3 2 1 6 5 4 5 2 2 2 4
[806] 2 2 5 6 5 2 6 6 3 2 4 5 5 2 1 4 2 2 3 1 3 6 5 5 3 2 4 3 6 5 3 1 6 2 5
[841] 3 1 1 1 1 2 3 3 2 2 4 4 1 1 3 3 5 1 4 2 2 2 1 1 3 3 6 5 2 5 6 6 5 6 5
[876] 1 1 3 1 4 3 2 6 4 3 6 1 2 3 4 3 1 5 2 6 1 1 6 3 4 6 3 4 3 2 5 2 2 4 2
[911] 6 1 6 2 1 2 4 3 5 1 5 2 4 3 1 1 4 5 4 6 3 3 1 6 2 2 1 5 4 2 6 1 6 2 4
[946] 1 5 3 6 6 2 5 1 6 6 5 2 1 3 1 4 5 3 4 5 4 3 3 6 4 1 3 3 3 4 2 5 3 4 2
[981] 3 4 4 3 4 5 1 2 6 1 2 6 2 5 6 3 5 4 2 4
> hist(saikoro3(1000))
> table(saikoro3(1000))

1 2 3 4 5 6
152 171 154 175 175 173
> tenki2
function(n){
count <- 0
for(i in 1:n){
x<- runif(1)
if (x<= 7/10) count<- count+1
else count<- count
}
return(count)
}
> tenki3<-function(n){
+ count <- 0
+ for(i in 1:n){
+ x<- runif(1)
+ if (x<= 1/10) count<- count+1
+ else count<- count
+ }
+ if(count==0) return(1)
+ else return(0)
+ }
> tenki3(7)
[1] 0
> tenki3(7)
[1] 0
> tenki3(7)
[1] 1
> tenki3(7)
[1] 0
> tenki3(7)
[1] 1
> tenki3(7)
[1] 0
> tenki3(7)
[1] 0
> tenki3(7)
[1] 0
> tenki3(7)
[1] 1
> tenki3(7)
[1] 1
> tenki3(7)
[1] 1
> tenki3(7)
[1] 0
> tenki3(7)
[1] 0
> tenki3(7)
[1] 0
> tenki3(7)
[1] 0
> tenki3(7)
[1] 0
> tenki3(7)
[1] 0
> tenki3(7)
[1] 0
> weather.week<-function(){
+ count <- 0
+ for(i in 1:7){
+ x<- runif(1)
+ if (x<= 1/10) count<- count+1
+ else count<- count
+ }
+ if(count==0) return(1)
+ else return(0)
+ }
> wether.week()
エラー： 関数 "wether.week" を見つけることができませんでした
> weather.week()
[1] 1
> weather.week()
[1] 0
> weather.week()
[1] 0
> weather.week()
[1] 1
> weather.week()
[1] 0
> weather.week()
[1] 0
> weather.week()
[1] 0
> weather.week()
[1] 1
> weather.week()
[1] 0
> weather.montecarlo<-function(){
+ count <- 0
+ count2<-0
+ for(j in 1:52){
+
+
+ for(i in 1:7){
+ x<- runif(1)
+ if (x<= 1/10) count<- count+1
+ else count<- count
+ }
+
+
+ if(count==0) count2<-count2+1
+ else count2<-count2
+ }
+ return(count2)
+ }
> weather.montecarlo()
[1] 4
> weather.montecarlo()
[1] 4
> weather.montecarlo()
[1] 1
> weather.montecarlo()
[1] 1
> weather.montecarlo()
[1] 0
> weather.montecarlo()
[1] 0
> weather.montecarlo()
[1] 0
> weather.montecarlo()
[1] 3
> weather.montecarlo()
[1] 1
> weather.montecarlo()
[1] 1
> weather.montecarlo()
[1] 0
> weather.montecarlo()
[1] 3
> weather.montecarlo()
[1] 1
> weather.montecarlo()
[1] 0
> weather.montecarlo()
[1] 0
> weather.montecarlo()
[1] 0
> weather.montecarlo()
[1] 0
> weather.montecarlo()
[1] 2
> weather.montecarlo()
[1] 0
> weather.montecarlo()
[1] 1
> weather.montecarlo()
[1] 5
> weather.montecarlo()
[1] 4
> weather.montecarlo()
[1] 0
> ls()
[1] "a" "A" "aaa"
[4] "b" "B" "coin"
[7] "count" "D" "DD"
[10] "ex1" "f" "ff"
[13] "g" "i" "myabs"
[16] "mycointoss" "mydouble" "myeven"
[19] "myloop" "myplus" "mypower02"
[22] "mypower2" "mysqrtlog" "r"
[25] "result" "saikoro" "saikoro2"
[28] "saikoro3" "skincoin" "sum"
[31] "tenki" "tenki2" "tenki3"
[34] "U" "V" "weather.montecarlo"
[37] "weather.week" "x" "xxx"
[40] "y" "y2" "z"
> coin
function(){
x<- runif(1)
if(x<= 1/2) men<- 1
else men<- 0
return(men)
}
> saikoro
function(){
x<- runif(1)
if (x<= 1/6) men<- 1
else if(x <= 2/6) men<- 2
else if(x <= 3/6) men<- 3
else if(x <= 4/6) men<- 4
else if(x <= 5/6) men<- 5
else men<- 6
return(men)
}
> saikoro2
function(n){
count<-0
for (i in 1:n){
x<- runif(1)
if (x <= 1/6) count<- count+1
else count<-count
}
return(count)
}
> saikoro3
function(n){
count<-c()
for (i in 1:n){
x<- runif(1)
if (x <= 1/6) count<- c(count,1)
else if(x <= 2/6) count<- c(count,2)
else if(x <= 3/6) count<- c(count,3)
else if(x <= 4/6) count<- c(count,4)
else if(x <= 5/6) count<- c(count,5)
else count<- c(count,6)
}
return(count)
}
>

Rの勉強１

最近は4月からの研究のためにRを勉強しなおしています。というより、勉強しています。正直恥ずかしくなるようなことですが、書いておきます。

今読んでいる本は、The R Tips―データ解析環境Rの基本技・グラフィックス活用集という本でありまして、この中に練習問題を解きつつ、分からなかったらその章をよく読むという形で進めております。

で、今日は数値計算と微積についてやりました。この辺はRではあまりやったことがなかったので。

> f<-function(x){exp(x)-2}
> f
function(x){exp(x)-2}
> f<-function(x) exp(x)-2
> f
function(x) exp(x)-2
> result<-uniroot(f,c(0,1))
> result
$root
[1] 0.6931457

$f.root
[1] -2.943424e-06

$iter
[1] 5

$estim.prec
[1] 6.103516e-05

> result$root
[1] 0.6931457
> polyroot(c(2,3,1))
[1] -1+0i -2-0i
> round
function (x, digits = 0) .Primitive("round")
> help(round)
starting httpd help server ... done
> polyroot(c(1,1,1))
[1] -0.5+0.8660254i -0.5-0.8660254i
> round(polyroot(c(1,1,1)),digits=3)
[1] -0.5+0.866i -0.5-0.866i
> round(polyroot(c(1,1,1)),digits=2)
[1] -0.5+0.87i -0.5-0.87i
> round(polyroot(c(1,1,1)),digits=1)
[1] -0.5+0.9i -0.5-0.9i
> round(polyroot(c(1,1,1)),digits=8)
[1] -0.5+0.8660254i -0.5-0.8660254i
> round(polyroot(c(1,1,1)),digits=9)
[1] -0.5+0.8660254i -0.5-0.8660254i
> f<- function(x) x^2-2*x
> f
function(x) x^2-2*x
> uniroot(f,c(1,3))
$root
[1] 2.000000

$f.root
[1] -5.356504e-07

$iter
[1] 6

$estim.prec
[1] 6.535148e-05

> polyroot(c(-2,5,-4,1))
[1] 1-0i 1+0i 2+0i
> f<- expression(a*x^4)
> f
expression(a * x^4)
> D(f,"x")
a * (4 * x^3)
> fix(DD)
>
> function (expr,name,order=1)
+ {
+ if(order<1){
+ stop("order' must be >= 1")}else if(order==1){
+ D(expr,name)}else{DD(D(expr,name),name,order -1)}
+
+ }
function (expr,name,order=1)
{
if(order<1){
stop("order' must be >= 1")}else if(order==1){
D(expr,name)}else{DD(D(expr,name),name,order -1)}

}
>
> DD(f,"x",3)
a * (4 * (3 * (2 * x)))
> deriv(~x^2,"x",func=T)
function (x)
{
.value <- x^2
.grad <- array(0, c(length(.value), 1L), list(NULL, c("x")))
.grad[, "x"] <- 2 * x
attr(.value, "gradient") <- .grad
.value
}
> f<-deriv(~x^2,"x",func=T)
> f
function (x)
{
.value <- x^2
.grad <- array(0, c(length(.value), 1L), list(NULL, c("x")))
.grad[, "x"] <- 2 * x
attr(.value, "gradient") <- .grad
.value
}
> f(-2)
[1] 4
attr(,"gradient")
x
[1,] -4
> g<- deriv(~x^2*y,c("x","y"),func=T)
> g(2,3)
[1] 12
attr(,"gradient")
x y
[1,] 12 4
> help(deriv)
> f<-deriv(~x^2,"x",func=F)
> f
expression({
.value <- x^2
.grad <- array(0, c(length(.value), 1L), list(NULL, c("x")))
.grad[, "x"] <- 2 * x
attr(.value, "gradient") <- .grad
.value
})
> f<-deriv(~x^2,"x",func=T)
> f
function (x)
{
.value <- x^2
.grad <- array(0, c(length(.value), 1L), list(NULL, c("x")))
.grad[, "x"] <- 2 * x
attr(.value, "gradient") <- .grad
.value
}
>

あと、これまでメモ帳を使って関数を作っていたのですが、fixという関数でRのエディタが立ち上がることが分かったので、これでやっていくべきなのかなぁと…。

本当にどうってことないことばかりですが、以上。