Counting specific sets of repeats - r

I am having to write code in r where I have to count the number of times a specific set of numbers within a vector are repeated one after another.
For example, in the following set of numbers, I would want to count the number of times a number was repeated after itself, such as 2,2 and 4,4, or even repeating after itself 3 times in a row such as 1,1,1 or 3,3,3, not counting the number of times an individual number has occurred throughout the set.
5, 3, 2, 2, 4, 1, 4, 4, 6, 1, 3, 2, 1, 4, 3, 1, 6, 4, 5, 5, 3, 4, 3, 4, 4, 5, 6, 6, 2, 4, 6, 1, 1, 1, 2, 2, 4, 3, 3, 3, 1, 3, 5, 1, 5, 2, 2, 6, 5, 6, 3


You can use rle to find repeated consecutive values. For example,
i1 <- rle(x)
setNames(i1$lengths[i1$lengths > 1], paste0('value:', i1$values[i1$lengths > 1]))
#value:2 value:4 value:5 value:4 value:6 value:1 value:2 value:3 value:2
# 2 2 2 2 2 3 2 3 2
DATA
dput(x)
c(5, 3, 2, 2, 4, 1, 4, 4, 6, 1, 3, 2, 1, 4, 3, 1, 6, 4, 5, 5,
3, 4, 3, 4, 4, 5, 6, 6, 2, 4, 6, 1, 1, 1, 2, 2, 4, 3, 3, 3, 1,
3, 5, 1, 5, 2, 2, 6, 5, 6, 3)

Related

R: item name missing in the plot legend

With this code I get the plot I want
d <- density(mydata$item1)
plot(d)
This code is the same, but omits N/As. And there is a flaw in the plot's legend. As you can see, it doesn't tell what item is plotted, (x = .)
Can you tell where is the matter and how to fix it? Thank you for your help.
My data
structure(list(item1 = c(5, 5, 5, 5, 4, 4, 2, 1, 3, 4, 4, 3,
2, 5, 2, 4, 4, 3, 6, 5, 3, 2, 5, 3, 3, 1, 3, 5, 1, 3, 2, 6, 3,
5, 4, 4, 3, 5, 6, 3, 2, 6, 6, 5, 2, 2, 2, 3, 3, 3), item2 = c(5,
4, 5, 1, 2, 2, 3, 2, 2, 2, 2, 3, 2, 5, 1, 4, 4, 3, 3, 5, 3, 2,
4, 4, 3, 4, 4, 3, 7, NA, 2, 4, 2, 4, 2, 3, 5, 3, 5, 3, 2, 6,
6, 7, 2, 3, 2, 3, 1, 4), item3 = c(5, 5, 6, 7, 3, 4, 5, 2, 2,
6, 4, 2, 5, 7, 1, 2, 4, 5, 6, 6, 5, 2, 6, 5, 6, 4, 6, 4, 6, 4,
6, 5, 5, 6, 6, 6, 5, 6, 7, 5, 5, 7, 7, 6, 2, 6, 6, 6, 5, 3)), row.names = c(NA,
-50L), class = c("tbl_df", "tbl", "data.frame"))

Use the main = argument inside plot to make the title say whatever you want it to.
Data$item2 %>%
na.omit() %>%
density() %>%
plot(main = 'Density of Data$item2')

you had a little typo in your code as the density() call was piped into a plot call refering to the variable it was been written to ... this might have resulted in the strange plot.
In general the density() function won't work with NA values acording to the documentation so you have to set the argument na.rm = TRUE as the default is FALSE for the plot to work correctly... also as #AllanCameron pointed out in an earlier answer you can set the plot title manually.
d <- density(mydata$item2, na.rm = TRUE)
plot(d)
Possibly you can substitute, interpolate or impute the NA values so that you do not have to remove them for the denstiy() call. Though this obviously depends on your data, context and goals.

How can I get the initial communalities for an exploratory factor analysis in R?

I would like to obtain the initial communalities for an exploratory factor analysis in R
(that is, the R squared of each item when predicted by the other items included in the analysis).
Is there a way to do this with either jmv::efa or psych::fa ?
I only see the uniqueness, which informs me of the communalities AFTER factor extraction (1-uniqueness)...
Thank you for your consideration : )

As you note, the initial communalities in a factor analysis are the squared multiple correlations (SMC) of each variable by the remaining variables. Using the built-in attitude dataset as an example they are easily calculated without additional packages via:
1 - 1 / diag(solve(cor(attitude)))
rating complaints privileges learning raises critical advance
0.7326020 0.7700868 0.3831176 0.6194561 0.6770498 0.1881465 0.5186447
The psych package includes the smc() function for convenience:
psych::smc(attitude)
rating complaints privileges learning raises critical advance
0.7326020 0.7700868 0.3831176 0.6194561 0.6770498 0.1881465 0.5186447

Dataset
Here is the dput for the data I am using, hereafter called hwk:
hwk <- structure(list(V1 = structure(c(4, 4, 2, 2, 2, 2, 2, 2, 4, 4,
2, 3, 2, 3, 4, 2, 2, 2, 3, 3, 2, 3, 1, 3, 3, 3, 3, 4, 1, 2, 4,
1, 2, 3, 2, 3, 1, 1, 2, 2, 4, 3, 2, 1, 2, 3, 3, 4, 3, 3, 2, 3,
1, 4, 3, 2, 3, 4, 1, 3, 3, 3, 2, 2, 1, 2, 3, 4, 4, 2, 4, 3, 2,
3, 3, 3, 3, 2, 4, 3, 3, 3, 2, 2, 3, 4, 2, 4, 4, 2, 2, 3, 3), format.spss = "F8.0"),
V2 = structure(c(4, 4, 3, 4, 3, 4, 3, 2, 4, 1, 3, 3, 3, 4,
3, 3, 2, 3, 4, 3, 1, 4, 2, 3, 4, 2, 4, 3, 3, 2, 3, 2, 3,
3, 4, 3, 3, 3, 3, 3, 3, 2, 4, 2, 2, 2, 4, 3, 4, 4, 2, 4,
2, 3, 3, 3, 3, 3, 4, 3, 3, 3, 3, 4, 3, 3, 4, 4, 4, 4, 4,
3, 4, 3, 3, 3, 4, 2, 4, 3, 4, 3, 3, 2, 3, 3, 4, 3, 4, 3,
4, 4, 3), format.spss = "F8.0"), V3 = structure(c(4, 4, 4,
4, 4, 4, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4), format.spss = "F8.0"),
V4 = structure(c(4, 4, 3, 4, 3, 4, 2, 1, 3, 2, 3, 1, 4, 4,
2, 3, 2, 2, 2, 4, 1, 2, 2, 2, 3, 2, 3, 2, 2, 1, 3, 1, 1,
2, 4, 1, 1, 2, 3, 2, 2, 1, 1, 1, 3, 2, 4, 3, 3, 3, 3, 3,
3, 4, 3, 1, 4, 3, 4, 3, 2, 3, 2, 1, 4, 1, 4, 1, 2, 4, 4,
4, 3, 3, 3, 2, 2, 1, 4, 3, 2, 3, 2, 1, 3, 4, 1, 2, 4, 3,
4, 2, 2), format.spss = "F8.0"), V5 = structure(c(3, 3, 3,
4, 3, 4, 3, 1, 1, 1, 1, 2, 1, 2, 2, 2, 1, 2, 2, 2, 3, 2,
2, 2, 2, 4, 2, 3, 2, 3, 4, 1, 4, 2, 3, 3, 2, 2, 3, 2, 2,
3, 3, 2, 3, 3, 3, 2, 2, 2, 3, 2, 3, 3, 2, 2, 3, 3, 2, 3,
2, 2, 3, 3, 3, 2, 3, 3, 3, 4, 3, 2, 3, 3, 3, 3, 3, 3, 4,
3, 3, 3, 3, 3, 3, 3, 3, 2, 3, 3, 4, 3, 3), format.spss = "F8.0"),
V6 = structure(c(4, 4, 3, 4, 3, 4, 4, 1, 3, 3, 3, 3, 2, 3,
4, 2, 4, 3, 3, 3, 3, 4, 4, 3, 3, 3, 4, 4, 4, 3, 4, 4, 3,
3, 3, 4, 2, 2, 3, 3, 3, 4, 2, 4, 3, 4, 4, 4, 3, 4, 2, 4,
3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 3, 1, 4, 4, 4, 4, 4, 4,
4, 3, 4, 4, 4, 4, 2, 4, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 3,
4, 4, 4), format.spss = "F8.0"), V7 = structure(c(4, 4, 2,
4, 2, 4, 4, 3, 3, 3, 2, 2, 4, 4, 3, 3, 1, 4, 3, 3, 1, 2,
4, 3, 4, 2, 4, 4, 3, 3, 2, 2, 3, 2, 4, 3, 3, 3, 3, 3, 3,
1, 4, 3, 2, 2, 4, 3, 4, 4, 2, 4, 2, 3, 4, 3, 3, 3, 4, 3,
4, 4, 3, 4, 4, 3, 4, 4, 4, 4, 3, 4, 4, 4, 3, 3, 4, 3, 4,
3, 3, 3, 3, 2, 2, 4, 4, 4, 4, 2, 4, 4, 3), format.spss = "F8.0"),
V8 = structure(c(4, 4, 2, 1, 2, 1, 1, 1, 3, 3, 2, 3, 2, 3,
4, 2, 2, 2, 3, 3, 2, 3, 1, 3, 3, 3, 3, 4, 1, 2, 4, 1, 2,
3, 2, 3, 1, 1, 2, 2, 3, 1, 1, 1, 2, 3, 3, 4, 3, 3, 2, 3,
1, 3, 4, 2, 3, 4, 1, 3, 3, 3, 2, 2, 1, 2, 3, 4, 4, 2, 4,
3, 4, 4, 4, 4, 3, 2, 4, 3, 3, 3, 2, 2, 3, 4, 2, 4, 4, 2,
1, 3, 4), format.spss = "F8.0"), V9 = structure(c(4, 4, 4,
4, 4, 4, 4, 4, 3, 3, 2, 3, 3, 3, 3, 2, 3, 3, 2, 3, 4, 4,
4, 4, 3, 4, 4, 4, 4, 4, 4, 4, 3, 3, 3, 4, 3, 2, 4, 3, 4,
4, 4, 4, 4, 4, 3, 3, 3, 3, 4, 4, 4, 4, 4, 3, 4, 3, 2, 4,
3, 3, 4, 4, 4, 3, 4, 4, 4, 4, 4, 3, 4, 3, 4, 3, 4, 4, 4,
4, 3, 4, 4, 4, 4, 4, 3, 2, 4, 4, 4, 4, 4), format.spss = "F8.0"),
V10 = structure(c(4, 4, 2, 4, 2, 4, 3, 2, 3, 3, 3, 2, 4,
4, 2, 2, 1, 3, 4, 4, 1, 4, 2, 3, 3, 2, 4, 3, 2, 3, 3, 1,
3, 2, 4, 3, 2, 3, 3, 3, 3, 1, 2, 4, 2, 3, 4, 4, 3, 3, 2,
4, 2, 4, 3, 3, 4, 3, 4, 3, 4, 4, 4, 1, 4, 3, 3, 4, 3, 4,
4, 3, 3, 3, 3, 3, 4, 1, 4, 3, 3, 3, 3, 2, 3, 4, 4, 2, 4,
2, 4, 4, 3), format.spss = "F8.0"), V11 = structure(c(3,
3, 1, 4, 1, 4, 1, 1, 1, 1, 2, 1, 1, 1, 3, 2, 2, 2, 2, 1,
2, 3, 1, 2, 3, 3, 2, 1, 2, 2, 2, 3, 2, 2, 3, 2, 1, 2, 2,
1, 1, 4, 3, 1, 3, 2, 3, 1, 2, 1, 2, 1, 2, 2, 1, 2, 2, 3,
2, 2, 2, 2, 2, 2, 1, 1, 1, 3, 3, 4, 2, 1, 2, 2, 3, 3, 3,
3, 4, 3, 2, 3, 3, 2, 2, 2, 2, 1, 3, 1, 4, 1, 3), format.spss = "F8.0"),
V12 = structure(c(4, 4, 3, 2, 3, 2, 3, 1, 3, 3, 3, 3, 2,
3, 3, 2, 4, 3, 3, 4, 4, 3, 3, 4, 4, 3, 3, 3, 4, 3, 4, 4,
3, 3, 3, 4, 2, 2, 3, 3, 3, 4, 2, 4, 3, 4, 4, 4, 3, 4, 2,
4, 3, 3, 3, 3, 4, 3, 3, 2, 2, 1, 1, 3, 1, 4, 4, 4, 4, 4,
4, 4, 3, 3, 2, 2, 2, 2, 4, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4,
3, 2, 3, 4), format.spss = "F8.0")), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -93L))
EFA
I did some research after my initial answer and it appears that there is a package for this called EFA Tools. There is a function called EFA that allows you to specify that you want the initial communalities. First, run the library and the EFA itself below:
# Load EFA Tools library:
library(EFAtools)
# Run EFA:
hwkfa <- EFA(hwk,
n_factors = 3,
start_method = "psych",
method = "PAF",
rotation = "promax",
init_comm = "smc", # selected initial communalities
type = "SPSS")
Obtaining initial communalities:
Then from there you can simply select the initial communalities by using the following code:
hwkfa$h2_init
Which gives you the following vector of output:
V1 V2 V3 V4 V5 V6 V7
0.8034001 0.5583605 0.5487691 0.3255253 0.5685402 0.4643686 0.5227481
V8 V9 V10 V11 V12
0.8050573 0.3474202 0.5564858 0.3496354 0.3783390
I ran the same thing in SPSS and got matching values:

Math Symbols within for loop of GGplots in R

I'm currently trying to develop a similar result as this link. I have a significant number of columns and several different labels for the x-axis.
col1 <- c(2, 4, 1, 2, 5, 1, 2, 0, 1, 4, 4, 3, 5, 2, 4, 3, 3, 6, 5, 3, 6, 4, 3, 4, 4, 3, 4,
2, 4, 3, 3, 5, 3, 5, 5, 0, 0, 3, 3, 6, 5, 4, 4, 1, 3, 3, 2, 0, 5, 3, 6, 6, 2, 3,
3, 1, 5, 3, 4, 6)
col2 <- c(2, 4, 4, 0, 4, 4, 4, 4, 1, 4, 4, 3, 5, 0, 4, 5, 3, 6, 5, 3, 6, 4, 4, 2, 4, 4, 4,
1, 1, 2, 2, 3, 3, 5, 0, 3, 4, 2, 4, 5, 5, 4, 4, 2, 3, 5, 2, 6, 5, 2, 4, 6, 3, 3,
3, 1, 4, 3, 5, 4)
col3 <- c(2, 5, 4, 1, 4, 2, 3, 0, 1, 3, 4, 2, 5, 1, 4, 3, 4, 6, 3, 4, 6, 4, 1, 3, 5, 4, 3,
2, 1, 3, 2, 2, 2, 4, 0, 1, 4, 4, 3, 5, 3, 2, 5, 2, 3, 3, 4, 2, 4, 2, 4, 5, 1, 3,
3, 3, 4, 3, 5, 4)
col4 <- c(2, 5, 2, 1, 4, 1, 3, 4, 1, 3, 5, 2, 4, 3, 5, 3, 4, 6, 3, 4, 6, 4, 3, 2, 5, 5, 4,
2, 3, 2, 2, 3, 3, 4, 0, 1, 4, 3, 3, 5, 4, 4, 4, 3, 3, 5, 4, 3, 5, 3, 6, 6, 4, 2,
3, 3, 4, 4, 4, 6)
data2 <- data.frame(col1,col2,col3,col4)
data2[,1:4] <- lapply(data2[,1:4], as.factor)
colnames(data2)<- c("A","B","C", "D")
> x.axis.list
[[1]]
expression(beta[paste(1, ",", 1L)])
[[2]]
expression(beta[paste(1, ",", 2L)])
[[3]]
expression(beta[paste(1, ",", 3L)])
[[4]]
expression(beta[paste(1, ",", 4L)])
myplots <- vector('list', ncol(data2))
for (i in seq_along(data2)) {
message(i)
myplots[[i]] <- local({
i <- i
p1 <- ggplot(data2, aes(x = data2[[i]])) +
geom_histogram(fill = "lightgreen") +
xlab(x.axis.list[[i]])
print(p1)
})
}
In the past, I've been able to do something similar to this where I can just put x.axis.list[[i]] in my loop and change the symbols. However, I continue to get the term expression on the axis. So the symbol for Beta is correct as well as the subscript but the word "expression" remains. I'm not sure exactly what I'm doing wrong, for a moment, I was able to produce a plot without "expression" but it has since stayed in the ggplot.
I want to be able to produce this plot, or one with the title on the y-axis without the word "expression".
My image currently looks . I'm not worried about this example data and the result of the plot, I'm wondering how to get rid of "expression" so only the math symbol shows.
Thanks in advance.

You can do:
for (i in seq_along(data2)) {
df <- data2[i]
names(df)[1] <- "x"
myplots[[i]] <- local({
p1 <- ggplot(df, aes(x = x)) +
geom_bar(fill = "lightgreen", stat = "count") +
xlab(x.axis.list[[i]])
})
}
And we can show all the plots together:
library(patchwork)
(myplots[[1]] + myplots[[2]]) / (myplots[[3]] + myplots[[4]])
Note I created the expression list like this:
x.axis.list <- lapply(1:4, function(i){
parse(text = paste0("beta[paste(1, \",\", ", i, ")]"))
})

R: how to count the number of times two elements have the same ID (perhaps using the outer function)

I have the following three dimensional array:
dput(a)
structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 2, 1, 1, 1, 2, 2,
2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 6, 2, 7, 6, 2, 7, 6, 2, 7, 4, 2, 4, 4, 2, 6, 4, 2, 4, 6, 2,
7, 4, 2, 6, 4, 2, 6, 4, 2, 6, 4, 2, 4, 4, 2, 6, 4, 2, 4, 4, 2,
6, 4, 2, 6, 4, 2, 6, 6, 2, 7, 4, 2, 6, 4, 2, 6, 4, 2, 4, 2, 3,
1, 2, 3, 1, 2, 3, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 2, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 3, 7, 2, 3,
7, 2, 3, 7, 2, 3, 7, 2, 3, 7, 2, 3, 7, 2, 3, 7, 2, 3, 7, 2, 3,
7, 2, 3, 7, 1, 2, 5, 2, 3, 7, 1, 2, 4, 2, 3, 7, 2, 3, 7, 2, 3,
7, 2, 3, 7, 2, 3, 7, 2, 3, 7, 2, 3, 7, 2, 6, 3, 2, 6, 3, 2, 6,
3, 2, 6, 3, 2, 6, 3, 2, 6, 3, 2, 6, 3, 2, 6, 3, 2, 6, 3, 2, 6,
3, 1, 1, 1, 2, 6, 3, 1, 5, 5, 2, 6, 3, 2, 6, 3, 2, 6, 3, 2, 6,
3, 2, 6, 3, 2, 6, 3, 2, 6, 3, 3, 3, 2, 3, 3, 2, 3, 3, 2, 3, 13,
2, 3, 13, 2, 3, 5, 2, 3, 5, 2, 15, 17, 2, 15, 17, 2, 15, 17,
2, 3, 5, 2, 15, 17, 2, 3, 13, 2, 15, 17, 2, 15, 17, 2, 3, 13,
2, 3, 5, 2, 15, 17, 2, 15, 17, 2, 3, 5, 2), .Dim = c(3L, 20L,
6L), .Dimnames = list(c("cl.tmp", "cl.tmp", "cl.tmp"), NULL,
NULL))
The dimension of this array (a) is 3x20x6 (after edits).
I wanted to count the proportion of times that a[,i,] matches a[,j,] element-by-element in the matrix. Basically, I wanted to get mean(a[,i,] == a[,j,]) for all i, j, and I would like to do this fast but in R.
It occurred to me that the outer function might be a possibility but I am not sure how to specify the function. Any suggestions, or any other alternative ways?
The output would be a 20x20 symmetric matrix of nonnegative elements with 1 on the diagonals.
The solution given below works (thanks!) but I have one further question (sorry).
I would like to display the coordinates above in a heatmap. I try the following:
n<-dim(a)[2]
xx <- matrix(apply(a[,rep(1:n,n),]==a[,rep(1:n,each=n),],2,sum),nrow=n)/prod(dim(a)[-2])
image(1:20, 1:20, xx, xlab = "", ylab = "")
This gives me the following heatmap.
However, I would like to display (reorder the coordinate) such that I get all the coordinates that have high-values amongst each other together. However, I would not like to bias the results by deciding on the number of groups myself. I tried
hc <- hclust(as.dist(1-xx), method = "single")
but I can not decide how to cut the resulting tree to decide on bunching the coordinates together. Any suggestions? Bascically, in the figure, I would like the coordinate pairs in the top left (and bottom right off-diagonal blocks) to be as low-valued (in this case as red) as possible.
Looking around on SO, I found that there exists a function heatmap which might do this,
heatmap(xx,Colv=T,Rowv=T, scale='none',symm = T)
and I get the following:
which is all right, but I can not figure out how to get rid of the dendrograms on the sides or the axes labels. It does work if I extract out and do the following:
yy <- heatmap(xx,Colv=T,Rowv=T, scale='none',symm = T,keep.dendro=F)
image(1:20, 1:20, xx[yy$rowInd,yy$colInd], xlab = "", ylab = "")
so I guess that is what I will stick with. Here is the result:

Try this:
n<-dim(a)[2]
matrix(apply(a[,rep(1:n,n),]==a[,rep(1:n,each=n),],2,sum),nrow=n)/prod(dim(a)[-2])
It has to be stressed that the memory usage of this method goes with n^2 so you might have trouble to use it with larger arrays.

Generate a sequence number (1,1,1,2,2,2,3,3,3) within groups of different length

I have a data frame with a column "Tag", here with four different levels. I need help to create the "Seq" column, a sequence generated from the "Tag" Column:
df <- data.frame(Tag = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4),
Seq = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3 )
Each "Tag" should be divided into 3 sub-groups defined by "Seq". We need to generate runs of 1, 2, and 3, with a total length of that of each "Tag". Thus, the length of each run of 1, 2, and 3 respectively depends on length of each "Tag".
Note that the length each "Tag" differs. For example, Tag 1 is of length 31, and has a "Seq" 10 times 1, 10 times 2, and 11 times 3.

To begin with, Tag 1 is 31 while tag 2 is 32. Looking at the code below, the first number (1) will always be of lesser length than the next two (2,3). I used a ceiling process to come up with this. There is no clear criteria on what the code should do if the number is eg 31/3.. should it give a length of 10, 10, 11? or even 9, 11,11 will be fine? The code gives a 9, 11, 11 length:
ec=table(Tag)
unlist(mapply(function(x,y)rep(c(1,2,3),c(x,y,y)),ec-2*ceiling(ec/3),ceiling(ec/3)))
To check the outputted results, save the results in a variable.. d=mapply(...
then do sapply(d,table).
Hope this will be of help.

ave(Tag, Tag, FUN = function(x){sort(rep(x = 1:3, length.out = length(x)))})
Explanation: For each level of "Tag" (ave(Tag, Tag, ...): repeat each level of "Seq" (x = 1:3) to the length of the subset of "Tag" (length.out = length(x)). sort the numbers.

Resources