Nothing
## ----preliminaries, echo=FALSE, results='hide'------------------------
library("knitr")
opts_chunk$set(highlight=FALSE, prompt=TRUE, background='#FFFFFF')
options(replace.assign=TRUE, width=72, prompt="R> ")
## ----setup, include=FALSE, cache=FALSE--------------------------------
render_sweave()
## ----intelligence, message=FALSE--------------------------------------
library("smacof")
idiss <- sim2diss(intelligence[,paste0("T", 1:8)])
fitrat <- mds(idiss)
fitint <- mds(idiss, type = "interval")
fitord <- mds(idiss, type = "ordinal")
fitspl <- mds(idiss, type = "mspline")
round(c(fitrat$stress, fitint$stress, fitord$stress, fitspl$stress), 3)
## ----shepard-plot, eval=FALSE, echo=FALSE-----------------------------
# op <- par(mfrow = c(2,2))
# plot(fitrat, plot.type = "Shepard", main = "Ratio MDS")
# plot(fitint, plot.type = "Shepard", main = "Interval MDS")
# plot(fitord, plot.type = "Shepard", main = "Ordinal MDS")
# plot(fitspl, plot.type = "Shepard", main = "Spline MDS")
# par(op)
## ----shepard-plot1, echo=FALSE, fig.width=8, fig.height=8, out.width='0.8\\textwidth'----
op <- par(mfrow = c(2,2))
plot(fitrat, plot.type = "Shepard", main = "Ratio MDS")
plot(fitint, plot.type = "Shepard", main = "Interval MDS")
plot(fitord, plot.type = "Shepard", main = "Ordinal MDS")
plot(fitspl, plot.type = "Shepard", main = "Spline MDS")
par(op)
## ----lawlerfit--------------------------------------------------------
WishD <- sim2diss(wish, method = 7)
fitWish <- mds(WishD)
## ----rstarts, cache=TRUE----------------------------------------------
set.seed(123)
stressvec <- rep(NA, 100)
fitbest <- mds(WishD, init = "random")
stressvec[1] <- fitbest$stress
for(i in 2:100) {
fitran <- mds(WishD, init = "random")
stressvec[i] <- fitran$stress
if (fitran$stress < fitbest$stress) fitbest <- fitran
}
round(fitbest$stress, 4)
## ----ic-plot, eval=FALSE----------------------------------------------
# set.seed(123)
# icWish <- icExplore(WishD, nrep = 100, returnfit = TRUE)
# plot(icWish, main = "IC Plot Wish")
## ----ic-plot1, echo=FALSE, cache=TRUE, out.width='0.7\\textwidth'-----
set.seed(123)
icWish <- icExplore(WishD, nrep = 100, returnfit = TRUE)
plot(icWish, main = "IC Plot Wish")
## ----lawler-----------------------------------------------------------
LawlerD <- sim2diss(Lawler, to.dist = TRUE)
fitLaw <- mds(LawlerD)
## ----rstress, cache=TRUE----------------------------------------------
set.seed(123)
rstress <- randomstress(n = 9, ndim = 2, nrep = 500, type = "ratio")
## ----mrstress---------------------------------------------------------
bound <- mean(rstress) - 2*sd(rstress)
round(bound, 3)
## ----permlaw, cache=TRUE----------------------------------------------
set.seed(123)
permLaw <- permtest(fitLaw, nrep = 500, verbose = FALSE)
permLaw
## ----wenmds-----------------------------------------------------------
data("Wenchuan", package = "MPsychoR")
Wdelta <- dist(t(Wenchuan))
fitWen <- mds(Wdelta, type = "interval")
round(fitWen$stress, 3)
## ----wenperm, cache=TRUE----------------------------------------------
set.seed(123)
permWen <- permtest(fitWen, data = Wenchuan, method.dat = "euclidean",
nrep = 1000, verbose = FALSE)
permWen
## ----wenperm-plot, eval=FALSE, echo = FALSE---------------------------
# op <- par(mfrow = c(1,2))
# plot(permWen, xlim = c(0.19, 0.30))
# perm5 <- quantile(permWen$stressvec, probs = 0.05)
# hist(permWen$stressvec, xlim = c(0.10, 0.40), xlab = "Stress Values",
# main = "Wenchuan Permutation Histogram")
# abline(v = perm5, lty = 2, col = "gray", lwd = 2)
# abline(v = fitWen$stress, col = "gray")
# par(op)
## ----wenperm-plot1, echo=FALSE, fig.width=12, fig.height=6------------
op <- par(mfrow = c(1,2))
plot(permWen, xlim = c(0.19, 0.30))
perm5 <- quantile(permWen$stressvec, probs = 0.05)
hist(permWen$stressvec, xlim = c(0.10, 0.40), xlab = "Stress Values",
main = "Wenchuan Permutation Histogram")
abline(v = perm5, lty = 2, col = "gray", lwd = 2)
abline(v = fitWen$stress, col = "gray")
par(op)
## ----jackmds----------------------------------------------------------
data("Rogers", package = "MPsychoR")
RogersSub <- Rogers[,1:16]
RogersD <- dist(t(RogersSub))
fitRogers <- mds(RogersD, type = "ordinal")
jackRogers <- jackmds(fitRogers)
jackRogers
## ----jack-plot, eval=FALSE--------------------------------------------
# plot(jackRogers, legend = TRUE, cex.legend = 0.8, inset = c(-0.3, 0))
## ----jack-plot1, echo=FALSE, out.width='0.8\\textwidth'---------------
plot(jackRogers, legend = TRUE, cex.legend = 0.8, inset = c(-0.3, 0))
## ----bootmds1, eval=FALSE---------------------------------------------
# set.seed(123)
# bootRogers <- bootmds(fitRogers, RogersSub, method.dat = "euclidean",
# nrep = 500)
# bootRogers
## ----boot-plot, eval=FALSE--------------------------------------------
# plot(bootRogers)
## ----boot-plot1, echo=FALSE, out.width='0.7\\textwidth'---------------
plot(bootRogers)
## ----confmds----------------------------------------------------------
fitRogers2 <- mds(RogersD)
confRogers <- confEllipse(fitRogers2)
## ----cell-plot, eval=FALSE--------------------------------------------
# plot(confRogers, eps = 0.01, ylim = c(-0.11, 0.11),
# ell = list(lty = 1, col = "gray"))
## ----cell-plot1, echo=FALSE, out.width='0.7\\textwidth'---------------
plot(confRogers, eps = 0.01, ylim = c(-0.11, 0.11),
ell = list(lty = 1, col = "gray"))
## ----simplebi---------------------------------------------------------
fitFace <- mds(FaceExp, type = "ordinal")
ext <- data.frame(PU = FaceScale[,1])
biFace <- biplotmds(fitFace, extvar = ext)
coef(biFace)
## ----biaxprep---------------------------------------------------------
library("calibrate")
biFace2 <- biplotmds(fitFace, extvar = ext, scale = FALSE)
coef(biFace2)
PUc <- scale(ext, scale = FALSE)
tm <- seq(floor(min(ext)), ceiling(max(ext)), by = 1)
tmc_PU <- tm - mean(tm)
X <- fitFace$conf
## ----simplebi-plot, eval=FALSE----------------------------------------
# plot(biFace, main = "Biplot Vector Representation", vecscale = 0.8,
# xlim = c(-1.5, 1.5), vec.conf = list(col = "brown"), pch = 20, cex = 0.5)
# plot(fitFace, main = "Biplot Axis Representation", xlim = c(-1.5, 1.5))
# abline(h = 0, v = 0, lty = 2, col = "gray")
# calPU <- calibrate(coef(biFace2), PUc, tm = tmc_PU, tmlab = tm, Fr = X,
# dp = TRUE, axiscol = "brown", axislab = "PU", labpos = 3, verb = FALSE)
## ----simplebi-plot1, echo=FALSE, message=FALSE, out.width='0.6\\textwidth'----
plot(biFace, main = "Biplot Vector Representation", vecscale = 0.8,
xlim = c(-1.5, 1.5), vec.conf = list(col = "brown"), pch = 20, cex = 0.5)
plot(fitFace, main = "Biplot Axis Representation", xlim = c(-1.5, 1.5))
abline(h = 0, v = 0, lty = 2, col = "gray")
calPU <- calibrate(coef(biFace2), PUc, tm = tmc_PU, tmlab = tm, Fr = X,
dp = TRUE, axiscol = "brown", axislab = "PU", labpos = 3, verb = FALSE)
## ----neuralbi---------------------------------------------------------
library("MPsychoR")
data("NeuralActivity")
data("NeuralScales")
NeuralD <- Reduce("+", NeuralActivity)/length(NeuralActivity)
fitNeural <- mds(NeuralD, type = "mspline")
biNeural <- biplotmds(fitNeural, NeuralScales[,1:8])
round(biNeural$R2vec, 3)
## ----neuralbi-plot, eval=FALSE, echo=FALSE----------------------------
# plot(biNeural, col = "gray", label.conf = list(col = "gray", cex = 0.7),
# vec.conf = list(col = "brown"), main = "Neural Biplot",
# xlim = c(-1.55, 1.55), ylim = c(-1.55, 1.55))
## ----neuralbi-plot1, echo=FALSE, out.width='0.7\\textwidth'-----------
plot(biNeural, col = "gray", label.conf = list(col = "gray", cex = 0.7),
vec.conf = list(col = "brown"), main = "Neural Biplot",
xlim = c(-1.55, 1.55), ylim = c(-1.55, 1.55))
## ----facecons_int-----------------------------------------------------
fitFace <- mds(FaceExp, type = "ordinal")
Z <- FaceScale[, c(1,3)]
fitFaceC1 <- smacofConstraint(FaceExp, type = "ordinal",
constraint = "diagonal", external = Z, constraint.type = "interval",
init = fitFace$conf)
round(fitFaceC1$C, 3)
## ----faceint-plot, eval=FALSE, echo=FALSE-----------------------------
# Zc <- scale(Z, scale = FALSE)
# X1 <- fitFaceC1$conf
# tm <- seq(1, 9, by = 1)
# tmc_PU <- tm - mean(Z[,1])
# tmc_TS <- tm - mean(Z[,2])
# op <- par("xpd" = TRUE, mar = c(5, 4, 7, 5) + 0.1)
# plot(fitFaceC1, main = "Constrained MDS (Interval)", xlim = c(-1.4, 1.4), ylim = c(-1, 1))
# calPU <- calibrate(c(1,0), Zc[,"PU"], tm = tmc_PU, tmlab = tm, Fr = X1, dp = FALSE,
# axiscol = "brown", axislab = "PU", labpos = 3, verb = FALSE, shiftvec = c(0, par("usr")[4]),
# shiftfactor = 1, where = 2, laboffset = c(-0.2, 0.15), cex.axislab = 0.9, reverse = TRUE)
# calTS <- calibrate(c(0,1), Zc[,"TS"], tm = tmc_TS, tmlab = tm, Fr = X1, dp = FALSE,
# axiscol = "brown", axislab = "TS", labpos = 3, verb = FALSE, shiftvec = c(par("usr")[2], 0),
# shiftfactor = 1, where = 2, laboffset = c(0.2, -0.25), cex.axislab = 0.9)
# par(op)
## ----faceint-plot1, echo=FALSE, out.width='0.65\\textwidth'-----------
Zc <- scale(Z, scale = FALSE)
X1 <- fitFaceC1$conf
tm <- seq(1, 9, by = 1)
tmc_PU <- tm - mean(Z[,1])
tmc_TS <- tm - mean(Z[,2])
op <- par("xpd" = TRUE, mar = c(5, 4, 7, 5) + 0.1)
plot(fitFaceC1, main = "Constrained MDS (Interval)", xlim = c(-1.4, 1.4), ylim = c(-1, 1))
calPU <- calibrate(c(1,0), Zc[,"PU"], tm = tmc_PU, tmlab = tm, Fr = X1, dp = FALSE,
axiscol = "brown", axislab = "PU", labpos = 3, verb = FALSE, shiftvec = c(0, par("usr")[4]),
shiftfactor = 1, where = 2, laboffset = c(-0.2, 0.15), cex.axislab = 0.9, reverse = TRUE)
calTS <- calibrate(c(0,1), Zc[,"TS"], tm = tmc_TS, tmlab = tm, Fr = X1, dp = FALSE,
axiscol = "brown", axislab = "TS", labpos = 3, verb = FALSE, shiftvec = c(par("usr")[2], 0),
shiftfactor = 1, where = 2, laboffset = c(0.2, -0.25), cex.axislab = 0.9)
par(op)
## ----fitface_ord------------------------------------------------------
fitFaceC2 <- smacofConstraint(FaceExp, type = "ordinal",
constraint = "diagonal", external = Z, constraint.type = "ordinal",
init = fitFace$conf)
round(fitFaceC2$C, 3)
## ----trafo-plot, eval=FALSE, echo=FALSE-------------------------------
# op <- par(mfrow = c(1,2))
# ind1 <- order(Z[,1])
# plot(Z[ind1, 1], fitFaceC2$external[ind1, 1], type = "s", lwd = 2,
# xlab = "Original Scale", ylab = "Transformed Scale",
# main = "Pleasant-Unpleasant Transformation")
# ind2 <- order(Z[,2])
# plot(Z[ind2, 2], fitFaceC2$external[ind2, 2], type = "s", lwd = 2,
# xlab = "Original Scale", ylab = "Transformed Scale",
# main = "Tension-Sleep Transformation")
# par(op)
## ----trafo-plot1, echo=FALSE, fig.width = 12, fig.height = 5----------
op <- par(mfrow = c(1,2))
ind1 <- order(Z[,1])
plot(Z[ind1, 1], fitFaceC2$external[ind1, 1], type = "s", lwd = 2,
xlab = "Original Scale", ylab = "Transformed Scale",
main = "Pleasant-Unpleasant Transformation")
ind2 <- order(Z[,2])
plot(Z[ind2, 2], fitFaceC2$external[ind2, 2], type = "s", lwd = 2,
xlab = "Original Scale", ylab = "Transformed Scale",
main = "Tension-Sleep Transformation")
par(op)
## ----faceord-plot, eval=FALSE, echo=FALSE-----------------------------
# X2 <- fitFaceC2$conf
# Zhat <- fitFaceC2$external
# tm <- seq(-0.8, 0.8, by = 0.2)
# op <- par("xpd" = TRUE, mar = c(5, 4, 7, 5) + 0.1)
# plot(fitFaceC2, main = "Constrained MDS (Ordinal)", xlim = c(-1.4, 1.4), ylim = c(-1, 1))
# calPU <- calibrate(c(1,0), Zhat[,"PU"], tm = tm, tmlab = tm, Fr = X2, dp = FALSE,
# axiscol = "brown", axislab = "PU transformed", labpos = 3, verb = FALSE, shiftvec = c(0, par("usr")[4]),
# shiftfactor = 1, where = 2, laboffset = c(-0.2, 0.15), cex.axislab = 0.9, reverse = TRUE)
# calPU <- calibrate(c(0,1), Zhat[,"TS"], tm = tm, tmlab = tm, Fr = X2, dp = FALSE,
# axiscol = "brown", axislab = "TS transformed", labpos = 3, verb = FALSE, shiftvec = c(par("usr")[2], 0),
# shiftfactor = 1, where = 2, laboffset = c(0.25, -0.2), cex.axislab = 0.9)
# par(op)
## ----faceord-plot1, echo=FALSE, out.width='0.65\\textwidth'-----------
X2 <- fitFaceC2$conf
Zhat <- fitFaceC2$external
tm <- seq(-0.8, 0.8, by = 0.2)
op <- par("xpd" = TRUE, mar = c(5, 4, 7, 5) + 0.1)
plot(fitFaceC2, main = "Constrained MDS (Ordinal)", xlim = c(-1.4, 1.4), ylim = c(-1, 1))
calPU <- calibrate(c(1,0), Zhat[,"PU"], tm = tm, tmlab = tm, Fr = X2, dp = FALSE,
axiscol = "brown", axislab = "PU transformed", labpos = 3, verb = FALSE, shiftvec = c(0, par("usr")[4]),
shiftfactor = 1, where = 2, laboffset = c(-0.2, 0.15), cex.axislab = 0.9, reverse = TRUE)
calPU <- calibrate(c(0,1), Zhat[,"TS"], tm = tm, tmlab = tm, Fr = X2, dp = FALSE,
axiscol = "brown", axislab = "TS transformed", labpos = 3, verb = FALSE, shiftvec = c(par("usr")[2], 0),
shiftfactor = 1, where = 2, laboffset = c(0.25, -0.2), cex.axislab = 0.9)
par(op)
## ----face2b-----------------------------------------------------------
Z <- FaceScale
fitFaceC3 <- smacofConstraint(FaceExp, type = "ordinal",
constraint = "unrestricted", external = Z, constraint.type = "interval",
init = fitFace$conf)
round(fitFaceC3$C, 3)
## ----face2-plot, eval=FALSE, echo=FALSE-------------------------------
# Zc <- scale(Z, scale = FALSE)
# X <- fitFaceC3$conf
# biFaceZ <- biplotmds(fitFaceC3, extvar = Z, scale = FALSE)
# betas <- coef(biFaceZ)
# tm <- seq(1, 9, by = 1)
# tmc_PU <- tm - mean(Z[,1])
# tmc_AR <- tm - mean(Z[,2])
# tmc_TS <- tm - mean(Z[,3])
# plot(fitFaceC3, main = "Constraint MDS Biplot", xlim = c(-1.3, 1.3), ylim = c(-1, 1))
# abline(h = 0, v = 0, lty = 2, col = "gray")
# calPU <- calibrate(betas[,"PU"], Zc[,"PU"], tm = tmc_PU, tmlab = tm, Fr = X,
# dp = FALSE, axiscol = "brown", axislab = "PU", labpos = 3, verb = FALSE)
# calAR <- calibrate(betas[,"AR"], Zc[,"AR"], tm = tmc_AR, tmlab = tm, Fr = X,
# dp = FALSE, axiscol = "brown", axislab = "AR", labpos = 3, verb = FALSE)
# calTS <- calibrate(betas[,"TS"], Zc[,"TS"], tm = tmc_TS, tmlab = tm, Fr = X,
# dp = FALSE, axiscol = "brown", axislab = "TS", labpos = 3, verb = FALSE)
## ----face2-plot1, echo=FALSE, out.width='0.7\\textwidth'--------------
Zc <- scale(Z, scale = FALSE)
X <- fitFaceC3$conf
biFaceZ <- biplotmds(fitFaceC3, extvar = Z, scale = FALSE)
betas <- coef(biFaceZ)
tm <- seq(1, 9, by = 1)
tmc_PU <- tm - mean(Z[,1])
tmc_AR <- tm - mean(Z[,2])
tmc_TS <- tm - mean(Z[,3])
plot(fitFaceC3, main = "Constraint MDS Biplot", xlim = c(-1.3, 1.3), ylim = c(-1, 1))
abline(h = 0, v = 0, lty = 2, col = "gray")
calPU <- calibrate(betas[,"PU"], Zc[,"PU"], tm = tmc_PU, tmlab = tm, Fr = X,
dp = FALSE, axiscol = "brown", axislab = "PU", labpos = 3, verb = FALSE)
calAR <- calibrate(betas[,"AR"], Zc[,"AR"], tm = tmc_AR, tmlab = tm, Fr = X,
dp = FALSE, axiscol = "brown", axislab = "AR", labpos = 3, verb = FALSE)
calTS <- calibrate(betas[,"TS"], Zc[,"TS"], tm = tmc_TS, tmlab = tm, Fr = X,
dp = FALSE, axiscol = "brown", axislab = "TS", labpos = 3, verb = FALSE)
## ----carconf, message=FALSE-------------------------------------------
library("prefmod")
carconf1 <- carconf[1:100, 1:6]
head(carconf1)
## ----ordinal-unfolding------------------------------------------------
unf_ord <- unfolding(carconf1, type = "ordinal")
unf_ord
## ----carunf-plot, eval=FALSE, echo=2:5--------------------------------
# op <- par(mfrow = c(1,2))
# plot(unf_ord, main = "Unfolding Configuration Car Preferences",
# ylim = c(-1, 1))
# plot(unf_ord, plot.type = "Shepard",
# main = "Shepard Diagram Car Preferences")
# par(op)
## ----carunf-plot1, echo=FALSE, fig.width=12, fig.height=6-------------
op <- par(mfrow = c(1,2))
plot(unf_ord, main = "Unfolding Configuration Car Preferences",
ylim = c(-1, 1))
plot(unf_ord, plot.type = "Shepard",
main = "Shepard Diagram Car Preferences")
par(op)
## ----row-unfolding, cache = TRUE--------------------------------------
startconf <- list(unf_ord$conf.row, unf_ord$conf.col)
unf_cond <- unfolding(carconf1, type = "ordinal", conditionality = "row",
eps = 6e-5, init = startconf)
unf_cond
## ----condunf-plot, eval=FALSE, echo=2:5-------------------------------
# op <- par(mfrow = c(1,2))
# plot(unf_cond, main = "Conditional Unfolding Configuration Car Preferences")
# plot(unf_cond, plot.type = "Shepard",
# main = "Shepard Diagram Car Preferences", col.dhat = "gray",
# xlim = c(0.9, 6.1))
# par(op)
## ----condunf-plot1, echo=FALSE, fig.width=12, fig.height=6------------
op <- par(mfrow = c(1,2))
plot(unf_cond, main = "Conditional Unfolding Configuration Car Preferences")
plot(unf_cond, plot.type = "Shepard",
main = "Shepard Diagram Car Preferences", col.dhat = "gray",
xlim = c(0.9, 6.1))
par(op)
## ----valcirc----------------------------------------------------------
tuv <- matrix(NA, nrow = ncol(PVQ40agg), ncol = 2)
alpha <- -360/10
for (i in 1:10){
alpha <- alpha+360/10
tuv[i,1] <- cos(alpha*pi/180)
tuv[i,2] <- sin(alpha*pi/180)
}
## ----extunf-----------------------------------------------------------
delta <- (max(PVQ40agg) + 1) - PVQ40agg
unf_pvq <- unfolding(delta, type = "ordinal")
unf_pvqext <- unfolding(delta, type = "ordinal", fixed = "column",
fixed.coord = tuv)
## ----unfext-plot1, echo=FALSE, message=FALSE, fig.width=12, fig.height=6----
op <- par(mfrow = c(1,2))
plot(unf_pvq, label.conf.columns = list(cex = 1), ylim = c(-1.1, 1.1), main = "PVQ Unrestricted")
plot(unf_pvqext, label.conf.columns = list(cex = 1), ylim = c(-1.1, 1.1), main = "PVQ Fixed Value Circle")
par(op)
## ----unfcircle, cache=TRUE--------------------------------------------
unf_vals <- unfolding(indvalues)
unf_valsc <- unfolding(indvalues, circle = "column")
## ----schwartzcir-plot, eval=FALSE, echo=FALSE-------------------------
# op <- par(mfrow = c(1,2))
# plot(unf_vals, main = "Values Unfolding Configuration (Unrestricted)", ylim = c(-1.5, 1.1))
# abline(h = 0, v = 0, col = "gray", lty = 2)
# plot(unf_valsc, main = "Values Unfolding Configuration (Circular Restriction)", ylim = c(-1.5, 1.1))
# abline(h = 0, v = 0, col = "gray", lty = 2)
# rad <- sqrt(sum(unf_valsc$conf.col[1,]^2))
# draw.circle(0, 0, radius = rad, border = "cadetblue", lty = 2)
# par(op)
## ----schwartzcir-plot1, echo=FALSE, message=FALSE, fig.width=12, fig.height=6----
op <- par(mfrow = c(1,2))
plot(unf_vals, main = "Values Unfolding Configuration (Unrestricted)", ylim = c(-1.5, 1.1))
abline(h = 0, v = 0, col = "gray", lty = 2)
plot(unf_valsc, main = "Values Unfolding Configuration (Circular Restriction)", ylim = c(-1.5, 1.1))
abline(h = 0, v = 0, col = "gray", lty = 2)
rad <- sqrt(sum(unf_valsc$conf.col[1,]^2))
draw.circle(0, 0, radius = rad, border = "cadetblue", lty = 2)
par(op)
## ----vmu--------------------------------------------------------------
fit_vmu <- vmu(PVQ40agg)
fit_vmu
## ----vmubi-plot, eval=FALSE-------------------------------------------
# plot(fit_vmu, col = c("black", "coral3"), cex = c(1, 0.7))
## ----vmubi-plot1, echo=FALSE, message=FALSE, out.width='0.7\\textwidth'----
plot(fit_vmu, col = c("black", "coral3"), cex = c(1, 0.7))
## ----plato------------------------------------------------------------
PlatoD <- dist(t(Plato7))
fitPlato <- uniscale(PlatoD, verbose = FALSE)
round(sort(fitPlato$conf), 3)
## ---------------------------------------------------------------------
gopD <- gravity(GOPdtm)$gravdiss
## ----gravity-plot, eval=FALSE-----------------------------------------
# fitGOP <- mds(gopD, type = "ordinal")
# plot(fitGOP, plot.type = "bubbleplot", bubscale = 20)
## ----gravity-plot1, echo=FALSE, out.width='0.7\\textwidth'------------
fitGOP <- mds(gopD, type = "ordinal")
plot(fitGOP, plot.type = "bubbleplot", bubscale = 20)
## ----drift-plot, eval=FALSE-------------------------------------------
# morseDrift <- driftVectors(morse2, type = "ordinal")
# plot(morseDrift, main = "Drift Vectors Morse Codes",
# col.drift = "darkgray")
## ----drift-plot1, echo=FALSE, out.width='0.7\\textwidth'--------------
morseDrift <- driftVectors(morse2, type = "ordinal")
plot(morseDrift, main = "Drift Vectors Morse Codes",
col.drift = "darkgray")
## ----maryam-----------------------------------------------------------
artD <- sim2diss(VaziriXu$artificialR)
fitart <- mds(artD, type = "ordinal")
realD <- sim2diss(VaziriXu$realR)
fitnat <- mds(realD, type = "ordinal")
## ----maryam-plot, echo=FALSE, eval=FALSE------------------------------
# op <- par(mfrow = c(1,2))
# plot(fitart, main = "Configuration Artificial")
# plot(fitnat, main = "Configuration Natural")
# par(op)
## ----maryam-plot1, echo=FALSE, fig.width=12, fig.height=6-------------
op <- par(mfrow = c(1,2))
plot(fitart, main = "Configuration Artificial")
plot(fitnat, main = "Configuration Natural")
par(op)
## ----procnat----------------------------------------------------------
fitproc <- Procrustes(fitart$conf, fitnat$conf)
fitproc
## ----proc-plot, eval=FALSE--------------------------------------------
# plot(fitproc, legend = list(labels = c("artificial", "natural")))
## ----proc-plot1, echo=FALSE, out.width='0.6\\textwidth'---------------
plot(fitproc, legend = list(labels = c("artificial", "natural")))
## ----stress0----------------------------------------------------------
stress0(rectangles, init = rect_constr)$stress
## ----proc2-plot, eval=FALSE, echo=TRUE--------------------------------
# fitrect <- mds(rectangles, type = "ordinal", init = rect_constr)
# procRect <- Procrustes(rect_constr, fitrect$conf)
# plot(procRect, legend = list(labels = c("theoretical", "observed")),
# xlim = c(2, 7))
## ----proc2-plot1, echo=FALSE, out.width='0.6\\textwidth'--------------
fitrect <- mds(rectangles, type = "ordinal", init = rect_constr)
procRect <- Procrustes(rect_constr, fitrect$conf)
plot(procRect, legend = list(labels = c("theoretical", "observed")),
xlim = c(2, 7))
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.