Визуализируйте критические значения / парные сравнения из posthoc Tukey в R - PullRequest
Новая
       5

Визуализируйте критические значения / парные сравнения из posthoc Tukey в R

2 голосов
/ 06 декабря 2011

Я пытаюсь получить детальную визуализацию критических значений, полученных от posthoc Tukey. Есть хорошие рекомендации для визуализации парных сравнений, но мне нужно что-то более изощренное. Идея состоит в том, что у меня будет график, где каждый маленький квадрат будет представлять критическое значение из матрицы ниже, закодированной таким образом, что:

  • если значение больше или равно 5,45 - это черный квадрат;
  • если значение ниже или равно -5,45 - это серый квадрат;
  • если значение от -5,65 до 5,65 - это белый квадрат.

Матрица данных здесь .

Или, может быть, вам лучше предложить, как визуализировать эти критические значения?

РЕДАКТИРОВАТЬ: Следуя комментариям @Aaron и @DWin, я хочу предоставить немного больше контекста для приведенных выше данных и обоснование моего вопроса. Я смотрю на средние оценки приемлемости для семи виртуальных персонажей, каждый из которых анимирован на 5 разных уровнях. Таким образом, у меня есть два фактора - характер (7 уровней) и движение (5 уровней). Поскольку я обнаружил взаимодействие между этими двумя факторами, я решил взглянуть на различия между средствами для всех персонажей для всех уровней движения, что привело к этой массивной матрице, в качестве вывода Posthoc Tukey. Сейчас, наверное, слишком много деталей, но, пожалуйста, не выкидывайте меня в Кросс Валидед, они сожрут меня заживо ...

Ответы [ 4 ]

5 голосов
/ 06 декабря 2011

Это довольно просто с image: 

d <- as.matrix(read.table("http://dl.dropbox.com/u/2505196/postH.dat"))    
image(x=1:35, y=1:35, as.matrix(d), breaks=c(min(d), -5.45, 5.45, max(d)), 
      col=c("grey", "white", "black"))

Всего на половину установите половину как отсутствующую с помощью d[upper.tri(d)] <- NA и добавьте na.rm=TRUE к min и max функции.

enter image description here

4 голосов
/ 06 декабря 2011

Вот решение ggplot2.Я уверен, что есть более простые способы сделать это - я думаю, я увлекся! 

library(ggplot2)

# Load data.
postH = read.table("~/Downloads/postH.dat")
names(postH) = paste("item", 1:35, sep="") # add column names.
postH$item_id_x = paste("item", 1:35, sep="") # add id column.

# Convert data.frame to long form.
data_long = melt(postH, id.var="item_id_x", variable_name="item_id_y")

# Convert to factor, controlling the order of the factor levels.
data_long$item_id_y = factor(as.character(data_long$item_id_y), 
                        levels=paste("item", 1:35, sep=""))
data_long$item_id_x = factor(as.character(data_long$item_id_x), 
                        levels=paste("item", 1:35, sep=""))

# Create critical value labels in a new column.
data_long$critical_level = ifelse(data_long$value >= 5.45, "high",
                             ifelse(data_long$value <= -5.65, "low", "middle"))

# Convert to labels to factor, controlling the order of the factor levels.
data_long$critical_level = factor(data_long$critical_level,
                                  levels=c("high", "middle", "low"))

# Named vector for ggplot's scale_fill_manual
critical_level_colors = c(high="black", middle="grey80", low="white")

# Calculate grid line positions manually.
x_grid_lines = seq(0.5, length(levels(data_long$item_id_x)), 1)
y_grid_lines = seq(0.5, length(levels(data_long$item_id_y)), 1)

# Create plot.
plot_1 = ggplot(data_long, aes(xmin=as.integer(item_id_x) - 0.5,
                               xmax=as.integer(item_id_x) + 0.5,
                               ymin=as.integer(item_id_y) - 0.5,
                               ymax=as.integer(item_id_y) + 0.5,
                               fill=critical_level)) +
     theme_bw() +
     opts(panel.grid.minor=theme_blank(), panel.grid.major=theme_blank()) +
     coord_cartesian(xlim=c(min(x_grid_lines), max(x_grid_lines)),
                     ylim=c(min(y_grid_lines), max(y_grid_lines))) +
     scale_x_continuous(breaks=seq(1, length(levels(data_long$item_id_x))),
                        labels=levels(data_long$item_id_x)) +
     scale_y_continuous(breaks=seq(1, length(levels(data_long$item_id_x))),
                        labels=levels(data_long$item_id_y)) +
     scale_fill_manual(name="Critical Values", values=critical_level_colors) +
     geom_rect() +
     geom_hline(yintercept=y_grid_lines, colour="grey40", size=0.15) +
     geom_vline(xintercept=x_grid_lines, colour="grey40", size=0.15) +
     opts(axis.text.y=theme_text(size=9)) +
     opts(axis.text.x=theme_text(size=9, angle=90)) +
     opts(title="Critical Values Matrix")

# Save to pdf file.
pdf("plot_1.pdf", height=8.5, width=8.5)
print(plot_1)
dev.off()

enter image description here

2 голосов
/ 06 декабря 2011

Если вы установите это с помощью findInterval в качестве индекса для аргументов bg, col и / или pch (хотя они все являются квадратами на данный момент), вы должны найти код довольно компактным и понятным.

Сначала вам нужно получить данные в длинном формате;вот один из способов: 

d <- as.matrix(read.table("http://dl.dropbox.com/u/2505196/postH.dat"))
dat <- within(as.data.frame(as.table(d)), 
              { Var1 <- as.numeric(Var1)  
                Var2 <- as.numeric(Var2) })

Тогда код выглядит следующим образом;pch=22 использует заполненные квадраты, bg устанавливает цвет заливки квадрата, col устанавливает цвет границы, а cex=1.5 просто делает их немного больше, чем по умолчанию. 

plot(dat$Var1, dat$Var2, 
     bg = c("grey", "white", "black")[1+findInterval(dat$Freq, c(-5.45,5.45))],
     col="white", cex=1.5, pch = 22)

Вытам нужно 1+, потому что значения будут 0,1,2, а ваши индексы должны начинаться с 1.

enter image description here

1 голос
/ 25 декабря 2011

Чтобы сделать заключение, я использовал большинство предложений @DWin и @Aaron для создания сюжета ниже.Самый легкий уровень серого означает незначительные значения.Я также использовал rect для создания линий над именами осей, чтобы лучше различать условия: 

d <- as.matrix(read.table("http://dl.dropbox.com/u/2505196/postH.dat"))
#remove upper half of the values (as they are mirrored values)
d[upper.tri(d)] <- NA
dat <- within(as.data.frame(as.table(d)),{
Var1 <- as.numeric(Var1)
Var2 <- as.numeric(Var2)})
par(mar=c(6,3,3,6))
colPh=c("gray50","gray90","black")
plot(dat$Var1,dat$Var2,bg = colPh[1+findInterval(dat$Freq, c(-5.45,5.45))],
    col="white",cex=1.2,pch = 21,axes=F,xlab="",ylab="")
labDis <- rep(c("A","B","C","D","E"),times=7)
labChar <- c(1:7)
axis(1,at=1:35,labels=labDis,cex.axis=0.5,tick=F,line=-1.4)
axis(1,at=seq(3,33,5),labels=labChar, tick=F)
#drawing lines above axis for better identification
rect(1,0,5,0,angle=90);rect(6,0,10,0,angle=90);rect(11,0,15,0,angle=90);
rect(16,0,20,0,angle=90);rect(21,0,25,0,angle=90);rect(26,0,30,0,angle=90);
rect(31,0,35,0,angle=90)
axis(4,at=1:35,labels=labDis,cex.axis=0.5,tick=F,line=-1.4)
axis(4,at=seq(3,33,5),labels=labChar,tick=F)
#drawing lines above axis for better identification
rect(36,1,36,5,angle=90);rect(36,6,36,10,angle=90);rect(36,11,36,15,angle=90);
rect(36,16,36,20,angle=90);rect(36,21,36,25,angle=90);rect(36,26,36,30,angle=90);
rect(36,31,36,35,angle=90)
legend("topleft",legend=c("not significant","p<0.01","p<0.05"),pch=16,
col=c("gray90","gray50","black"),cex=0.7,bty="n")

enter image description here

...