{"id":400597,"date":"2026-04-16T06:04:00","date_gmt":"2026-04-16T12:04:00","guid":{"rendered":"https:\/\/quantixed.org\/?p=3753"},"modified":"2026-04-16T06:04:00","modified_gmt":"2026-04-16T12:04:00","slug":"my-domain-proteome-wide-scanning-of-tmds","status":"publish","type":"post","link":"https:\/\/www.r-bloggers.com\/2026\/04\/my-domain-proteome-wide-scanning-of-tmds\/","title":{"rendered":"My Domain: proteome-wide scanning of TMDs"},"content":{"rendered":"\r\n\r\n
\r\n[This article was first published on Rstats \u2013 quantixed<\/a><\/strong>, and kindly contributed to R-bloggers<\/a>]. (You can report issue about the content on this page here<\/a>)\r\n
Want to share your content on R-bloggers? click here<\/a> if you have a blog, or here<\/a> if you don't.\r\n<\/div>\n\n

I wanted to know:<\/p>\n\n\n\n

    \n
  1. how many proteins in the human proteome have transmembrane domains?<\/li>\n\n\n\n
  2. of those that do, how many have 1 or 2 or n transmembrane domains?<\/li>\n<\/ol>\n\n\n\n

    After a little bit of searching, I couldn\u2019t find any answers. So I decided to use R to retrieve the necessary info from Uniprot and calculate it myself. I thought I\u2019d post it here in case it\u2019s useful for others.<\/p>\n\n\n\n

    Human<\/h2>\n\n\n\n
    \"\"\n\t\t\t\n\t\t\t\t\n\t\t\t<\/svg>\n\t\t<\/button><\/figure>\n\n\n\n

    We\u2019ll start with the info I wanted. According to Uniprot there are 20,659 proteins in the human proteome. One quarter of these have one or more TMD<\/strong>. The majority have one TMD and there are almost 1,000 7TM proteins (all those GPCRs, I guess). There\u2019s 413 4TM and 327 2TM proteins. We can find examples of 1 through 17 TMDs, there\u2019s no proteins with 18, 4 proteins with 19TM, 21 with 24TM and 2 with 38TM.<\/p>\n\n\n\n

    The analysis is done simply by looking at how many TRANSMEM<\/code> Uniprot has for each IDs in the reference proteome. I have not distinguished between helical and partial entries, and of course it\u2019s possible that the annotations are not quite correct.<\/p>\n\n\n\n

    TMDs<\/td>Count<\/td>Frequency (proteome as %)<\/td>Frequency (TMDPs as %)<\/td><\/tr>
    1<\/td>2402<\/td>11.6<\/td>45.8<\/td><\/tr>
    2<\/td>327<\/td>1.6<\/td>6.2<\/td><\/tr>
    3<\/td>159<\/td>0.8<\/td>3.0<\/td><\/tr>
    4<\/td>413<\/td>2.0<\/td>7.9<\/td><\/tr>
    5<\/td>77<\/td>0.4<\/td>1.5<\/td><\/tr>
    6<\/td>276<\/td>1.3<\/td>5.3<\/td><\/tr>
    7<\/td>947<\/td>4.6<\/td>18.0<\/td><\/tr>
    8<\/td>83<\/td>0.4<\/td>1.6<\/td><\/tr>
    9<\/td>63<\/td>0.3<\/td>1.2<\/td><\/tr>
    10<\/td>123<\/td>0.6<\/td>2.3<\/td><\/tr>
    11<\/td>75<\/td>0.4<\/td>1.4<\/td><\/tr>
    12<\/td>202<\/td>1.0<\/td>3.8<\/td><\/tr>
    13<\/td>24<\/td>0.1<\/td>0.5<\/td><\/tr>
    14<\/td>26<\/td>0.1<\/td>0.5<\/td><\/tr>
    15<\/td>13<\/td>0.1<\/td>0.2<\/td><\/tr>
    16<\/td>1<\/td>0.0<\/td>0.0<\/td><\/tr>
    17<\/td>9<\/td>0.0<\/td>0.2<\/td><\/tr>
    19<\/td>4<\/td>0.0<\/td>0.1<\/td><\/tr>
    24<\/td>21<\/td>0.1<\/td>0.4<\/td><\/tr>
    38<\/td>2<\/td>0.0<\/td>0.0<\/td><\/tr><\/tbody><\/table><\/figure>\n\n\n\n

    Having written this code, I decided to run some other proteomes to see how they compare.<\/p>\n\n\n\n

    Model organisms<\/h2>\n\n\n\n
    \n
    \"\"\n\t\t\t\n\t\t\t\t\n\t\t\t<\/svg>\n\t\t<\/button><\/figure>\n\n\n\n
    \"\"\n\t\t\t\n\t\t\t\t\n\t\t\t<\/svg>\n\t\t<\/button><\/figure>\n\n\n\n
    \"\"\n\t\t\t\n\t\t\t\t\n\t\t\t<\/svg>\n\t\t<\/button><\/figure>\n\n\n\n
    \"\"\n\t\t\t\n\t\t\t\t\n\t\t\t<\/svg>\n\t\t<\/button><\/figure>\n<\/figure>\n\n\n\n

    These four organisms have between 18% and 29% of the proteome made of proteins with TMDs. The pattern of numbers of TMDs are kind of similar although there\u2019s no peak in yeast for 7TM and the peaks for 2, 4, 6 or 12 TMs differ from human.<\/p>\n\n\n\n

    Maybe this information is out there in some database or other. As I said, I couldn\u2019t find something easily. Even if there are more precise ways of determining the TMDs, I think this data is good enough to know roughly what the proportions are.<\/p>\n\n\n\n

    The code<\/h2>\n\n\n\n

    I manually downloaded the fasta.gz files for the reference proteomes. They are currently linked here<\/a>.<\/p>\n\n\n\n

    To extract all the Uniprot IDs, I used a shell one-liner:<\/p>\n\n\n

    \nawk '\/^>sp\\|.*\\|\/{gsub(\/^>sp\\|\/,""); gsub(\/\\|.*\/,""); print ">" $0; next} {print}' file.fasta | grep "^>" | sed 's\/>\/\/g' > species_uniprot.txt\n<\/pre>\n\n\n
    Then I used this R script. The main function can probably be simplified. I had to add several checks to make sure I got all the data back from the API. Before posting, I tried to cut it back to make it easier to read, but Ionly succeeded in breaking the script! This is the working version.<\/p>\n\n\n
    \n# if (!require("BiocManager", quietly = TRUE)) {\n#   install.packages("BiocManager") \n# }\n# BiocManager::install("biomaRt")\nlibrary(httr)\nlibrary(stringr)\nlibrary(ggplot2)\nlibrary(biomaRt)\nlibrary(dplyr)\nlibrary(tidyr)\nlibrary(cowplot)\n\n## FUNCTIONS ----\n\nisJobReady <- function(jobId, pollingInterval = 5, maxWaitSeconds = 3600) {\n  if (is.null(jobId) || length(jobId) == 0 || is.na(jobId) || !nzchar(jobId)) {\n    return(FALSE)\n  }\n  nTries <- ceiling(maxWaitSeconds \/ pollingInterval)\n  for (i in 1:nTries) {\n    url <- paste("https:\/\/rest.uniprot.org\/idmapping\/status\/", jobId, sep = "")\n    r <- GET(url = url, accept_json())\n    status <- content(r, as = "parsed")\n    if (!is.null(status[["results"]]) || !is.null(status[["failedIds"]])) {\n      return(TRUE)\n    }\n    if (!is.null(status[["messages"]])) {\n      print(status[["messages"]])\n      return(FALSE)\n    }\n    Sys.sleep(pollingInterval)\n  }\n  return(FALSE)\n}\n\nretrieveUniprotInfo <- function(x,\n                                chunk_size = 5000,\n                                maxWaitSeconds = 3600,\n                                taxId = "9606",\n                                progress = TRUE) {\n  normalize_uniprot_ids <- function(values) {\n    values <- trimws(values)\n    # Accept FASTA-style headers like: sp|P12345|... or tr|A0A...|...\n    m <- str_match(values, regex("^>?\\\\s*(?:sp|tr)\\\\|([^|]+)\\\\|", ignore_case = TRUE))\n    values <- ifelse(!is.na(m[, 2]), m[, 2], values)\n    values\n  }\n  \n  ids <- unique(normalize_uniprot_ids(x))\n  ids <- ids[!is.na(ids) & nzchar(ids)]\n  if (length(ids) == 0) {\n    stop("No valid identifiers were provided to retrieveUniprotInfo().")\n  }\n  \n  fields <- "accession,id,protein_name,gene_names,ft_transmem,length,cc_function,cc_subcellular_location,go_p,go_c"\n  acc_pattern <- "^[OPQ][0-9][A-Z0-9]{3}[0-9](-[0-9]+)?$|^[A-NR-Z][0-9](?:[A-Z][A-Z0-9]{2}[0-9]){1,2}(-[0-9]+)?$"\n  is_accession <- str_detect(ids, acc_pattern)\n  \n  split_into_chunks <- function(values, chunk_size = chunk_size) {\n    split(values, ceiling(seq_along(values) \/ chunk_size))\n  }\n  \n  get_next_link <- function(link_header) {\n    if (is.null(link_header)) {\n      return(NULL)\n    }\n    links <- unlist(strsplit(link_header, ",\\\\s*"))\n    next_link <- links[str_detect(links, "rel=\\\\\\"next\\\\\\"")]\n    if (length(next_link) == 0) {\n      return(NULL)\n    }\n    next_url <- str_extract(next_link[1], "(?<=<).+?(?=>)")\n    if (is.na(next_url) || !nzchar(next_url)) {\n      return(NULL)\n    }\n    next_url\n  }\n  \n  read_tsv_response <- function(resp) {\n    read.table(\n      text = content(resp, as = "text", encoding = "UTF-8"),\n      sep = "\\t",\n      header = TRUE,\n      fill = TRUE,\n      quote = "",\n      comment.char = "",\n      check.names = FALSE\n    )\n  }\n  \n  fetch_from_redirect <- function(redirect_url) {\n    if (is.null(redirect_url) || length(redirect_url) == 0 ||\n        is.na(redirect_url) || !nzchar(redirect_url)) {\n      return(NULL)\n    }\n    \n    # The paged idmapping results endpoint is capped at size <= 500.\n    # Use stream endpoint to retrieve the full chunk in one response.\n    stream_url <- gsub("\/results\/", "\/results\/stream\/", redirect_url)\n    sep <- ifelse(str_detect(stream_url, "\\\\?"), "&", "?")\n    stream_url <- paste0(\n      stream_url,\n      sep,\n      "fields=", URLencode(fields, reserved = TRUE),\n      "&format=tsv"\n    )\n    \n    r <- GET(url = stream_url)\n    if (status_code(r) < 400) {\n      return(read_tsv_response(r))\n    }\n    \n    # Fallback to paged endpoint if stream is unavailable.\n    sep <- ifelse(str_detect(redirect_url, "\\\\?"), "&", "?")\n    url <- paste0(\n      redirect_url,\n      sep,\n      "fields=", URLencode(fields, reserved = TRUE),\n      "&format=tsv&size=500"\n    )\n    \n    r <- GET(url = url)\n    stop_for_status(r)\n    resultsTable <- read_tsv_response(r)\n    \n    next_url <- get_next_link(headers(r)[["link"]])\n    while (!is.null(next_url) && !is.na(next_url) && nzchar(next_url)) {\n      r <- GET(url = next_url)\n      stop_for_status(r)\n      resultsTable <- rbind(resultsTable, read_tsv_response(r))\n      next_url <- get_next_link(headers(r)[["link"]])\n    }\n    \n    resultsTable\n  }\n  \n  map_ids <- function(values, from_db, to_db, chunk_size, taxId = NULL,\n                      label = "ids") {\n    if (length(values) == 0) {\n      return(NULL)\n    }\n    \n    results_list <- list()\n    chunks <- split_into_chunks(values, chunk_size = chunk_size)\n    n_chunks <- length(chunks)\n    for (i in seq_along(chunks)) {\n      chunk <- chunks[[i]]\n      if (isTRUE(progress)) {\n        cat(sprintf("[UniProt] %s chunk %d\/%d (%d ids)\\n",\n                    label, i, n_chunks, length(chunk)))\n      }\n      \n      files <- list(\n        ids = paste0(chunk, collapse = ","),\n        from = from_db,\n        to = to_db\n      )\n      if (!is.null(taxId)) {\n        files$taxId <- taxId\n      }\n      \n      r <- POST(url = "https:\/\/rest.uniprot.org\/idmapping\/run", body = files,\n                encode = "multipart", accept_json())\n      stop_for_status(r)\n      submission <- content(r, as = "parsed", encoding = "UTF-8")\n      \n      job_id <- submission[["jobId"]]\n      if (is.null(job_id) || length(job_id) == 0 || is.na(job_id) || !nzchar(job_id)) {\n        if (isTRUE(progress)) {\n          cat(sprintf("[UniProt] %s chunk %d\/%d: no jobId returned\\n",\n                      label, i, n_chunks))\n        }\n        next\n      }\n      if (!isJobReady(job_id, maxWaitSeconds = maxWaitSeconds)) {\n        if (isTRUE(progress)) {\n          cat(sprintf("[UniProt] %s chunk %d\/%d: timeout\/not ready\\n",\n                      label, i, n_chunks))\n        }\n        next\n      }\n      \n      details_url <- paste("https:\/\/rest.uniprot.org\/idmapping\/details\/",\n                           job_id, sep = "")\n      r <- GET(url = details_url, accept_json())\n      stop_for_status(r)\n      details <- content(r, as = "parsed", encoding = "UTF-8")\n      \n      redirect_url <- details[["redirectURL"]]\n      if (is.null(redirect_url) || length(redirect_url) == 0 ||\n          is.na(redirect_url) || !nzchar(redirect_url)) {\n        if (isTRUE(progress)) {\n          cat(sprintf("[UniProt] %s chunk %d\/%d: missing redirectURL\\n",\n                      label, i, n_chunks))\n        }\n        next\n      }\n      chunk_result <- fetch_from_redirect(redirect_url)\n      if (is.null(chunk_result)) {\n        if (isTRUE(progress)) {\n          cat(sprintf("[UniProt] %s chunk %d\/%d: invalid redirectURL\\n",\n                      label, i, n_chunks))\n        }\n        next\n      }\n      \n      results_list[[length(results_list) + 1]] <- chunk_result\n      if (isTRUE(progress)) {\n        cat(sprintf("[UniProt] %s chunk %d\/%d: completed\\n",\n                    label, i, n_chunks))\n      }\n    }\n    \n    if (length(results_list) == 0) {\n      return(NULL)\n    }\n    do.call(rbind, results_list)\n  }\n  \n  accession_ids <- ids[is_accession]\n  gene_like_ids <- ids[!is_accession]\n  \n  acc_results <- map_ids(\n    values = accession_ids,\n    from_db = "UniProtKB_AC-ID",\n    to_db = "UniProtKB",\n    chunk_size = chunk_size,\n    label = "accessions"\n  )\n  \n  gene_results <- map_ids(\n    values = gene_like_ids,\n    from_db = "Gene_Name",\n    to_db = "UniProtKB-Swiss-Prot",\n    chunk_size = chunk_size,\n    taxId = taxId,\n    label = "gene_names"\n  )\n  \n  results_list <- list()\n  if (!is.null(acc_results)) {\n    results_list[[length(results_list) + 1]] <- acc_results\n  }\n  if (!is.null(gene_results)) {\n    results_list[[length(results_list) + 1]] <- gene_results\n  }\n  \n  if (length(results_list) == 0) {\n    stop("No UniProt results were returned. Check identifiers and taxId.")\n  }\n  \n  resultsTable <- do.call(rbind, results_list)\n  if ("Entry" %in% colnames(resultsTable)) {\n    resultsTable <- resultsTable[!duplicated(resultsTable$Entry), ]\n  }\n  return(resultsTable)\n}\n\n\n\n## SCRIPT ----\n\nspecies <- c("human", "zebrafish", "drosophila", "worm", "yeast")\nsci_names <- c("human" = "Homo sapiens", "zebrafish" = "Danio rerio", "drosophila" = "Drosophila melanogaster",\n               "worm" = "Caenorhabditis elegans", "yeast" = "Saccharomyces cerevisiae")\n\nfor (org in species) {\n  # look up scientific name of org\n  sci_name <- sci_names[org]\n  output_path <- paste0("Output\/Data\/", org, "_uniprot.csv")\n  if(file.exists(output_path)) {\n    message(paste("File", output_path, "already exists. Loading", org))\n    df <- read.csv(output_path)\n  } else {\n    message(paste("Retrieving UniProt info for", org))\n    species_ids <- read.delim(paste0("Data\/", org, "_uniprot.txt"), header = FALSE)\n    names(species_ids) <- c("uniprot_id")\n    df <- retrieveUniprotInfo(species_ids$uniprot_id)\n    # save this result\n    write.csv(df, output_path, row.names = FALSE)\n  }\n  \n  df$tms <- str_count(df$Transmembrane, "TRANSMEM")\n  tm_counts <- df %>%\n    group_by(tms) %>%\n    summarise(count = n()) %>% \n    filter(tms > 0)\n  \n  p1 <- ggplot(tm_counts, aes(x = tms, y = count)) +\n    geom_col(fill = "#009988") +\n    labs(x = "Transmembrane domains", y = "Count",\n         title = sci_name) +\n    lims(x = c(0.5,NA), y = c(0,NA)) +\n    theme_bw(10)\n  \n  p2 <- SuperPlotR::pieplot(x1 = c(sum(df$tms == 0), sum(df$tms > 0)),\n                            cols = c("#bbbbbb", "#009988")) +\n    # blank background and no legend\n    theme_void() +\n    theme(legend.position = "none")\n  \n  # inset p2 in p1 and add information about the percentages\n  p <- ggdraw() +\n    draw_plot(p1) +\n    # top right\n    draw_plot(p2, x = 0.9, y = 0.9, hjust = 1, vjust = 1, width = 0.4, height = 0.4) +\n    draw_label(paste0("Total Proteins: ", nrow(df),\n                      "\\nNo TM: ", round(sum(df$tms == 0) \/ nrow(df) * 100, 1),\n                      "%\\nWith TM(s): ",\n                      round(sum(df$tms > 0) \/ nrow(df) * 100, 1), "%"),\n               x = 0.97, y = 0.85, hjust = 1, vjust = 1, size = 8)\n  plot_path <- paste0("Output\/Plots\/", org, "_uniprot_tm_counts.png")\n  ggsave(plot_path, p, width = 1600, height = 900, units = "px", dpi = 300)\n}\n<\/pre>\n\n\n
    Note that I am using {cowplot}<\/code> at the end to inset the pie chart and to add the text onto the main plot.<\/p>\n\n\n\n
    \u2014<\/p>\n\n\n\n
    The post title comes from \u201cMy Domain\u201d by Bernard Butler from his People Move On album.<\/p>\n\n
    \r\n
    To leave a comment<\/strong> for the author, please follow the link and comment on their blog:  Rstats \u2013 quantixed<\/a><\/strong>.<\/div>\r\n
    \r\n    R-bloggers.com<\/a> offers daily e-mail updates<\/a><\/strong> about R<\/a> news and tutorials about learning R<\/a> and many other topics. Click here if you're looking to post or find an R\/data-science job<\/a>.\r\n\r\n
    Want to share your content on R-bloggers?     click here<\/a> if you have a blog, or  here<\/a> if you don't.\r\n<\/div>","protected":false},"excerpt":{"rendered":"
     I wanted to know: After a little bit of searching, I couldn\u2019t find any answers. So I decided to use R to retrieve the necessary info from Uniprot and calculate it myself. I thought I\u2019d post it here in case it\u2019s useful for others. Human We\u2019ll …<\/div>\n
    <\/div>\n
    <\/div>\n","protected":false},"author":2887,"featured_media":0,"comment_status":"closed","ping_status":"closed","sticky":false,"template":"","format":"standard","meta":[],"categories":[4],"tags":[],"aioseo_notices":[],"jetpack-related-posts":[],"amp_enabled":true,"_links":{"self":[{"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/posts\/400597"}],"collection":[{"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/users\/2887"}],"replies":[{"embeddable":true,"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/comments?post=400597"}],"version-history":[{"count":10,"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/posts\/400597\/revisions"}],"predecessor-version":[{"id":400774,"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/posts\/400597\/revisions\/400774"}],"wp:attachment":[{"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/media?parent=400597"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/categories?post=400597"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/tags?post=400597"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}