Just to show you that there are always numerous ways to do the same stuff, here's a solution that feels a little more like typical R code to me -- nothing wrong with Christian's answer though, consider my example for educational purposes.
You will find that R table formats will differ from what you find useful in Excel. Generally speaking, tables will be longer, rather than wide.
So my first lines of codes mostly deal with formatting, you can easily do that in Excel if you prefer.
library(magrittr) # this is a useful package that introduces %>% for stringing commands together
# I saved your table above in a file called "test.txt"
test <- read.table("~/Downloads/test.txt", header = TRUE, stringsAsFactors = FALSE)
Ind M1 M2 M3 M4 M5
1 P1 A/A Unused G/A T/T T/T
2 P2 T/T A/A A/A A/A G/G
3 1 T/A A/A G/A T/T G/G
4 2 T/T A/A G/A T/T T/G
5 3 T/T A/A G/A T/T T/G
6 4 T/T A/A G/A A/T G/G
7 5 T/A A/A G/A A/T T/G
I'll make a separate table just for the parents.
parents <- as.data.frame(t(test[1:2,-1]))
names(parents) = c("P1","P2")
# replacing "unused" with NA because NA is a native identifier of missing data
parents$P1 <- gsub("Unused", NA, parents$P1)
parents$P2 <- gsub("Unused", NA, parents$P2)
# now, I'm adding separate columns for the individual alleles of P1 and P2
# gsub has the syntax: gsub(pattern to be replaced, replacement, string to operate on)
parents$P1.all1 <- gsub("\\/.","", parents$P1) # this replaces the / and the letter after it with nothing
parents$P1.all2 <- gsub(".\\/","", parents$P1) # this replaces the / and the letter BEFORE it with nothing
parents$P2.all1 <- gsub("\\/.","", parents$P2)
parents$P2.all2 <- gsub(".\\/","", parents$P2)
P1 P2 P1.all1 P1.all2 P2.all1 P2.all2
M1 A/A T/T A A T T
M2 <NA> A/A <NA> <NA> A A
M3 G/A A/A G A A A
M4 T/T A/A T T A A
M5 T/T G/G T T G G
I also make a separate table for the offspring:
offspring <- test[-c(1:2),] # removing the lines corresponding to the parents
offspring <- reshape2::melt(offspring, id.vars = "Ind", variable.name = "type") # changing the format using function melt of the library reshape2
Ind type value
1 1 M1 T/A
2 2 M1 T/T
3 3 M1 T/T
4 4 M1 T/T
5 5 M1 T/A
6 1 M2 A/A
# like for the parents, I add separate columns for allele 1 and 2
offspring$all.1 <- gsub("\\/.","", offspring$value)
offspring$all.2 <- gsub(".\\/","", offspring$value)
Now, let's get to work.
First, identify the individual types (M1 to M5) that are relevant based on your first criterion: P1 and P2 should be homozygous and P1 should not be the same as P2.
relevant_offspring <- subset(parents, ((P1.all1 == P1.all2) & (P2.all1 == P2.all2)) & P1 != P2 ) %>% rownames
# use those names to filter the offspring table
offspring <- subset(offspring, type %in% relevant_offspring)
Now, we need to combine the parent and offspring info again.
off_par <- merge(offspring, parents, by.x = "type", by.y = "row.names")
type Ind value all.1 all.2 P1 P2 P1.all1 P1.all2 P2.all1 P2.all2
1 M1 1 T/A T A A/A T/T A A T T
2 M1 2 T/T T T A/A T/T A A T T
3 M1 3 T/T T T A/A T/T A A T T
4 M1 4 T/T T T A/A T/T A A T T
5 M1 5 T/A T A A/A T/T A A T T
6 M4 1 T/T T T T/T A/A T T A A
Let's add a new column with your code for match, no match, heterozygous.
I'm going to use the
ifelse() function that has the following syntax:
ifelse( condition, what should happen if condition is TRUE, what should happen if condition is FALSE).
off_par$code <- with(off_par, ifelse(value == P2, "1", # homozygous match
ifelse( all.1 == all.2, "0", # if it's not a match, but still homozygous, we put 0
ifelse( (all.1 == P1.all1 | all.1 == P2.all1) & (all.2 == P1.all1 | all.2 == P2.all1) , "H", NA )
The last condition seems a bit complicated, but I just want to make sure we're really only setting an "H" if we make sure that we have a proper heterozygous. There should be an NA if the individual has a completely inexplicable genotype.
The result looks similar to what Christian had once we change the format again:
off_par[c("type", "Ind","code")] %>% reshape2::dcast(., Ind~type, value.var = "code")
Ind M1 M4 M5
1 1 H 0 1
2 2 1 0 H
3 3 1 0 H
4 4 1 H 1
5 5 H H H