
<style>
body {
  width: 600px;
}
</style>

```{r echo=FALSE, message=FALSE, warnings=FALSE}
opts_chunk$set(echo = FALSE, messages = FALSE, 
               fig.height = 6, fig.width = 6)
```

# Austrian national guest survey

```{r results='hide', message=FALSE, warning=FALSE, error=FALSE}
source("helpers.R")
```

This document reproduces the example "Austrian national guest survey"
presented in the paper "[Probabilistic archetypal analysis](http://arxiv.org/abs/1312.7604)" by Seth and Eugster (2014). The [Rmd file](GSAW97-report.Rmd) lists the 
corresponding [R](http://www.r-project.org) code.


```{r results='asis'}
cat("* Read tourist data from file `GSAW97_bin.csv`\n")
GSAW97bin <- read.csv2("data_GSAW97/GSAW97_bin.csv")

cat("* Load precomputed PAA solution from file `GSAW97_paa.mat`\n")
paa <- load_paa("data_GSAW97/GSAW97_paa.mat", GSAW97bin)
```


#### Cost plot:

```{r fig.height=4}
op <- par(mar = c(4, 4, 1, 1))
plot(paa$obj, type = "l", xlab = "Iterations", ylab = "Cost")
par(op)
```


#### Archetypal winter tourist profiles:

```{r results='asis'}
colnames(paa$Z) <- c("Maximal", "Cultural", "Minimal", "Modern", "Traditional", "Wellness")

print(xtable(paa$Z[, c(1, 3, 5, 4, 6, 2)]), type = "html")
```


#### Simplex visulation showing the model deviance:

```{r}
## Color coding:
dev <- bernoulli_deviance(paa, GSAW97bin)

val <- (dev / max(dev))
val <- (1 - (exp(-val*2)))/(1-exp(-2))
ci <- classIntervals(val, style = "pretty", n = 10)
point_cols <- findColours(ci, sequential_hcl(11))


## Simplex plot:
op <- par(mar = c(1.5, 1.5, 1.5, 1.5), xpd = TRUE)

set.seed(1239)
s <- simplexplot_paa(paa, show_direction = TRUE, direction_length = 1,
  show_circle = FALSE, show_points = FALSE, directions_col = point_cols,
  projection = tspsimplex_projection, show_edges = FALSE, 
  labels = colnames(paa$Z))

legend("topleft",  fill = attr(point_cols, "palette"), 
       border = attr(point_cols, "palette"), bg = "white", horiz = FALSE,
       legend = names(attr(point_cols, "table")), cex = 1, box.lwd = NA)

par(op)
```


#### Simplex visualization show the Shopping variable:

```{r}
var_cod <- c(Yes = "black", No = "lightgray")

## Color coding:
var <- "Shopping"
point_cols <- GSAW97bin[, grepl(tolower(var), colnames(GSAW97bin))]


## Simplex plot:
op <- par(mar = c(1.5, 1.5, 1.5, 1.5), xpd = TRUE)

set.seed(1239)
s <- simplexplot_paa(paa, show_direction = FALSE, 
  show_circle = FALSE, show_points = FALSE,
  projection = tspsimplex_projection, show_edges = FALSE, 
  labels = colnames(paa$Z))

points(s$proj_h[point_cols == 0, ], col = var_cod["No"], pch = 19, cex = 0.5)
points(s$proj_h[point_cols == 1, ], col = var_cod["Yes"], pch = 19, cex = 0.5)

legend("topleft", fill = var_cod, border = var_cod, title = var, 
       legend = names(var_cod), bg = "white", horiz = FALSE, cex = 1,
       box.lwd = NA)

par(op)
```


#### Simplex visualization showing the Snowboard variable:

```{r}
## Color coding:
var <- "Snowboard"

point_cols <- GSAW97bin[, grepl(tolower(var), colnames(GSAW97bin))]


## Simplex plot:
op <- par(mar = c(1.5, 1.5, 1.5, 1.5), xpd = TRUE)

set.seed(1239)
s <- simplexplot_paa(paa, show_direction = FALSE, 
  show_circle = FALSE, show_points = FALSE,
  projection = tspsimplex_projection, show_edges = FALSE, 
  labels = colnames(paa$Z))

points(s$proj_h[point_cols == 0, ], col = var_cod["No"], pch = 19, cex = 0.5)
points(s$proj_h[point_cols == 1, ], col = var_cod["Yes"], pch = 19, cex = 0.5)

legend("topleft", fill = var_cod, border = var_cod, title = var, 
       legend = names(var_cod), bg = "white", horiz = FALSE, cex = 1,
       box.lwd = NA)

par(op)
```


#### Simplex visualization showing the Museum variable:

```{r}
## Color coding:
var <- "Museum"
point_cols <- GSAW97bin[, grepl(tolower(var), colnames(GSAW97bin))]


## Simplex plot:
op <- par(mar = c(1.5, 1.5, 1.5, 1.5), xpd = TRUE)

set.seed(1239)
s <- simplexplot_paa(paa, show_direction = FALSE, 
  show_circle = FALSE, show_points = FALSE,
  projection = tspsimplex_projection, show_edges = FALSE, 
  labels = colnames(paa$Z))

points(s$proj_h[point_cols == 0, ], col = var_cod["No"], pch = 19, cex = 0.5)
points(s$proj_h[point_cols == 1, ], col = var_cod["Yes"], pch = 19, cex = 0.5)

legend("topleft", fill = var_cod, border = var_cod, title = var, 
       legend = names(var_cod), bg = "white", horiz = FALSE, cex = 1,
       box.lwd = NA)

par(op)
```

