Theo Sanderson

Example Talk

Sat, 01 Jun 2030 13:00:00 +0000

Click on the Slides button above to view the built-in slides feature.

Slides can be added in a few ways:

Create slides using Wowchemy’s Slides feature and link using slides parameter in the front matter of the talk file
Upload an existing slide deck to static/ and link using url_slides parameter in the front matter of the talk file
Embed your slides (e.g. Google Slides) or presentation video on this page using shortcodes.

Further event details, including page elements such as image galleries, can be added to the body of this page.

A molnupiravir-associated mutational signature in global SARS-CoV-2 genomes

Fri, 27 Oct 2023 00:00:00 +0000

SVG export from DeckGL

Thu, 14 Sep 2023 00:00:00 +0000

Taxonium, my tool for exploring large phylogenetic trees, uses a few tricks to be fast even when exploring trees of 15 million sequences. One is sparsification: there is no need to draw every single node when sometimes thousands are overlapping and occluding those below: where nodes overlap we only draw some of them. But even so, there are tens of thousands of nodes being shown, which means we need a framework for showing them that is faster than classic web approaches. We use DeckGL which makes use of the GPU to display large numbers of visual elements quickly.

DeckGL is inherently raster-based, it works in pixels. You can take screenshots of it in this pixelly form – but these aren’t great for publications, where we much prefer infinitely zoomable vector graphics. DeckGL doesn’t have a way to export in a vector format, due to its underlying architecture, this but I’ve been thinking for a while that it wouldn’t be too hard to hack something together, and have finally got round to trying it.

And it works pretty nicely:

Below is an outline of the approach - this isn’t a full tutorial or anything but might provide some inspiration if you’re facing a similar issue.

Normally you build a layers object for DeckGL layers which might look something like

const layers = [
    new ScatterplotLayer({
      data: [
        {position: [-122.45, 37.8], color: [255, 0, 0], radius: 100}
      ],
      getFillColor: d => d.color,
      getRadius: d => d.radius
    })
  ]

To be able to output SVG we want to first build an intermediate version which doesn’t use the DeckGL layers (there may be an alternative approach where you use them all along, but anyway..), so we use:

const intermediateLayers =  [
    {
      layerType: 'ScatterplotLayer',
      data: [
        {position: [-122.45, 37.8], color: [255, 0, 0], radius: 100}
      ],
      getFillColor: d => d.color,
      getRadius: d => d.radius
    }
  ]

Of course we can easily generate our DeckGL layers from this intermediate version:

const processedLayers = layers.map((layer) => {
    switch (layer.layerType) {
      case "ScatterplotLayer":
        return new ScatterplotLayer(layer);
      case "LineLayer":
        return new LineLayer(layer);
      case "PolygonLayer":
        return new PolygonLayer(layer);
      case "TextLayer":
        return new TextLayer(layer);
      case "SolidPolygonLayer":
        return new SolidPolygonLayer(layer);
      default:
        console.log("could not map layer spec for ", layer);
    }
});

(You may need to add more cases to this switch statement depending on what layers you are using.)

But we can also generate SVG from this same intermediate object. Here is the code I use to do that. It won’t work for you out of the box, it uses some viewState parameters called min_x, max_x, min_y, max_y which I set in other code. But hopefully it may be a source of inspiration in terms of how to go about things.

Here’s the function that does the real work:


const getSVG = (layers, viewState, svgWidth, svgHeight) => {
const applyBounds = (point) => {
    const minY = viewState.min_y;
    const maxY = viewState.max_y;
    const minX = viewState.min_x;
    const maxX = viewState.max_x;
    const initial = point;
    const x = normalise(initial[0], minX, maxX);
    const y = normalise(initial[1], minY, maxY);
    return [x * svgWidth, y * svgHeight];
};
if (!viewState.min_x) {
    window.alert("Please zoom in and out a little before SVG export");
    return false;
}
let svgContent = `<svg xmlns='http://www.w3.org/2000/svg' width="${svgWidth}" height="${svgHeight}">`;

for (const layer of layers) {
    // unless layer id starts with "main"
    if (!layer.id.startsWith("main")) {
    continue;
    }

    switch (layer.layerType) {
    case "ScatterplotLayer":
        for (const point of layer.data) {
        const [x, y] = applyBounds(layer.getPosition(point));
        
        const accessor = layer.getFillColor
            ? layer.getFillColor
            : layer.getColor;
        let color;
        if (!accessor) {
            // make color transparent
            color = "none";
        } else {
            const initColor = accessOrConstant(accessor, point);
            // if rgba
            if (initColor.length === 4) {
            color = `rgba(${initColor.join(",")})`;
            if (initColor[3] === 0) {
                color = "none";
            }
            }
            // if rgb
            else if (initColor.length === 3) {
            color = `rgb(${initColor.join(",")})`;
            } else {
            console.warn("Unsupported color format");
            }
        }
        // check if stroked
        let strokeColor, strokeWidth;
        if (layer.stroked) {
            strokeColor = accessOrConstant(layer.getLineColor, point).join(
            ","
            );
            strokeWidth = accessOrConstant(layer.getLineWidth, point);
        }

        // if getRadius is a fn call it otherwise assume it's a value
        const radius = accessOrConstant(layer.getRadius, point);
        svgContent += `<circle cx="${x}" cy="${y}" r="${radius}" fill="${color}"
        ${
            layer.stroked
            ? `stroke="rgb(${strokeColor})" stroke-width="${strokeWidth}"`
            : ""
        } />`;
        }
        break;

    case "LineLayer":
        for (const line of layer.data) {
        const [x1, y1] = applyBounds(layer.getSourcePosition(line));
        const [x2, y2] = applyBounds(layer.getTargetPosition(line));
        // if either is null, skip this point
        if (x1 === null || y1 === null || x2 === null || y2 === null) {
            continue;
        }
        const colorAccessor = layer.getLineColor
            ? layer.getLineColor
            : layer.getColor;
        // if colorAccessor is a function, call it with the line as an argument, otherwise assume it's an array
        const color = accessOrConstant(colorAccessor, line).join(",");
        const width = accessOrConstant(layer.getWidth, line);
        svgContent += `<line x1="${x1}" y1="${y1}" x2="${x2}" y2="${y2}" stroke="rgb(${color})" stroke-width="${width}" />`;
        }
        break;

    case "TextLayer":
        for (const text of layer.data) {
        //const [x, y] = applyModelMatrix(layer.modelMatrix, layer.getPosition(text));
        const original = layer.getPosition(text);
        const adjusted = applyBounds(original);

        const [x, y] = adjusted;
        const size = accessOrConstant(layer.getSize, text);
        const alignment = accessOrConstant(
            layer.getAlignmentBaseline,
            text
        );
        const anchor = accessOrConstant(layer.getTextAnchor, text);
        const pixelOffset = accessOrConstant(layer.getPixelOffset, text);

        const color = accessOrConstant(layer.getColor, text).join(",");
        const newContent = `<text x="${x}" y="${y}" font-family="${
            layer.fontFamily
        }" font-weight="${layer.fontWeight}" fill="rgb(${color})"
        font-size="${size}" text-anchor="${anchor}" alignment-baseline="${alignment}" dx="${
            pixelOffset[0]
        }" dy="${pixelOffset[1]}"
        >${layer.getText(text)}</text>`;
        svgContent += newContent;
        }
        break;

    // You can extend this with other layer types such as PolygonLayer, SolidPolygonLayer, etc.

    default:
        console.warn(`Unsupported layer type: ${layer.layerType}`);
        break;
    }
}

svgContent += "</svg>";
return svgContent;
};

There’s also a useful function in there that will trigger a download of the SVG.

You can see it all in action by clicking the 📷 button in the bottom right on Cov2Tree.

Anyway, if you’re stuck on this problem hopefully this provides inspiration that a solution is possible. Best of luck!

Independent SARS-CoV-2 staff testing protected academic and health-care institutions in northwest London

Mon, 19 Jun 2023 00:00:00 +0000

LabGPT

Thu, 16 Mar 2023 00:00:00 +0000

Yesterday, GPT-4 was released.

I had a play to see how well it might be able to plan and run biological experiments. Scroll to the bottom for some caveats.

THEO

You are LabGPT. You are in charge of conducting scientific experiments to achieve a stated goal. You have access to an OpenTrons OT2 robot and a lab helper

The OpenTrons robot is equipped with a P300 Multi GEN2 (20-300 µL) which has 8 channels in columnar format

You have access to the following commands:

Request: enter a request to a user. you can use this for example to get them to set some labware up inside the robot in desired positions.

ExecuteRobotScript: runs a Python script written in the OT2 API

After running a command wait for user to respond confirming the action.

Use the following format:

Task: the input task you must complete

Thought: you should always think about what to do

Thought: [you can think multiple times]

Thought: [you should describe exactly what the action below will achieve in granular detail and how that helps your objective]

Action: the action to take, should be one of [Request, ExecuteRobotScript]

Action Input: The input to the action. Format scripts in ``` blocks

[at this point wait for a response from the user / robot]

Thought: OK, now I can move to the next step, I will now [..]

Plan: The action below will first get some tips from tip rack in slot 5, then pick up compound 1 from the reservoir at 6 then dispense it in column 4. This should result in column 4 having drug. Then it will [..]

Action [etc.]

Hints:

don’t mix bleach with compounds that could generate chlorine
for serial dilutions don’t forget to add media before doing the serial dilution
achieve final volumes of 200ul for plate-based assays

Let’s begin.

THEO

Your task is to set up an assay that will allow the IC50 of a malaria drug to be calculated.

You have these reagents:

drug: the drug in a reservoir
media: malaria culture media in a reservoir for diluting the drug
parasites: packed RBCs infected with malaria parasites

You can ask the user to set these up as you want (as long as there is one item per slot). You can request whatever extra empty labware you want.

CHATGPT

Task: Set up an assay that will allow the IC50 of a malaria drug to be calculated.

Thought: First, I need to ask the user to set up the labware and reagents in the appropriate positions on the OT2 robot deck.

Thought: I should request labware for the drug, media, parasites, a tip rack, an empty 96-well plate for the serial dilutions and assay, and an extra reservoir for waste.

Request: Please set up the following labware on the OT2 robot deck:

Place the drug reservoir in slot 1.

Place the media reservoir in slot 2.

Place the parasite reservoir in slot 3.

Place a P300 tip rack in slot 5.

Place an empty 96-well plate in slot 6 for the serial dilutions and assay.

Place an empty reservoir in slot 7 for waste disposal.

THEO

That’s done

CHATGPT

Thought: Great, the labware is set up. Now I can start preparing the serial dilutions of the drug in the 96-well plate.

Thought: I’ll begin by adding 100 µL of media to columns 1-11 of the 96-well plate. This will create a base for the serial dilutions.

ExecuteRobotScript:


from opentrons import protocol_api
metadata = {'apiLevel': '2.11'}
def run(protocol: protocol_api.ProtocolContext):
    # Labware
    tip_rack = protocol.load_labware('opentrons_96_tiprack_300ul', 5)
    media_reservoir = protocol.load_labware('nest_12_reservoir_15ml', 2)
    plate = protocol.load_labware('corning_96_wellplate_360ul_flat', 6)
    # Pipettes
    p300_multi = protocol.load_instrument('p300_multi_gen2', 'left', tip_racks=[tip_rack])
    # Add 100 µL of media to columns 1-11 of the 96-well plate
    p300_multi.pick_up_tip()
    for column in plate.columns()[0:11]:
        p300_multi.aspirate(100, media_reservoir['A1'])
        p300_multi.dispense(100, column[0])
    p300_multi.drop_tip()

Thought: Once the media is added to the plate, I can proceed with the serial dilutions.

THEO

That’s done

CHATGPT

Thought: Now that the media is in the 96-well plate, I can start preparing the serial dilutions by adding the drug to column 1 and then performing the dilutions across columns 2-11.

Thought: First, I’ll add 100 µL of the drug to column 1, which will result in a 1:1 dilution.

ExecuteRobotScript:


from opentrons import protocol_api

metadata = {'apiLevel': '2.11'}

def run(protocol: protocol_api.ProtocolContext):
    # Labware
    tip_rack = protocol.load_labware('opentrons_96_tiprack_300ul', 5)
    drug_reservoir = protocol.load_labware('nest_12_reservoir_15ml', 1)
    plate = protocol.load_labware('corning_96_wellplate_360ul_flat', 6)

    # Pipettes
    p300_multi = protocol.load_instrument('p300_multi_gen2', 'left', tip_racks=[tip_rack])

    # Add 100 µL of the drug to column 1 of the 96-well plate
    p300_multi.pick_up_tip()
    p300_multi.aspirate(100, drug_reservoir['A1'])
    p300_multi.dispense(100, plate['A1'])
    p300_multi.drop_tip()

Thought: After adding the drug to column 1, I can perform the serial dilutions across columns 2-11.

THEO

That’s done too :)

CHATGPT

Thought: The drug has been added to column 1. Now I can perform the serial dilutions across columns 2-11 by transferring 100 µL from one column to the next and mixing.

ExecuteRobotScript:


from opentrons import protocol_api

metadata = {'apiLevel': '2.11'}

def run(protocol: protocol_api.ProtocolContext):
    # Labware
    tip_rack = protocol.load_labware('opentrons_96_tiprack_300ul', 5)
    plate = protocol.load_labware('corning_96_wellplate_360ul_flat', 6)

    # Pipettes
    p300_multi = protocol.load_instrument('p300_multi_gen2', 'left', tip_racks=[tip_rack])

    # Perform serial dilutions across columns 2-11
    for source_col, dest_col in zip(plate.columns()[0:10], plate.columns()[1:11]):
        p300_multi.pick_up_tip()
        p300_multi.aspirate(100, source_col[0])
        p300_multi.dispense(100, dest_col[0])
        p300_multi.mix(5, 100, dest_col[0])
        p300_multi.blow_out(dest_col[0].top())
        p300_multi.drop_tip()

Thought: Once the serial dilutions are complete, I can add the parasites to each well and set up the assay.

THEO

That’s done

CHATGPT

Thought: The serial dilutions are ready. Now, I can add 100 µL of the parasite suspension to each well in columns 1-11 of the 96-well plate to set up the assay.

ExecuteRobotScript:


from opentrons import protocol_api

metadata = {'apiLevel': '2.11'}

def run(protocol: protocol_api.ProtocolContext):
    # Labware
    tip_rack = protocol.load_labware('opentrons_96_tiprack_300ul', 5)
    parasite_reservoir = protocol.load_labware('nest_12_reservoir_15ml', 3)
    plate = protocol.load_labware('corning_96_wellplate_360ul_flat', 6)

    # Pipettes
    p300_multi = protocol.load_instrument('p300_multi_gen2', 'left', tip_racks=[tip_rack])

    # Add 100 µL of parasite suspension to each well in columns 1-11 of the 96-well plate
    p300_multi.pick_up_tip()
    for column in plate.columns()[0:11]:
        p300_multi.aspirate(100, parasite_reservoir['A1'])
        p300_multi.dispense(100, column[0])
        p300_multi.mix(5, 100, column[0])
    p300_multi.drop_tip()

Thought: With the parasites added to the wells, the assay is set up and ready for incubation and further analysis.

THEO

Fantastic – thanks! I’ll stick them in the incubator

So: pretty cool. But, to confirm doing it like this is not ready for prime time. Firstly, I haven’t actually checked this code runs, though it looks fairly plausible. In my various experiments it definitely sometimes tried to run protocols which didn’t quite make sense, and I added some hints to guide it in the prompt. Clearly setting up dilution series is something that will be in the training set already. Also, trying to do more complex stuff “set up an assay that would allow me to draw an isobologram” didn’t go so well.

However on the other side of the coin, this model has never been remotely fine-tuned for this task. There may well be a lot of low-hanging gains to be made from doing a bit of fine-tuning with some specific tasks. Even just from working out exactly what hints to add to the prompt. With the 32k context length you could imagine a really long prompt with a bunch of examples. Watch this space.

** Update **

It’s better to use the Jupyter-style OT API to avoid the boilerplate above.

Here it does some maths to figure out how to make up a mastermix:

GPT-4 sets up a PCR (pt 1) pic.twitter.com/J6NDloCDLW
— Theo Sanderson (@theosanderson) March 16, 2023

(contd.) pic.twitter.com/czMfySDs9C
— Theo Sanderson (@theosanderson) March 16, 2023

ProteInfer: deep networks for protein functional inference

Mon, 27 Feb 2023 00:00:00 +0000

Regulators of male and female sexual development critical for transmission of a malaria parasite

Sun, 01 Jan 2023 00:00:00 +0000

Taxonium, a web-based tool for exploring large phylogenetic trees

Tue, 01 Nov 2022 00:00:00 +0000

Treenome Browser: co-visualization of enormous phylogenies and millions of genomes

Sat, 01 Oct 2022 00:00:00 +0000

Determinants of Spike infectivity, processing, and neutralization in SARS-CoV-2 Omicron subvariants BA. 1 and BA. 2

Thu, 01 Sep 2022 00:00:00 +0000

Identifying malaria phenotype papers with GPT-3

Thu, 11 Aug 2022 00:00:00 +0000

Visit papers.phenoplasm.org

Some years ago I launched PhenoPlasm which aims to catalogue all reported phenotypes in Plasmodium in a systematic machine- (and human-) readable format. At the time I tried to populate it with all reported phenotypes in Plasmodium falciparum to date, using a series of searches on Google scholar. RMgmDB pre-dates Phenoplasm, and provides an amazing curated resource for the rodent malaria databases.

Since then I have done my best to stay on top of the literature and add new phenotypes to the database as they appear. (Also, anyone can add a phenotype, and I encourage you to!)

However it isn’t always easy to stay on top of the literature, especially in recent years where I have been spending time on SARS-CoV-2 genetics. When the Bushell lab invited me to contribute to a review of the impact of screening in malaria parasites, by pulling out the latest phenotypes from the database, I felt I had better do a substantial update, sifting the literature again for phenotypes I might have missed in recent years. And I decided to do so with the help of machine learning.

I actually have quite a good training set. Each PhenoPlasm curated phenotype, and each RMgmDB entry, is associated with a Pubmed ID, so I had a list of several hundred Pubmed IDs, representing the sort of papers that I need to read to identify phenotypes. I don’t have a list of definite negatives, but just identifying papers that come up in a search for “malaria OR plasmodium” and aren’t in the positives produces a set that are almost all papers that are not of interest.

I decided to use a process called “fine-tuning” to train a model, where I’d start with a model (GPT-3) already trained to do other tasks in English, and then tweak it to be good at classifying papers according to whether they reported a phenotype. This is helpful because the model can already start with a good knowledge of English, which is helpful if there aren’t thousands of positive training examples. If the model really knows what words mean then it may be able to trained on examples that say “we deleted gene X” and “we disrupted gene X”, and then generalise to examples it has not seen like “we abrogated the function of gene X”.

The downside of using GPT-3 is that it is a commercial offering and you pay for each token (approximately per word) that you use. I have two pieces of data for each PubMed ID: the title and the abstract. I decided to take an approach very like a human who is limited by how much time they can spend reading. I trained one model to classify papers by just their title. Then I trained a second model to perform classification based on reading the full abstract.

If the cheap title model gave a reasonable probability that the paper might report a phenotype then I ran it through the abstract model to get more confidence one way or the other.

Because RMgmDB handles the rodent malaria phenotypes, I don’t necessarily need to read those papers, so I also built in a classifier for whether the paper reports a phenotype in P. berghei or P. falciparum.

When we look at the 10 titles that the title classifier is most confident report a phenotype they look like this:

Plasmodium liver stage developmental arrest by depletion of a protein at the parasite-host interface.

A Plasmodium homolog of ER tubule-forming proteins is required for parasite virulence.

A role for the Plasmodium falciparum RESA protein in resistance against heat shock demonstrated using gene disruption.

An essential role of the basal body protein SAS-6 in Plasmodium male gamete development and malaria transmission.

Disruption of the Plasmodium falciparum PfPMT gene results in a complete loss of phosphatidylcholine biosynthesis via the serine-decarboxylase-phosphoethanolamine-methyltransferase pathway and severe growth and survival defects.

You can see that these titles are those with very clear flags of a phenotype (knockdown, essential, etc.)

In contrast the ten titles least likely to report a phenotype look like this:

A critical review of traditional medicine and traditional healer use for malaria and among people in malaria-endemic areas: contemporary research in low to middle-income Asia-Pacific countries.

Co-infections of Schistosoma spp. and malaria with hepatitis viruses from endemic countries: A systematic review and meta-analysis.

Same-day antiretroviral therapy initiation for people living with HIV who have tuberculosis symptoms: a systematic review.

Efficacy and safety of artemisinin-based combination therapies for the treatment of uncomplicated malaria in pediatrics: a systematic review and meta-analysis.

Aetiology of fever in returning travellers and migrants: a systematic review and meta-analysis.

These are papers with clear flags of relating to malaria in medicine, rather than molecular biology.

In general this title model seems to be doing a decent job, and the abstract model adds significant confirmation, as well as identifying the species involved.

I now run this model over the latest PubMed results each day, and the results are at papers.phenoplasm.org

The origins and molecular evolution of SARS-CoV-2 lineage B. 1.1. 7 in the UK

Wed, 01 Jun 2022 00:00:00 +0000

Barcoding genetically distinct Plasmodium falciparum strains for comparative assessment of fitness and antimalarial drug resistance

Sat, 01 Jan 2022 00:00:00 +0000

CRISPR/Cas9 and genetic screens in malaria parasites: small genomes, big impact

Sat, 01 Jan 2022 00:00:00 +0000

Emergence of new subgenomic mRNAs in SARS-CoV-2

Sat, 01 Jan 2022 00:00:00 +0000

Using deep learning to annotate the protein universe

Sat, 01 Jan 2022 00:00:00 +0000

Genomic reconstruction of the SARS-CoV-2 epidemic in England

Fri, 01 Oct 2021 00:00:00 +0000

Two tips for experimental design of barseq experiments

Thu, 30 Sep 2021 00:00:00 +0000

In my time I’ve done various bits of analysis for barcode-sequencing (barseq) experiments (in Plasmodium), and sometimes have chats with people who are starting for the first time. Basically these chats tend to often hit the same two beats about experimental design so here’s a quick blog post about them.

Tip 1: work out how many barcodes you expect to go into your process

Probably the biggest contribution I made to the design of barseq experiments I was involved with was to figure out that we simply weren’t loading enough barcodes into our PCRs. To figure out whether this could be an issue for you, you just need to work through some simple maths.

Say you are taking a timecourse of cultured parasites, and at each timepoint you take 1 ml of culture for extraction. If you’re working at 2% haematocrit, then that’s 20 μl of packed blood. A red blood cell is about 100 femtolitres, so in this sample you have about 200 million RBCs.

In some of your samples, perhaps parasitaemia is as low as 0.1%? If so then your 200 million RBCs contain 200,000 parasites. Now you take that blood and you put it through a DNA extraction. Suppose this is 50% efficient. Now you are down to 100,000 parasites. You elute in 200 microlitres, so in each microlitre you have just 500 parasites' worth of barcodes.

Suppose you use 2 μl of template in your barcode amplification PCR, that is 1000 parasites that make it to the PCR. Now suppose you have 20 different barcodes represented in this sample. In an idealised situation where those barcodes are equally abundant you would have 50 barcodes for each of them. In practice however, there is probably quite a range of abundances, perhaps with some barcodes ten times as common as others. So there could easily be barcodes for which we expect only 5 copies to be present in the template.

Of course although we “expect” 5, the process of sampling is essentially a binomial distribution and so we could easily by chance end up with 4, or 6, or 3, or 2. (This is the same sort of uncertainty that one gets in opinion polls with small sample sizes). If in one timepoint by chance one has 2 barcodes, and in the next by chance one has 6, that appears to be a three-fold change which might actually not be meaningful at all.

If one is able to boost the number of barcodes that get into the sample, for instance by extracting into say 10 μl and still loading 2 μl (a twenty-fold boost), one can get a much better signal-to-noise ratio.

Tip 2: always perform technical duplicate PCRs

We’ve seen above that random sampling can potentially create uncertainty in your measurements. One issue is that with a single PCR from each sample, you won’t actually be aware of these uncertainties! You’ll just have some numbers for barcodes present in each sample.

This is easy to fix by performing technical duplicate PCRs for each sample (N.B. you can probably do even better with UMI approaches, but I haven’t yet). You may worry that duplicates aren’t enough to quantify uncertainty and that you need triplicates or more, but because you have so many pairwise comparisons in each sample (one for each barcode), you can improve the estimate of uncertainty for a particular barcode by taking a rolling average with other barcodes of similar abundance. And fundamentally with a scatter-plot you can get a good sense of whether a particular sample has failed. The duplicates hugely add to your ability to interpret your data.

This approach lets you quantify the sampling-induced uncertainty for each measurement, and you can then propagate that uncertainty through to all downstream steps where you calculate downstream values of interest based on these measurements.

FlowAlign

Tue, 27 Apr 2021 00:00:00 +0000

Python package / CLI tool for easy alignment of viral sequences to reference (using minimap2 under the hood)

LFD, PCR, PPV, TLA

Fri, 09 Apr 2021 10:18:37 +0000

People are very interested in the positive predictive value of lateral flow tests. That is, if you receive a positive result from the test, how likely is it that you truly are infected? Personally I think that in terms of measuring whether these tests are helpful to society, this metric is actually not terribly useful - since it is strongly affected by how much virus is circulating in the population. That means that the metric implies that lateral flow testing is useless in countries with very low numbers of cases – but actually LFDs have exactly the same effect on R whatever the level of virus in the population, and the same number of absolute false positives.

Nevertheless, it is understandable that people want a test to ideally give them the right answer about their own status. They are now helped by the fact that the government says that all LFD positives should be followed up by confirmatory PCR testing, which both helps an individual to confirm their status, and also has the potential to provide us all with information about the general reliability of these tests. Information has not been released systematically on what proportion of PCR retests confirm LFD results, but today the coronavirus dashboard has changed to exclude cases which were retested and gave negative results. Therefore by comparing today’s results with yesterdays we can get a sense of this metric and calculate the minimum possible PPV, assuming that the PCR retest has 100% sensitivity. These sorts of analyses have already been described by Oliver Johnson and Alex Selby amongst others.

Here is my quick look in R



before = read_csv("https://api.coronavirus.data.gov.uk/v2/data?areaType=nation&areaCode=E92000001&metric=newCasesLFDOnlyBySpecimenDate&metric=changeInNewCasesBySpecimenDate&format=csv&release=2021-04-08&metric=newCasesLFDConfirmedPCRBySpecimenDate")

#> Parsed with column specification:
#> cols(
#>   date = col_date(format = ""),
#>   areaType = col_character(),
#>   areaCode = col_character(),
#>   areaName = col_character(),
#>   newCasesLFDOnlyBySpecimenDate = col_double(),
#>   changeInNewCasesBySpecimenDate = col_double(),
#>   newCasesLFDConfirmedPCRBySpecimenDate = col_double()
#> )


after = read_csv("https://api.coronavirus.data.gov.uk/v2/data?areaType=nation&areaCode=E92000001&metric=newCasesLFDOnlyBySpecimenDate&metric=changeInNewCasesBySpecimenDate&format=csv&release=2021-04-09&metric=newCasesLFDConfirmedPCRBySpecimenDate")

#> Parsed with column specification:
#> cols(
#>   date = col_date(format = ""),
#>   areaType = col_character(),
#>   areaCode = col_character(),
#>   areaName = col_character(),
#>   newCasesLFDOnlyBySpecimenDate = col_double(),
#>   changeInNewCasesBySpecimenDate = col_double(),
#>   newCasesLFDConfirmedPCRBySpecimenDate = col_double()
#> )

library(zoo)

#> 
#> Attaching package: 'zoo'

#> The following objects are masked from 'package:base':
#> 
#>     as.Date, as.Date.numeric

both = inner_join(before,after,by="date", suffix=c("_before","_after")) %>% filter(date>"2020-12-15")%>% filter(date<"2021-04-01")

both= both %>% mutate(notional_false_positives = newCasesLFDOnlyBySpecimenDate_before - newCasesLFDOnlyBySpecimenDate_after -  (newCasesLFDConfirmedPCRBySpecimenDate_before - newCasesLFDConfirmedPCRBySpecimenDate_after) ) %>% arrange(date) %>% mutate(notional_false_positives=rollsum(notional_false_positives,7,na.pad=T),newCasesLFDConfirmedPCRBySpecimenDate_after=rollsum(newCasesLFDConfirmedPCRBySpecimenDate_after,7,na.pad=T)) %>% mutate( notional_proportion_of_positives_false = notional_false_positives / (notional_false_positives+ newCasesLFDConfirmedPCRBySpecimenDate_after ) )%>% filter(notional_false_positives>0)

ggplot(both,aes(x=date,y=1-notional_proportion_of_positives_false))+geom_point()+geom_smooth()+coord_cartesian(ylim=c(0,1))+labs(x="Day",y="Notional minimum positive predictive value")+scale_y_continuous(label=scales::percent)+theme_bw() 

#> `geom_smooth()` using method = 'loess' and formula 'y ~ x'

Mixology: a tool for calculating required masses and volumes for laboratory solutions

Thu, 01 Apr 2021 00:00:00 +0000

Five lines of R

Tue, 30 Mar 2021 10:18:37 +0000

Somebody on Twitter asked me whether B.1.1.7 data from Florida was still compatible with a logistic increase.

It’s amazing how simple this sort of thing is to look at with the Tidyverse and nicely formatted SGTF data from Helix.

library(tidyverse)
data = read_csv(url("https://raw.githubusercontent.com/myhelix/helix-covid19db/master/counts_by_state.csv"))
state_selection = (data %>% group_by(state) %>% summarise(total=sum(positive)) %>% filter(total>5000))$state
data = data  %>% mutate(percent_sgtf=all_SGTF/positive) %>% filter(state %in% state_selection)
ggplot(data,aes(x=collection_date, y=percent_sgtf))+geom_point()+ stat_smooth(method = "glm", method.args = list(family = "binomial"), se = FALSE,  fullrange=TRUE) +xlim(lubridate::ymd("2020-12-01"),lubridate::ymd("2021-04-30"))+labs(title="US SGTF",x="Date",y="Percent SGTF")+facet_wrap(~state)+theme_bw()+scale_y_continuous(label=scales::percent)

There are lots of ways one could improve this, bringing in genome data and modelling uncertainty, but it provides a quick look at what’s happening.

Addendum

Despite the title, I decided to extend this a bit. Let’s first do as above but take rolling averages of SGTF across 7-day intervals:

library(tidyverse)
library(zoo)
data = read_csv(url("https://raw.githubusercontent.com/myhelix/helix-covid19db/master/counts_by_state.csv"))
state_selection = (data %>% group_by(state) %>% summarise(total=sum(positive)) %>% filter(total>5000))$state
data = data  %>% filter(state %in% state_selection) %>% arrange(collection_date) %>% group_by(state) %>% mutate(all_SGTF = rollsum(all_SGTF,7,na.pad=T),  positive=rollsum(positive,7,na.pad=T), percent_sgtf=all_SGTF/positive)

#ggplot(data,aes(x=collection_date, y=percent_sgtf))+geom_point()+ stat_smooth(method = "glm", method.args = list(family = "binomial"), se = FALSE,  fullrange=TRUE) +xlim(lubridate::ymd("2020-12-01"),lubridate::ymd("2021-04-30"))+labs(x="Date",y="Percent SGTF")+facet_wrap(~state)+theme_bw()+scale_y_continuous(label=scales::percent)

And now bring in case data from the New York Times and split these cases by likely SGTF status.

case_data = read_csv(url("https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-states.csv")) %>% rename(State=state)

case_data= case_data %>% group_by(State) %>% arrange(date) %>% mutate(daily_cases=cases-lag(cases)) %>% mutate(smoothed_daily_cases=rollmean(daily_cases,k=7,na.pad=T))
case_data = read_csv(url("https://raw.githubusercontent.com/jasonong/List-of-US-States/master/states.csv"))%>% inner_join(case_data) 
together = data %>% inner_join(case_data,by = c("collection_date"="date","state"="Abbreviation")) %>% mutate(`SGTF cases` = percent_sgtf * smoothed_daily_cases, `non-SGTF cases` = (1-percent_sgtf) * smoothed_daily_cases) %>% select(State,collection_date,`SGTF cases`,`non-SGTF cases`)  %>% pivot_longer(c(`SGTF cases`,`non-SGTF cases`))
ggplot(together %>% filter(value>0),aes(x=collection_date, y=value,color=name))+geom_line()+labs(title="US daily cases by SGTF status",x="Date",y="Daily cases",color="Type")+facet_wrap(~State)+theme_bw()+xlim(lubridate::ymd("2021-1-01"),NA)+scale_y_log10()+scale_color_manual(values=c("blue","red"))+coord_cartesian(ylim=c(10,10000))

Note that in the graph above we are relying here on SGTF data from one company, Helix, and then assuming it is representative of all cases in a state. This may not be an accurate assumption, as noted by Marm Kilpatrick. Interpret with caution.

Turning a graph back into data

Wed, 03 Feb 2021 10:18:37 +0000

Summary: The ONS Coronavirus Infection Survey is an immensely valuable scientific project measuring prevalence of coronavirus in the community. However some useful data have been released only in graphical form which makes them hard to re-analyse. Here I describe how I went about turning one of these graphs back into data in R and briefly explore what it can tell us about SGTF in samples today.

Background

The ONS infection survey is an extremely valuable and well-conducted piece of work. As I discussed in a previous post sometimes the raw data outputs can be subject to different interpretations.

One challenge in interpreting this data in that post was that information on the relationship between the number of genes detected and the distribution of Ct values was not available. I resorted to examining this by calculating the Ct value in different regions, and relating this to the area’s mean Ct value. But what I really wanted was a line list containing Ct value data for each test, along with how many genes were detected (and ideally further information).

I have since discovered that some of this data is available in a preprint published by the survey team in October 2020. Specifically, for me - the most valuable data is the graph below, which depicts individual tests with their Ct values, symptomatic status, and number of genes detected.

Unfortunately this data is only presented graphically. But since the graphic is present in a vector format we may be able to get the data back out again without locating every point by hand. Here is how I went about this.

knitr::opts_chunk$set(dev.args = list(png = list(type = "cairo")))
require(xml2)
library(tidyverse)
library(lubridate)
library(rvest)

First we will read in the SVG file as XML and look at the straight lines - i.e. the axes, things like the axes and tick-lines.

theme_set(theme_classic())

doc <- read_xml("ons_scatterplot.svg") %>% xml_ns_strip()
lines <- xml_nodes(doc, "line")

linesdf <-
  tibble(bind_rows(lapply(xml_attrs(lines), as.data.frame.list))) %>%
  mutate_at(c("x1", "x2", "y1", "y2"), as.character) %>%
  mutate_at(c("x1", "x2", "y1", "y2"), as.numeric) %>%
  mutate(y1 = -y1, y2 = -y2) %>% # y-axis is reversed in SVG - screen format is from top left
  mutate(length = sqrt((x2 - x1)^2 + (y2 - y1)^2))

Let’s try drawing this set of lines in ggplot. We’ll colour them in by their SVG class to see what class corresponds to which items of the plot.

ggplot(linesdf, aes(x = x1, xend = x2, y = y1, yend = y2, color = class)) +
  geom_segment()

OK, so st14 represents the black lines of the axis - lets extract those and mark them each as horizontal or vertical.


black_lines <- linesdf %>%
  filter(class == "st14") %>%
  mutate(horizontal = abs(y2 - y1) < 10 * abs(x2 - x1)) %>%
  mutate(vertical = !horizontal)

ggplot(black_lines, aes(x = x1, xend = x2, y = y1, yend = y2, color = horizontal)) +
  geom_segment()

We can also look at the distribution of line lengths to be able to separate out the short ‘ticks’.

ggplot(black_lines, aes(x = length)) +
  geom_histogram()

#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

It looks like any line with length less than 30 will be a tick.


ticks <- black_lines %>%
  mutate(is_tick = length < 30) %>%
  filter(is_tick)
horiz_limits <- ticks %>%
  filter(horizontal) %>%
  filter(y1 == max(y1) | y1 == min(y1))
vert_limits <- ticks %>%
  filter(vertical) %>%
  filter(x1 == max(x1) | x1 == min(x1))


#ggplot(bind_rows(horiz_limits, vert_limits), aes(x = x1, xend = x2, y = y1, yend = y2, color = horizontal)) +
#  geom_segment()

Now we can extract the positions of the maximum and minimum tick for each axis, and manually write in the real values those correspond to from the label:

x_min_svg <- min(vert_limits$x1)
x_max_svg <- max(vert_limits$x1)
y_min_svg <- min(horiz_limits$y1)
y_max_svg <- max(horiz_limits$y1)

We’ll also manually enter the corresponding real values from the tick labels

x_min_real <- ymd("2020-04-26")
x_max_real <- ymd("2020-10-11")
y_min_real <- 10
y_max_real <- 40

We’ve dealt with the axes. Now time to move onto the points. Unfortunately they are not points, they are paths (bezier-curves), drawing circles to represent points!

Here is a tool I found useful for interpreting SVG commands.

We’ll extract all the paths.

paths <- xml_nodes(doc, "path")

And then try to split up the bezier curves into sub commands, like M (move to a point), C draw a curve in absolute coordinates, c draw a curve in relative coordinates, and so on.

pathsdf <-
  tibble(bind_rows(lapply(xml_attrs(paths), as.data.frame.list))) %>%
  mutate(id = 1:n()) %>%
  mutate(d = gsub("S", "|S", d)) %>%
  mutate(d = gsub("s", "|s", d)) %>%
  mutate(d = gsub("z", "|z", d)) %>%
  mutate(d = gsub("c", "|c:", d)) %>%
  mutate(d = gsub("C", "|C:", d)) %>%
  mutate(d = gsub("M", "M:", d)) %>%
  mutate(d = gsub("\n", "", d)) %>%
  mutate(d = gsub(" ", "", d)) %>%
  mutate(d = gsub("([0-9])-", "\\1,-", d))

commandsdf <- pathsdf %>%
  separate_rows(d, sep = "\\|") %>%
  filter(d != "z") %>%
  separate(d, into = c("command", "parameters"), ":")

#> Warning: Expected 2 pieces. Missing pieces filled with `NA` in 24 rows [23, 25, 28, 30, 7933, 7935, 7938, 7940, 8673, 8675, 8678, 8680, 16233, 16235, 16238, 16240, 16243, 16245, 16248, 16250, ...].


commands_processed <- commandsdf %>%
  separate(parameters, into = c("p1", "p2", "p3", "p4", "p5", "p6"), sep = ",") %>%
  mutate(abs_x = case_when(command == "M" ~ p1, command == "C" ~ p5), abs_y = case_when(command == "M" ~ p2, command == "C" ~ p6)) %>%
  mutate(rel_x = case_when(command == "c" ~ p5), rel_y = case_when(command == "c" ~ p6))

#> Warning: Expected 6 pieces. Missing pieces filled with `NA` in 3796 rows [1, 6, 11, 16, 21, 26, 31, 36, 41, 46, 51, 56, 61, 66, 71, 76, 81, 86, 91, 96, ...].

These circles in SVG form curves, with 4 control points. If we take the average of these we can find the position of the point. One of the points is absolute, from the M coordinates, but 3 are from c commands, and they only have relative coordinates, so we need to calculate the cumulative sums of these, and then add them to the M coordinates. Then we’ll average out, and add back the class metadata.

lowercase_cs <- commands_processed %>%
  group_by(id) %>%
  filter(command == "c") %>%
  mutate(rel_x_sum = cumsum(rel_x), rel_y_sum = cumsum(rel_y)) %>%
  select(id, rel_x_sum, rel_y_sum)

zeroes <- lowercase_cs %>%
  group_by(id) %>%
  summarise(rel_x_sum = 0, rel_y_sum = 0)

#> `summarise()` ungrouping output (override with `.groups` argument)


full_relative_set <- bind_rows(lowercase_cs, zeroes)

uppercase_cs <- commands_processed %>%
  filter(command == "C") %>%
  select(id, command, abs_x, abs_y) %>%
  mutate(abs_x = as.numeric(abs_x), abs_y = as.numeric(abs_y))

both <- inner_join(uppercase_cs, full_relative_set, by = "id") %>% mutate(x = abs_x + rel_x_sum, y = abs_y + rel_y_sum)

point_types <- pathsdf %>% select(id, class)

points <- both %>%
  group_by(id) %>%
  summarise(x = mean(x), y = mean(y)) %>%
  inner_join(point_types, by = "id") %>%
  mutate(y = -y) %>%
  filter(class %in% c("st10", "st7", "st9", "st12", "st11", "st5"))

#> `summarise()` ungrouping output (override with `.groups` argument)

Above you can see I have filtered to only some of the classes. This is because some points were represented by two curves, one a stroke and one a fill. Now let’s plot the points.

ggplot(black_lines, aes(x = x1, xend = x2, y = y1, yend = y2)) +
  geom_segment() +
  geom_point(data = points %>% mutate(x2 = 0, y2 = 0), aes(x = x, y = y, color = class)) +
  scale_color_brewer(type = "qual", palette = "Paired")

Conveniently, the points in the key are still there, so we can easily label these classes with their correct metadata

genes_detected <- c(1, 1, 2, 2, 3, 3)
symptoms <- c("yes", "no", "yes", "no", "yes", "no")
classes <- c("st9", "st12", "st7", "st11", "st5", "st10")

class_info <- tibble(class = classes, symptoms = symptoms, genes_detected = genes_detected)

points_detail <- points %>%
  inner_join(class_info) %>%
  mutate(genes_detected = as.factor(genes_detected))

#> Joining, by = "class"


ggplot(black_lines, aes(x = x1, xend = x2, y = y1, yend = y2)) +
  geom_segment() +
  geom_point(data = points_detail %>% mutate(x2 = 0, y2 = 0), aes(x = x, y = y, color = genes_detected, shape = symptoms)) +
  scale_color_manual(values = c("red", "blue", "black"))+scale_shape_manual(values=c(1,16))

We’re getting there! We have recreated the chart within our ggplot.

Now we just need to transform ourselves into the right axes:


transform <- function(vector, a_in, a_out, b_in, b_out) {
  scaling <- (b_out - a_out) / (b_in - a_in)
  vector <- (vector - a_in) * scaling + a_out
  return(vector)
}

ytransform <- partial(transform, a_in = y_min_svg, a_out = y_min_real, b_in = y_max_svg, b_out = y_max_real)
xtransform <- partial(transform, a_in = x_min_svg, a_out = x_min_real, b_in = x_max_svg, b_out = x_max_real)

new_axes <- black_lines %>% mutate(y1 = ytransform(y1), y2 = ytransform(y2), x1 = xtransform(x1), x2 = xtransform(x2))
points_transformed <- points_detail %>% mutate(y = ytransform(y), x = xtransform(x))

ggplot(new_axes, ) +
  geom_segment(aes(x = x1, xend = x2, y = y1, yend = y2)) +
  geom_point(data = points_transformed %>% mutate(x2 = ymd("2020-01-01"), y2 = ymd("2020-01-01")), aes(x = x, y = y, color = genes_detected, shape = symptoms)) +
  scale_color_manual(values = c("red", "blue", "black"))+scale_shape_manual(values=c(1,16))

OK, the coordinates look right. At this point we can throw away the old axes and just focus on the points.

values <- points_transformed %>%
  filter(y > 0) %>%
  mutate(Date = x, Ct = y) %>%
  select(-x, -y, -class,-id)

write_csv(values, "ons_ct_value_genes_detected_and_symptoms.csv")
values

#> # A tibble: 1,886 x 4
#>    symptoms genes_detected Date          Ct
#>    <chr>    <fct>          <date>     <dbl>
#>  1 yes      3              2020-04-28  26.8
#>  2 yes      3              2020-04-28  21.7
#>  3 yes      3              2020-05-07  22.9
#>  4 yes      3              2020-05-09  29.4
#>  5 yes      3              2020-05-10  21.8
#>  6 yes      3              2020-05-10  27.3
#>  7 yes      3              2020-05-11  18.1
#>  8 yes      3              2020-05-11  16.8
#>  9 yes      3              2020-05-11  27.3
#> 10 yes      3              2020-05-13  19.3
#> # … with 1,876 more rowsm

There’s our dataset.

And here’s our graph.

ggplot(values,aes(x=Date,y=Ct,color=genes_detected,shape=symptoms)) +
  scale_color_manual(values = c("red", "blue", "black"))+scale_shape_manual(values=c(1,16)) +geom_point()+theme_bw()+ theme(legend.position="bottom")

as compared to:

Now we can see what this data can tell us about Ct value distributions:

What is the distribution of 1, 2, and 3 gene positives at different Ct values?

ggplot(values,aes(x=Ct,fill=genes_detected,y=..count..)) +
  scale_fill_manual(values = c("red", "blue", "black")) + geom_density(alpha=0.3)

What is the distribution of Ct values with and without symptoms?


ggplot(values,aes(x=Ct,fill=symptoms,y=..count..)) + geom_density(alpha=0.3)

Does symptomatic Ct distribution vary over time?


ggplot(values,aes(x=Date,y=Ct,color=symptoms)) + geom_smooth()

#> `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'

(yes, it does – which I hadn’t especially expected – this may be because it includes symptoms either side of the test at any length of time, so at times of high Ct perhaps people aren’t mostly symptomatic at the time of testing)

Crucially from the point of view of assessing B.1.1.7 proportions, we can calculate how we expect the number of genes detected to change with Ct value for wild-type SARS-CoV2.

ggplot(values,aes(x=Ct,fill=genes_detected,y=..count..)) +
  scale_fill_manual(values = c("red", "blue", "black")) + geom_density(alpha=0.5,position="stack")

This dataset gives us a sense of how much ‘false positive B.1.1.7’ we might see from random S dropout at a range of different Ct values (i.e. the 2 values might be predominantly this).

And we can even simulate what B.1.1.7 would look like under these conditions. We know that it is very rare to see the S positive unless OR and N are both also positive. So essentially B.1.1.7 SGTF would just turn 3 into 2 here.

simul_b117 = values %>% mutate(genes_detected=ifelse(genes_detected=="3","2",genes_detected)) %>% filter(genes_detected>0)


ggplot(simul_b117,aes(x=Ct,fill=genes_detected,y=..count..)) +
  scale_fill_manual(values = c("red", "blue", "black")) + geom_density(alpha=0.5,position="stack")

We can see that at high Ct, we see a lot of the single gene OR or N.

With the median Ct value around 31 in recent weeks, this can help to explain the presence of single gene positive samples that were previously called as not-compatible with the new variant.

Conclusion

We’ve been able to convert a valuable dataset generated by the ONS Infection Survey team into a machine-readable form, which permits insights into the apparent relative decline of B.1.1.7 in the recent report. Hopefully this can provide a useful building block in downstream analyses of Ct, gene dropout, and temporal dynamics.

If you enjoyed this exploration of how to extract data from vector-graphics in R, you might also want to see my extraction of data from a rasterised chloropleth map.

Looking again at Maccabi data for efficacy after initial Pfizer dose

Sun, 31 Jan 2021 10:18:37 +0000

Update(2021-02-03): Maccabi have also now released a different report looking at a cohort, which gives a less rosy picture of initial efficacy. The explanation may be the older age group in the cohort. I think the calculations below still stand, but am flagging this important further data for context.

Maccabi have now released a preprint on Pfizer vaccine efficacy after the first dose. Let’s take a look at it.

Firstly a little complaint. If you go to the `Data' tab on bioRxiv, it says:

Now of course one understands that there may be lots of underlying patient data that can’t be released for regulatory reasons. But some data definitely can, because they release it in this preprint, in graphical form.

At bare minimum, we should demand that the data directly plotted in graphs are released in numerical form to permit further analysis. There can be no regulatory justification for not doing so.

Fortunately, the data are there, we just need to extract them. For this image file I did that by hand with WebPlotDigitizer.

maccabi = read_csv("maccabi.csv",col_names = c('Day','CumulativeIncidence')) %>% mutate(Day=round(Day)) 

ggplot(maccabi,aes(x=Day,y=CumulativeIncidence))+geom_line(color="blue")+theme_bw()+labs(x="Day",y="Cumulative Incidence")+scale_y_continuous(labels=scales::percent,limits=c(0,NA))

Looks like we’ve pretty much got it. Now let’s convert that cumulative incidence into a daily incidence (something not done in the Maccabi preprint).

perday = maccabi %>% arrange(Day,CumulativeIncidence) %>% group_by(Day) %>% summarise(CumulativeIncidence=max(CumulativeIncidence)) %>% mutate(DailyIncidence=CumulativeIncidence-lag(CumulativeIncidence),type="Vaccinated") 

ggplot(perday,aes(x=Day,y=DailyIncidence))+geom_line(color="blue")+theme_bw()+labs(x="Day",y="Daily Incidence")+scale_y_continuous(labels=scales::percent,limits=c(0,NA))

Now we have a fair idea of what went on. On day 1 after vaccination, 0.024% of those vaccinated tested positive. That proportion seems to have risen until about day 8, when 0.06% of those vaccinated tested positive. It then fell until day 25, when just 0.005% tested positive.

Now, to properly calculate vaccine efficacy we would need some control group who have not been vaccinated. In the original trials that was a randomly selected half who were given a placebo injection. We compared how many cases they developed, as compared to those who were vaccinated.

There is no placebo group here. No set of matching people who were not vaccinated. So to have any way of calculating an efficacy value we essentially have to invent one and imagine what the incidence would have been in it.

Doing this for the first ~10 days, seems pretty easy. We really don’t expect to see the vaccine have any effect here, so the control group might look something like this:

control_group = tibble(Day=1:10,DailyIncidence=seq(0.00032,0.00059,length.out=10),type="Synthetic control")
ggplot(bind_rows(control_group, perday),aes(x=Day,y=DailyIncidence,color=type))+geom_line()+theme_bw()+labs(color="",x="Day",y="Daily Incidence")+scale_y_continuous(labels=scales::percent,limits=c(0,NA)) +scale_color_manual(values=c("red","blue"))

The reason for this not being a horizontal line would have to be some genuine rise in cases over this period. One possibility is the general increasing number of cases in Israel, which continued up to around 15 Jan.

Unforunately, having this synthetic control line for the first 7 days isn’t especially useful. By construction this shows ~0% efficacy in that period, because that’s what we designed it to. What I’m really interested is that the efficacy around Day 24. So how should we extend the line?

I’ve illustrated 3 possible scenarios below, one where cases continue to rise in the placebo group, another where they stay flat, and another where they fall :

 syn_control <- function(final, name,offset){
return(bind_rows(tibble(Day=1:10,DailyIncidence=seq(0.00032+offset,0.00059+offset,length.out=10),type=name),
                  tibble(Day=10:25,DailyIncidence=seq(0.00059+offset,final,length.out=16),type=name)) )
}
combo =bind_rows(syn_control(0.0010,"Synthetic control: Growth",0.00001),syn_control(0.00059,"Synthetic control: flat",0),syn_control(0.00029,"Synthetic control: decreasing",-0.00001), perday)
ggplot(combo,aes(x=Day,y=DailyIncidence,color=type))+geom_line()+theme_bw()+labs(color="",x="Day",y="Daily Incidence")+scale_y_continuous(labels=scales::percent,limits=c(0,NA)) +scale_color_manual(values=c("pink","red","darkred","blue"))

These choices have a substantial effect on the efficacy we measure for days 23-25, which range from 82% (placebo cases fall) to 94% (placebo cases rise).

combo %>% filter(Day>22) %>% group_by(type) %>% summarise(Incidence = mean(DailyIncidence)) %>% mutate(efficacy_percent = 100*(1- min(Incidence)/Incidence)) %>% filter(type!="Vaccinated") %>% select(-Incidence)

#> `summarise()` ungrouping output (override with `.groups` argument)

#> # A tibble: 3 x 2
#>   type                          efficacy_percent
#>   <chr>                                    <dbl>
#> 1 Synthetic control: decreasing             82.4
#> 2 Synthetic control: flat                   90.8
#> 3 Synthetic control: Growth                 94.4

So what did Maccabi do? Well something quite different to any of these. They used the period from days 0 to 12 as the control for days 13 to 24. That looks like this:

control_group = perday %>% mutate(Day=Day+12, type= "Synthetic control") %>% filter(Day<25)
maccabi_analysis = bind_rows(control_group, perday %>% filter(Day<25))
ggplot(maccabi_analysis,aes(x=Day,y=DailyIncidence,color=type))+geom_line()+theme_bw()+labs(color="",x="Day",y="Daily Incidence")+scale_y_continuous(labels=scales::percent,limits=c(0,NA)) +scale_color_manual(values=c("red","blue"))

If again you look at day 23-24 efficacy here, you get an efficacy of 88%.

maccabi_analysis %>% filter(Day>22) %>% group_by(type) %>% summarise(Incidence = mean(DailyIncidence)) %>% mutate(efficacy_percent = 100*(1- min(Incidence)/Incidence)) %>% filter(type!="Vaccinated") %>% select(-Incidence)

#> `summarise()` ungrouping output (override with `.groups` argument)

#> # A tibble: 1 x 2
#>   type              efficacy_percent
#>   <chr>                        <dbl>
#> 1 Synthetic control             87.5

Maccabi however looked across the entire period. If you do that you get an efficacy close to 50% (they got 51%, I got 56%, possibly due to slight differences in the weighting of different days based on the number of people in them).

maccabi_analysis %>% filter(Day>12) %>% group_by(type) %>% summarise(Incidence = mean(DailyIncidence)) %>% mutate(efficacy_percent = 100*(1- min(Incidence)/Incidence)) %>% filter(type!="Vaccinated") %>% select(-Incidence)

#> `summarise()` ungrouping output (override with `.groups` argument)

#> # A tibble: 1 x 2
#>   type              efficacy_percent
#>   <chr>                        <dbl>
#> 1 Synthetic control             56.1

So, what to conclude? Essentially the way Maccabi analysed this data was one relatively arbitrary possibility among many. Efficacy estimates are quite sensitive to the guesses one makes about how many cases there would have been in the control group. Maccabi’s decision here is quite conservative in that it includes as a control group the day 10 to 12 period where some cases may well have been averted by vaccination.

The decision to look at the entire day 12-24 period rather than the end of it, will yield a result lower than the true efficacy towards the end of this period, given the clear evidence for an increase in efficacy over the period. This is incredibly valuable data, and all in all, things look pretty good.

ggplot(perday,aes(x=Day,y=DailyIncidence))+geom_line(color="black")+theme_bw()+labs(x="Day",y="Daily Incidence")+scale_y_continuous(labels=scales::percent,limits=c(0,NA)) +geom_smooth()

#> `geom_smooth()` using method = 'loess' and formula 'y ~ x'

perday

#> # A tibble: 26 x 4
#>      Day CumulativeIncidence DailyIncidence type      
#>    <dbl>               <dbl>          <dbl> <chr>     
#>  1     0           0.0000251      NA        Vaccinated
#>  2     1           0.000269        0.000244 Vaccinated
#>  3     2           0.000626        0.000357 Vaccinated
#>  4     3           0.000990        0.000363 Vaccinated
#>  5     4           0.00149         0.000501 Vaccinated
#>  6     5           0.00197         0.000476 Vaccinated
#>  7     6           0.00247         0.000501 Vaccinated
#>  8     7           0.00303         0.000564 Vaccinated
#>  9     8           0.00365         0.000614 Vaccinated
#> 10     9           0.00413         0.000489 Vaccinated
#> # … with 16 more rowsm


incidence_data = read_csv("data_from_chart.csv") 

#> Parsed with column specification:
#> cols(
#>   Day = col_double(),
#>   VaccinatedCohort = col_double()
#> )

cohort_size=132015
incidence_data$CumulativeIncidence = cumsum(incidence_data$VaccinatedCohort)/ cohort_size
incidence_data$type = "Incidence plot"



maccabi_offset = maccabi %>% filter(Day>3) %>% mutate(CumulativeIncidence = CumulativeIncidence-min(CumulativeIncidence), type="Kaplan-Meier plot" )
 


ggplot(bind_rows(incidence_data,maccabi_offset),aes(color=type, group=type, x=Day,y=CumulativeIncidence))+geom_line()+theme_bw()+labs(x="Day",y="Cumulative Incidence")+scale_y_continuous(labels=scales::percent,limits=c(0,NA)) +scale_color_manual(values=c("darkgreen","red"))


ggsave("comparison.png",type="cairo",width=7,height=3)

Analysing Maccabi data on initial efficacy of first vaccine dose

Fri, 22 Jan 2021 22:18:37 +0000

This exciting chart has emerged from the Maccabi study, providing evidence for efficacy of the Pfizer vaccine after the first dose.

As Eran Segal pointed out on Twitter, the blue line actually includes the green line. I was interested to see what this would look like replotted as a Kaplan-Meier curve like the Pfizer graph.

size_of_cohort = 50777
size_of_all_members = 480000
size_of_unvaccinated = size_of_all_members-size_of_cohort
data = data %>% mutate(new_infections_all_members = AllMembersNormalised*size_of_all_members/size_of_cohort)
data = data %>% mutate(new_infections_unvaccinated = new_infections_all_members - VaccinatedCohort)
data = data %>% mutate(daily_incidence_unvaccinated = new_infections_unvaccinated/size_of_unvaccinated)
data = data %>% mutate(daily_incidence_vaccinated = VaccinatedCohort/size_of_cohort)

graphdata = data %>% select(c(Day,contains("daily_incidence"))) %>% pivot_longer(-Day,names_to="group",values_to="daily_incidence") %>% separate(group,into=c("bla","bla2","condition"),sep="_") %>% select(-contains("bla")) %>% group_by(condition) %>% arrange(Day) %>% mutate(cumulative_incidence=cumsum(daily_incidence))


graphdata$condition = ifelse(graphdata$condition=="unvaccinated","Control cohort",graphdata$condition)
ggplot(graphdata,aes(x=Day,y=cumulative_incidence,color=condition))+geom_line()+theme_classic()+labs(caption="Caveats: based on 7-day-moving average data so sharpness of start of initial efficacy will be understated. \n Control cohort may contain vaccinated people",color="Condition",y="Cumulative Incidence")+scale_color_manual(values=c("red","blue"))+geom_point()

There are a lot of caveats about whether this is comparing like-for-like in terms of endpoint. In some respects it is definitely not, and everything is smoothed out by the 7 day moving average. In addition, this is a much older age group where we’d very much expect the immune response to take longer. Another really important caveat is that the blue line likely includes people who were vaccinated later on.

In general the top plot presented by Maccabi is much more useful for getting a sense of what is going on (what direction the lines are pointing at the end of the Kaplain-Meier plot).

New-variant compatibility in the ONS infection survey

Fri, 22 Jan 2021 14:18:37 +0000

Code behind this analysis: https://github.com/theosanderson/theo.io/tree/master/content/post/2021-01-22-ons-data

The ONS infection survey has come out and there has been a lot of discussion on the apparent decrease in proportion of “new variant compatible” cases.

To try to understand these patterns we need to go into a bit more detail. How are “new variant compatible” cases defined?

The TaqPath tests that produce this data amplify parts of three genes in the SARS-CoV2 genome:

The N gene
ORF1ab
The S gene

We know that B.1.1.7 often gives complete loss of the S-gene amplicon (data from Portugal suggest it doesn’t always).

When B.1.1.7 was emerging the ONS defined a fairly conservative definition of “new variant compatible” tests. They said that these must be positive for N, and ORF1AB, but not for S. That is what we would expect to see for B.1.1.7 when there a lot of virions in the sample. But if a sample has a low number of virions, one or other of these genes might randomly drop below the detection threshold. Fortunately the ONS also report the data split out by each of the possible amplicon combinations, so we can examine this.

First let’s convince ourselves that, irrespective of B.1.1.7, dropouts of amplicons can occur for various reasons. Let’s look at the distribution of amplicons period of time in September, before B.1.1.7 had really emerged.

subset = data %>% filter(week=="2020-09-21") %>% filter(RegionType=="EnglandRegion") %>% mutate(AmpliconType = case_when(
 Amplicons %in% c("N only","N+S","OR only","OR+S","S only") ~ "Random dropout",
  Amplicons == "OR+N+S" ~ "Definite non-B.1.1.7",
  Amplicons == "OR+N" ~ "Likely(?) B.1.1.7"
))
                                                                                                
                                                                                                
ggplot(subset,aes(x=AmpliconType,y=Count,fill=Amplicons))+geom_bar(stat="identity")+facet_wrap(~Region)+theme_bw()+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))

I’ve separated out the OR+N amplicon types, which the ONS considers new variant compatible. Let’s ignore these for now. We can see that there is a substantial variation in the other amplicon groups. If there were no random dropout (and no other variants that compromise an assay), we would expect everything else to be OR+N+S. But in the South West these make up a minority of the total positives identified. Instead it seems that some of these amplicons are randomly dropping out there.

We can also see a lot of geographical heterogeneity in the level of this random dropout. What drives this? We also have the mean Ct values for each region so we can test the hypothesis that high Ct values (low number of virions), due to a higher proportion of infections being identified longer after the original infection, are responsible for the “random dropout”.

# Exclude suspected B.1.1.7 from the data
subset = data %>% filter(week=="2020-09-21") %>% filter(RegionType=="EnglandRegion") %>% filter(Amplicons!="OR+S")

#Calculate the proportion with "no random dropout", then invert to get proportion of "random dropout"
subset =subset %>% group_by(Region) %>% mutate(proportion = Count/sum(Count)) %>% filter(Amplicons=="OR+N+S") %>% mutate(RandomDropout=1-proportion)

subset_cts = data_ct %>% filter(week=="2020-09-21") %>% filter(RegionType=="EnglandRegion")

both <- inner_join(subset,subset_cts) 

#> Joining, by = c("Region", "RegionType", "week")


ggplot(both,aes(x=Mean,y=RandomDropout,label=Region))+geom_point()+labs(x="Mean Ct value",y="Proportion of 'random dropout'")+geom_text_repel()+theme_bw()+scale_y_continuous(labels=scales::percent)+labs("Relationship between Ct and levels of random dropout in September")

Having convinced ourselves that random dropouts can occur at different levels due to differences in Ct values (and that Ct values can differ due to epidemiological dynamics)), we can examine whether an increased rate of random dropouts in the N or ORF1ab genes (or both!) might cause an underestimation of B.1.1.7 prevalence when considering only OR+N+S as compatible with the new variant.

Now lets look at the trajectories of all amplicon groups over time in England.

data = data %>% group_by(Region,week) %>% mutate(proportion = Count/sum(Count)) 

ggplot(data%>% filter(Region=="England"), aes(x=week,y=proportion,color=Amplicons))+geom_line()+theme_bw()+scale_y_continuous(labels=scales::percent)



data$Amplicons = factor(as.character(data$Amplicons),levels = c("S only","OR+S","N+S","OR+N+S","N only","OR only","OR+N"))

p<-ggplot(data%>% filter(Region=="England")%>% filter(Amplicons!="S only"), aes(x=week,y=proportion,fill=Amplicons))+geom_area()+theme_bw()+scale_y_continuous(expand=c(0,0),labels=scales::percent)+scale_fill_brewer(type="qual",palette=4)+labs(x="Date",y="Proportion")+scale_x_date(expand=c(0,0))

ggsave("plot.pdf",width=5,height=3)

An annotated version of that plot:

ggplot(data%>% filter(RegionType=="EnglandRegion")%>% filter(Amplicons!="S only"), aes(x=week,y=proportion,fill=Amplicons))+geom_area()+theme_bw()+scale_y_continuous(expand=c(0,0),labels=scales::percent)+scale_fill_brewer(type="qual",palette=4)+labs(x="Date",y="Proportion")+scale_x_date(expand=c(0,0)) +facet_wrap(~Region)


ggsave("plotregion.png",width=7*1.2,height=4*1.2)

We can see a rise in OR+N over time. But this seems to tail off to at least horizontal at the end. Does this mean that B.1.1.7 is no longer increasing at the expense of other variants? Well I don’t think we have evidence for this. OR+N may be horizontal, but OR+N+S seems likely to be decreasing faster. It is likely that this is due to a general change in the epidemic stage, as lockdown controls new infections and a higher proportion of old detections are detected.

Again if we want to look for an explanation we can investigate the Cts.

ggplot(data_ct%>% filter(RegionType=="EnglandRegion"),aes(x=week, y=Mean))+geom_line() +labs(title="Regions")+facet_wrap(~Region)+theme_bw()+labs(y="Mean Ct value")

In all regions we see an increase in mean Ct over January, which we’d expect to cause more random dropouts, and reduce the number of both WT viruses that appear as OR+N+S and of B.1.1.7 viruses that appear as OR+N.

One (imperfect) way to try to get a handle on this is to just plot the ratio of OR+N+S to OR+N, because both of these are affected by random drop out.

ggplot(data%>% filter(Region=="England",Amplicons %in% c("OR+N+S","OR+N")),aes(x=week, fill=Amplicons,y=Count))+geom_bar(stat="identity",position="fill")+scale_y_continuous(labels=scales::percent) +labs(title="England")


ggplot(data%>% filter(RegionType=="EnglandRegion",Amplicons %in% c("OR+N+S","OR+N")),aes(x=week, fill=Amplicons,y=Count))+geom_bar(stat="identity",position="fill")+scale_y_continuous(labels=scales::percent) +labs(title="Regions")+facet_wrap(~Region)

Similarly we can also plot how the proportion of B.1.1.7 incompatible cases (those that do show S amplification) has changed.

data = data %>% mutate(B117_incompatible = grepl('S',Amplicons))

ggplot(data%>% filter(Region=="England",Amplicons %in% c("OR+N+S","OR+N")),aes(x=week, fill=B117_incompatible,y=Count))+geom_bar(stat="identity",position="fill")+scale_y_continuous(labels=scales::percent) +labs(title="England")


ggplot(data%>% filter(RegionType=="EnglandRegion",Amplicons %in% c("OR+N+S","OR+N")),aes(x=week, fill=B117_incompatible,y=Count))+geom_bar(stat="identity",position="fill")+scale_y_continuous(labels=scales::percent) +labs(title="Regions")+facet_wrap(~Region)

to be continued

Investigating the latest round of REACT

Thu, 21 Jan 2021 17:58:37 +0000

The latest round of the REACT study has come out, and been quite controversial. Let’s examine some of the raw data behind it.

library(tidyverse)

Let’s download the REACT data and process it into a nice format:

positive <- read_csv(url("https://raw.githubusercontent.com/mrc-ide/reactidd/master/inst/extdata/positive.csv"))

#> Warning: Missing column names filled in: 'X1' [1]

total <- read_csv(url("https://raw.githubusercontent.com/mrc-ide/reactidd/master/inst/extdata/total.csv"))

#> Warning: Missing column names filled in: 'X1' [1]

positive$type = "positive"
total$type = "total"
all = bind_rows(positive, total)
colnames(all)[1] = "Date"

all = all %>% pivot_longer(c(-Date,-type),names_to="Region") %>% pivot_wider(names_from=type)
all

#> # A tibble: 1,485 x 4
#>    Date       Region                   positive total
#>    <date>     <chr>                       <dbl> <dbl>
#>  1 2020-05-05 South East                      0   113
#>  2 2020-05-05 North East                      0    13
#>  3 2020-05-05 North West                      1    73
#>  4 2020-05-05 Yorkshire and The Humber        0    33
#>  5 2020-05-05 East Midlands                   1    77
#>  6 2020-05-05 West Midlands                   0    51
#>  7 2020-05-05 East of England                 0    93
#>  8 2020-05-05 London                          0    39
#>  9 2020-05-05 South West                      0    42
#> 10 2020-05-06 South East                      0    62
#> # … with 1,475 more rowsm

Now we can calculate binomial confidence intervals by location for each date and plot them.

all = all %>% filter(!is.na(positive)) %>% filter(!is.na(total))
library(binom)

cis = binom.confint(all$positive,all$total, method="exact")


all$lower=cis$lower
all$mean = cis$mean
all$upper=cis$upper

ggplot(all %>% filter(Date>"2020-12-15"),aes(x=Date,ymin=lower,ymax=upper,y=mean))+geom_pointrange(color="black") +facet_wrap(~Region,scales="free_y")+scale_y_log10(labels = scales::percent)+theme_bw() + labs(y="Probability of testing positive")

#> Warning: Transformation introduced infinite values in continuous y-axis

#> Warning: Transformation introduced infinite values in continuous y-axis



ggsave("plot.png",width=9,height=5, type="cairo")

#> Warning: Transformation introduced infinite values in continuous y-axis

#> Warning: Transformation introduced infinite values in continuous y-axis

This looks to accord well with the table of R values that REACT provide in Table 3:

This isn’t especially surprising, but I think the visualisation helps to make sense of how these values came to be calculated (even though they are probably based on a more complex analysis weighting for various demographic factors).

That’s it for now.

The virus vs. the vaccine

Thu, 21 Jan 2021 16:58:37 +0000

One framing for thinking about COVID is as a race between vaccination and infection, since we expect the former to have at least some mitigating effect on the latter. To get a sense for this I plot the cumulative infection estimates from the MRC Biostatistics Nowcasting Reports against the vaccination numbers from PHE (with historical data filled in from Our World in Data).

try(library(tidyverse), silent=TRUE)
library(jsonlite)
library(ggthemes)
a = fromJSON("mrc_biostats.json")
df=tibble(date=a[[1]],y=a[[2]])
df$date=lubridate::ymd(df$date)


df$label = "People infected"
b = read_csv("vaccinations.csv")
b$y=b$numFirstDose
b$date=lubridate::dmy(b$date)
b$label = "People vaccinated"
ggplot(bind_rows(df,b),aes(x=date,y=y/1000000,color=label))+geom_line(size=1) +labs(x="Date",y="Number of people (millions)",color="Type",title="Infection and vaccination levels in England",caption="Data sources: MRC Biostatistics Unit (cumulative infection estimates)\nOur World In Data & PHE (vaccination figures – at least one dose)")+theme_hc()++
  theme(plot.title = element_text(hjust = 0.5))

ggsave("plot.png",width=7.3,height=4, type = "cairo")

If we literally were to imagine vaccination and infection to be mutually exclusive (which clearly isn’t true in either direction), we could plot a graph like this to look at where they might meet.



c=b
c$label = "People unvaccinated"
c$y=56000000-c$y
ggplot(bind_rows(df,c),aes(x=date,y=y/1000000,color=label))+geom_line(size=1) +labs(x="Date",y="Number of people (millions)",color="Type",title="Infection and vaccination levels in England",caption="Data sources: MRC Biostatistics Unit (cumulative infection estimates)\nOur World In Data & PHE (vaccination figures – at least one dose)")+theme_hc()++
  theme(plot.title = element_text(hjust = 0.5))



ggsave("plot2.png",width=7.3,height=4, type = "cairo")

An apicoplast-resident folate transporter is essential for sporogony of malaria parasites