「偏差値の低そうな学校名」に関する考察とぼくのかんがえた さいきょうの せいゆう キャスティングを丸パクリして、薬品名から最も価格の高いおくすりを創りだす。
診療報酬情報提供サービスの医薬品マスターをダウンロードする。
R上で薬品名をアイウエオだけ取り出して使用頻度と価格から回帰分析する。価格は0円以上なので
ただし
はァからン
という感じでモデルにする。
説明変数が70くらいで、データ数が20000件くらいあるからまあいいだろうと思ってやったけど、計算時間がかかるので交差検証や変数選択は行なっていない。
とりあえずsummaryすると、ヌァゼボムイセが最も価格が高い(ァィェォュが上位だったが、これらの小さい字がたくさん入っても不自然なのでァだけ採用した)。ただしこれらはアイウエオの使用頻度から価格を推定しただけで、単なる相関関係だし、カタカナを組み合わせたから価格が決まるわけではない。モデルによる推定もたいしてよくない。
このときの薬の価格は64789009円になる。
ちなみにいま一番高い薬はゼヴァリン イットリウム（９０Ｙ）静注用セットという、CD20に対する分子標的薬に放射性物質がくっついた薬剤で、再発または難治性の低悪性度B細胞性非ホジキンリンパ腫かマントル細胞リンパ腫に使うらしく、2605862円である。
Coefficients: (1 not defined because of singularities) Estimate Std. Error z value Pr(>|z|) (Intercept) 8.2919538 0.0004136 20049.00 <2e-16 *** ー -0.6379701 0.0004235 -1506.29 <2e-16 *** ァ 2.8937688 0.0008463 3419.31 <2e-16 *** ア -0.1624075 0.0004737 -342.83 <2e-16 *** ィ 2.1850829 0.0008370 2610.66 <2e-16 *** イ 0.6296043 0.0003866 1628.44 <2e-16 *** ウ -0.4625029 0.0006260 -738.77 <2e-16 *** ェ 1.4677813 0.0009731 1508.42 <2e-16 *** エ -0.6900072 0.0006901 -999.84 <2e-16 *** ォ 1.8923394 0.0017194 1100.55 <2e-16 *** オ -0.1889279 0.0006369 -296.65 <2e-16 *** カ -1.3833706 0.0008368 -1653.10 <2e-16 *** ガ 0.1759308 0.0009434 186.48 <2e-16 *** キ -0.7083005 0.0006689 -1058.92 <2e-16 *** ギ 0.1462766 0.0017555 83.32 <2e-16 *** ク -0.2042494 0.0004838 -422.18 <2e-16 *** グ -0.0891857 0.0006439 -138.50 <2e-16 *** ケ -0.5820240 0.0015079 -385.98 <2e-16 *** ゲ -0.3986549 0.0013596 -293.21 <2e-16 *** コ -0.7549670 0.0008014 -942.03 <2e-16 *** ゴ 0.0948961 0.0018084 52.48 <2e-16 *** サ 0.0622428 0.0007299 85.28 <2e-16 *** ザ 0.3967174 0.0007507 528.44 <2e-16 *** シ 0.1064793 0.0004700 226.57 <2e-16 *** ジ 0.1341717 0.0004529 296.28 <2e-16 *** ス 0.4066163 0.0003773 1077.68 <2e-16 *** ズ -2.0261225 0.0047241 -428.89 <2e-16 *** セ 0.5606501 0.0004669 1200.91 <2e-16 *** ゼ 1.0349798 0.0006627 1561.79 <2e-16 *** ソ 0.3545358 0.0007412 478.30 <2e-16 *** ゾ -0.9112466 0.0013159 -692.47 <2e-16 *** タ -0.2156319 0.0005454 -395.35 <2e-16 *** ダ -0.5021248 0.0010094 -497.43 <2e-16 *** チ -0.1932831 0.0005844 -330.71 <2e-16 *** ヂ -3.1968866 0.0374133 -85.45 <2e-16 *** ッ 0.1315847 0.0005256 250.35 <2e-16 *** ツ -0.5894194 0.0008979 -656.47 <2e-16 *** ヅ -7.1900723 0.4127458 -17.42 <2e-16 *** テ 0.0725899 0.0006507 111.56 <2e-16 *** デ -1.0241445 0.0010536 -972.05 <2e-16 *** ト 0.3049327 0.0003890 783.88 <2e-16 *** ド -0.2394772 0.0006292 -380.62 <2e-16 *** ナ -0.7003145 0.0007650 -915.39 <2e-16 *** ニ -0.8194845 0.0008909 -919.85 <2e-16 *** ヌ 3.1968832 0.0009687 3300.12 <2e-16 *** ネ 0.3197691 0.0007576 422.06 <2e-16 *** ノ 0.4690383 0.0006183 758.64 <2e-16 *** ハ -0.6772659 0.0013896 -487.37 <2e-16 *** バ -0.3267690 0.0007269 -449.53 <2e-16 *** パ -0.4052398 0.0007903 -512.75 <2e-16 *** ヒ 0.0129940 0.0012373 10.50 <2e-16 *** ビ -0.0687314 0.0006932 -99.16 <2e-16 *** ピ -0.9119080 0.0009627 -947.24 <2e-16 *** フ -1.9556238 0.0007932 -2465.38 <2e-16 *** ブ 0.4288718 0.0006280 682.92 <2e-16 *** プ -0.2594415 0.0005356 -484.36 <2e-16 *** ヘ -0.2440663 0.0015570 -156.76 <2e-16 *** ベ 0.1758298 0.0006840 257.07 <2e-16 *** ペ -1.1201794 0.0011843 -945.83 <2e-16 *** ホ -0.8645107 0.0016477 -524.68 <2e-16 *** ボ 0.7337224 0.0006516 1126.09 <2e-16 *** ポ 0.0400708 0.0009210 43.51 <2e-16 *** マ -0.1353876 0.0006020 -224.91 <2e-16 *** ミ -0.8532843 0.0008292 -1029.05 <2e-16 *** ム 0.6450842 0.0004972 1297.36 <2e-16 *** メ -1.3814976 0.0012656 -1091.55 <2e-16 *** モ -1.0313235 0.0011756 -877.29 <2e-16 *** ャ -1.7406211 0.0025613 -679.58 <2e-16 *** ヤ -0.8351742 0.0024738 -337.61 <2e-16 *** ュ 1.4460424 0.0008386 1724.38 <2e-16 *** ユ -2.6361917 0.0057406 -459.22 <2e-16 *** ョ -3.9906244 0.0105727 -377.45 <2e-16 *** ヨ -0.7144133 0.0016099 -443.77 <2e-16 *** ラ 0.0494248 0.0004317 114.49 <2e-16 *** リ 0.4878857 0.0003590 1359.11 <2e-16 *** ル -0.4107927 0.0004275 -961.01 <2e-16 *** レ 0.1581330 0.0005426 291.45 <2e-16 *** ロ -0.4756305 0.0004894 -971.91 <2e-16 *** ワ -1.4311572 0.0013279 -1077.75 <2e-16 *** ヰ -3.2185566 0.0992230 -32.44 <2e-16 *** ヱ NA NA NA NA ヲ -3.6604255 0.0452673 -80.86 <2e-16 *** ン -0.3816831 0.0003736 -1021.57 <2e-16 ***
dat <- read.csv("yakka.csv", header=FALSE) # SJISをutf8にしてる yakuhin <- strsplit(as.character(dat$V35), "") iranai <- strsplit(gsub("[ァ-ンー]", "", dat$V35), "") # 正規表現でゴリ押し kakaku <- dat$V12 # 価格 drug <- mapply(function(i) setdiff(yakuhin[[i]], iranai[[i]]), seq(yakuhin)) library(arules) tr <- as(drug, "transactions") mat <- as(tr, "matrix") # 各カタカタの使用頻度にする mat[] <- 0 pb <- txtProgressBar(min=1, max=length(yakuhin), style=3) # "[ァ-ンー]"の使用頻度行列を作る # クッソ時間かかる for(i in seq(yakuhin)){ setTxtProgressBar(pb, i) idx <- match(yakuhin[[i]], colnames(mat)) idx <- idx[!is.na(idx)] mat[i, idx] <- mat[i, idx] + 1 } dat0 <- as.data.frame(cbind(kakaku, mat)) summary(sapply(drug, length)) # 使用されているカタカナのsummary g1 <- glm(kakaku ~ ., data=dat0, family="poisson") # 回帰 pred1 <- predict(g1, dat0, type="response") # モデルによる推定 xl <- yl <- c(0, 100000) plot(kakaku, pred1, xlim=xl, ylim=yl, pch=16, cex=0.5, xlab="実際の価格(円)", ylab="推定価格(円)", cex.lab=1.2) cand <- c("ヌ", "ァ", "ゼ", "ボ", "ム", "イ", "セ") # 売れそうなカタカナ cand1 <- mat[1,] cand1[] <- 0 cand1 <- replace(cand1, match(cand, names(cand1)), 1) predict(g1, cand1, type="response") # 予測
