Here are a couple of examples from DDAR, trying to use the seriation
package for reordering rows and columns of frequency tables to make
mosaic displays more coherent.
The idea is pretty simple, but I’m looking for some technique that
can be used semi-automatically to permute rows/cols by CA dimensions in
the vcd package or
vcdExtra
This document tests some recent additions to seriation
in Version 1.3.6.9000, installed using
install.packages("seriation", repos = "https://mhahsler.r-universe.dev")
Packages
library(seriation)
library(vcd)
library(vcdExtra)
library(ca)
Hair color, eye color data
Only use hair color and eye color here
data("HairEyeColor")
haireye <- margin.table(HairEyeColor, 1:2)
Mosaic of the original table
The order of the eye colors doesn’t permit an understanding of an
overall pattern of association.
mosaic(haireye, shade=TRUE, legend=FALSE)

Show correspondence analysis
It’s clear that both variables are ordered on Dim 1,
and the nature of association is that light eyes are
associated with light hair and vice versa.
haireye.ca <- ca(haireye)
plot(haireye.ca, lines = TRUE)

Try to use seriation for this.
The goal here is to find a **simple* interface to
seriation that could be used in the vcd or
vcdExtra package to make it easier to permute the table
being plotted by mosaic().
seriate() finds an order based on the CA dim=1, which is
fine here, and usually enough.
(NB: in other cases, we might want to seriate along CA
dim=2, but I don’t know how to do this. There is some
buried option, also used in the seriate PCA method to use
the 2nd dimension.
order <- seriate(haireye, method = "CA")
Actual permutation is done by permute(). But sadly,
permute() only allows one margin :( Would be easier if I
could use margin = 1:2.
permute(haireye, order, margin=1)
Eye
Hair Brown Blue Hazel Green
Black 68 20 15 5
Brown 119 84 54 29
Red 26 17 14 14
Blond 7 94 10 16
permute(haireye, order, margin=2)
Eye
Hair Brown Hazel Green Blue
Black 68 15 5 20
Brown 119 54 29 84
Red 26 14 14 17
Blond 7 10 16 94
To do both, without looking at the plot, need to extract the orders
for the two margins, confusingly also called dim=.
o1 <- get_order(order, dim=1)
o2 <- get_order(order, dim=2)
haireye[o1, o2]
Eye
Hair Brown Hazel Green Blue
Black 68 15 5 20
Brown 119 54 29 84
Red 26 14 14 17
Blond 7 10 16 94
Mosaic of the permuted table
The trick that works is to index the table by [o1, o2]
The difference here is subtle; it was only the eye colors that needed to
be permuted.
mosaic(haireye[o1, o2], shade=TRUE, legend=FALSE)

Mental impairment data
Maybe a better test case for this. Take something simple, make it
more complicated, see whether/how seriate can help.
data(Mental, package = "vcdExtra")
str(Mental)
'data.frame': 24 obs. of 3 variables:
$ ses : Ord.factor w/ 6 levels "1"<"2"<"3"<"4"<..: 1 1 1 1 2 2 2 2 3 3 ...
$ mental: Ord.factor w/ 4 levels "Well"<"Mild"<..: 1 2 3 4 1 2 3 4 1 2 ...
$ Freq : int 64 94 58 46 57 94 54 40 57 105 ...
mental and ses were created as ordered
factors. For this example, unorder them: mental: alphabetically; ses:
random permutation
set.seed(1234)
Mental$mental <- factor(Mental$mental, levels = sort(levels(Mental$mental)))
Mental$ses <- factor(Mental$ses, levels = sample(levels(Mental$ses)))
mental.tab <- xtabs(Freq ~ ses + mental, data=Mental)
Initial mosaic
mosaic(mental.tab, shade=TRUE, legend=FALSE)

CA
ca() uncovers the true ordering
mental.ca <- ca(mental.tab)
plot(mental.ca, lines = TRUE)

Use seriate to get this
order <- seriate(mental.tab, method = "CA")
o1 <- get_order(order, dim=1)
o2 <- get_order(order, dim=2)
Mosaic of permuted table
mosaic(mental.tab[o1, o2], shade=TRUE, legend = FALSE)

Using the latest version of permute
Michael Hahsler updated permute() to allow specifying
margin=1:2 to permute both dimensions in a single call.
See: https://github.com/mhahsler/seriation/issues/17#issuecomment-1280091881
hec_perm <- permute(haireye, "CA", margin = 1:2)
mosaic(hec_perm, shade=TRUE, legend=FALSE)

mental.tab <- permute(mental.tab, "CA") # margin=1:2 is the default
mosaic(mental.tab, shade=TRUE, legend = FALSE)

Summary
seriation::seriate() has the infrastructure for a wide
range of seriation tasks, but initially seemed overly complex for the
application to frequency tables using CA with a goal of incorporating in
vcd:mosaic().
The latest version, with the change to permute() is now
something that can be easily used.
Some questions:
- There are cases where one might want to permute the rows/cols
according to the CA 2nd dimension. Is this possible?
IycgLS0tDQojJyB0aXRsZTogVGVzdCBvcmRlcmluZyBvZiBmcmVxdWVuY3kgdGFibGVzIHVzaW5nIHNlcmlhdGlvbiBwYWNrYWdlDQojJyBhdXRob3I6IE1pY2hhZWwgRnJpZW5kbHkNCiMnIGRhdGU6ICJgciBmb3JtYXQoU3lzLkRhdGUoKSlgIg0KIycgb3V0cHV0Og0KIycgICBodG1sX2RvY3VtZW50Og0KIycgICAgIHRoZW1lOiByZWFkYWJsZQ0KIycgICAgIGNvZGVfZG93bmxvYWQ6IHRydWUNCiMnIC0tLQ0KIycgDQojJyBIZXJlIGFyZSBhIGNvdXBsZSBvZiBleGFtcGxlcyBmcm9tIFtEREFSXShodHRwOi8vZGRhci5kYXRhdmlzLmNhL3BhZ2VzL2hvbWUpLCB0cnlpbmcgdG8gdXNlIHRoZSBbc2VyaWF0aW9uIHBhY2thZ2VdKGh0dHBzOi8vY3Jhbi5yLXByb2plY3Qub3JnL3BhY2thZ2U9c2VyaWF0aW9uKSBmb3IgcmVvcmRlcmluZyByb3dzIGFuZCBjb2x1bW5zDQojJyBvZiBmcmVxdWVuY3kgdGFibGVzIHRvIG1ha2UgbW9zYWljIGRpc3BsYXlzIG1vcmUgY29oZXJlbnQuIA0KIycgDQojJyBUaGUgaWRlYSBpcyBwcmV0dHkgc2ltcGxlLCBidXQgSSdtDQojJyBsb29raW5nIGZvciBzb21lIHRlY2huaXF1ZSB0aGF0IGNhbiBiZSB1c2VkIHNlbWktYXV0b21hdGljYWxseSB0byBwZXJtdXRlIHJvd3MvY29scyBieSBDQSBkaW1lbnNpb25zDQojJyBpbiB0aGUgW3ZjZCBwYWNrYWdlXShodHRwczovL2NyYW4uci1wcm9qZWN0Lm9yZy9wYWNrYWdlPXZjZCkgb3IgW3ZjZEV4dHJhXShodHRwczovL2NyYW4uci1wcm9qZWN0Lm9yZy9wYWNrYWdlPXZjZEV4dHJhKQ0KIycgDQojJyBUaGlzIGRvY3VtZW50IHRlc3RzIHNvbWUgcmVjZW50IGFkZGl0aW9ucyB0byBgc2VyaWF0aW9uYCBpbiBWZXJzaW9uIGByIHBhY2thZ2VWZXJzaW9uKCJzZXJpYXRpb24iKWAsDQojJyBpbnN0YWxsZWQgdXNpbmcgDQojJyANCiMnICAgICAgaW5zdGFsbC5wYWNrYWdlcygic2VyaWF0aW9uIiwgcmVwb3MgPSAiaHR0cHM6Ly9taGFoc2xlci5yLXVuaXZlcnNlLmRldiIpDQojJyANCg0KIysgc2V0dXAsIGluY2x1ZGU9RkFMU0UNCmtuaXRyOjpvcHRzX2NodW5rJHNldChtZXNzYWdlPUZBTFNFLCBlcnJvcj1UUlVFLCB3YXJuaW5nPUZBTFNFLCBjb21tZW50PU5BKQ0Kb3B0aW9ucyh3aWR0aD0xMDApDQoNCiMnIFBhY2thZ2VzDQpsaWJyYXJ5KHNlcmlhdGlvbikNCmxpYnJhcnkodmNkKQ0KbGlicmFyeSh2Y2RFeHRyYSkNCmxpYnJhcnkoY2EpDQoNCiMnICMjIEhhaXIgY29sb3IsIGV5ZSBjb2xvciBkYXRhDQojJyBPbmx5IHVzZSBoYWlyIGNvbG9yIGFuZCBleWUgY29sb3IgaGVyZQ0KZGF0YSgiSGFpckV5ZUNvbG9yIikNCmhhaXJleWUgPC0gbWFyZ2luLnRhYmxlKEhhaXJFeWVDb2xvciwgMToyKQ0KDQojJyAjIyMgTW9zYWljIG9mIHRoZSBvcmlnaW5hbCB0YWJsZQ0KIycgVGhlIG9yZGVyIG9mIHRoZSBleWUgY29sb3JzIGRvZXNuJ3QgcGVybWl0IGFuIHVuZGVyc3RhbmRpbmcgb2YgYW4gb3ZlcmFsbCBwYXR0ZXJuIG9mIGFzc29jaWF0aW9uLg0KbW9zYWljKGhhaXJleWUsIHNoYWRlPVRSVUUsIGxlZ2VuZD1GQUxTRSkNCg0KIycgIyMjIFNob3cgY29ycmVzcG9uZGVuY2UgYW5hbHlzaXMNCiMnIEl0J3MgY2xlYXIgdGhhdCBib3RoIHZhcmlhYmxlcyBhcmUgb3JkZXJlZCBvbiBEaW0gMSwgKiphbmQqKiB0aGUgbmF0dXJlIG9mIGFzc29jaWF0aW9uIGlzIHRoYXQNCiMnIGxpZ2h0IGV5ZXMgYXJlIGFzc29jaWF0ZWQgd2l0aCBsaWdodCBoYWlyIGFuZCB2aWNlIHZlcnNhLg0KaGFpcmV5ZS5jYSA8LSBjYShoYWlyZXllKQ0KcGxvdChoYWlyZXllLmNhLCBsaW5lcyA9IFRSVUUpDQoNCiMnICMjIyBUcnkgdG8gdXNlIHNlcmlhdGlvbiBmb3IgdGhpcy4NCiMnIFRoZSBnb2FsIGhlcmUgaXMgdG8gZmluZCBhICoqc2ltcGxlKiBpbnRlcmZhY2UgdG8gYHNlcmlhdGlvbmAgdGhhdCBjb3VsZCBiZSB1c2VkIGluIHRoZSBgdmNkYCBvciBgdmNkRXh0cmFgDQojJyBwYWNrYWdlIHRvIG1ha2UgaXQgZWFzaWVyIHRvIHBlcm11dGUgdGhlIHRhYmxlIGJlaW5nIHBsb3R0ZWQgYnkgYG1vc2FpYygpYC4NCiMnIA0KIycgYHNlcmlhdGUoKWAgZmluZHMgYW4gb3JkZXIgYmFzZWQgb24gdGhlIENBIGRpbT0xLCB3aGljaCBpcyBmaW5lIGhlcmUsIGFuZCB1c3VhbGx5IGVub3VnaC4NCiMnIA0KIycgIChOQjogaW4gb3RoZXIgY2FzZXMsIHdlIG1pZ2h0IHdhbnQgdG8gc2VyaWF0ZSBhbG9uZyBDQSBgZGltPTJgLCBidXQgSSBkb24ndCBrbm93IGhvdyB0byBkbyB0aGlzLg0KIycgIFRoZXJlIGlzIHNvbWUgYnVyaWVkIG9wdGlvbiwgYWxzbyB1c2VkIGluIHRoZSBzZXJpYXRlIGBQQ0FgIG1ldGhvZCB0byB1c2UgdGhlIDJuZCBkaW1lbnNpb24uDQpvcmRlciA8LSBzZXJpYXRlKGhhaXJleWUsIG1ldGhvZCA9ICJDQSIpDQoNCiMnIEFjdHVhbCBwZXJtdXRhdGlvbiBpcyBkb25lIGJ5IGBwZXJtdXRlKClgLg0KIycgQnV0IHNhZGx5LCBgcGVybXV0ZSgpYCBvbmx5IGFsbG93cyBvbmUgbWFyZ2luIDooDQojJyBXb3VsZCBiZSBlYXNpZXIgaWYgIEkgY291bGQgdXNlIGBtYXJnaW4gPSAxOjJgLg0KcGVybXV0ZShoYWlyZXllLCBvcmRlciwgbWFyZ2luPTEpDQpwZXJtdXRlKGhhaXJleWUsIG9yZGVyLCBtYXJnaW49MikNCg0KIycgVG8gZG8gYm90aCwgd2l0aG91dCBsb29raW5nIGF0IHRoZSBwbG90LCBuZWVkIHRvIGV4dHJhY3QgdGhlIG9yZGVycyBmb3IgdGhlIHR3byBtYXJnaW5zLCBjb25mdXNpbmdseQ0KIycgYWxzbyBjYWxsZWQgYGRpbT1gLiANCm8xIDwtIGdldF9vcmRlcihvcmRlciwgZGltPTEpDQpvMiA8LSBnZXRfb3JkZXIob3JkZXIsIGRpbT0yKQ0KaGFpcmV5ZVtvMSwgbzJdDQoNCiMnICMjIyBNb3NhaWMgb2YgdGhlIHBlcm11dGVkIHRhYmxlDQojJyBUaGUgdHJpY2sgdGhhdCB3b3JrcyBpcyB0byBpbmRleCB0aGUgdGFibGUgYnkgYFtvMSwgbzJdYA0KIycgVGhlIGRpZmZlcmVuY2UgaGVyZSBpcyBzdWJ0bGU7IGl0IHdhcyBvbmx5IHRoZSBleWUgY29sb3JzIHRoYXQgbmVlZGVkIHRvIGJlIHBlcm11dGVkLiANCm1vc2FpYyhoYWlyZXllW28xLCBvMl0sIHNoYWRlPVRSVUUsIGxlZ2VuZD1GQUxTRSkNCg0KDQojJyAjIyBNZW50YWwgaW1wYWlybWVudCBkYXRhDQojJyBNYXliZSBhIGJldHRlciB0ZXN0IGNhc2UgZm9yIHRoaXMuIFRha2Ugc29tZXRoaW5nIHNpbXBsZSwgbWFrZSBpdCBtb3JlIGNvbXBsaWNhdGVkLCBzZWUNCiMnIHdoZXRoZXIvaG93IGBzZXJpYXRlYCBjYW4gaGVscC4NCiMnIA0KZGF0YShNZW50YWwsIHBhY2thZ2UgPSAidmNkRXh0cmEiKQ0Kc3RyKE1lbnRhbCkNCg0KIycgYG1lbnRhbGAgYW5kIGBzZXNgIHdlcmUgY3JlYXRlZCBhcyBvcmRlcmVkIGZhY3RvcnMuDQojJyBGb3IgdGhpcyBleGFtcGxlLCB1bm9yZGVyIHRoZW06IG1lbnRhbDogYWxwaGFiZXRpY2FsbHk7IHNlczogcmFuZG9tIHBlcm11dGF0aW9uDQoNCnNldC5zZWVkKDEyMzQpDQpNZW50YWwkbWVudGFsIDwtIGZhY3RvcihNZW50YWwkbWVudGFsLCBsZXZlbHMgPSBzb3J0KGxldmVscyhNZW50YWwkbWVudGFsKSkpDQpNZW50YWwkc2VzICAgIDwtIGZhY3RvcihNZW50YWwkc2VzLCBsZXZlbHMgPSBzYW1wbGUobGV2ZWxzKE1lbnRhbCRzZXMpKSkNCg0KbWVudGFsLnRhYiA8LSB4dGFicyhGcmVxIH4gc2VzICsgbWVudGFsLCBkYXRhPU1lbnRhbCkNCg0KIycgIyMjIEluaXRpYWwgbW9zYWljIA0KbW9zYWljKG1lbnRhbC50YWIsIHNoYWRlPVRSVUUsIGxlZ2VuZD1GQUxTRSkNCg0KIycgIyMjIENBDQojJyBjYSgpIHVuY292ZXJzIHRoZSB0cnVlIG9yZGVyaW5nDQptZW50YWwuY2EgPC0gY2EobWVudGFsLnRhYikNCnBsb3QobWVudGFsLmNhLCBsaW5lcyA9IFRSVUUpDQoNCiMnICMjIyBVc2Ugc2VyaWF0ZSB0byBnZXQgdGhpcw0Kb3JkZXIgPC0gc2VyaWF0ZShtZW50YWwudGFiLCBtZXRob2QgPSAiQ0EiKQ0KbzEgPC0gZ2V0X29yZGVyKG9yZGVyLCBkaW09MSkNCm8yIDwtIGdldF9vcmRlcihvcmRlciwgZGltPTIpDQoNCiMnICMjIyBNb3NhaWMgb2YgcGVybXV0ZWQgdGFibGUNCm1vc2FpYyhtZW50YWwudGFiW28xLCBvMl0sIHNoYWRlPVRSVUUsIGxlZ2VuZCA9IEZBTFNFKQ0KDQojJyAjIyMgVXNpbmcgdGhlIGxhdGVzdCB2ZXJzaW9uIG9mIHBlcm11dGUNCiMnIA0KIycgTWljaGFlbCBIYWhzbGVyIHVwZGF0ZWQgYHBlcm11dGUoKWAgdG8gYWxsb3cgc3BlY2lmeWluZyBgbWFyZ2luPTE6MmAgdG8gcGVybXV0ZSBib3RoIGRpbWVuc2lvbnMgaW4gYSBzaW5nbGUNCiMnIGNhbGwuIFNlZTogaHR0cHM6Ly9naXRodWIuY29tL21oYWhzbGVyL3NlcmlhdGlvbi9pc3N1ZXMvMTcjaXNzdWVjb21tZW50LTEyODAwOTE4ODENCiMnIA0KIycgDQpoZWNfcGVybSA8LSBwZXJtdXRlKGhhaXJleWUsICJDQSIsIG1hcmdpbiA9IDE6MikNCm1vc2FpYyhoZWNfcGVybSwgc2hhZGU9VFJVRSwgbGVnZW5kPUZBTFNFKQ0KDQptZW50YWwudGFiIDwtIHBlcm11dGUobWVudGFsLnRhYiwgIkNBIikgICAgICAgICAgIyBtYXJnaW49MToyIGlzIHRoZSBkZWZhdWx0DQptb3NhaWMobWVudGFsLnRhYiwgc2hhZGU9VFJVRSwgbGVnZW5kID0gRkFMU0UpDQoNCg0KIycgIyMgU3VtbWFyeQ0KIycgYHNlcmlhdGlvbjo6c2VyaWF0ZSgpYCBoYXMgdGhlIGluZnJhc3RydWN0dXJlIGZvciBhIHdpZGUgcmFuZ2Ugb2Ygc2VyaWF0aW9uIHRhc2tzLCBidXQgDQojJyBpbml0aWFsbHkgc2VlbWVkIG92ZXJseSBjb21wbGV4DQojJyBmb3IgdGhlIGFwcGxpY2F0aW9uIHRvIGZyZXF1ZW5jeSB0YWJsZXMgdXNpbmcgQ0Egd2l0aCBhIGdvYWwgb2YgaW5jb3Jwb3JhdGluZyBpbiBgdmNkOm1vc2FpYygpYC4NCiMnIA0KIycgVGhlIGxhdGVzdCB2ZXJzaW9uLCB3aXRoIHRoZSBjaGFuZ2UgdG8gYHBlcm11dGUoKWAgaXMgbm93IHNvbWV0aGluZyB0aGF0IGNhbiBiZSBlYXNpbHkgdXNlZC4NCiMnIA0KIycgU29tZSBxdWVzdGlvbnM6DQojJyANCiMnICogVGhlcmUgYXJlIGNhc2VzIHdoZXJlIG9uZSBtaWdodCB3YW50IHRvIHBlcm11dGUgdGhlIHJvd3MvY29scyBhY2NvcmRpbmcgdG8gdGhlIENBIDJuZCBkaW1lbnNpb24uDQojJyBJcyB0aGlzIHBvc3NpYmxlPw0KIycgDQojJyANCg0KDQoNCg==