Εκφώνηση


Βρείτε όλα τα δυνατά ραβδογράμματα που μπορούν να απεικονιστούν στο πλαίσιο στα δεξιά της παρακάτω εικόνας, ώστε να ισχύουν τα στατιστικά του πίνακα που δίνεται στα αριστερά.

alt text


Επίλυση με χρήση της R


Από τον πίνακα με όλες τις δυνατές διατάξεις των αριθμών 0 έως 8 ανά 6, φιλτράρονται μόνο οι γραμμές που αντιστοιχούν σε συχνότητες των έξι score, οι οποίες αντιστοιχούν σε δείγματα που επαληθεύουν τα ζητούμενα στατιστικά.


suppressPackageStartupMessages(library(gtools))
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(matrixStats))
suppressPackageStartupMessages(library(sjPlot))
suppressPackageStartupMessages(library(xtable))
suppressPackageStartupMessages(library(gridExtra))

n <- 8
dt <- permutations(n+1,6,v=0:n,repeats.allowed=TRUE)

# SmplMode <- function(x) {
#   tabSmpl <- tabulate(x)
#   SmplMode <- which(tabSmpl == max(tabSmpl))
#   if (sum(tabSmpl == max(tabSmpl)) > 1)
#     SmplMode <- 0
#   return(SmplMode)
# }
# 
# res <- dt[apply(dt,1,function(x) {
#   y <- rep(c(1,2,3,4,5,6),c(x[1],x[2],x[3],x[4],x[5],x[6]))
#   return(mean(y)==3 & diff(range(y))==4 & median(y)==3.5 & SmplMode(y)==4)
#   }),]

df <- data.frame(dt)

df$m <- rowMaxs(dt)                                       #for SmplMode(y)  
S <- matrix(1:6, ncol=ncol(dt), nrow=nrow(dt), byrow=T)
Z <- S*(dt!=0)
Z[Z==0] <- NA
df$Range <- rowMaxs(Z, na.rm=TRUE)-rowMins(Z, na.rm=TRUE) #for diff(rang(y))

df$Mean <- rowSums(S*dt)/rowSums(dt)                      #for mean(y)

res <- df %>% 
  filter(X4  == m, (X1==m)+(X2==m)+(X3==m)+(X4==m)+(X5==m)+(X6==m)==1, 
         Range == 4, # range condition here
         Mean == 3) %>% #mean condition here
  rowwise() %>% 
  mutate(Med = median(rep(c(1,2,3,4,5,6), c(X1, X2, X3, X4, X5, X6)))) %>%
  filter(Med == 3.5) %>%   #median condition here 
  select(-m, -Range, -Mean, -Med) %>% # get rid of newcols
  as.matrix


Στον πιο πάνω κώδικα ο τρόπος που είχε αρχικά χρησιμοποιηθεί για το φιλτράρισμα φαίνεται ως σχόλιο. Στη συνέχεια αντικαταστάθηκε από την πολύ ταχύτερη προσέγγιση που φαίνεται κάτω από το σχόλιο, η οποία αποτελεί λύση που προτάθηκε από τον χρήστη ExperimenteR σε αυτό το ερώτημα.

Ο πίνακας με τις 48 λύσεις για τις συχνότητες των score που επαληθεύουν το ζητούμενο, δίνεται στη συνέχεια.


if (my_output == "html"){
  print(xtable(res, align="lcccccc"), type="html", 
        html.table.attributes='class="table table-striped table-hover center"')
}
X1 X2 X3 X4 X5 X6
1 2 1 1 3 1 0
2 2 2 1 4 1 0
3 2 3 1 5 1 0
4 2 4 1 6 1 0
5 2 5 1 7 1 0
6 2 6 1 8 1 0
7 3 0 2 4 1 0
8 3 1 2 5 1 0
9 3 2 1 4 2 0
10 3 2 2 6 1 0
11 3 3 1 5 2 0
12 3 3 2 7 1 0
13 3 4 1 6 2 0
14 3 4 2 8 1 0
15 3 5 1 7 2 0
16 3 6 1 8 2 0
17 4 0 3 6 1 0
18 4 1 2 5 2 0
19 4 1 3 7 1 0
20 4 2 2 6 2 0
21 4 2 3 8 1 0
22 4 3 1 5 3 0
23 4 3 2 7 2 0
24 4 4 1 6 3 0
25 4 4 2 8 2 0
26 4 5 1 7 3 0
27 4 6 1 8 3 0
28 5 0 3 6 2 0
29 5 0 4 8 1 0
30 5 1 3 7 2 0
31 5 2 2 6 3 0
32 5 2 3 8 2 0
33 5 3 2 7 3 0
34 5 4 1 6 4 0
35 5 4 2 8 3 0
36 5 5 1 7 4 0
37 5 6 1 8 4 0
38 6 0 4 8 2 0
39 6 1 3 7 3 0
40 6 2 3 8 3 0
41 6 3 2 7 4 0
42 6 4 2 8 4 0
43 6 5 1 7 5 0
44 6 6 1 8 5 0
45 7 0 4 8 3 0
46 7 2 3 8 4 0
47 7 4 2 8 5 0
48 7 6 1 8 6 0


Στο πιο κάτω γράφημα έχουν σχεδιαστεί όλα τα δυνατά ραβδογράμματα, βάσει του παραπάνω πίνακα συχνοτήτων.

Σύμφωνα με τα συμπεράσματα που προκύπτουν από τη θεωρητική αντιμετώπιση, θα παρατηρήσετε στα διαγράμματα τα εξής:

  • Δεν είναι δυνατή λύση με \(\text{score}=6\), δηλ. \(X_6=0\)
  • Το πλήθος των τιμών κάθε δείγματος είναι άρτιος αριθμός
  • \(X_1 + X_2 + X_3 = X_4 + X_5\)
  • \(X_4=Χ_2+2Χ_3\)
  • \(X_1=Χ_3+Χ_5\)


sjp.setTheme(theme = "blues", geom.alpha = 0.8)
string<-""

for (i in 1:nrow(res)){
  y <- rep(c(1,2,3,4,5,6),res[i,])
  assign(paste0("p",i),sjp.frq(y,  title=paste("Λύση",i), geom.colors ="deepskyblue4", 
                               gridBreaksAt=2, showCountValues=TRUE, 
                               axisLimits.y=c(0,9.3), showPercentageValues=FALSE, 
                               printPlot = FALSE))
  string <- paste0(string,ifelse(i!=1,", ",""),paste0("p",i,"$plot"))
}

string <- paste0("grid.arrange(",string,",nrow=12)")
eval(parse(text = string))

plot of chunk unnamed-chunk-4