Hatena::ブログ(Diary)

極めて個人的なメモ Twitter

Θ・)ノシ Bob#3のメモ帳です。
1972 | 12 |
2003 | 03 | 04 | 05 | 06 | 11 | 12 |
2004 | 01 | 02 | 03 | 04 | 05 | 06 | 09 | 10 | 11 | 12 |
2005 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 09 | 10 | 11 |
2006 | 03 | 04 | 05 | 06 | 07 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 05 | 06 | 07 | 10 | 11 | 12 |
2008 | 01 | 02 | 04 | 05 | 08 | 09 | 10 | 11 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 |
2011 | 05 | 06 | 09 | 10 |
2012 | 02 | 03 | 05 | 06 | 08 |
2013 | 01 | 02 | 03 |
2015 | 02 |

2015-02-06 このエントリーを含むブックマーク このエントリーのブックマークコメント

トラックバック - http://d.hatena.ne.jp/bob3/20150206

2013-03-22

[]Rでコンジョイント分析 Rでコンジョイント分析を含むブックマーク Rでコンジョイント分析のブックマークコメント

Rにはコンジョイント分析用のパッケージが無いなー、とずいぶん前から思っていましたがいつの間にやら登録されていたようです。

コンジョイント分析とは何か?についてはアルベルト社の解説が分かりやすいと思います。


install.packages("conjoint") #パッケージのインストール。初回のみ。

library(conjoint) #パッケージの呼び出し。

data(tea) #サンプルデータの呼び出し

# 各プロファイルの表示
# 13プロファイル(4属性(3水準、3水準、3水準、2水準))
print(tprof) # 各プロファイルの表示
#    price variety kind aroma
# 1      3       1    1     1
# 2      1       2    1     1
# 3      2       2    2     1
# 4      2       1    3     1
# 5      3       3    3     1
# 6      2       1    1     2
# 7      3       2    1     2
# 8      2       3    1     2
# 9      3       1    2     2
# 10     1       3    2     2
# 11     1       1    3     2
# 12     2       2    3     2
# 13     3       2    3     2

# 各水準のラベル
print(tlevn)
#        levels
# 1         low
# 2      medium
# 3        high
# 4       black
# 5       green
# 6         red
# 7        bags
# 8  granulated
# 9       leafy
# 10        yes
# 11         no

# 選好マトリクス。数値が大きい方が高評価。
head(tprefm) #100名×13プロファイル
#   profil1 profil2 profil3 profil4 profil5 profil6 profil7 profil8 profil9 profil10 profil11 profil12 profil13
# 1       8       1       1       3       9       2       7       2       2        2        2        3        4
# 2       0      10       3       5       1       4       8       6       2        9        7        5        2
# 3       4      10       3       5       4       1       2       0       0        1        8        9        7
# 4       6       7       4       9       6       3       7       4       8        5        2       10        9
# 5       5       1       7       8       6      10       7      10       6        6        6       10        7
# 6      10       1       1       5       1       0       0       0       0        0        0        1        1

# 分析する。最小二乗法。
# 引数は順に選好マトリクス、プロファイル、水準のラベル
Conjoint(tprefm, tprof, tlevn)
# [1] "Part worths (utilities) of levels (model parameters for whole sample):"
#        levnms    utls
# 1   intercept  3,5534
# 2         low  0,2402
# 3      medium -0,1431
# 4        high -0,0971
# 5       black  0,6149
# 6       green  0,0349
# 7         red -0,6498
# 8        bags  0,1369
# 9  granulated -0,8898
# 10      leafy  0,7529
# 11        yes  0,4108
# 12         no -0,4108
# [1] "Average importance of factors (attributes):"
# [1] 24,76 32,22 27,15 15,88
# [1] Sum of average importance:  100,01
# [1] "Chart of average factors importance"

各水準の部分効用値と各属性寄与率のグラフも同時に出力される。


price

f:id:bob3:20130323011752p:image


variety

f:id:bob3:20130323011753p:image


kind

f:id:bob3:20130323011754p:image


aroma

f:id:bob3:20130323011755p:image


寄与

f:id:bob3:20130323011756p:image


また、結果の分析だけでなくプロファイルの作成もできる。

experiment <- expand.grid(
  price   = c("low", "medium", "high"),
  variety = c("black", "green", "red"),
  kind    = c("bags", "granulated", "leafy"),
  aroma   = c("yes", "no"))
design <- caFactorialDesign(data=experiment, type="orthogonal")
# フルプロファイル法はtype="full"
# 直交計画はtype="orthogonal"
# を指定した計画type="fractional", cards=16
design
#     price variety       kind aroma
# 3    high   black       bags   yes
# 5  medium   green       bags   yes
# 10    low   black granulated   yes
# 17 medium     red granulated   yes
# 22    low   green      leafy   yes
# 27   high     red      leafy   yes
# 34    low     red       bags    no
# 42   high   green granulated    no
# 47 medium   black      leafy    no

# 分析に使うときはこれをさらにコーディングする。
caEncodedDesign(design)
#    price variety kind aroma
# 3      3       1    1     1
# 5      2       2    1     1
# 10     1       1    2     1
# 17     2       3    2     1
# 22     1       2    3     1
# 27     3       3    3     1
# 34     1       3    1     2
# 42     3       2    2     2
# 47     2       1    3     2

ちなみにできたプロファイルの直交性を確認したい時は、プロファイルコーディングした後、相関係数を見ればよい。

cor(caEncodedDesign(design))
#         price variety kind aroma
# price       1       0    0     0
# variety     0       1    0     0
# kind        0       0    1     0
# aroma       0       0    0     1

他に

といった関数が実装されています。


評価の無いプロファイルがある場合に対応してないとか、最小二乗法以外の解法が無いとか物足りない点もありますが、けっこう使い勝手が良さそうじゃないですか?これ。


なお、選択型コンジョイント分析(CBC)についてはデータ解析環境Rによる選択型コンジョイント分析入門(PDF注意)を参照されたい。

Bob3Bob3 2013/03/23 10:11 プロファイルの作成のところでexperimentを設定するコードが抜けてました。PC持たずに外出してしまったので夜に追記します。

2013-03-12

数独をRで解く 数独をRで解くを含むブックマーク 数独をRで解くのブックマークコメント

ったつもりが簡単な問題だった件 に載っている数独の問題をRで解きます。

といっても、例によって必要なパッケージを呼び出して、関数一発です。

そう、数独用のパッケージがあるのです、Rならね。


install.packages("sudoku")
library(sudoku)
HW1 <- matrix(c(0,6,1,0,0,7,0,0,3,
                0,9,2,0,0,3,0,0,0,
                0,0,0,0,0,0,0,0,0,
                0,0,8,5,3,0,0,0,0,
                0,0,0,0,0,0,5,0,4,
                5,0,0,0,0,8,0,0,0,
                0,4,0,0,0,0,0,0,1,
                0,0,0,1,6,0,8,0,0,
                6,0,0,0,0,0,0,0,0), 9, byrow=TRUE)
solveSudoku(HW1, verbose=TRUE)

Inkara1 <- matrix(c(0,0,5,3,0,0,0,0,0,
                    8,0,0,0,0,0,0,2,0,
                    0,7,0,0,1,0,5,0,0,
                    4,0,0,0,0,5,3,0,0,
                    0,1,0,0,7,0,0,0,6,
                    0,0,3,2,0,0,0,8,0,
                    0,6,0,5,0,0,0,0,9,
                    0,0,4,0,0,0,0,3,0,
                    0,0,0,0,0,9,7,0,0), 9, byrow=TRUE)
solveSudoku(Inkara1, verbose=TRUE)

Inkara2 <- matrix(c(8,0,0,0,0,0,0,0,0,
                    0,0,3,6,0,0,0,0,0,
                    0,7,0,0,9,0,2,0,0,
                    0,5,0,0,0,7,0,0,0,
                    0,0,0,0,4,5,7,0,0,
                    0,0,0,1,0,0,0,3,0,
                    0,0,1,0,0,0,0,6,8,
                    0,0,8,5,0,0,0,1,0,
                    0,9,0,0,0,0,4,0,0), 9, byrow=TRUE)
solveSudoku(Inkara2, verbose=TRUE)

結果はネタバレになるので書きません。

処理時間はHW1が0.39秒、Inkara1が3.12秒、Inkara2が10.95秒でした。