rplotlyinterpolationcontourspatial-interpolation

Drawing something resembling contour lines for an annually advancing ray of fungi?


I would be happy for any tips for drawing something resembling contour lines for the growth advancement lines around a fungal fairy ring that advances annually uphill. This is a plot of the records of fruit bodies I have found from the years 2009-2022 in an x-y coordinate system of latitudinal/logitudinal positions:

enter image description here

Really, the "ring" is rather an advancing front(=half-circle) than an actual closed ring, gradually growing through the landscape. We have marked the positions of the fruitbodies every year with poles in an x~y coordinate system, so my file presently looks something like this for the years 2009-2022:

Year,x=horizontal position of fruitbody, y=vertical position of fruitbody

This is a dput of my data frame:

 dput(head(mydataframe)) 

structure(list(Year = c(2022L, 2014L, 2015L, 2014L, 2014L, 2015L), xpos = c(5487.5, 5475, 5475, 5450, 5425, 5400), ypos = c(262.5, 550, 537.5, 525, 500, 475)), row.names = c(NA, 6L), class = "data.frame")

I would like to draw something like the image here:

enter image description here

with gradually advancing lines drawn between annual points of observations (preferably being reasonably interpolated between points as contours in the landscape). Colours are unimportant.

There are more points in some years than in others, and the "ring" is taking some turns.

Is what I am trying really feasible, or would I be better served doing som hand-drawing sketches?

Best wishes, Christoffer

Update: This below is the entire data frame:

dput(mydataframe)

structure(list(Year = c(2022L, 2014L, 2015L, 2014L, 2014L, 2015L, 
2020L, 2014L, 2013L, 2014L, 2013L, 2014L, 2010L, 2014L, 2009L, 
2010L, 2011L, 2015L, 2017L, 2018L, 2020L, 2014L, 2010L, 2009L, 
2016L, 2020L, 2018L, 2018L, 2010L, 2011L, 2011L, 2014L, 2019L, 
2018L, 2014L, 2019L, 2009L, 2014L, 2018L, 2014L, 2019L, 2017L, 
2010L, 2012L, 2016L, 2018L, 2015L, 2017L, 2019L, 2014L, 2016L, 
2019L, 2019L, 2022L, 2011L, 2014L, 2015L, 2014L, 2016L, 2017L, 
2014L, 2017L, 2017L, 2018L, 2014L, 2017L, 2011L, 2014L, 2018L, 
2020L, 2010L, 2011L, 2017L, 2017L, 2010L, 2020L, 2020L, 2022L, 
2014L, 2020L, 2021L, 2022L, 2022L, 2022L, 2022L, 2017L, 2015L, 
2022L, 2021L, 2022L, 2022L, 2020L, 2015L, 2010L, 2014L, 2021L, 
2018L, 2022L, 2016L, 2020L, 2021L, 2018L, 2010L, 2014L, 2015L, 
2010L, 2014L, 2016L, 2018L, 2019L, 2018L, 2010L, 2014L, 2019L, 
2014L, 2012L, 2018L, 2019L, 2020L, 2018L, 2016L, 2014L, 2015L, 
2014L, 2015L, 2014L, 2010L, 2014L, 2015L, 2010L, 2009L, 2009L, 
2009L, 2010L, 2013L, 2014L, 2010L, 2011L, 2012L, 2014L, 2014L, 
2009L, 2014L, 2017L, 2018L, 2015L, 2017L, 2014L, 2018L, 2020L, 
2014L, 2022L, 2020L, 2015L, 2018L, 2020L, 2022L, 2018L, 2018L, 
2020L, 2020L, 2018L, 2018L, 2022L, 2018L, 2020L, 2022L, 2020L, 
2022L, 2022L, 2021L, 2022L, 2022L, 2022L, 2020L, 2022L, 2022L, 
2016L, 2018L, 2020L, 2017L, 2016L, 2018L, 2022L, 2022L, 2018L, 
2020L, 2021L, 2022L, 2021L, 2022L, 2017L, 2015L, 2016L, 2018L, 
2014L, 2015L, 2022L, 2014L, 2015L, 2021L, 2014L, 2011L, 2015L, 
2014L, 2019L, 2020L, 2014L, 2015L, 2019L, 2019L, 2016L, 2018L, 
2019L, 2019L, 2020L, 2020L, 2021L, 2021L, 2022L, 2021L, 2022L, 
2021L, 2022L, 2020L, 2021L, 2022L, 2010L, 2014L, 2014L, 2010L, 
2015L, 2017L, 2022L, 2016L, 2018L, 2012L, 2014L, 2014L, 2016L, 
2015L, 2014L, 2014L, 2015L, 2017L, 2016L, 2018L, 2017L, 2017L, 
2017L, 2018L, 2016L, 2018L, 2014L, 2015L, 2014L, 2015L, 2017L, 
2014L, 2011L, 2009L, 2010L, 2009L, 2010L, 2016L, 2009L, 2010L, 
2010L, 2010L, 2009L, 2012L, 2014L, 2016L, 2019L, 2020L, 2022L, 
2019L, 2022L, 2014L, 2016L, 2017L, 2022L, 2016L, 2022L, 2020L, 
2020L), xpos = c(5487.5, 5475, 5475, 5450, 5425, 5400, 5400, 
5375, 5350, 5350, 5325, 5325, 5275, 5275, 5250, 5250, 5250, 5225, 
5200, 5200, 5200, 5187.5, 5175, 5175, 5175, 5137.5, 5125, 5100, 
5075, 5075, 5075, 5075, 5075, 5062.5, 5050, 5050, 5025, 5025, 
5025, 5000, 5000, 4987.5, 4975, 4975, 4975, 4975, 4950, 4950, 
4950, 4937.5, 4937.5, 4937.5, 4925, 4925, 4900, 4900, 4900, 4862.5, 
4862.5, 4862.5, 4837.5, 4837.5, 4825, 4825, 4800, 4775, 4750, 
4750, 4750, 4750, 4675, 4675, 4675, 4675, 4650, 4650, 4650, 4612.5, 
4600, 4587.5, 4587.5, 4587.5, 4575, 4550, 4537.5, 4525, 4512.5, 
4500, 4487.5, 4487.5, 4437.5, 4425, 4412.5, 4400, 4400, 4400, 
4387.5, 4387.5, 4375, 4375, 4375, 4362.5, 4350, 4350, 4337.5, 
4325, 4325, 4325, 4325, 4325, 4312.5, 4300, 4300, 4300, 4287.5, 
4275, 4275, 4275, 4275, 4262.5, 4212.5, 4200, 4200, 4175, 4175, 
4162.5, 4150, 4150, 4137.5, 4100, 3975, 3925, 3900, 3875, 3737.5, 
3625, 3425, 3412.5, 3362.5, 3362.5, 3362.5, 3337.5, 3262.5, 2762.5, 
2750, 2737.5, 2737.5, 2712.5, 2712.5, 2712.5, 2687.5, 2687.5, 
2662.5, 2637.5, 2637.5, 2637.5, 2625, 2587.5, 2562.5, 2562.5, 
2512.5, 2487.5, 2312.5, 2225, 2212.5, 2175, 2175, 2125, 2112.5, 
2075, 2050, 2050, 2025, 2012.5, 2000, 2000, 1975, 1950, 1950, 
1950, 1937.5, 1925, 1925, 1925, 1912.5, 1900, 1900, 1900, 1900, 
1875, 1862.5, 1850, 1837.5, 1837.5, 1837.5, 1825, 1825, 1812.5, 
1787.5, 1775, 1775, 1762.5, 1750, 1750, 1737.5, 1725, 1725, 1712.5, 
1712.5, 1700, 1700, 1687.5, 1687.5, 1675, 1662.5, 1637.5, 1637.5, 
1637.5, 1637.5, 1637.5, 1612.5, 1612.5, 1587.5, 1587.5, 1575, 
1562.5, 1562.5, 1550, 1550, 1550, 1525, 1525, 1525, 1525, 1512.5, 
1512.5, 1500, 1500, 1487.5, 1462.5, 1450, 1437.5, 1412.5, 1400, 
1400, 1375, 1375, 1362.5, 1350, 1350, 1337.5, 1325, 1325, 1312.5, 
1287.5, 1275, 1225, 1225, 1125, 812.5, 800, 775, 650, 650, 587.5, 
550, 550, 475, 475, 462.5, 437.5, 437.5, 437.5, 437.5, 437.5, 
412.5, 400, 400, 387.5, 387.5, 362.5, 350, 337.5, 337.5, 87.5, 
12.5), ypos = c(262.5, 550, 537.5, 525, 500, 475, 312.5, 487.5, 
512.5, 475, 537.5, 475, 600, 475, 587.5, 562.5, 537.5, 437.5, 
350, 312.5, 250, 450, 575, 550, 387.5, 275, 337.5, 337.5, 562.5, 
537.5, 462.5, 425, 300, 325, 437.5, 287.5, 600, 437.5, 287.5, 
437.5, 287.5, 337.5, 550, 475, 362.5, 312.5, 387.5, 337.5, 287.5, 
412.5, 362.5, 300, 325, 187.5, 537.5, 437.5, 412.5, 412.5, 387.5, 
325, 412.5, 337.5, 337.5, 300, 412.5, 325, 537.5, 437.5, 300, 
250, 562.5, 537.5, 412.5, 387.5, 562.5, 375, 350, 262.5, 475, 
325, 287.5, 262.5, 262.5, 275, 275, 437.5, 475, 275, 300, 275, 
275, 350, 500, 625, 525, 325, 412.5, 300, 475, 362.5, 337.5, 
412.5, 650, 525, 500, 625, 537.5, 512.5, 437.5, 400, 425, 625, 
537.5, 400, 562.5, 637.5, 412.5, 387.5, 337.5, 425, 450, 575, 
462.5, 600, 412.5, 612.5, 750, 625, 387.5, 762.5, 800, 800, 825, 
837.5, 812.5, 862.5, 925, 900, 862.5, 812.5, 800, 937.5, 800, 
912.5, 875, 950, 887.5, 962.5, 850, 800, 962.5, 750, 800, 925, 
850, 800, 750, 850, 850, 800, 812.5, 850, 800, 662.5, 762.5, 
737.5, 687.5, 712.5, 637.5, 562.5, 575, 550, 537.5, 537.5, 587.5, 
512.5, 512.5, 687.5, 625, 562.5, 662.5, 687.5, 587.5, 512.5, 
500, 625, 550, 512.5, 487.5, 525, 475, 612.5, 737.5, 675, 587.5, 
762.5, 700, 475, 737.5, 700, 487.5, 712.5, 750, 687.5, 700, 537.5, 
512.5, 687.5, 675, 537.5, 537.5, 625, 550, 525, 537.5, 512.5, 
512.5, 487.5, 487.5, 462.5, 487.5, 462.5, 487.5, 462.5, 512.5, 
487.5, 462.5, 737.5, 637.5, 625, 725, 600, 537.5, 462.5, 575, 
525, 675, 625, 625, 562.5, 600, 625, 650, 625, 575, 762.5, 550, 
587.5, 712.5, 625, 675, 800, 712.5, 850, 837.5, 875, 875, 800, 
900, 812.5, 1000, 975, 1000, 975, 737.5, 1025, 1000, 950, 950, 
1025, 1025, 850, 775, 712.5, 675, 625, 737.5, 625, 900, 825, 
775, 687.5, 787.5, 700, 800, 775)), class = "data.frame", row.names = c(NA, 
-286L))

Update II: Ben BolkerĀ“s excellent reply did the trick for me. enter image description here I added some features and did annual breaks. I used it on the part of the front where all years had fungal fruitbodies - no artifacts in this case.

Just briefly: If anyone has a good suggestion to change the legend labels from (2009-2010) to 2009-10 without scale_fill_discrete() and keep this colour scheme here, I am all ears.


Solution

  • Here's a start: fit a 2-D GAM to your points, then draw filled contours based on its predictions.

    library(ggplot2)
    library(mgcv)
    ## 'tensor product smooth' of x and y
    m1 <- gam(Year ~ te(xpos, ypos), data = dd)
    gg0 <- ggplot(dd, aes(xpos, ypos)) +
        geom_point() +
        theme_classic()
    ## points only, coloured
    ## gg0 + aes(colour = Year)  + scale_colour_viridis_c()
    

    Construct a prediction grid and fill it in:

    pframe <- with(dd,
                   expand.grid(xpos = seq(min(xpos), max(xpos), length.out = 41),
                               ypos = seq(min(ypos), max(ypos), length.out = 41)))
    pframe$Year <- predict(m1, newdata = pframe)   
    

    Plot:

    gg0 + geom_contour_filled(data = pframe, aes(z = Year),
                              alpha = 0.8,
                              breaks = seq(2010,2022, by = 2))
    ggsave("rings.png")
    

    enter image description here

    I haven't figured out an easy way to get rid of the artifacts yet.


    Re-doing for x>4300 and with adjusted labels

    yrlabs <- paste(2010:2021, 2011:2022, sep = "-")
    gg1 <- gg0 + geom_contour_filled(data = pframe, aes(z = Year),
                              alpha = 0.8,
                              breaks = seq(2010,2022)) +
        scale_fill_viridis_d(name = "period", labels = yrlabs)
    

    enter image description here