library(shiny)
library(shinyAce)
library(psych)
shinyServer(function(input, output) {
bs <- reactive({
x <- read.csv(text=input$text, sep="\t")
describe(x)[2:13]
})
correl <- reactive({
x <- read.csv(text=input$text, sep="\t")
round(cor(cbind(x), use = "complete"),3)
})
makecorPlot <- function(){
x <- read.csv(text=input$text, sep="\t")
pairs.panels(x)
}
output$corPlot <- renderPlot({
print(makecorPlot())
})
sp <- reactive({
dat <- read.csv(text=input$text, sep="\t")
sp <- fa.parallel(dat)
list(sp = sp) #他で使用するため
})
output$makesPlot <- renderPlot({
dat <- read.csv(text=input$text, sep="\t")
fa.parallel(dat)
})
nf <- reactive({
#dat <- read.csv(text=input$text, sep="\t")
#res <- fa.parallel(dat)
facno <- sp()$sp[[7]]
compono <- sp()$sp[[8]]
fa.val <- round(sp()$sp[[1]],2)
pc.val <- round(sp()$sp[[3]],2)
cat(" Parallel analysis suggests that the number of factors =", facno, "\n",
"and the number of components =", compono, "\n",
"\n",
"Eigen values of original factors:", "\n",
fa.val,"\n","\n",
"Eigen values of Original components:", "\n",
pc.val)
})
efaresult <- reactive({
dat <- read.csv(text=input$text, sep="\t")
# sp <- fa.parallel(dat) #2021-02ここを追加
# ここからパラレルの場合（デフォルト）
if (input$numfactor == "parallel") {
# factanal 関数の結果を整形して表示する
# http://aoki2.si.gunma-u.ac.jp/R/src/factanal2.R
factanal2 <- function( dat, # データ行列
factors=0, # 抽出する因子数
rotation=c("promax", "varimax", "none"), # 因子軸の回転法
scores=c("none", "regression", "Bartlett"), # 因子得点の算出法
verbose=TRUE) # 結果の画面表示をするかどうか
{
p <- ncol(dat) # 変数の個数
n <- nrow(dat) # 行数（欠損値を含むケースも含む）
if (is.null(colnames(dat))) colnames(dat) <- paste("Var", 1:p, sep=".") # 変数名がないときにデフォルト名をつける
if (is.null(rownames(dat))) rownames(dat) <- paste("Case", 1:n, sep="-")# 行名がないときにデフォルト名をつける
dat <- subset(dat, complete.cases(dat)) # 欠損値を持つケースを除く
rotation <- match.arg(rotation) # 引数の補完
scores <- match.arg(scores) # 引数の補完
if (factors == 0) { # 抽出因子数が指定されないときは，
factors <- max(1, floor((2*p+1-sqrt((2*p+1)^2-4*(p^2-p)))/2)) # デフォルトの因子数
}
result<-factanal(dat, factors=factors, rotation=rotation, scores=scores)# 関数呼び出し
Communality <- 1-result$uniquenesses # 共通性は，斜交回転のときには因子負荷量の二乗和ではない
result$cosmetic <- cbind(result$loadings, Communality) # 共通性を付加
if (rotation!="promax") { # 斜交回転でない場合には，
SS.loadings <- colSums(result$loadings^2) # 因子負荷量の二乗和
SS.loadings <- c(SS.loadings, sum(SS.loadings)) # 総和を加える
Proportion <- SS.loadings/p*100 # 寄与率
Cum.Prop. <- cumsum(Proportion) # 累積寄与率
Cum.Prop.[factors+1] <- NA
result$cosmetic <- rbind(result$cosmetic, SS.loadings, Proportion, Cum.Prop.)
}
if (verbose == TRUE) { # 画面表示をするとき
if (result$dof) { # モデル適合度の自由度が 0 でないとき
test <- data.frame(result$STATISTIC, result$dof, result$PVAL)
colnames(test) <- c("Chi sq.", "d.f.", "P value")
rownames(test) <- ""
cat(sprintf("H0: %i factors are sufficient.\n", factors))
print(test)
}
else { # 自由度が 0 になるとき
cat(sprintf("The degrees of freedom for the model is 0 and the fit was %g\n", result$criteria[1]))
}
#cat(sprintf("\nFactor loadings(rotation:%s)\n", rotation)) # 因子負荷量
#print(result$cosmetic)
#if (scores != "none") {
#cat(sprintf("\nFactor scores(%s)\n", scores)) # 因子得点
#print(result$scores)
#}
}
invisible(result) # 明示的に print しないと，何も出力しない
}
suggested <- sp()$sp[[7]]
efa <- factanal2(dat, factors=suggested, rotation="promax")
#list(efa = efa)
# 因子負荷量の大きさの順に変数を並べ替える
# http://aoki2.si.gunma-u.ac.jp/R/src/sort.loadings.R
sort.loadings <- function(x) # factanalが返すオブジェクト
{
a <- x$loadings
y <- abs(a) # 因子負荷量の絶対値
z <- apply(y, 1, which.max) # 各変数をどの因子に含めるべきか
loadings <- NULL # 結果
for (i in 1:ncol(y)) {
b <- a[z == i,, drop=FALSE]
if (nrow(b)) {
t <- order(b[, i, drop=FALSE], decreasing=TRUE) # 因子単位で並べ替え情報を得る
loadings <- rbind(loadings, b[t,, drop=FALSE])
}
}
class(loadings) <- "loadings" # クラスの設定
return(loadings) # 結果を返す
}
print(sort.loadings(efa), cutoff=0)
cat("\n")
cat("Factor correlation:", "\n")
if (ncol(efa$loadings) == 1) {
c("No factor correlation available")
} else {
# プロマックス解の因子間相関係数行列
# http://aoki2.si.gunma-u.ac.jp/R/src/factor.correlation.R
factor.correlation <- function(x, factors, ...)
{
ans <- factanal(x, factors, rotation="none", ...) # 回転を行わない結果を求める
ans2 <- promax(ans$loadings) # プロマックス回転による結果を求める
name <- colnames(ans2$loadings) # 名前の保存
o <- order(colSums(ans2$loadings^2), decreasing=TRUE) # SS loadings の大きい順
ans2$loadings <- ans2$loadings[, o] # loadings の並べ替え（行）
colnames(ans2$loadings) <- name # 名前の付け替え
class(ans2$loadings) <- "loadings" # class がなくなるので再設定
ans2$rotmat <- ans2$rotmat[o, o] # rotmat の並べ替え（行・列）
ans3 <- ans2$rotmat # 回転行列を取り出す
r <- solve(t(ans3) %*% ans3) # 因子間相関係数行列を計算する
colnames(r) <- rownames(r) <- name # 名前を付ける（必須ではない）
r <- round(r, 3)
return(r) # プロマックス解と因子間相関係数行列
}
factor.correlation(~., data=dat, suggested)
}
# ここまでパラレルの場合（デフォルト）
} else { # ここから因子数指定の場合
# factanal 関数の結果を整形して表示する
# http://aoki2.si.gunma-u.ac.jp/R/src/factanal2.R
factanal2 <- function( dat, # データ行列
factors=0, # 抽出する因子数
rotation=c("promax", "varimax", "none"), # 因子軸の回転法
scores=c("none", "regression", "Bartlett"), # 因子得点の算出法
verbose=TRUE) # 結果の画面表示をするかどうか
{
p <- ncol(dat) # 変数の個数
n <- nrow(dat) # 行数（欠損値を含むケースも含む）
if (is.null(colnames(dat))) colnames(dat) <- paste("Var", 1:p, sep=".") # 変数名がないときにデフォルト名をつける
if (is.null(rownames(dat))) rownames(dat) <- paste("Case", 1:n, sep="-")# 行名がないときにデフォルト名をつける
dat <- subset(dat, complete.cases(dat)) # 欠損値を持つケースを除く
rotation <- match.arg(rotation) # 引数の補完
scores <- match.arg(scores) # 引数の補完
if (factors == 0) { # 抽出因子数が指定されないときは，
factors <- max(1, floor((2*p+1-sqrt((2*p+1)^2-4*(p^2-p)))/2)) # デフォルトの因子数
}
result<-factanal(dat, factors=factors, rotation=rotation, scores=scores)# 関数呼び出し
Communality <- 1-result$uniquenesses # 共通性は，斜交回転のときには因子負荷量の二乗和ではない
result$cosmetic <- cbind(result$loadings, Communality) # 共通性を付加
if (rotation!="promax") { # 斜交回転でない場合には，
SS.loadings <- colSums(result$loadings^2) # 因子負荷量の二乗和
SS.loadings <- c(SS.loadings, sum(SS.loadings)) # 総和を加える
Proportion <- SS.loadings/p*100 # 寄与率
Cum.Prop. <- cumsum(Proportion) # 累積寄与率
Cum.Prop.[factors+1] <- NA
result$cosmetic <- rbind(result$cosmetic, SS.loadings, Proportion, Cum.Prop.)
}
if (verbose == TRUE) { # 画面表示をするとき
if (result$dof) { # モデル適合度の自由度が 0 でないとき
test <- data.frame(result$STATISTIC, result$dof, result$PVAL)
colnames(test) <- c("Chi sq.", "d.f.", "P value")
rownames(test) <- ""
cat(sprintf("H0: %i factors are sufficient.\n", factors))
print(test)
}
else { # 自由度が 0 になるとき
cat(sprintf("The degrees of freedom for the model is 0 and the fit was %g\n", result$criteria[1]))
}
#cat(sprintf("\nFactor loadings(rotation:%s)\n", rotation)) # 因子負荷量
#print(result$cosmetic)
#if (scores != "none") {
#cat(sprintf("\nFactor scores(%s)\n", scores)) # 因子得点
#print(result$scores)
#}
}
invisible(result) # 明示的に print しないと，何も出力しない
}
nfact <- input$numspec # 因子数
efa <- factanal2(dat, factors=nfact, rotation="promax")
#list(efa = efa)
# 因子負荷量の大きさの順に変数を並べ替える
# http://aoki2.si.gunma-u.ac.jp/R/src/sort.loadings.R
sort.loadings <- function(x) # factanalが返すオブジェクト
{
a <- x$loadings
y <- abs(a) # 因子負荷量の絶対値
z <- apply(y, 1, which.max) # 各変数をどの因子に含めるべきか
loadings <- NULL # 結果
for (i in 1:ncol(y)) {
b <- a[z == i,, drop=FALSE]
if (nrow(b)) {
t <- order(b[, i, drop=FALSE], decreasing=TRUE) # 因子単位で並べ替え情報を得る
loadings <- rbind(loadings, b[t,, drop=FALSE])
}
}
class(loadings) <- "loadings" # クラスの設定
return(loadings) # 結果を返す
}
print(sort.loadings(efa), cutoff=0)
cat("\n")
cat("Factor correlation:", "\n")
if (ncol(efa$loadings) == 1) {
c("No factor correlation available")
} else {
# プロマックス解の因子間相関係数行列
# http://aoki2.si.gunma-u.ac.jp/R/src/factor.correlation.R
factor.correlation <- function(x, factors, ...)
{
ans <- factanal(x, factors, rotation="none", ...) # 回転を行わない結果を求める
ans2 <- promax(ans$loadings) # プロマックス回転による結果を求める
name <- colnames(ans2$loadings) # 名前の保存
o <- order(colSums(ans2$loadings^2), decreasing=TRUE) # SS loadings の大きい順
ans2$loadings <- ans2$loadings[, o] # loadings の並べ替え（行）
colnames(ans2$loadings) <- name # 名前の付け替え
class(ans2$loadings) <- "loadings" # class がなくなるので再設定
ans2$rotmat <- ans2$rotmat[o, o] # rotmat の並べ替え（行・列）
ans3 <- ans2$rotmat # 回転行列を取り出す
r <- solve(t(ans3) %*% ans3) # 因子間相関係数行列を計算する
colnames(r) <- rownames(r) <- name # 名前を付ける（必須ではない）
r <- round(r, 3)
return(r) # プロマックス解と因子間相関係数行列
}
factor.correlation(~., data=dat, nfact)
}
} # ここまで因子数指定の場合
})
plotInput <- renderPlot({
dat <- read.csv(text=input$text, sep="\t")
dat <- na.omit(dat) #プロットだけ追加
if (input$numfactor == "prallel") {
suggested <- sp()$sp[[7]]
efa <- factanal(dat, factors=suggested, rotation="promax", na.action = na.omit)
} else {
nfact <- input$numspec # 因子数
efa <- factanal(dat, factors=nfact, rotation="promax", na.action = na.omit)
}
if (ncol(efa$loadings) == 1) {
barplot(efa$loadings[,1], main="Factor 1", ylim=c(0,1))
} else {
par(mfrow = c(2, 1)) # グラフを横に2つ並べる
barplot(efa$loadings[,1], main="Factor 1", ylim=c(0,1))
barplot(efa$loadings[,2], main="Factor 2", ylim=c(0,1))
}
})
makePlot1 <- function() {
dat <- read.csv(text=input$text, sep="\t")
dat <- na.omit(dat) #プロットだけ追加
if (input$numfactor == "parallel") {
suggested <- sp()$sp[[7]]
efa <- factanal(dat, factors=suggested, rotation="promax", na.action = na.omit)
} else {
nfact <- input$numspec # 因子数
efa <- factanal(dat, factors=nfact, rotation="promax", na.action = na.omit)
}
if (ncol(efa$loadings) == 1) {
barplot(efa$loadings[,1], main="Factor 1", ylim=c(0,1))
} else {
par(mfrow = c(2, 1)) # グラフを横に2つ並べる
barplot(efa$loadings[,1], main="Factor 1", ylim=c(0,1))
barplot(efa$loadings[,2], main="Factor 2", ylim=c(0,1))
}
}
output$facPlot1 <- renderPlot({
print(makePlot1())
})
makePlot2 <- function() {
dat <- read.csv(text=input$text, sep="\t")
dat <- na.omit(dat) #プロットだけ追加
if (input$numfactor == "parallel") {
suggested <- sp()$sp[[7]]
efa <- factanal(dat, factors=suggested, rotation="promax", na.action = na.omit)
if (ncol(efa$loadings) >= 2) {
plot(efa$loadings[,1:2], type="n", xlim=c(-1,1), ylim=c(-1,1))
text(efa$loadings[,1:2], colnames(dat))
abline(v=0, lty=3) #0で縦に線を引き，破線（lty=3）を引く
abline(h=0, lty=3) #0で横に線を引き，破線（lty=3）を引く
}
} else {
nfact <- input$numspec # 因子数
efa <- factanal(dat, factors=nfact, rotation="promax", na.action = na.omit)
if (ncol(efa$loadings) >= 2) {
par(mfrow = c(1, 1)) # グラフを横に2つ並べる
plot(efa$loadings[,1:2], type="n", xlim=c(-1,1), ylim=c(-1,1))
text(efa$loadings[,1:2], colnames(dat))
abline(v=0, lty=3) #0で縦に線を引き，破線（lty=3）を引く
abline(h=0, lty=3) #0で横に線を引き，破線（lty=3）を引く
}
}
}
output$facPlot2 <- renderPlot({
print(makePlot2())
})
info <- reactive({
info1 <- paste("This analysis was conducted with ", strsplit(R.version$version.string, " \\(")[[1]][1], ".", sep = "")# バージョン情報
info2 <- paste("It was executed on ", date(), ".", sep = "")# 実行日時
cat(sprintf(info1), "\n")
cat(sprintf(info2), "\n")
})
output$info.out <- renderPrint({
info()
})
output$textarea.out <- renderPrint({
bs()
})
output$correl.out <- renderPrint({
correl()
})
output$nf.out <- renderPrint({
nf()
})
output$efaresult.out <- renderPrint({
efaresult()
})
output$check <- renderTable({
head(check(), n = 10)
}, digits = 0)
})
library(shiny)
library(shinyAce)
shinyUI(bootstrapPage(
headerPanel("Exploratory Factor Analysis"),
########## loading message #######################################
tags$head(tags$style(type="text/css", "
#loadmessage {
position: fixed;
top: 0px;
left: 0px;
width: 100%;
padding: 10px 0px 10px 0px;
text-align: center;
font-weight: bold;
font-size: 100%;
color: #000000;
background-color: #CCFF66;
z-index: 105;
}
")),
conditionalPanel(condition="$('html').hasClass('shiny-busy')",
tags$div("Analyzing...",id="loadmessage")),
###################################################################
mainPanel(
tabsetPanel(
tabPanel("Main",
p('Estimation may take a few seconds to minutes depending on the dataset.'),
h3("Data"),
p('Input values must be separated by tabs. Copy and paste from Excel/Numbers.'),
p(HTML("<b><div style='background-color:#FADDF2;border:1px solid black;'>Please make sure that your data includes the header (variable names) in the first row.</div></b>")),
aceEditor("text", value="item1\titem2\titem3\titem4\titem5\titem6\titem7\titem8\n7\t6\t6\t6\t7\t6\t6\t7\n5\t5\t6\t7\t6\t5\t5\t4\n7\t6\t5\t7\t6\t6\t6\t6\n3\t3\t3\t5\t4\t4\t3\t3\n6\t4\t5\t5\t5\t4\t5\t4\n5\t4\t4\t7\t6\t4\t6\t4\n6\t7\t6\t6\t7\t5\t5\t6\n7\t7\t7\t7\t4\t4\t4\t4\n5\t6\t4\t5\t4\t2\t2\t4\n7\t5\t6\t7\t6\t4\t5\t6\n6\t4\t4\t6\t3\t2\t2\t4\n6\t5\t4\t5\t5\t4\t4\t2\n7\t6\t5\t6\t7\t6\t6\t6\n6\t5\t7\t7\t5\t4\t4\t4\n6\t2\t1\t5\t2\t2\t2\t2\n4\t4\t5\t5\t5\t3\t3\t2\n5\t6\t4\t7\t5\t3\t3\t5\n5\t6\t5\t6\t6\t6\t5\t5\n5\t7\t6\t6\t6\t3\t4\t4\n4\t5\t4\t5\t5\t2\t3\t3\n7\t7\t2\t4\t7\t1\t1\t1\n5\t6\t5\t6\t5\t3\t4\t5\n5\t5\t5\t5\t7\t4\t4\t4\n4\t5\t2\t5\t6\t5\t5\t5\n6\t6\t6\t7\t6\t7\t7\t4\n6\t5\t3\t6\t4\t3\t4\t4\n5\t5\t5\t6\t5\t4\t5\t5\n6\t7\t6\t7\t7\t5\t6\t7\n5\t5\t4\t6\t5\t4\t4\t5\n6\t4\t7\t7\t7\t6\t5\t5\n6\t6\t4\t6\t6\t6\t6\t5\n5\t5\t3\t4\t4\t4\t4\t5\n6\t6\t6\t6\t6\t5\t5\t5\n5\t6\t4\t5\t4\t3\t4\t6\n4\t4\t4\t5\t5\t5\t5\t5\n6\t7\t6\t6\t5\t5\t4\t6\n4\t7\t5\t5\t5\t4\t4\t5\n7\t7\t3\t7\t7\t7\t7\t7\n6\t7\t5\t7\t7\t6\t5\t6\n5\t5\t5\t5\t7\t5\t7\t7\n7\t2\t2\t2\t5\t1\t2\t3\n5\t5\t4\t6\t6\t4\t5\t5\n5\t5\t5\t5\t6\t5\t5\t6\n5\t4\t4\t4\t1\t1\t1\t1\n5\t7\t6\t7\t6\t4\t4\t5\n5\t6\t4\t6\t5\t3\t4\t4\n5\t5\t4\t5\t6\t4\t4\t4\n6\t4\t4\t7\t4\t4\t4\t4\n6\t6\t4\t7\t6\t4\t4\t5\n6\t7\t3\t5\t4\t3\t4\t5\n5\t6\t6\t6\t5\t4\t4\t5\n7\t7\t7\t7\t7\t7\t6\t6\n7\t6\t5\t7\t6\t5\t5\t4\n5\t5\t4\t5\t5\t3\t3\t4\n7\t6\t5\t7\t7\t5\t7\t7\n6\t6\t4\t5\t3\t2\t3\t2\n4\t4\t3\t4\t2\t1\t1\t1\n7\t7\t7\t7\t7\t6\t6\t7\n3\t5\t5\t3\t5\t4\t4\t2\n3\t2\t2\t5\t2\t2\t2\t2\n7\t6\t4\t5\t7\t6\t7\t7\n4\t7\t4\t7\t7\t7\t7\t7\n5\t5\t4\t6\t5\t4\t4\t5\n5\t5\t5\t5\t5\t3\t3\t3\n5\t4\t3\t5\t3\t2\t3\t3\n5\t4\t5\t6\t5\t3\t5\t4\n6\t6\t4\t6\t5\t4\t3\t4\n4\t6\t5\t6\t6\t6\t4\t4\n6\t7\t3\t4\t4\t2\t3\t3\n5\t4\t4\t5\t6\t5\t5\t4\n7\t7\t7\t7\t7\t7\t7\t7\n4\t3\t3\t5\t6\t5\t5\t4\n5\t7\t4\t6\t5\t4\t4\t4\n6\t6\t6\t6\t6\t5\t5\t5\n5\t5\t4\t5\t5\t4\t4\t5\n6\t5\t4\t6\t5\t4\t4\t4\n6\t3\t3\t4\t5\t4\t4\t4\n6\t7\t6\t5\t3\t3\t2\t1\n5\t5\t4\t6\t6\t5\t5\t4\n4\t6\t5\t7\t7\t6\t7\t7\n5\t5\t3\t5\t4\t3\t4\t4\n6\t4\t5\t5\t5\t4\t3\t3\n6\t7\t6\t7\t5\t2\t6\t6\n4\t7\t5\t7\t5\t3\t4\t5\n5\t4\t4\t5\t3\t3\t3\t3\n6\t5\t5\t6\t5\t4\t5\t6\n5\t4\t5\t6\t4\t3\t3\t4\n4\t3\t3\t5\t5\t3\t4\t4\n4\t6\t4\t5\t4\t2\t2\t4\n6\t5\t4\t6\t6\t4\t4\t5\n6\t6\t4\t7\t3\t2\t2\t4\n5\t4\t6\t6\t4\t1\t4\t3\n4\t5\t5\t5\t3\t3\t3\t3\n4\t6\t4\t6\t4\t4\t4\t5\n4\t4\t4\t4\t4\t3\t3\t3\n5\t5\t5\t5\t4\t3\t3\t4\n7\t5\t5\t6\t6\t5\t4\t6\n6\t6\t5\t6\t7\t6\t6\t6\n6\t6\t6\t6\t5\t6\t6\t5\n7\t5\t6\t7\t6\t3\t5\t5\n6\t6\t4\t6\t5\t4\t5\t5\n6\t6\t4\t5\t5\t4\t4\t6\n5\t5\t4\t6\t2\t2\t2\t5\n6\t7\t4\t6\t4\t4\t3\t4\n5\t5\t4\t5\t4\t4\t4\t4\n6\t5\t3\t5\t4\t3\t6\t6\n3\t7\t2\t5\t6\t5\t4\t4\n2\t5\t5\t5\t4\t3\t3\t3\n7\t6\t5\t7\t7\t6\t7\t7\n6\t6\t6\t7\t6\t6\t7\t6\n5\t3\t4\t5\t6\t5\t5\t5\n5\t3\t3\t3\t7\t2\t2\t5\n5\t5\t4\t6\t6\t2\t5\t4\n7\t6\t5\t6\t7\t7\t7\t7\n7\t5\t7\t6\t3\t4\t2\t3\n5\t4\t5\t5\t6\t6\t6\t6\n4\t6\t3\t5\t5\t3\t3\t4\n5\t4\t4\t5\t6\t5\t5\t5\n6\t6\t6\t7\t6\t4\t4\t4\n5\t7\t5\t6\t7\t6\t6\t6\n5\t6\t4\t6\t5\t4\t4\t4\n5\t4\t4\t6\t4\t4\t4\t4\n6\t7\t5\t5\t4\t3\t3\t4\n4\t6\t6\t7\t6\t3\t3\t3\n5\t5\t5\t5\t5\t5\t5\t5\n6\t4\t5\t5\t6\t4\t4\t5\n6\t6\t6\t6\t6\t4\t5\t6\n7\t7\t7\t7\t7\t7\t7\t7\n5\t3\t4\t5\t5\t3\t4\t5",
mode="r", theme="cobalt"),
br(),
h3("Basic statistics"),
verbatimTextOutput("textarea.out"),
br(),
h3("Correlation"),
verbatimTextOutput("correl.out"),
br(),
strong("Scatter plot matrices"),
br(),
plotOutput("corPlot"),
br(),
h3("Scree plot"),
plotOutput(outputId ="makesPlot", width="80%"),
strong("Suggested number of factors"),
verbatimTextOutput("nf.out"),
br(),
br(),
h3("Specifying the number of factors"),
radioButtons("numfactor", strong("Number of factors:"),
list("Use the number of factors suggested by parallel analysis" = "parallel",
"Specify the number of factors" = "spec"), selected = "parallel"),
conditionalPanel(
condition = "input.numfactor == 'spec'",
numericInput("numspec", "Number of factors:", 3)
),
br(),
h3("Results of exploratory factor analysis"),
p("Maximum likelihood with promax rotation"),
verbatimTextOutput("efaresult.out"),
br(),
h3("Factor loadings plot (Factors 1 and 2)"),
#downloadButton('downloadPlot1', 'Download the plot as pdf'),
plotOutput("facPlot1", height = "600px"),
br(),
#downloadButton('downloadPlot2', 'Download the plot as pdf'),
plotOutput("facPlot2", height = "500px"),
br(),
br(),
strong('R session info'),
verbatimTextOutput("info.out")
),
tabPanel("About",
strong('Note'),
p('This web application is developed with',
a("Shiny.", href="http://www.rstudio.com/shiny/", target="_blank"),
''),
br(),
strong('List of Packages Used'), br(),
code('library(shiny)'),br(),
code('library(shinyAce)'),br(),
code('library(psych)'),br(),
br(),
strong('Code'),
p('Source code for this application is based on',
a('"The handbook of Research in Foreign Language Learning and Teaching" (Takeuchi & Mizumoto, 2012).', href='http://mizumot.com/handbook/', target="_blank")),
p('The code for this web application is available at',
a('GitHub.', href='https://github.com/mizumot/efa', target="_blank")),
p('If you want to run this code on your computer (in a local R session), run the code below:',
br(),
code('library(shiny)'),br(),
code('runGitHub("efa","mizumot")')
),
br(),
strong('Citation in Publications'),
p('Mizumoto, A. (2015). Langtest (Version 1.0) [Web application]. Retrieved from http://langtest.jp'),
br(),
strong('Article'),
p('Mizumoto, A., & Plonsky, L. (2015).', a("R as a lingua franca: Advantages of using R for quantitative research in applied linguistics.", href='http://applij.oxfordjournals.org/content/early/2015/06/24/applin.amv025.abstract', target="_blank"), em('Applied Linguistics,'), 'Advance online publication. doi:10.1093/applin/amv025'),
br(),
strong('Recommended'),
p('To learn more about R, I suggest this excellent and free e-book (pdf),',
a("A Guide to Doing Statistics in Second Language Research Using R,", href="http://cw.routledge.com/textbooks/9780805861853/guide-to-R.asp", target="_blank"),
'written by Dr. Jenifer Larson-Hall.'),
p('Also, if you are a cool Mac user and want to use R with GUI,',
a("MacR", href="https://sites.google.com/site/casualmacr/", target="_blank"),
'is defenitely the way to go!'),
br(),
strong('Author'),
p(a("Atsushi MIZUMOTO,", href="http://mizumot.com", target="_blank"),' Ph.D.',br(),
'Professor of Applied Linguistics',br(),
'Faculty of Foreign Language Studies /',br(),
'Graduate School of Foreign Language Education and Research,',br(),
'Kansai University, Osaka, Japan'),
br(),
a(img(src="http://i.creativecommons.org/p/mark/1.0/80x15.png"), target="_blank", href="http://creativecommons.org/publicdomain/mark/1.0/"),
p(br())
)
))
))
