Plotting a heat map of binary and continious values - r

I have this matrix of pathway analysis. Genes in each pathway gets 1 if not 0. I also have fold change for genes. I tried to plot this but fold change being confused with absence and pretense of genes like :
I have tried
heatmap(m)
dput(m)
structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1, 1,
1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0,
0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 1, 0, 1, 0,
1, 1, 1, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1,
1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0,
1, 1, 1, 1, -0.903826171835163, -0.247705285294349, -0.401239527828149,
-1.20189443333319, -0.758305343685411, -1.10106389326754, -0.585488441571586,
-0.610209849183418, -1.28841166063443, -1.2443689942311, -0.44380661806954,
-0.393767679922636, -0.9865911233588, -1.16638985537113, -0.846196153682942,
-1.08069734237831, -0.585488441571586, -0.501442757103725, -1.09515274600357,
-1.28841166063443, -0.758305343685411, -0.358909656766957, -0.435604213681894,
-0.233037798755743, -0.401239527828149, -1.28841166063443, -0.563163557390339,
-1.08069734237831, -0.247705285294349, -0.903826171835163, -0.9865911233588,
0.377359646511066, 0.453386357728066, 1.70862112102298, 0.532342427101257,
1.61935728655752, 1.15211775940032, 0.265720938549918, 0.420856476956162,
0.377359646511066, 0.350765937539292, 0.276646264257092), .Dim = c(42L,
8L), .Dimnames = list(c("CCL2", "CCL4", "CD40", "CLCF1", "CSF3",
"CXCL5", "CXCL6", "CXCL8", "IL1B", "IL6", "IL6R", "LTB", "OSM",
"TNFRSF1B", "TNFSF10", "FOS", "FOSL1", "MMP3", "PTGS2", "TNFAIP3",
"BCL2A1", "BIRC3", "CFLAR", "DDX58", "GADD45B", "TIRAP", "EDN1",
"SOCS3", "IGF2", "JAK1", "NR4A1", "CACNA1D", "CALML5", "CALML6",
"CCNA2", "CCND2", "CDK6", "MAPK1", "RBL1", "CDC6", "CDKN2C",
"SMC3"), c("Cytokine-cytokine receptor interaction", "IL-17 signaling",
"NF-kappa B signaling", "TNF signaling", "PI3K-Akt signaling",
"Cellular senescence", "Cell cycle", "Log2FC")))
> head(m)
Cytokine-cytokine receptor interaction IL-17 signaling
CCL2 1 1
CCL4 1 0
CD40 1 0
CLCF1 1 0
CSF3 1 1
CXCL5 1 1
NF-kappa B signaling TNF signaling PI3K-Akt signaling
CCL2 0 1 0
CCL4 1 0 0
CD40 1 0 0
CLCF1 0 0 0
CSF3 0 0 1
CXCL5 0 1 0
Cellular senescence Cell cycle Log2FC
CCL2 0 0 -0.9038262
CCL4 0 0 -0.2477053
CD40 0 0 -0.4012395
CLCF1 0 0 -1.2018944
CSF3 0 0 -0.7583053
CXCL5 0 0 -1.1010639
>
Can you help to solve this?


heatmap(as.matrix(m[,1:7])) should do the trick.

Related

How do I compute the average per row of multiple numeric columns

I have 8 age categories as 8 separate columns. Each column has a value between 1 and 3. I want to compute a new column that holds the average age per row.
This is my data:
structure(list(`2.5` = c(0, 0, 0, 1, 1, 2, 1, 2, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 2, 0,
0, 2, 0, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 2, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 2, 1, 0, 0, 2, 0, 0, 0,
0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 2, 0, 2, 2,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 2, 0, 2, 0, 1, 0, 0, 0, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0,
0, 1, 0, 0, 0, 0, 2, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 2, 0, 0, 0,
0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 3,
0, 0, 1), `9` = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0,
1, 0, 0, 0, 0, 2, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0, 1, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 3, 0, 1,
0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 2, 0,
2, 0, 3, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
1, 0, 0, 0, 1, 0, 0, 0, 0, 2, 0, 1, 1, 2, 0, 0, 0, 0, 0, 0, 1
), `15.5` = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 2, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0),
`21.5` = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), `29.5` = c(0,
1, 2, 0, 1, 0, 0, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 1, 2, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 2, 0, 0, 1, 0, 1, 0, 2, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0,
0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 2, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 2, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 2,
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0,
0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0), `42` = c(0, 0, 0,
2, 1, 2, 2, 2, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 1, 1, 0, 2,
0, 0, 1, 0, 1, 0, 1, 1, 2, 1, 2, 0, 2, 0, 1, 1, 2, 0, 2,
1, 0, 0, 0, 0, 2, 1, 2, 1, 0, 0, 0, 1, 0, 0, 0, 0, 2, 0,
2, 0, 1, 0, 0, 0, 2, 2, 2, 1, 0, 2, 0, 0, 1, 0, 0, 2, 0,
2, 1, 1, 0, 0, 2, 0, 0, 0, 2, 1, 1, 1, 1, 0, 1, 2, 2, 0,
0, 0, 0, 2, 0, 2, 0, 0, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0,
0, 1, 0, 2, 0, 2, 1, 0, 1, 1, 2, 0, 0, 2, 1, 2, 2, 2, 0,
1, 0, 1, 0, 2, 2, 2, 1, 0, 0, 2, 0, 0, 0, 0, 2, 0, 2, 2,
2, 2, 1, 2, 0, 2, 0, 2, 0, 2, 2, 1, 0, 0, 0, 2, 2, 0, 2,
0, 0, 2, 2, 0, 0, 0, 0, 2, 1, 2, 0, 0, 1, 2, 0, 0, 0, 1,
1, 2, 2, 1, 0, 0, 0, 2, 1, 1, 2), `57` = c(0, 1, 0, 0, 0,
0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 2, 1,
0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 0, 2, 0, 0, 2,
0, 0, 2, 0, 0, 0, 0, 1, 0, 2, 0, 1, 0, 2, 2, 0, 0, 0, 0,
0, 0, 2, 0, 0, 0, 0, 1, 2, 0, 0, 1, 0, 2, 0, 0, 1, 0, 0,
0, 0, 2, 0, 0, 2, 0, 0, 0, 1, 1, 0, 2, 0, 0, 0, 2, 0, 1,
2, 0, 2, 0, 1, 1, 0, 0, 0, 2, 0, 0, 1, 2, 2, 2, 0, 2, 0,
0, 0, 0, 0, 1, 2, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 2, 0, 0,
0, 0, 0, 0, 0, 0, 0, 2, 0, 1, 2, 2, 2, 0, 0, 0, 0, 0, 0,
0, 0, 2, 0, 1, 0, 2, 0, 0, 0, 2, 2, 0, 0, 0, 1, 0, 0, 1,
0, 0, 1, 1, 2, 0, 0, 1, 0, 0, 2, 0, 0, 0, 0, 0, 1, 0, 0,
0, 1, 2, 0, 1, 0, 1, 0, 0), `72` = c(2, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 2, 0, 0, 0, 1, 1, 1, 0, 0, 1, 0, 0, 0, 0, 2,
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 2, 0, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 2, 0, 2, 0, 0, 0, 2,
0, 0, 2, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 2, 1, 0, 0,
0, 1, 0, 2, 0, 0, 0, 1, 0, 0, 0, 2, 1, 0, 0, 0, 0, 1, 0,
0, 2, 1, 0, 0, 0, 0)), row.names = c(NA, -204L), class = c("data.table",
"data.frame"))

First, create a temporary data frame where you calculate the ages from column names. Then, with rowSums calculate average ages. (Supposed your data frame is called d.)
tmp <- do.call(cbind, lapply(seq(d), function(x) d[x] * as.numeric(colnames(d)[x])))
d$mu <- rowSums(tmp) / rowSums(d)
head(d)
# 2.5 9 15.5 21.5 29.5 42 57 72 mu
# 1 0 0 0 0 0 0 0 2 72.00000
# 2 0 0 0 0 1 0 1 0 43.25000
# 3 0 0 0 0 2 0 0 0 29.50000
# 4 1 0 0 0 0 2 0 0 28.83333
# 5 1 0 0 0 1 1 0 1 36.50000
# 6 2 0 0 0 0 2 0 0 22.25000

apply is a useful option, where 1 tells it to compute by row. It also seems to play nicely with data.tables:
df$means <- apply(df, 1, function(r) sum(r * as.double(names(df))) / sum(r))
#### OUTPUT ####
2.5 9 15.5 21.5 29.5 42 57 72 means
1: 0 0 0 0 0 0 0 2 72.00000
2: 0 0 0 0 1 0 1 0 43.25000
3: 0 0 0 0 2 0 0 0 29.50000
4: 1 0 0 0 0 2 0 0 28.83333
5: 1 0 0 0 1 1 0 1 36.50000
---
200: 0 0 0 0 0 0 1 1 64.50000
201: 3 0 0 0 0 2 0 0 18.30000
202: 0 0 1 0 0 1 1 0 38.16667
203: 0 0 0 0 1 1 0 0 35.75000
204: 1 1 0 0 0 2 0 0 23.87500

Here is a base R one-liner where we multiply values in the columns of dataframe by its names, calculate the sum of column values and divide by its rowSums.
df$result <- colSums(t(df) * as.numeric(names(df)))/rowSums(df)
head(df)
# 2.5 9 15.5 21.5 29.5 42 57 72 result
#1 0 0 0 0 0 0 0 2 72.00000
#2 0 0 0 0 1 0 1 0 43.25000
#3 0 0 0 0 2 0 0 0 29.50000
#4 1 0 0 0 0 2 0 0 28.83333
#5 1 0 0 0 1 1 0 1 36.50000
#6 2 0 0 0 0 2 0 0 22.25000

colnames and rownames with pairwise distance matrix outputs

EDIT:
I am trying to collect these values/Cols/Rows
** The numbers have changed slightly.
I am trying to extract the pairwise result of the following matrix.
ID1_2001 ID2_2001 ID3_2001 ID1_2000 ID2_2000
ID2_2001 0.96747537
ID3_2001 0.96850817 0.67983338
ID1_2000 0.11324889 0.97507292 0.97586446
ID2_2000 1.00000000 0.75336751 0.83321843 1.00000000
ID3_2000 1.00000000 0.76556229 0.81577353 1.00000000 0.05728332
That is the values of 0.1132489, 0.7533675, 0.8157735.
Thanks to another user on this site I know of the following function proxy::dist(m[1:3,], m[4:6,], pairwise=TRUE, method="cosine") which gives me just the following results 0.1132489 0.7533675 0.8157735.
However I would also like the column and row names from where the result comes from. So 0.1132489 would be assigned to ID1_2000_ID1_2001, and 0.7533675 assigned to ID2_2000_ID2_2001, and finally 0.81577353 assigned to ID3_2000_ID3_2001. However I cannot put this distance matrix into a data frame to Access/extract row_names and colnames.
It would be most optimal to run just the following proxy::dist(m[1:3,], m[4:6,], pairwise=TRUE, method="cosine") and obtain the pairwise results along with their colnames and rownames (saving on computational time).
How can I replace the m[1:3] with "groups", i.e. take 2001 group and then take 2000 group. Since I hope to scale this up to more years/IDs and I cannot count the rows 1:3 and 4:6 for all years/IDs.
library(tidyr)
x <- m %>%
data.frame() %>%
tibble::rownames_to_column("rownames") %>%
separate(rownames, c("id", "year"), "_")
Other:
dist.matrix = proxy::dist(m, pairwise = TRUE, method = "cosine")
proxy::dist(m[1:3,], m[4:6,], pairwise=TRUE, method="cosine")
Data:
data <- structure(c(0.96747537487273, 0.968508167135111, 0.113248890901578,
1, 1, 0.67983337671352, 0.97507292188601, 0.753367507803825,
0.765562291938692, 0.975864460398726, 0.833218430412641, 0.815773525411265,
1, 1, 0.0572833227621783), Size = 6L, Labels = c("ID1_2001",
"ID2_2001", "ID3_2001", "ID1_2000", "ID2_2000", "ID3_2000"), class = "dist", Diag = FALSE, Upper = FALSE, method = "cosine", call = proxy::dist(x = m,
method = "cosine", pairwise = TRUE))
Data 2 (m)
m <- structure(c(0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
1, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
0, 0, 1, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0,
0, 0, 2, 2, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0, 1, 3, 3, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 1,
0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0,
0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0,
0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0,
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,
0, 0, 2, 2, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1,
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1,
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0,
0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 8, 0,
0, 12, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0,
0, 0, 0, 1, 1, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 2, 1, 0,
1, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1,
0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0,
0, 1, 0, 2, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1,
0, 0, 1, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0,
1, 1, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0,
0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0,
0, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,
1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 2, 2, 0,
1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0,
3, 4, 0, 1, 3, 0, 1, 1, 0, 2, 1, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0,
0, 0, 0, 1, 1, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0,
0, 0, 0, 0, 0, 0, 1, 2, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0,
0, 0, 0, 1, 1, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1,
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
0, 1, 0, 0, 0, 3, 0, 0, 3, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0,
0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0,
1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 0, 3, 0, 0, 2, 2, 0, 0, 0, 0,
1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 1, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 2, 0, 0, 2, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0,
1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1,
0, 0, 0, 2, 1, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0,
2, 2, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 4, 2, 0, 1, 1, 0,
1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1,
0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1,
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0,
0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0,
1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 0, 0, 2, 0, 0, 0,
0, 0, 0, 1, 1), .Dim = c(6L, 196L), .Dimnames = list(Docs = c("ID1_2001",
"ID2_2001", "ID3_2001", "ID1_2000", "ID2_2000", "ID3_2000"),
Terms = c("-field", "(22-yard)", "(doubles).", "(either",
"(known", "(singles)", "(specifically", "20-metre", "able",
"across", "activity", "adjudicated", "aided", "although",
"american", "appears", "appears.", "around", "association",
"australian", "badminton", "bails", "bails,", "balanced",
"ball", "bat--ball", "bat,", "batting", "beach", "bowled",
"bowled,", "bowling", "called", "can", "canadian", "casual",
"catching", "centre", "certain", "codes", "common", "commonly",
"communicate", "comprising", "context", "cord", "countries",
"countries);", "court", "court.", "covered", "cricket", "degrees",
"degrees,", "different", "dislodges", "dismiss", "dismissal",
"dismissed,", "doubles", "each", "either", "eleven", "end,",
"ends", "family", "felt", "field", "fielding", "football",
"football);", "football.[1][2]", "football;", "football12",
"form", "formal", "forms", "gaelic", "gain", "game", "games",
"goal", "goal.", "gridiron", "ground.", "half", "hit", "hits",
"hollow", "include", "individually", "indoor", "information.",
"innings", "international", "involve", "involve,", "kicking",
"known", "landing", "larger", "league", "maneuver", "match",
"match's", "matches.", "may", "means", "net", "object", "often",
"one", "opponent", "opponent's", "opposing", "opposite",
"outdoor", "per", "pitch", "places", "play", "played", "player",
"players", "point,", "points", "popular", "prevent", "racket",
"racquet", "racquets", "record", "rectangular", "refer",
"referee", "regional", "return", "return.", "roles.", "rubber",
"rugby", "rules", "runs", "score", "scored", "scorers", "scores",
"shuttlecock", "side", "sides", "single", "singles", "soccer",
"specifically", "sport", "sports", "statistical", "strike",
"striking", "strung", "stumps", "stumps.", "swap", "team",
"teams", "ten", "tennis", "the", "these", "they", "third",
"three", "tries", "two", "umpire", "umpires,", "unable",
"understood", "union", "union);", "unqualified", "unqualified,",
"uses", "using", "valid", "variations", "varying", "way",
"when", "whichever", "wicket", "will", "will.", "within",
"word", "yard")))
EDIT:
I found this workaround to put into a data frame. Not sure how efficient it will be on the large matrix
x <- data.matrix(dist.matrix)
x <- as.data.frame(x)
EDIT2:
> data.frame(rownames(dist.matrix), colnames(dist.matrix), as.vector(dist.matrix))
rownames.dist.matrix. colnames.dist.matrix. as.vector.dist.matrix.
1 ID1_2001 ID2_2001 0.97192896
2 ID1_2001 ID2_2001 0.97288923
3 ID1_2001 ID2_2001 0.01505221
4 ID1_2001 ID2_2001 1.00000000
5 ID1_2001 ID2_2001 1.00000000
6 ID1_2001 ID2_2001 0.69527190
7 ID1_2001 ID2_2001 0.97565046
8 ID1_2001 ID2_2001 0.75908178
9 ID1_2001 ID2_2001 0.77099402
10 ID1_2001 ID2_2001 0.97648342
11 ID1_2001 ID2_2001 0.77840308
12 ID1_2001 ID2_2001 0.76921180
13 ID1_2001 ID2_2001 1.00000000
14 ID1_2001 ID2_2001 1.00000000
15 ID1_2001 ID2_2001 0.05728332
EDIT 3:
I run the following;
dist.matrix = as.matrix(dist.matrix)
df <- data.frame(row = rownames(dist.matrix),
col = colnames(dist.matrix),
value = as.vector(dist.matrix))
Which gives me the following output:
row col value
1 ID1_2001 ID1_2001 0.00000000
2 ID2_2001 ID2_2001 0.97192896
3 ID3_2001 ID3_2001 0.97288923
4 ID1_2000 ID1_2000 0.01505221
5 ID2_2000 ID2_2000 1.00000000
6 ID3_2000 ID3_2000 1.00000000
7 ID1_2001 ID1_2001 0.97192896
8 ID2_2001 ID2_2001 0.00000000
9 ID3_2001 ID3_2001 0.69527190
10 ID1_2000 ID1_2000 0.97565046
11 ID2_2000 ID2_2000 0.75908178
12 ID3_2000 ID3_2000 0.77099402
13 ID1_2001 ID1_2001 0.97288923
14 ID2_2001 ID2_2001 0.69527190
15 ID3_2001 ID3_2001 0.00000000
16 ID1_2000 ID1_2000 0.97648342
17 ID2_2000 ID2_2000 0.77840308
18 ID3_2000 ID3_2000 0.76921180
19 ID1_2001 ID1_2001 0.01505221
20 ID2_2001 ID2_2001 0.97565046
21 ID3_2001 ID3_2001 0.97648342
22 ID1_2000 ID1_2000 0.00000000
23 ID2_2000 ID2_2000 1.00000000
24 ID3_2000 ID3_2000 1.00000000
25 ID1_2001 ID1_2001 1.00000000
26 ID2_2001 ID2_2001 0.75908178
27 ID3_2001 ID3_2001 0.77840308
28 ID1_2000 ID1_2000 1.00000000
29 ID2_2000 ID2_2000 0.00000000
30 ID3_2000 ID3_2000 0.05728332
31 ID1_2001 ID1_2001 1.00000000
32 ID2_2001 ID2_2001 0.77099402
33 ID3_2001 ID3_2001 0.76921180
34 ID1_2000 ID1_2000 1.00000000
35 ID2_2000 ID2_2000 0.05728332
36 ID3_2000 ID3_2000 0.00000000
EDIT 4:
x <- data.matrix(dist.matrix)
x <- as.data.frame(x)
library(tibble)
library(tidyr)
y <- x %>%
rownames_to_column("row") %>%
separate(row, c("id_row", "year_row"), "_")
z <- melt(y)
z
w <- z %>%
separate(variable, c("id_col", "year_col"), "_")
w
Which seems to give
> head(w)
id_row year_row id_col year_col value
1 ID1 2001 ID1 2001 0.00000000
2 ID2 2001 ID1 2001 0.97192896
3 ID3 2001 ID1 2001 0.97288923
4 ID1 2000 ID1 2001 0.01505221
5 ID2 2000 ID1 2001 1.00000000
6 ID3 2000 ID1 2001 1.00000000

Just stick the rownames and colnames in a dataframe alongside the data itself. "Unraveling" the matrix as a vector (and vector recycling for the names) will take care of the rest:
# example data
mat <- matrix(1:100, 10, 10)
rownames(mat) <- paste0("row",1:10)
colnames(mat) <- paste0("col",1:10)
# what you want
df <- data.frame(row = rownames(mat),
col = colnames(mat),
value = as.vector(mat) )
# take a look at the result
head(df)
# row col value
# row1 col1 1
# row2 col2 2
# row3 col3 3
# row4 col4 4
# row5 col5 5
# row6 col6 6

Counts by group and calculation/display of tables

I have information from science papers, where there are binary data on funding source (government (GVT) - yes/no), and categorical data on lead author nationality (LEAD).
This code counts the number of GTV funded papers per lead nation:
gvt.funding=aggregate(data.frame(count=sysrev$GVT),
list(value=sysrev$GVT),length)
gvt.not=format(round(((gvt_funding[1,2]/(gvt_funding[1,2]+
gvt_funding[2,2]))*100),1),nsmall=1)
gvt.yes=format(round(((gvt_funding[2,2]/(gvt_funding[1,2]+
gvt_funding[2,2]))*100),1),nsmall=1)
This code produces the following table:
gvt.not gvt.yes gvt.not(%) gvt.yes(%)
CAN 39 143 21.42857 78.571429
DEU 7 7 50.00000 50.000000
DNK 9 35 20.45455 79.545455
GBR 10 5 66.66667 33.333333
JPN 2 8 20.00000 80.000000
NOR 20 49 28.98551 71.014493
RUS 13 1 92.85714 7.142857
USA 84 104 44.68085 55.319149
TOTAL 214 373 36.45656 63.543441
I need a table aggregated pr year looking like this:
YEAR CAN-GVTyes CAN% DEU-GVTyes DEU% USA-GVTyes USA% etc.
2015 .... .. .... .. .... ..
2014 .... .. .... .. .... ..
2013 .... .. .... .. .... ..
etc
Appreciate any help. Below is an DPUT excerpt of data:
structure(list(YR = c(2015, 2015, 2015, 2015, 2015, 2015, 2015,
2015, 2015, 2015, 2015, 2015, 2014, 2014, 2014, 2014, 2014, 2014,
2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014,
2014, 2014, 2014, 2014, 2014, 2013, 2013, 2013, 2013, 2013, 2013,
2013, 2013, 2013), NRAUTH = c(6, 7, 3, 22, 10, 4, 23, 4, 4, 11,
9, 6, 7, 9, 4, 6, 1, 3, 5, 4, 7, 5, 3, 2, 2, 4, 7, 4, 26, 6,
2, 4, 6, 5, 7, 5, 7, 3, 3, 2, 6, 3, 3), LEAD = structure(c(12L,
5L, 2L, 2L, 12L, 12L, 12L, 11L, 12L, 2L, 5L, 5L, 4L, 4L, 12L,
12L, 11L, 9L, 2L, 2L, 12L, 12L, 1L, 8L, 2L, 12L, 12L, 10L, 4L,
1L, 6L, 12L, 12L, 12L, 4L, 5L, 7L, 2L, 3L, 12L, 12L, 2L, 2L), .Label = c("AUS",
"CAN", "COS", "DEU", "DNK", "GBR", "GRL", "KOR", "NOR", "POL",
"RUS", "USA"), class = "factor"), CAN = c(0, 1, 1, 1, 1, 1, 1,
0, 0, 1, 1, 0, 0, 1, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 1, 0,
0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1), DNK = c(0, 1, 0,
0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0), GRL = c(0,
1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0
), USA = c(1, 0, 0, 0, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0,
0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 0,
0, 1, 1, 0, 0), NOR = c(0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), RUS = c(0, 0, 0, 0, 0, 0, 1, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), NATX = c(0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0,
0, 0, 1, 1, 1, 0, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0), ALL = c(0,
0, 1, 1, 0, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1, 0, 0, 1, 1,
1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0
), AB = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0), BB = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 0, 0), BS = c(0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), CS = c(0, 0, 0, 0, 0,
1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0), DS = c(0,
0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), EG = c(0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1,
0, 0, 0, 0, 0), FB = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 1), GB = c(0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), KB = c(0, 0, 0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), KS = c(0,
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), LS = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0), LP = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), MC = c(0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), NB = c(0, 0, 0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), NW = c(0,
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), SB = c(1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 1, 0, 0, 0), SH = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 1), VM = c(0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), WH = c(0, 0, 0, 0, 0,
0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1), GVT = c(1,
1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0,
0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 1, 1, 1, 1, 0, 1, 0, 1, 1
), NGO = c(0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0,
0, 0, 0, 0, 0), COM = c(0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), ACA = c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), FUNDX = c(0, 1, 1, 1,
0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), FUNDNN = c(0,
0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1, 1, 0, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0
), POPSTAT = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0), POPABU = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0), POPTR = c(0, 0, 0, 0, 0, 0,
1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), BOUND = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), HARV = c(0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0), CC = c(0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 0, 0, 1, 0, 0), HAB = c(0, 0, 0, 0, 1, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0), HABP = c(0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), POLL = c(0,
1, 0, 1, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0
), SHIP = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0), TOUR = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0), BEH = c(0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), REPEC = c(0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), ZOO = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), PHYS = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0), TEK = c(0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), HWC = c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), PRED = c(0, 0, 0, 0,
1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0), METH = c(0,
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0
), DIS = c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0), ANA = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), POPGEN = c(0, 0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), EVO = c(0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), RESIMP = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), ISSUE = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0), PROT = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), PA = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), PEFF = c(0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), .Names = c("YR",
"NRAUTH", "LEAD", "CAN", "DNK", "GRL", "USA", "NOR", "RUS", "NATX",
"ALL", "AB", "BB", "BS", "CS", "DS", "EG", "FB", "GB", "KB",
"KS", "LS", "LP", "MC", "NB", "NW", "SB", "SH", "VM", "WH", "GVT",
"NGO", "COM", "ACA", "FUNDX", "FUNDNN", "POPSTAT", "POPABU",
"POPTR", "BOUND", "HARV", "CC", "HAB", "HABP", "POLL", "SHIP",
"TOUR", "BEH", "REPEC", "ZOO", "PHYS", "TEK", "HWC", "PRED",
"METH", "DIS", "ANA", "POPGEN", "EVO", "RESIMP", "ISSUE", "PROT",
"PA", "PEFF"), row.names = c(NA, -43L), class = "data.frame")

Counting frequencies of categorical parameters, total and by groups, and appending the output to existing matrices

In my data (DPUT below) I have many categorical binary parameters holding various information about scientific papers. These are all 0=absent/no or 1=present/yes. Does the study have government funding, yes or no? Is harvest discussed in the paper, yes or no? And so on, for more than 30 parameters. I also have the nationality of the lead author. One thing I am trying to do is to have a look at the total fraction of studies being funded from governments (GVT), and the same fraction per country.
This code gives a matrix on the number of studies not funded by GVT, and those funded by GVT:
gvt_funding=aggregate(data.frame(count=sysrevt$GVT),list(value=sysrevt$GVT),length)
which gives the matrix:
value count
0 32
1 66
Then I calculate the percentage of total:
gvt.not=format(round(((gvt_funding[1,2]/(gvt_funding[1,2]+
gvt_funding[2,2]))*100),1),nsmall=1)
gvt.yes=format(round(((gvt_funding[2,2]/(gvt_funding[1,2]+
gvt_funding[2,2]))*100),1),nsmall=1)
Now I want to append these percentages in a new column in the matrix, change the name of these two columns to "TOTAL"and "TOTAL%", and then to calculate the same ratios and percentages for all nations (as shown by the column "LEAD"), and append these ratios and percentages to the same matrix with matching column titles.
It is quite possible that there are several more elegant ways to do this, but this is as far as I have come...
Here's the data:
structure(list(YR = c(2015, 2015, 2015, 2015, 2015, 2015, 2015,
2015, 2015, 2015, 2015, 2015, 2014, 2014, 2014, 2014, 2014, 2014,
2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014,
2014, 2014, 2014, 2014, 2014, 2013, 2013, 2013, 2013, 2013, 2013,
2013, 2013, 2013), NRAUTH = c(6, 7, 3, 22, 10, 4, 23, 4, 4, 11,
9, 6, 7, 9, 4, 6, 1, 3, 5, 4, 7, 5, 3, 2, 2, 4, 7, 4, 26, 6,
2, 4, 6, 5, 7, 5, 7, 3, 3, 2, 6, 3, 3), LEAD = structure(c(12L,
5L, 2L, 2L, 12L, 12L, 12L, 11L, 12L, 2L, 5L, 5L, 4L, 4L, 12L,
12L, 11L, 9L, 2L, 2L, 12L, 12L, 1L, 8L, 2L, 12L, 12L, 10L, 4L,
1L, 6L, 12L, 12L, 12L, 4L, 5L, 7L, 2L, 3L, 12L, 12L, 2L, 2L), .Label = c("AUS",
"CAN", "COS", "DEU", "DNK", "GBR", "GRL", "KOR", "NOR", "POL",
"RUS", "USA"), class = "factor"), CAN = c(0, 1, 1, 1, 1, 1, 1,
0, 0, 1, 1, 0, 0, 1, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 1, 0,
0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1), DNK = c(0, 1, 0,
0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0), GRL = c(0,
1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0
), USA = c(1, 0, 0, 0, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0,
0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 0,
0, 1, 1, 0, 0), NOR = c(0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), RUS = c(0, 0, 0, 0, 0, 0, 1, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), NATX = c(0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0,
0, 0, 1, 1, 1, 0, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0), ALL = c(0,
0, 1, 1, 0, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1, 0, 0, 1, 1,
1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0
), AB = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0), BB = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 0, 0), BS = c(0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), CS = c(0, 0, 0, 0, 0,
1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0), DS = c(0,
0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), EG = c(0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1,
0, 0, 0, 0, 0), FB = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 1), GB = c(0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), KB = c(0, 0, 0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), KS = c(0,
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), LS = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0), LP = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), MC = c(0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), NB = c(0, 0, 0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), NW = c(0,
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), SB = c(1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 1, 0, 0, 0), SH = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 1), VM = c(0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), WH = c(0, 0, 0, 0, 0,
0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1), GVT = c(1,
1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0,
0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 1, 1, 1, 1, 0, 1, 0, 1, 1
), NGO = c(0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0,
0, 0, 0, 0, 0), COM = c(0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), ACA = c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), FUNDX = c(0, 1, 1, 1,
0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), FUNDNN = c(0,
0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1, 1, 0, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0
), POPSTAT = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0), POPABU = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0), POPTR = c(0, 0, 0, 0, 0, 0,
1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), BOUND = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), HARV = c(0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0), CC = c(0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 0, 0, 1, 0, 0), HAB = c(0, 0, 0, 0, 1, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0), HABP = c(0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), POLL = c(0,
1, 0, 1, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0
), SHIP = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0), TOUR = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0), BEH = c(0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), REPEC = c(0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), ZOO = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), PHYS = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0), TEK = c(0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), HWC = c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), PRED = c(0, 0, 0, 0,
1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0), METH = c(0,
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0
), DIS = c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0), ANA = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), POPGEN = c(0, 0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), EVO = c(0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), RESIMP = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), ISSUE = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0), PROT = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), PA = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), PEFF = c(0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), .Names = c("YR",
"NRAUTH", "LEAD", "CAN", "DNK", "GRL", "USA", "NOR", "RUS", "NATX",
"ALL", "AB", "BB", "BS", "CS", "DS", "EG", "FB", "GB", "KB",
"KS", "LS", "LP", "MC", "NB", "NW", "SB", "SH", "VM", "WH", "GVT",
"NGO", "COM", "ACA", "FUNDX", "FUNDNN", "POPSTAT", "POPABU",
"POPTR", "BOUND", "HARV", "CC", "HAB", "HABP", "POLL", "SHIP",
"TOUR", "BEH", "REPEC", "ZOO", "PHYS", "TEK", "HWC", "PRED",
"METH", "DIS", "ANA", "POPGEN", "EVO", "RESIMP", "ISSUE", "PROT",
"PA", "PEFF"), row.names = c(NA, -43L), class = "data.frame")

Like this?
tab <- addmargins(table(sysrevt$LEAD, sysrevt$GVT), 1)
tab <- cbind(tab, 100 * prop.table(tab, 1))
colnames(tab) <- c('gvt.not', 'gvt.yes', 'gvt.not(%)', 'gvt.yes(%)')
rownames(tab)[nrow(tab)] <- 'TOTAL'
round(tab, 2)
The output is
gvt.not gvt.yes gvt.not(%) gvt.yes(%)
AUS 1 1 50.00 50.00
CAN 1 8 11.11 88.89
COS 1 0 100.00 0.00
DEU 1 3 25.00 75.00
DNK 0 4 0.00 100.00
GBR 1 0 100.00 0.00
GRL 0 1 0.00 100.00
KOR 1 0 100.00 0.00
NOR 0 1 0.00 100.00
POL 1 0 100.00 0.00
RUS 1 1 50.00 50.00
USA 7 9 43.75 56.25
TOTAL 15 28 34.88 65.12

How to compare consecutive rows in a matrix column and then change value accordingly

I have a matrix full of 1's and 0's. The columns represent samples and the rows represent chromosomes.
I would like to keep all rows that have consecutive 1's in them (ie at least two consecutive rows with a 1 in it). This has to be restricted per chromosome (so that consecutive 1's between two chromosomes is not counted).
I would like to do this for each column in the matrix.
My data is as follows:
chr leftPos OC_030_ST.res OC_031_WG.res
1 4324 0 1
1 23433 1 1
1 34436 1 0
1 64755 1 1
3 234 1 0
3 354 0 1
4 1666 0 1
4 4565 0 1
5 34777 1 1
7 2345 1 1
7 4567 1 1
and the output should be:
chr leftPos OC_030_ST.res OC_031_WG.res
1 4324 0 1
1 23433 1 1
1 34436 1 0
1 64755 1 0
3 234 0 0
3 354 0 0
4 1666 0 1
4 4565 0 1
5 34777 0 0
7 2345 1 1
7 4567 1 1
I don't know how to compare consecutive rows according to chromosome. I imagine I could group by dplyr and somehow compare rows but the comparison is a bit beyond me.
EDIT
Using dput actual data
structure(list(chr = 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, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), leftPos = c(240000,
1080000, 1200000, 1320000, 1440000, 1800000, 2400000, 2520000,
3120000, 3360000, 3480000, 3600000, 3720000, 4200000, 4560000,
4920000, 5040000, 5160000, 5280000, 6000000, 7080000, 7200000,
7320000, 7440000, 7560000, 7680000, 7800000, 8280000, 8400000,
8520000, 8760000, 9120000, 9720000, 9840000, 9960000, 10080000,
10200000, 10320000, 10440000, 10560000, 10800000, 11040000, 11160000,
11280000, 11400000, 11520000, 11760000, 11880000, 12000000, 12120000
), chr.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), leftPos.res = c(0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0), OC_AH_026C.res = c(0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), OC_AH_026C.1.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_AH_026C.2.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_AH_084C.res = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0), OC_AH_086C.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_AH_086C.1.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_AH_086C.2.res = c(0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0), OC_AH_086C.3.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0), OC_AH_088C.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_AH_094C.res = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0), OC_AH_094C.1.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_AH_094C.2.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_AH_094C.3.res = c(0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0), OC_AH_094C.4.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_AH_094C.5.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_AH_094C.6.res = c(0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0), OC_AH_094C.7.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_AH_096C.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_AH_100C.res = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0), OC_AH_100C.1.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_AH_127C.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_AH_133C.res = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0), OC_ED_008C.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_ED_008C.1.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0), OC_ED_008C.2.res = c(0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
0, 0), OC_ED_008C.3.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_ED_016C.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_ED_031C.res = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0), OC_ED_036C.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_GS_001C.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_QE_062C.res = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0), OC_RS_010C.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_RS_027C.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_RS_027C.1.res = c(0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0), OC_RS_027C.2.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_SH_051C.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_ST_014C.res = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0), OC_ST_014C.1.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_ST_020C.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_ST_024C.res = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0), OC_ST_033C.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_ST_034C.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_ST_034C.1.res = c(0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0), OC_ST_034C.2.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_ST_035C.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_ST_036C.res = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0), OC_ST_040C.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_WG_002C.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), OC_WG_005C.res = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0), OC_WG_006C.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), OC_WG_019C.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), Type.res = c(NA_real_, NA_real_, NA_real_,
NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_,
NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_,
NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_,
NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_,
NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_,
NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_,
NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), ZSSLX.10457.FastSeqA.BloodDMets_16AF_AHMMH.s_1.r_1.fq.gz.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), ZSSLX.10457.FastSeqB.BloodDMets_13AF_AHMMH.s_1.r_1.fq.gz.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0), ZSSLX.10457.FastSeqC.BloodDMets_16AF_AHMMH.s_1.r_1.fq.gz.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0), ZSSLX.10457.FastSeqD.BloodDMets_27AF_AHMMH.s_1.r_1.fq.gz.res = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0), Means.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
sd.res = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), count = 1:50), .Names = c("chr",
"leftPos", "chr.res", "leftPos.res", "OC_AH_026C.res", "OC_AH_026C.1.res",
"OC_AH_026C.2.res", "OC_AH_084C.res", "OC_AH_086C.res", "OC_AH_086C.1.res",
"OC_AH_086C.2.res", "OC_AH_086C.3.res", "OC_AH_088C.res", "OC_AH_094C.res",
"OC_AH_094C.1.res", "OC_AH_094C.2.res", "OC_AH_094C.3.res", "OC_AH_094C.4.res",
"OC_AH_094C.5.res", "OC_AH_094C.6.res", "OC_AH_094C.7.res", "OC_AH_096C.res",
"OC_AH_100C.res", "OC_AH_100C.1.res", "OC_AH_127C.res", "OC_AH_133C.res",
"OC_ED_008C.res", "OC_ED_008C.1.res", "OC_ED_008C.2.res", "OC_ED_008C.3.res",
"OC_ED_016C.res", "OC_ED_031C.res", "OC_ED_036C.res", "OC_GS_001C.res",
"OC_QE_062C.res", "OC_RS_010C.res", "OC_RS_027C.res", "OC_RS_027C.1.res",
"OC_RS_027C.2.res", "OC_SH_051C.res", "OC_ST_014C.res", "OC_ST_014C.1.res",
"OC_ST_020C.res", "OC_ST_024C.res", "OC_ST_033C.res", "OC_ST_034C.res",
"OC_ST_034C.1.res", "OC_ST_034C.2.res", "OC_ST_035C.res", "OC_ST_036C.res",
"OC_ST_040C.res", "OC_WG_002C.res", "OC_WG_005C.res", "OC_WG_006C.res",
"OC_WG_019C.res", "Type.res", "ZSSLX.10457.FastSeqA.BloodDMets_16AF_AHMMH.s_1.r_1.fq.gz.res",
"ZSSLX.10457.FastSeqB.BloodDMets_13AF_AHMMH.s_1.r_1.fq.gz.res",
"ZSSLX.10457.FastSeqC.BloodDMets_16AF_AHMMH.s_1.r_1.fq.gz.res",
"ZSSLX.10457.FastSeqD.BloodDMets_27AF_AHMMH.s_1.r_1.fq.gz.res",
"Means.res", "sd.res", "count"), row.names = c(NA, 50L), class = "data.frame")

Here's a solution applying a function across chr values using the by = argument to data.table. Non-adjacent sequences are located using rle(). Should be fast too.
First, here is the data as I input it:
df <- read.table(textConnection(
"chr leftPos OC_030_ST.res OC_031_WG.res
1 4324 0 1
1 23433 1 1
1 34436 1 0
1 64755 1 1
3 234 1 0
3 354 0 1
4 1666 0 1
4 4565 0 1
5 34777 1 1
7 2345 1 1
7 4567 1 1"), header = TRUE)
Then the code to process the result:
# function to take an integer vector and make non-consecutive 1s into 0s
convertNonRuns <- function(booleanVec) {
rleVals <- rle(booleanVec)
makeZeroIndex1 <- which(rleVals$lengths == 1 & rleVals$values == 1)
makeZeroIndex2 <- sapply(makeZeroIndex1, function(x) cumsum(rleVals$lengths[1:x])[x])
if (length(makeZeroIndex2))
booleanVec[makeZeroIndex2] <- 0L
as.integer(booleanVec)
}
require(data.table)
dt <- data.table(df)
# use data.table's by command to convert runs within chr(omosome)
dt[, c("OC_030_ST.res", "OC_031_WG.res") :=
list(convertNonRuns(OC_030_ST.res), convertNonRuns(OC_031_WG.res)),
by = chr]
dt
## chr leftPos OC_030_ST.res OC_031_WG.res
## 1: 1 4324 0 1
## 2: 1 23433 1 1
## 3: 1 34436 1 0
## 4: 1 64755 1 0
## 5: 3 234 0 0
## 6: 3 354 0 0
## 7: 4 1666 0 1
## 8: 4 4565 0 1
## 9: 5 34777 0 0
## 10: 7 2345 1 1
## 11: 7 4567 1 1
Added
For the newly added dput data, this will work:
# select all variables OC*.res
varnamesToChange <- names(dt)[grep("^OC.*\\.res$", names(dt))]
dt[, varnamesToChange := lapply(varnamesToChange, function(x) dt[[x]]), by = chr]
I am using data.table version 1.9.6.

data.table solution, building on my initial ave solution, which is also below:
library(data.table)
setDT(dat)
for (nam in names(dat)[3:4]) {
dat[,
c(nam) := ((length((get(nam)==1)[get(nam)]) >= 2) & get(nam)==1)+0L,
by=list(chr, cumsum(get(nam)==0))
]
}
# chr leftPos OC_030_ST.res OC_031_WG.res
# 1: 1 4324 0 1
# 2: 1 23433 1 1
# 3: 1 34436 1 0
# 4: 1 64755 1 0
# 5: 3 234 0 0
# 6: 3 354 0 0
# 7: 4 1666 0 1
# 8: 4 4565 0 1
# 9: 5 34777 0 0
#10: 7 2345 1 1
#11: 7 4567 1 1
And my attempt using ave with a custom function:
fun <- function(x,grp,limit=2) {
runs <- ave(
x==1,
list(grp,cumsum(x==0)),
FUN=function(g) length(g[g]) >= limit
)
as.numeric(runs & x==1)
}
lapply(dat[3:4], fun, grp=dat$chr)
#$OC_030_ST.res
# [1] 0 1 1 1 0 0 0 0 0 1 1
#
#$OC_031_WG.res
# [1] 1 1 0 0 0 0 1 1 0 1 1
To overwrite your original data:
dat[3:4] <- lapply(dat[3:4], fun, grp=dat$chr)

f0(colNr,df) contains the row numbers in which the column df[,colNr] should change to 0. g(df) is the converted data frame.
f0 <- function( colNr, df )
{
col <- df[,colNr]
n1 <- which( col == 1 ) # The `1`-rows.
d0 <- which( diff(col) == 0 ) # Consecutive entries are equal.
dc0 <- which( diff(df[,1]) == 0 ) # Same chromosome.
m <- intersect( n1-1, intersect( d0, dc0 ) )
return ( setdiff( 1:nrow(df), union(m,m+1) ) )
}
g <- function( df )
{
for ( i in 3:ncol(df) ) { df[f0(i,df),i] <- 0 }
return ( df )
}
.
Example 1:
> df
chr leftPos OC_030_ST.res OC_031_WG.res
1 1 4324 0 1
2 1 23433 1 1
3 1 34436 1 0
4 1 64755 1 1
5 3 234 1 0
6 3 354 0 1
7 4 1666 0 1
8 4 4565 0 1
9 5 34777 0 1
10 7 2345 1 1
11 7 4567 1 1
> g(df)
chr leftPos OC_030_ST.res OC_031_WG.res
1 1 4324 0 1
2 1 23433 1 1
3 1 34436 1 0
4 1 64755 1 0
5 3 234 0 0
6 3 354 0 0
7 4 1666 0 1
8 4 4565 0 1
9 5 34777 0 0
10 7 2345 1 1
11 7 4567 1 1
>
Example 2:
> df
chr leftPos OC_030_ST.res OC_031_WG.res
1 1 4324 0 1
2 1 23433 1 1
3 1 34436 1 0
4 1 64755 1 1
5 3 234 1 0
6 3 354 1 1
7 4 1666 0 1
8 4 4565 1 1
9 5 34777 0 0
10 5 1234 1 0
11 7 2345 1 1
12 7 4567 1 1
> g(df)
chr leftPos OC_030_ST.res OC_031_WG.res
1 1 4324 0 1
2 1 23433 1 1
3 1 34436 1 0
4 1 64755 1 0
5 3 234 1 0
6 3 354 1 0
7 4 1666 0 1
8 4 4565 0 1
9 5 34777 0 0
10 5 1234 0 0
11 7 2345 1 1
12 7 4567 1 1
>

A simple trick can be to compare the original data set, say df, with its own copy df[-1,], which essentially takes the first row off.
Comparing (columnswise) df$OC_030_ST.res == df[-1,]$OC_030_ST.res (likewise for the others) gives back a true table where each element is being compared with its next one.

Perhaps you can make the next piece into a function and apply that per column per chromosome:
rand <- c(0,0,0,1,1,1,0,0,1,0,1,0,1,1,1,0,0,1,1,0)
first=T
keep <- vector(length=length(rand),'numeric')
for (i in 1:length(rand)){
if (first == T){first=F;if ((rand[i] == 1) & (rand[i+1] == 1)){keep[i] <- 1}} #check if first is 1 and had neigbour 1
else if (rand[i] == 0){keep[i] <- 0} # if 0 than keep = 0
else if (i == length(rand)){if (rand[i-1] == 1){keep[i] <- 1}} #if last than check if 1 and neighbour is 1 than keep = 1
else if ((rand[i-1]==1) | (rand[i+1]==1)){keep[i] <- 1} #if 1 and has neighbour 1 than keep =1
}
Output:
[1] 0 0 0 1 1 1 0 0 0 0 0 0 1 1 1 0 0 1 1 0

Resources