裏 RjpWiki

Julia ときどき R, Python によるコンピュータプログラム,コンピュータ・サイエンス,統計学

ベクトル演算を効率的に使う

2014年04月10日 | ブログラミング

“(※ただしイケメンに限る)” をランダムに挿入するR関数 だけど

3点についてコメント

1. 文字レベルで分解する必要はなくて,文に分解するに分解するときに,split に複数の文字を指定するやり方(オンラインヘルプに書いてある)

2. ある確率で何かをやるときは,rbinom ではなく runif を使う

3. for ではなくベクトル演算を行う

ということで,以下のような単純なプログラムになりました。

tadasi2 = function(text, p) {
    x = unlist(strsplit(text, "[。.!]"))
    y = ifelse(runif(length(x)) , "(※ただしイケメンに限る)", "")
    x = paste(x, y, "。", sep="")
    paste(x, collapse = "")
}
x = "英語なんて言葉なんだ! こんなものやれば誰だってできるようになる!"
tadasi2(x, 0.3)

コメント
  • X
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

プログラムも簡潔に書きたい

2014年04月10日 | ブログラミング

二人の相性(%)を瞬時に判定するR関数 だけど,計算を簡単に行うプログラムを書くのが面倒だとちょっと...

このプログラムを入力するのが面倒くさい。

というわけで,以下のように書いてみる。

uranai = function(NAME1, NAME2, PRINT = TRUE) {
    ### 名前を統合 ### 
    x = unlist(strsplit(c(NAME1, NAME2), split = ""))
    y = numeric(length(x))
    y[x %in% unlist(strsplit("あぁかさたなはまらがざだばぱやゃわ", ""))] = 1
    y[x %in% unlist(strsplit("いぃきしちにひみりぎじぢびぴ",      ""))] = 2
    y[x %in% unlist(strsplit("うぅくすつぬふむるぐずづぶぷゆゅっ", ""))] = 3
    y[x %in% unlist(strsplit("えぇけせてねへめれげぜでべぺ",      ""))] = 4
    y[x %in% unlist(strsplit("おぉこそとのほもろごぞどぼぽよょ",   ""))] = 5
    ### 計算 ### 
    for (i in 3:length(x)) {
        if (PRINT) {
            print(y)
        }
        n = length(y)
        if (n == 2) {
            break
        }
        y = (y[-n] + y[-1])%%10
    }
    ### パーセンテージで出力 ###
    cat(paste("ふたりの相性は、", 10 * y[1] + y[2], "%", " です。", sep = ""))
}
uranai("やべひろゆき", "あおきゆうこ")
uranai("うちだゆうや", "きききりん", PRINT = FALSE)
uranai("たむらゆう", "ふくたじゅんや", PRINT = TRUE)

ところで,元のプログラムで

x <- X[i]
ifelse( x == "あ" | x == "か"| ... | x == "ば" ,y[i] = 1,
ifelse(x == "い"...)...)

というのは,

y[i] = ifelse( x == "あ" | x == "か"| ... | x == "ば" , 1,
ifelse(x == "い"...)...)

などとすべし。

まあ,とにかく,ハッピー・ハッキング!!

 

コメント
  • X
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

ダミー変数の標準化偏回帰係数

2014年04月10日 | ブログラミング

重回帰分析で標準化回帰係数βを出力するR関数 が紹介されている

ちょっと,見にくいところと余分なことがあるので,修正してみた(代入記号に = を使うのは,不本意だが,許して欲しい)

lm.Beta2 = function(res) {
    ysd = sd(res$model[, 1]) # 結果変数のSD
    idv = res$model[, -1, drop = FALSE]
    N = ncol(idv)
    res.beta = sd = res$coefficients[-1]
    for (j in 1:N) {
        xxx = idv[, j]
        if (class(xxx) == "factor") {
            for (i in 2:nlevels(xxx)) {
                lab = paste(colnames(idv)[j], levels(xxx)[i], sep = "") # 対象の変数
                dummy = as.integer(xxx) == i # 1/0 の変数化
                sd[lab] = sd(dummy)
            }

        } else { # 数値だったら簡単にβを計算できる
            lab = colnames(idv)[j] # 対象の変数
            sd[lab] = sd(xxx)
        }
    }
    res.beta * sd / ysd
}

R の他の関数のように,下請けの関数を組み合わせて目的を達成するという方針でやるならば,以下のように簡単に書くことができる(1行にすることもできるが,そこまでは...)

lm 関数が返すオブジェクト object に対して,

lm.Beta3 = function(object) {
  d = model.matrix(object$terms, eval(object$model, parent.frame()))
  object$coefficients[-1] * apply(d[, -1, drop=FALSE], 2, sd) / sd(object$model[,1])
}

> lm.Beta3(res)
        x        zB        zC
0.5238095 0.2436580 0.5685352

楽しい,ハッキングだった(^_^)

ありがとうございました

コメント
  • X
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

PVアクセスランキング にほんブログ村

PVアクセスランキング にほんブログ村