├── data_manually_prepared ├── research_area.cpg ├── research_area.dbf ├── regionen2015g.dbf ├── regionen2015g.shp ├── regionen2015g.shx ├── regionen2017g.shp ├── regionen2017g.shx ├── research_area.shp ├── research_area.shx ├── research_area.prj ├── research_area.qpj ├── regionen2015g.prj ├── regionen2017g.prj ├── regionen2015g.qpj ├── regionen2017g.qpj ├── burial_traditions_pseudo.csv ├── regionen2017g.dbf └── bronze_age_chronology.csv ├── development_movie ├── README.md └── frames │ └── README.md ├── data_geo └── README.md ├── data_analysis └── README.md ├── data_simulation └── README.md ├── data_text_elements ├── dprcrosstab.RData ├── sf_desc.txt └── sf_prep.txt ├── figures_plots ├── general_maps │ ├── general_map.jpeg │ ├── general_map_research_area.jpeg │ ├── general_map_distance_network.jpeg │ ├── general_map_regions_countries.jpeg │ ├── general_map_research_area_regions.jpeg │ └── general_map_research_area_timeslices.jpeg ├── region_pictograms_colour │ ├── Benelux.png │ ├── England.png │ ├── Poland.png │ ├── Northern_Germany.png │ ├── Southern_Germany.png │ ├── Northeastern_France.png │ ├── Southern_Scandinavia.png │ └── Southeastern_Central_Europe.png ├── development │ ├── development_pseudoquant.jpeg │ ├── development_amount_regions_burial_type.jpeg │ ├── development_proportions_regions_burial_type.jpeg │ ├── development_amount_regions_burial_construction.jpeg │ └── development_proportions_regions_burial_construction.jpeg ├── sed_simulation │ ├── high_equal_interaction.jpeg │ ├── low_equal_interaction.jpeg │ ├── sed_simulation_step_1.jpeg │ ├── sed_simulation_step_2.jpeg │ ├── sed_simulation_step_3.jpeg │ ├── sed_simulation_step_4.jpeg │ ├── high_spatial_interaction.jpeg │ ├── low_spatial_interaction.jpeg │ └── squared_euclidian_distance_vs_spatial_distance_sim_multiple.jpeg ├── chronology │ └── bronze_age_europe_chronology.jpeg ├── simulation_parameter_exploration │ ├── vertitrans.jpeg │ ├── popsize_crossregions.jpeg │ └── startprop_distancemat.jpeg ├── sed │ ├── sed_map_research_area_timeslices_burial_type.jpeg │ ├── regions_squared_euclidian_distance_burial_type.jpeg │ ├── sed_map_research_area_timeslices_burial_construction.jpeg │ ├── regions_regions_squared_euclidian_distance_burial_type.jpeg │ ├── regions_squared_euclidian_distance_burial_construction.jpeg │ ├── squared_euclidian_distance_vs_spatial_distance_burial_type.jpeg │ ├── regions_regions_mean_squared_euclidian_distance_burial_type.jpeg │ ├── regions_regions_squared_euclidian_distance_burial_construction.jpeg │ ├── squared_euclidian_distance_burial_type_vs_burial_construction.jpeg │ ├── regions_regions_mean_squared_euclidian_distance_burial_construction.jpeg │ └── squared_euclidian_distance_vs_spatial_distance_burial_construction.jpeg ├── simulation_population_graph │ ├── population_graph_tulip.jpeg │ └── population_group_graph.jpeg ├── development_simulation │ ├── development_proportions_regions_simulation.jpeg │ ├── development_proportions_regions_simulation_example.jpeg │ └── development_proportions_regions_simulation_improved_vis.jpeg └── popgenerator_examples │ └── create_unit_population_size_development_comparison.jpeg ├── R ├── real_world_analysis │ ├── sed │ │ ├── 090_prepare_sed_function.R │ │ ├── 250_burial_type_mantel_test.R │ │ ├── 250_burial_construction_mantel_test.R │ │ ├── 500_general_mantel_test_sed_burial_type_burial_construction.R │ │ ├── 200_burial_type_sed_create_matrizes.R │ │ ├── 200_burial_construction_sed_create_matritzes.R │ │ ├── 100_burial_construction_sed.R │ │ ├── 100_burial_type_sed.R │ │ ├── 110_burial_type_sed_region_matrix.R │ │ ├── 110_burial_construction_sed_region_matrix.R │ │ ├── 120_burial_type_sed_region_matrix_mean.R │ │ ├── 120_burial_construction_sed_region_matrix_mean.R │ │ ├── 350_general_sed_development_map_data.R │ │ ├── 210_burial_type_sed_vs_spatial_distance_create_data.R │ │ ├── 210_burial_construction_sed_vs_spatial_distance_create_data.R │ │ ├── 130_burial_type_sed_regions.R │ │ ├── 130_burial_construction_sed_regions.R │ │ ├── 300_burial_type_sed_vs_spatial_distance.R │ │ ├── 300_burial_construction_sed_vs_spatial_distance.R │ │ ├── 600_general_sed_burial_type_vs_burial_construction.R │ │ ├── 400_burial_type_sed_map.R │ │ └── 400_burial_construction_sed_map.R │ ├── general_observations │ │ ├── observations_description.R │ │ └── observations_preparation.R │ ├── development │ │ ├── burial_type_amount_development.R │ │ ├── burial_construction_amount_development.R │ │ ├── experimental_dymanic.R │ │ ├── burial_type_proportions_development.R │ │ └── burial_construction_proportions_development.R │ ├── general_maps │ │ ├── general_map.R │ │ ├── general_map_research_area.R │ │ ├── general_map_timeslices.R │ │ ├── general_map_regions_countries.R │ │ ├── general_map_research_area_regions.R │ │ └── general_map_regions_distance_network.R │ ├── var │ │ └── var_test.R │ └── movie │ │ └── general_map_movie.R ├── run_all_data_analysis_scripts.R ├── run_all_simulation_scripts.R ├── real_world_data_preparation │ ├── 180_define_regions_order_and_colors.R │ ├── 160_crop_c14_dates_to_region_for_dataset_observations.R │ ├── 500_get_start_position_distribution.R │ ├── 250_region_pictograms.R │ ├── 450_fit_bronze_into_regions.R │ ├── 475_calculate_amount_timeseries.R │ ├── 050_prepare_spatial_data.R │ ├── 150_construct_circle_regions.R │ ├── 200_create_spatial_distance_matrix.R │ ├── 460_calculate_proportions_timeseries.R │ └── 100_prepare_c14_data.R ├── simulation │ ├── parameter_exploration │ │ ├── startprop_distancemat │ │ │ ├── 300_plot_results.R │ │ │ ├── 200_plot_template.R │ │ │ └── 100_run_simulation.R │ │ ├── vertitrans │ │ │ ├── 200_plot_template.R │ │ │ ├── 300_plot_results.R │ │ │ └── 100_run_simulation.R │ │ └── popsize_crossregions │ │ │ ├── 200_plot_template.R │ │ │ ├── 300_plot_results.R │ │ │ └── 100_run_simulation.R │ ├── sed │ │ ├── 400_multiple_simulation_sed_vs_spatial_distance_mantel_test.R │ │ ├── 200_multiple_simulation_sed_create_matritzes.R │ │ ├── 100_multiple_simulation_sed.R │ │ ├── 300_multiple_simulation_sed_vs_spatial_distance_create_data.R │ │ ├── 500_multiple_simulation_sed_vs_spatial_distance.R │ │ ├── 050_run_simulation_sed.R │ │ └── 600_multiple_simulation_sed_vs_spatial_distance_spearman.R │ └── population_graph_visualization │ │ ├── 200_individual_population_network.R │ │ └── 100_example_simulation.R ├── helper_functions │ └── geom_grob.R └── other_analysis │ ├── bronze_age_pseudoquant_development.R │ ├── popgenerator_examples │ └── generate_unit_comparison.R │ └── bronze_age_chronology_gantt.R ├── neomod_analysis.Rproj ├── README.md ├── .travis.yml ├── DESCRIPTION └── .gitignore /data_manually_prepared/research_area.cpg: -------------------------------------------------------------------------------- 1 | UTF-8 -------------------------------------------------------------------------------- /development_movie/README.md: -------------------------------------------------------------------------------- 1 | The finished movies. -------------------------------------------------------------------------------- /data_geo/README.md: -------------------------------------------------------------------------------- 1 | Intermediate data produced in and for analysis. -------------------------------------------------------------------------------- /development_movie/frames/README.md: -------------------------------------------------------------------------------- 1 | The individual rendered frames. -------------------------------------------------------------------------------- /data_analysis/README.md: -------------------------------------------------------------------------------- 1 | Intermediate data produced in and for analysis. -------------------------------------------------------------------------------- /data_simulation/README.md: -------------------------------------------------------------------------------- 1 | Data produced in and for the analysis of simulation data. -------------------------------------------------------------------------------- /data_manually_prepared/research_area.dbf: -------------------------------------------------------------------------------- 1 | _A idN 2 | 1 -------------------------------------------------------------------------------- /data_text_elements/dprcrosstab.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/data_text_elements/dprcrosstab.RData -------------------------------------------------------------------------------- /data_manually_prepared/regionen2015g.dbf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/data_manually_prepared/regionen2015g.dbf -------------------------------------------------------------------------------- /data_manually_prepared/regionen2015g.shp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/data_manually_prepared/regionen2015g.shp -------------------------------------------------------------------------------- /data_manually_prepared/regionen2015g.shx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/data_manually_prepared/regionen2015g.shx -------------------------------------------------------------------------------- /data_manually_prepared/regionen2017g.shp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/data_manually_prepared/regionen2017g.shp -------------------------------------------------------------------------------- /data_manually_prepared/regionen2017g.shx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/data_manually_prepared/regionen2017g.shx -------------------------------------------------------------------------------- /data_manually_prepared/research_area.shp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/data_manually_prepared/research_area.shp -------------------------------------------------------------------------------- /data_manually_prepared/research_area.shx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/data_manually_prepared/research_area.shx -------------------------------------------------------------------------------- /figures_plots/general_maps/general_map.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/general_maps/general_map.jpeg -------------------------------------------------------------------------------- /figures_plots/region_pictograms_colour/Benelux.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/region_pictograms_colour/Benelux.png -------------------------------------------------------------------------------- /figures_plots/region_pictograms_colour/England.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/region_pictograms_colour/England.png -------------------------------------------------------------------------------- /figures_plots/region_pictograms_colour/Poland.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/region_pictograms_colour/Poland.png -------------------------------------------------------------------------------- /figures_plots/development/development_pseudoquant.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/development/development_pseudoquant.jpeg -------------------------------------------------------------------------------- /figures_plots/sed_simulation/high_equal_interaction.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed_simulation/high_equal_interaction.jpeg -------------------------------------------------------------------------------- /figures_plots/sed_simulation/low_equal_interaction.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed_simulation/low_equal_interaction.jpeg -------------------------------------------------------------------------------- /figures_plots/sed_simulation/sed_simulation_step_1.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed_simulation/sed_simulation_step_1.jpeg -------------------------------------------------------------------------------- /figures_plots/sed_simulation/sed_simulation_step_2.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed_simulation/sed_simulation_step_2.jpeg -------------------------------------------------------------------------------- /figures_plots/sed_simulation/sed_simulation_step_3.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed_simulation/sed_simulation_step_3.jpeg -------------------------------------------------------------------------------- /figures_plots/sed_simulation/sed_simulation_step_4.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed_simulation/sed_simulation_step_4.jpeg -------------------------------------------------------------------------------- /figures_plots/chronology/bronze_age_europe_chronology.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/chronology/bronze_age_europe_chronology.jpeg -------------------------------------------------------------------------------- /figures_plots/general_maps/general_map_research_area.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/general_maps/general_map_research_area.jpeg -------------------------------------------------------------------------------- /figures_plots/sed_simulation/high_spatial_interaction.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed_simulation/high_spatial_interaction.jpeg -------------------------------------------------------------------------------- /figures_plots/sed_simulation/low_spatial_interaction.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed_simulation/low_spatial_interaction.jpeg -------------------------------------------------------------------------------- /data_manually_prepared/research_area.prj: -------------------------------------------------------------------------------- 1 | GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137,298.257223563]],PRIMEM["Greenwich",0],UNIT["Degree",0.017453292519943295]] -------------------------------------------------------------------------------- /figures_plots/general_maps/general_map_distance_network.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/general_maps/general_map_distance_network.jpeg -------------------------------------------------------------------------------- /figures_plots/general_maps/general_map_regions_countries.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/general_maps/general_map_regions_countries.jpeg -------------------------------------------------------------------------------- /figures_plots/region_pictograms_colour/Northern_Germany.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/region_pictograms_colour/Northern_Germany.png -------------------------------------------------------------------------------- /figures_plots/region_pictograms_colour/Southern_Germany.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/region_pictograms_colour/Southern_Germany.png -------------------------------------------------------------------------------- /figures_plots/region_pictograms_colour/Northeastern_France.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/region_pictograms_colour/Northeastern_France.png -------------------------------------------------------------------------------- /figures_plots/region_pictograms_colour/Southern_Scandinavia.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/region_pictograms_colour/Southern_Scandinavia.png -------------------------------------------------------------------------------- /figures_plots/simulation_parameter_exploration/vertitrans.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/simulation_parameter_exploration/vertitrans.jpeg -------------------------------------------------------------------------------- /figures_plots/general_maps/general_map_research_area_regions.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/general_maps/general_map_research_area_regions.jpeg -------------------------------------------------------------------------------- /figures_plots/general_maps/general_map_research_area_timeslices.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/general_maps/general_map_research_area_timeslices.jpeg -------------------------------------------------------------------------------- /figures_plots/sed/sed_map_research_area_timeslices_burial_type.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed/sed_map_research_area_timeslices_burial_type.jpeg -------------------------------------------------------------------------------- /figures_plots/development/development_amount_regions_burial_type.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/development/development_amount_regions_burial_type.jpeg -------------------------------------------------------------------------------- /figures_plots/region_pictograms_colour/Southeastern_Central_Europe.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/region_pictograms_colour/Southeastern_Central_Europe.png -------------------------------------------------------------------------------- /figures_plots/sed/regions_squared_euclidian_distance_burial_type.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed/regions_squared_euclidian_distance_burial_type.jpeg -------------------------------------------------------------------------------- /figures_plots/simulation_population_graph/population_graph_tulip.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/simulation_population_graph/population_graph_tulip.jpeg -------------------------------------------------------------------------------- /figures_plots/simulation_population_graph/population_group_graph.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/simulation_population_graph/population_group_graph.jpeg -------------------------------------------------------------------------------- /figures_plots/simulation_parameter_exploration/popsize_crossregions.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/simulation_parameter_exploration/popsize_crossregions.jpeg -------------------------------------------------------------------------------- /figures_plots/simulation_parameter_exploration/startprop_distancemat.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/simulation_parameter_exploration/startprop_distancemat.jpeg -------------------------------------------------------------------------------- /figures_plots/development/development_proportions_regions_burial_type.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/development/development_proportions_regions_burial_type.jpeg -------------------------------------------------------------------------------- /figures_plots/sed/sed_map_research_area_timeslices_burial_construction.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed/sed_map_research_area_timeslices_burial_construction.jpeg -------------------------------------------------------------------------------- /figures_plots/development/development_amount_regions_burial_construction.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/development/development_amount_regions_burial_construction.jpeg -------------------------------------------------------------------------------- /figures_plots/sed/regions_regions_squared_euclidian_distance_burial_type.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed/regions_regions_squared_euclidian_distance_burial_type.jpeg -------------------------------------------------------------------------------- /figures_plots/sed/regions_squared_euclidian_distance_burial_construction.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed/regions_squared_euclidian_distance_burial_construction.jpeg -------------------------------------------------------------------------------- /R/real_world_analysis/sed/090_prepare_sed_function.R: -------------------------------------------------------------------------------- 1 | sed <- function(pi, pj) { 2 | pi <- pi / sum(pi) 3 | pj <- pj / sum(pj) 4 | sum((pi - pj)^2) 5 | } 6 | 7 | save(sed, file = "data_analysis/sed_function.RData") 8 | -------------------------------------------------------------------------------- /figures_plots/sed/squared_euclidian_distance_vs_spatial_distance_burial_type.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed/squared_euclidian_distance_vs_spatial_distance_burial_type.jpeg -------------------------------------------------------------------------------- /figures_plots/development/development_proportions_regions_burial_construction.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/development/development_proportions_regions_burial_construction.jpeg -------------------------------------------------------------------------------- /figures_plots/sed/regions_regions_mean_squared_euclidian_distance_burial_type.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed/regions_regions_mean_squared_euclidian_distance_burial_type.jpeg -------------------------------------------------------------------------------- /figures_plots/development_simulation/development_proportions_regions_simulation.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/development_simulation/development_proportions_regions_simulation.jpeg -------------------------------------------------------------------------------- /figures_plots/sed/regions_regions_squared_euclidian_distance_burial_construction.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed/regions_regions_squared_euclidian_distance_burial_construction.jpeg -------------------------------------------------------------------------------- /figures_plots/sed/squared_euclidian_distance_burial_type_vs_burial_construction.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed/squared_euclidian_distance_burial_type_vs_burial_construction.jpeg -------------------------------------------------------------------------------- /figures_plots/popgenerator_examples/create_unit_population_size_development_comparison.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/popgenerator_examples/create_unit_population_size_development_comparison.jpeg -------------------------------------------------------------------------------- /figures_plots/sed/regions_regions_mean_squared_euclidian_distance_burial_construction.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed/regions_regions_mean_squared_euclidian_distance_burial_construction.jpeg -------------------------------------------------------------------------------- /figures_plots/sed/squared_euclidian_distance_vs_spatial_distance_burial_construction.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed/squared_euclidian_distance_vs_spatial_distance_burial_construction.jpeg -------------------------------------------------------------------------------- /figures_plots/development_simulation/development_proportions_regions_simulation_example.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/development_simulation/development_proportions_regions_simulation_example.jpeg -------------------------------------------------------------------------------- /figures_plots/sed_simulation/squared_euclidian_distance_vs_spatial_distance_sim_multiple.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/sed_simulation/squared_euclidian_distance_vs_spatial_distance_sim_multiple.jpeg -------------------------------------------------------------------------------- /figures_plots/development_simulation/development_proportions_regions_simulation_improved_vis.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/neomod_analysis/master/figures_plots/development_simulation/development_proportions_regions_simulation_improved_vis.jpeg -------------------------------------------------------------------------------- /neomod_analysis.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | -------------------------------------------------------------------------------- /data_manually_prepared/research_area.qpj: -------------------------------------------------------------------------------- 1 | GEOGCS["WGS 84",DATUM["WGS_1984",SPHEROID["WGS 84",6378137,298.257223563,AUTHORITY["EPSG","7030"]],AUTHORITY["EPSG","6326"]],PRIMEM["Greenwich",0,AUTHORITY["EPSG","8901"]],UNIT["degree",0.0174532925199433,AUTHORITY["EPSG","9122"]],AUTHORITY["EPSG","4326"]] 2 | -------------------------------------------------------------------------------- /data_text_elements/sf_desc.txt: -------------------------------------------------------------------------------- 1 | "name","value" 2 | "dpr sites amount",454 3 | "dpr period amount",41 4 | "dpr culture amount",25 5 | "dpr material bone amount",1160 6 | "dpr material cremated bones amount",169 7 | "dpr material charcoal wood amount",367 8 | "dpr material other amount",20 9 | "dpr material unknown amount",154 10 | "gpr size",1562 11 | "dpr size",1701 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.com/nevrome/neomod_analysis.svg?token=vxsQ9RjxoGASGtX4Q8jc&branch=master)](https://travis-ci.com/nevrome/neomod_analysis) 2 | 3 | Analysis code and plots of my master thesis [*Ein computerbasiertes Cultural Evolution Modell zur Ausbreitungsdynamik europäisch-bronzezeitlicher Bestattungssitten*](https://github.com/nevrome/neomod_textdev). 4 | -------------------------------------------------------------------------------- /data_manually_prepared/regionen2015g.prj: -------------------------------------------------------------------------------- 1 | PROJCS["WGS_1984_UTM_Zone_32N",GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137,298.257223563]],PRIMEM["Greenwich",0],UNIT["Degree",0.017453292519943295]],PROJECTION["Transverse_Mercator"],PARAMETER["latitude_of_origin",0],PARAMETER["central_meridian",9],PARAMETER["scale_factor",0.9996],PARAMETER["false_easting",500000],PARAMETER["false_northing",0],UNIT["Meter",1]] -------------------------------------------------------------------------------- /data_manually_prepared/regionen2017g.prj: -------------------------------------------------------------------------------- 1 | PROJCS["WGS_1984_UTM_Zone_32N",GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137,298.257223563]],PRIMEM["Greenwich",0],UNIT["Degree",0.017453292519943295]],PROJECTION["Transverse_Mercator"],PARAMETER["latitude_of_origin",0],PARAMETER["central_meridian",9],PARAMETER["scale_factor",0.9996],PARAMETER["false_easting",500000],PARAMETER["false_northing",0],UNIT["Meter",1]] -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: r 2 | cache: 3 | packages: true 4 | sudo: required 5 | 6 | before_install: 7 | - sudo add-apt-repository ppa:ubuntugis/ubuntugis-unstable --yes 8 | - sudo apt-get --yes --force-yes update -qq 9 | - sudo apt-get install --yes udunits-bin libproj-dev libgeos-dev libgdal-dev libgdal1-dev libudunits2-dev 10 | 11 | script: 12 | - R -e "devtools::install_github('ISAAKiel/c14bazAAR')" 13 | - Rscript R/run_all_data_analysis_scripts.R 14 | -------------------------------------------------------------------------------- /R/run_all_data_analysis_scripts.R: -------------------------------------------------------------------------------- 1 | library(magrittr) 2 | 3 | lapply( 4 | c( 5 | "./R/real_world_data_preparation", 6 | "./R/real_world_analysis/general_maps", 7 | "./R/real_world_analysis/development", 8 | "./R/real_world_analysis/general_observations", 9 | "./R/real_world_analysis/sed", 10 | "./R/other_analysis" 11 | ), 12 | function(x) { 13 | pbapply::pblapply( 14 | list.files(x, full.names = TRUE), 15 | function(y) { 16 | message("\n###### ", y, " ######\n") 17 | source(y) 18 | rm(list = ls()) 19 | } 20 | ) 21 | } 22 | ) 23 | -------------------------------------------------------------------------------- /data_manually_prepared/regionen2015g.qpj: -------------------------------------------------------------------------------- 1 | PROJCS["WGS 84 / UTM zone 32N",GEOGCS["WGS 84",DATUM["WGS_1984",SPHEROID["WGS 84",6378137,298.257223563,AUTHORITY["EPSG","7030"]],AUTHORITY["EPSG","6326"]],PRIMEM["Greenwich",0,AUTHORITY["EPSG","8901"]],UNIT["degree",0.0174532925199433,AUTHORITY["EPSG","9122"]],AUTHORITY["EPSG","4326"]],PROJECTION["Transverse_Mercator"],PARAMETER["latitude_of_origin",0],PARAMETER["central_meridian",9],PARAMETER["scale_factor",0.9996],PARAMETER["false_easting",500000],PARAMETER["false_northing",0],UNIT["metre",1,AUTHORITY["EPSG","9001"]],AXIS["Easting",EAST],AXIS["Northing",NORTH],AUTHORITY["EPSG","32632"]] 2 | -------------------------------------------------------------------------------- /data_manually_prepared/regionen2017g.qpj: -------------------------------------------------------------------------------- 1 | PROJCS["WGS 84 / UTM zone 32N",GEOGCS["WGS 84",DATUM["WGS_1984",SPHEROID["WGS 84",6378137,298.257223563,AUTHORITY["EPSG","7030"]],AUTHORITY["EPSG","6326"]],PRIMEM["Greenwich",0,AUTHORITY["EPSG","8901"]],UNIT["degree",0.0174532925199433,AUTHORITY["EPSG","9122"]],AUTHORITY["EPSG","4326"]],PROJECTION["Transverse_Mercator"],PARAMETER["latitude_of_origin",0],PARAMETER["central_meridian",9],PARAMETER["scale_factor",0.9996],PARAMETER["false_easting",500000],PARAMETER["false_northing",0],UNIT["metre",1,AUTHORITY["EPSG","9001"]],AXIS["Easting",EAST],AXIS["Northing",NORTH],AUTHORITY["EPSG","32632"]] 2 | -------------------------------------------------------------------------------- /R/run_all_simulation_scripts.R: -------------------------------------------------------------------------------- 1 | library(magrittr) 2 | 3 | if (!dir.exists("../simulationdata")) { 4 | dir.create("../simulationdata") 5 | } 6 | 7 | lapply( 8 | c( 9 | "R/simulation/parameter_exploration/popsize_crossregions", 10 | "R/simulation/parameter_exploration/vertitrans", 11 | "R/simulation/parameter_exploration/startprop_distancemat", 12 | "R/simulation/sed", 13 | "R/simulation/population_graph_visualization" 14 | ), 15 | function(x) { 16 | pbapply::pblapply( 17 | list.files(x, full.names = TRUE), 18 | function(y) { 19 | message("\n###### ", y, " ######\n") 20 | source(y) 21 | rm(list = ls()) 22 | } 23 | ) 24 | } 25 | ) 26 | -------------------------------------------------------------------------------- /R/real_world_data_preparation/180_define_regions_order_and_colors.R: -------------------------------------------------------------------------------- 1 | region_order <- c( 2 | "Southeastern Central Europe", 3 | "Poland", 4 | "Southern Germany", 5 | "Northeastern France", 6 | "Northern Germany", 7 | "Southern Scandinavia", 8 | "Benelux", 9 | "England" 10 | ) 11 | 12 | save(region_order, file = "data_analysis/region_order.RData") 13 | 14 | region_colors <- c( 15 | "Southeastern Central Europe" = "#999999", 16 | "Poland" = "#ffe500", 17 | "Southern Germany" = "#56B4E9", 18 | "Northeastern France" = "#009E73", 19 | "Northern Germany" = "#000000", 20 | "Southern Scandinavia" = "#0072B2", 21 | "Benelux" = "#D55E00", 22 | "England" = "#CC79A7" 23 | ) 24 | 25 | save(region_colors, file = "data_analysis/region_colors.RData") 26 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/250_burial_type_mantel_test.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/distance_matrix_spatial.RData") 2 | load("data_analysis/distance_matrizes_sed_burial_type.RData") 3 | 4 | #### 5 | 6 | mantel_test_results <- lapply( 7 | 1:length(distance_matrizes_sed), function(i, x, y, z) { 8 | mantel_result <- vegan::mantel(x[[i]], y, method = "spear", permutations=999) 9 | data.frame( 10 | time = z[[i]], 11 | statistic = mantel_result$statistic, 12 | signif = mantel_result$signif 13 | ) 14 | }, 15 | x = distance_matrizes_sed, 16 | y = distance_matrix_spatial, 17 | z = names(distance_matrizes_sed) 18 | ) %>% 19 | do.call(rbind, .) 20 | 21 | save( 22 | mantel_test_results, 23 | file = "data_analysis/mantel_sed_spatial_burial_type.RData" 24 | ) 25 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/250_burial_construction_mantel_test.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/distance_matrix_spatial.RData") 2 | load("data_analysis/distance_matrizes_sed_burial_construction.RData") 3 | 4 | #### 5 | 6 | mantel_test_results <- lapply( 7 | 1:length(distance_matrizes_sed), function(i, x, y, z) { 8 | mantel_result <- vegan::mantel(x[[i]], y, method = "spear", permutations=999) 9 | data.frame( 10 | time = z[[i]], 11 | statistic = mantel_result$statistic, 12 | signif = mantel_result$signif 13 | ) 14 | }, 15 | x = distance_matrizes_sed, 16 | y = distance_matrix_spatial, 17 | z = names(distance_matrizes_sed) 18 | ) %>% 19 | do.call(rbind, .) 20 | 21 | save( 22 | mantel_test_results, 23 | file = "data_analysis/mantel_sed_spatial_burial_construction.RData" 24 | ) 25 | 26 | 27 | -------------------------------------------------------------------------------- /R/real_world_data_preparation/160_crop_c14_dates_to_region_for_dataset_observations.R: -------------------------------------------------------------------------------- 1 | #### load spatial data #### 2 | 3 | load("data_analysis/regions.RData") 4 | load("data_analysis/bronze16.RData") 5 | 6 | #### prepare data #### 7 | 8 | load("data_analysis/bronze16.RData") 9 | bronze16 %<>% sf::st_as_sf(coords = c("lon", "lat")) 10 | sf::st_crs(bronze16) <- 4326 11 | bronze16 %<>% sf::st_transform("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 12 | 13 | #### intersect #### 14 | 15 | schnu <- sf::st_intersection(bronze16, regions) 16 | 17 | #### make tibble #### 18 | 19 | dates_per_region <- schnu %>% sf::st_set_geometry(NULL) %>% 20 | dplyr::mutate( 21 | region = NAME 22 | ) %>% 23 | dplyr::select( 24 | -id.1, -ID, -NAME 25 | ) 26 | 27 | save( 28 | dates_per_region, 29 | file = "data_analysis/dates_per_region.RData" 30 | ) 31 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/500_general_mantel_test_sed_burial_type_burial_construction.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/distance_matrizes_sed_burial_type.RData") 2 | dms_burial_type <- distance_matrizes_sed 3 | 4 | load("data_analysis/distance_matrizes_sed_burial_construction.RData") 5 | dms_burial_construction <- distance_matrizes_sed 6 | 7 | mantel_test_results <- lapply( 8 | 1:length(dms_burial_type), function(i, x, y, z) { 9 | mantel_result <- vegan::mantel(x[[i]], y[[i]], method = "pearson", permutations=999) 10 | data.frame( 11 | time = z[[i]], 12 | statistic = mantel_result$statistic, 13 | signif = mantel_result$signif 14 | ) 15 | }, 16 | x = dms_burial_type, 17 | y = dms_burial_construction, 18 | z = names(dms_burial_type) 19 | ) %>% 20 | do.call(rbind, .) 21 | 22 | save( 23 | mantel_test_results, 24 | file = "data_analysis/mantel_sed_spatial_burial_type_burial_construction.RData" 25 | ) 26 | -------------------------------------------------------------------------------- /data_text_elements/sf_prep.txt: -------------------------------------------------------------------------------- 1 | "name","value" 2 | "size bronze","10956" 3 | "size bronze0","7543" 4 | "size bronze05","2361" 5 | "bronze1 variable amount","15" 6 | "size bronze1","2336" 7 | "size bronze15","1894" 8 | "bronze15 labnrs amount","1831" 9 | "bronze15 labnr doubles","46" 10 | "bronze15 multi dates one grave","498" 11 | "bronze15 burial_type doubles","cremation: 170, inhumation: 104, unknown: 224" 12 | "bronze15 burial_construction doubles","flat: 82, mound: 86, unknown: 330" 13 | "bronze05 variable amount","15" 14 | "size bronze16","1848" 15 | "bronze16 max dates per grave","8" 16 | "bronze16 multi dates one grave","486" 17 | "bronze16 multi dates one grave with numbers","252" 18 | "size bronze17","1704" 19 | "regions graves amounts","*Southeastern Central Europe* (70), *Poland* (134), *Southern Germany* (213), *Northeastern France* (64), *Northern Germany* (475), *Southern Scandinavia* (209), *Benelux* (284), *England* (113)" 20 | -------------------------------------------------------------------------------- /R/simulation/parameter_exploration/startprop_distancemat/300_plot_results.R: -------------------------------------------------------------------------------- 1 | models <- pbapply::pblapply( 2 | list.files("../simulationdata/pe_startprop_distancemat", full.names = TRUE), 3 | function(y) { 4 | read.csv(y) %>% tibble::as.tibble() 5 | } 6 | ) 7 | 8 | models_groups <- do.call(rbind, models) %>% 9 | base::split(.$model_group) 10 | 11 | load("data_simulation/pe_startprop_distancemat.RData") 12 | 13 | library(ggplot2) 14 | plots <- cowplot::plot_grid( 15 | plotlist = lapply(models_groups, plot_by_group), 16 | labels = paste0(LETTERS[1:length(models_groups)], " - ", names(models_groups)), 17 | label_x = 0, 18 | hjust = 0, 19 | label_size = 10, 20 | ncol = 4, 21 | nrow = 3, 22 | align = "v" 23 | ) 24 | 25 | plots %>% 26 | ggsave( 27 | "figures_plots/simulation_parameter_exploration/startprop_distancemat.jpeg", 28 | plot = ., 29 | device = "jpeg", 30 | scale = 1, 31 | dpi = 300, 32 | width = 210, height = 297, units = "mm", 33 | limitsize = F 34 | ) 35 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: placeholder 2 | Title: Does not matter. 3 | Version: 0.0.1 4 | Imports: 5 | magrittr, 6 | txtstorage, 7 | Bchron (>= 4.3.0), 8 | broom (>= 0.5.0), 9 | car (>= 3.0-0), 10 | cowplot (>= 0.9.3), 11 | devtools (>= 1.13.6), 12 | dplyr (>= 0.7.6), 13 | dynlm (>= 0.3-5), 14 | forcats (>= 0.3.0), 15 | forecast (>= 8.4), 16 | ggplot2 (>= 3.0.0), 17 | ggtern (>= 2.2.1), 18 | gridExtra (>= 2.3), 19 | lmtest (>= 0.9-36), 20 | nlWaldTest (>= 1.1.3), 21 | pbapply (>= 1.3-4), 22 | plyr (>= 1.8.4), 23 | png (>= 0.1-7), 24 | pryr (>= 0.1.4), 25 | purrr (>= 0.2.5), 26 | raster (>= 2.6-7), 27 | readr (>= 1.1.1), 28 | rgdal (>= 1.3-4), 29 | rnaturalearth (>= 0.1.0), 30 | sandwich (>= 2.4-0), 31 | scales (>= 0.5.0), 32 | sf (>= 0.6-3), 33 | stringr (>= 1.3.1), 34 | tibble (>= 1.4.2), 35 | tidyr (>= 0.8.1), 36 | tseries (>= 0.10-45), 37 | vars (>= 1.5-3), 38 | vegan (>= 2.5-2) 39 | Remotes: github::ISAAKiel/c14bazAAR, github::nevrome/txtstorage 40 | 41 | 42 | -------------------------------------------------------------------------------- /data_manually_prepared/burial_traditions_pseudo.csv: -------------------------------------------------------------------------------- 1 | region,period,cremation,inhumation,mound,flat 2 | Southeastern Central Europe,Early Bronze Age,2,2,1,3 3 | Southeastern Central Europe,Middle Bronze Age,2,2,3,1 4 | Southeastern Central Europe,Late Bronze Age,3,1,1,3 5 | Poland,Early Bronze Age,1,3,2,2 6 | Poland,Middle Bronze Age,2,2,2,2 7 | Poland,Late Bronze Age,3,1,1,3 8 | Southern Germany,Early Bronze Age,1,3,1,3 9 | Southern Germany,Middle Bronze Age,2,2,3,1 10 | Southern Germany,Late Bronze Age,3,1,1,3 11 | Northeastern France,Early Bronze Age,2,2,2,2 12 | Northeastern France,Middle Bronze Age,2,2,3,1 13 | Northeastern France,Late Bronze Age,3,1,2,2 14 | Northern Germany,Early Bronze Age,1,3,2,2 15 | Northern Germany,Middle Bronze Age,1,3,3,1 16 | Northern Germany,Late Bronze Age,3,1,1,3 17 | Southern Scandinavia,Early Bronze Age,NA,NA,NA,NA 18 | Southern Scandinavia,Middle Bronze Age,2,2,3,1 19 | Southern Scandinavia,Late Bronze Age,3,1,2,2 20 | Benelux,Early Bronze Age,1,3,3,1 21 | Benelux,Middle Bronze Age,2,2,3,1 22 | Benelux,Late Bronze Age,3,1,2,2 23 | England,Early Bronze Age,1,3,3,1 24 | England,Middle Bronze Age,3,1,2,2 25 | England,Late Bronze Age,3,1,2,2 26 | -------------------------------------------------------------------------------- /R/simulation/sed/400_multiple_simulation_sed_vs_spatial_distance_mantel_test.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/distance_matrix_spatial.RData") 2 | load("data_simulation/sed_simulation_regions_timeslices_matrizes.RData") 3 | 4 | mantel_test_results <- pbapply::pblapply( 5 | 1:length(distance_matrizes_sed), function(i, x, y, model_id) { 6 | lapply( 7 | 1:length(x[[i]]), function(i, x, y, time, model_id) { 8 | mantel_result <- vegan::mantel(x[[i]], y, method = "spear", permutations=999) 9 | data.frame( 10 | model_id = model_id, 11 | time = time[[i]], 12 | statistic = mantel_result$statistic, 13 | signif = mantel_result$signif 14 | ) 15 | }, 16 | x = x[[i]], 17 | y = y, 18 | time = names(x[[i]]), 19 | model_id = model_id[[i]] 20 | ) %>% do.call(rbind, .) 21 | }, 22 | x = distance_matrizes_sed, 23 | y = distance_matrix_spatial, 24 | model_id = names(distance_matrizes_sed) 25 | ) %>% do.call(rbind, .) %>% tibble::as.tibble() 26 | 27 | save( 28 | mantel_test_results, 29 | file = "data_simulation/sed_simulation_mantel_sed_spatial.RData" 30 | ) 31 | -------------------------------------------------------------------------------- /R/simulation/parameter_exploration/vertitrans/200_plot_template.R: -------------------------------------------------------------------------------- 1 | #### specialized plot function #### 2 | 3 | plot_by_group <- function(x) { 4 | x %>% 5 | dplyr::filter( 6 | idea == "idea_1" 7 | ) %>% 8 | ggplot() + 9 | # geom_area(aes(x = timestep, y = proportion, fill = idea, group = idea)) + 10 | geom_line( 11 | aes(x = timestep, y = proportion, color = as.factor(model_id), group = model_id), 12 | size = 0.2, 13 | alpha = 1 14 | ) + 15 | facet_wrap(~region, nrow = 8) + 16 | theme_bw() + 17 | theme( 18 | strip.background = element_blank(), 19 | strip.text.x = element_blank(), 20 | axis.title = element_blank(), 21 | axis.text.y = element_blank(), 22 | axis.text.x = element_text(size = 8, angle = 45, hjust = 1), 23 | axis.ticks.y = element_blank(), 24 | plot.margin = unit(c(1.4,0.2,0.2,0), "lines") 25 | ) + 26 | guides(color = FALSE) + 27 | scale_y_continuous( 28 | breaks = c(0, 0.5, 1), 29 | labels = c("0%", "50%", "100%") 30 | ) + 31 | scale_x_continuous( 32 | breaks = seq(0, 1400, 200), 33 | limits = c(0, 1400) 34 | ) + 35 | ggthemes::scale_colour_colorblind() 36 | } 37 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/200_burial_type_sed_create_matrizes.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/squared_euclidian_distance_over_time_burial_type.RData") 2 | 3 | time_regions_grid <- regions_grid %>% dplyr::mutate( 4 | time = base::cut( 5 | time, 6 | seq(-2200, -800, 200), labels = paste(seq(-2200, -1000, 200), seq(-2000, -800, 200), sep = " - "), 7 | include.lowest = TRUE, 8 | right = FALSE) 9 | ) %>% 10 | dplyr::group_by( 11 | time, regionA, regionB 12 | ) %>% 13 | dplyr::summarise( 14 | mean_sed = mean(sed, na.rm = TRUE) 15 | ) %>% 16 | dplyr::ungroup() %>% 17 | # that's dangerous... 18 | dplyr::mutate( 19 | mean_sed = tidyr::replace_na(mean_sed, 0) 20 | ) 21 | 22 | save(time_regions_grid, file = "data_analysis/time_regions_grid_sed_burial_type.RData") 23 | 24 | distance_matrizes_sed <- lapply( 25 | base::split(time_regions_grid, time_regions_grid$time), function(x){ 26 | x %>% 27 | dplyr::select( 28 | -time 29 | ) %>% 30 | tidyr::spread(regionA, mean_sed) %>% 31 | dplyr::select( 32 | -regionB 33 | ) %>% 34 | as.matrix() 35 | } 36 | ) 37 | 38 | save(distance_matrizes_sed, file = "data_analysis/distance_matrizes_sed_burial_type.RData") 39 | -------------------------------------------------------------------------------- /R/simulation/parameter_exploration/popsize_crossregions/200_plot_template.R: -------------------------------------------------------------------------------- 1 | #### specialized plot function #### 2 | 3 | plot_by_group <- function(x) { 4 | x %>% 5 | dplyr::filter( 6 | idea == "idea_1" 7 | ) %>% 8 | ggplot() + 9 | # geom_area(aes(x = timestep, y = proportion, fill = idea, group = idea)) + 10 | geom_line( 11 | aes(x = timestep, y = proportion, color = as.factor(model_id), group = model_id), 12 | size = 0.2, 13 | alpha = 1 14 | ) + 15 | facet_wrap(~region, nrow = 8) + 16 | theme_bw() + 17 | theme( 18 | strip.background = element_blank(), 19 | strip.text.x = element_blank(), 20 | axis.title = element_blank(), 21 | axis.text.y = element_blank(), 22 | axis.text.x = element_text(size = 8, angle = 45, hjust = 1), 23 | axis.ticks.y = element_blank(), 24 | plot.margin = unit(c(1.4,0.2,0.2,0), "lines") 25 | ) + 26 | guides(color = FALSE) + 27 | scale_y_continuous( 28 | breaks = c(0, 0.5, 1), 29 | labels = c("0%", "50%", "100%") 30 | ) + 31 | scale_x_continuous( 32 | breaks = seq(0, 1400, 200), 33 | limits = c(0, 1400) 34 | ) + 35 | ggthemes::scale_colour_colorblind() 36 | } 37 | -------------------------------------------------------------------------------- /R/simulation/parameter_exploration/startprop_distancemat/200_plot_template.R: -------------------------------------------------------------------------------- 1 | #### specialized plot function #### 2 | 3 | plot_by_group <- function(x) { 4 | x %>% 5 | dplyr::filter( 6 | idea == "idea_1" 7 | ) %>% 8 | ggplot() + 9 | # geom_area(aes(x = timestep, y = proportion, fill = idea, group = idea)) + 10 | geom_line( 11 | aes(x = timestep, y = proportion, color = as.factor(model_id), group = model_id), 12 | size = 0.2, 13 | alpha = 1 14 | ) + 15 | facet_wrap(~region, nrow = 8) + 16 | theme_bw() + 17 | theme( 18 | strip.background = element_blank(), 19 | strip.text.x = element_blank(), 20 | axis.title = element_blank(), 21 | axis.text.y = element_blank(), 22 | axis.text.x = element_text(size = 8, angle = 45, hjust = 1), 23 | axis.ticks.y = element_blank(), 24 | plot.margin = unit(c(1.4,0.2,0.2,0), "lines") 25 | ) + 26 | guides(color = FALSE) + 27 | scale_y_continuous( 28 | breaks = c(0, 0.5, 1), 29 | labels = c("0%", "50%", "100%") 30 | ) + 31 | scale_x_continuous( 32 | breaks = seq(0, 1400, 200), 33 | limits = c(0, 1400) 34 | ) + 35 | ggthemes::scale_colour_colorblind() 36 | } 37 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # Example code in package build process 9 | *-Ex.R 10 | 11 | # Output files from R CMD build 12 | /*.tar.gz 13 | 14 | # Output files from R CMD check 15 | /*.Rcheck/ 16 | 17 | # RStudio files 18 | .Rproj.user/ 19 | 20 | # produced vignettes 21 | vignettes/*.html 22 | vignettes/*.pdf 23 | 24 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 25 | .httr-oauth 26 | 27 | # knitr and R markdown default cache directories 28 | /*_cache/ 29 | /cache/ 30 | 31 | # Temporary files created by R markdown 32 | *.utf8.md 33 | *.knit.md 34 | .Rproj.user 35 | 36 | # data and results that are not necessary or to big for the repo 37 | data_analysis/*.RData 38 | data_simulation/*.RData 39 | data_simulation/gluesless_input_output/*.txt 40 | data_simulation/gluesless_input_output/*.paj 41 | data_simulation/gluesless_input_output/*.csv 42 | data_simulation/neiman_counter_simulation/* 43 | data_simulation/sed_simulation/* 44 | data_geo/*.RData 45 | development_movie/*.mp4 46 | development_movie/*.gif 47 | development_movie/frames/*.jpeg 48 | Rplots.pdf 49 | 50 | # rstudio faulty creation of .Rbuildignore file 51 | .Rbuildignore 52 | 53 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/200_burial_construction_sed_create_matritzes.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/squared_euclidian_distance_over_time_burial_construction.RData") 2 | 3 | time_regions_grid <- regions_grid %>% dplyr::mutate( 4 | time = base::cut( 5 | time, 6 | seq(-2200, -800, 200), labels = paste(seq(-2200, -1000, 200), seq(-2000, -800, 200), sep = " - "), 7 | include.lowest = TRUE, 8 | right = FALSE) 9 | ) %>% 10 | dplyr::group_by( 11 | time, regionA, regionB 12 | ) %>% 13 | dplyr::summarise( 14 | mean_sed = mean(sed, na.rm = TRUE) 15 | ) %>% 16 | dplyr::ungroup() %>% 17 | # that's dangerous... 18 | dplyr::mutate( 19 | mean_sed = tidyr::replace_na(mean_sed, 0) 20 | ) 21 | 22 | save(time_regions_grid, file = "data_analysis/time_regions_grid_sed_burial_construction.RData") 23 | 24 | distance_matrizes_sed <- lapply( 25 | base::split(time_regions_grid, time_regions_grid$time), function(x){ 26 | x %>% 27 | dplyr::select( 28 | -time 29 | ) %>% 30 | tidyr::spread(regionA, mean_sed) %>% 31 | dplyr::select( 32 | -regionB 33 | ) %>% 34 | as.matrix() 35 | } 36 | ) 37 | 38 | save(distance_matrizes_sed, file = "data_analysis/distance_matrizes_sed_burial_construction.RData") 39 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/100_burial_construction_sed.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/sed_function.RData") 2 | load("data_analysis/development_proportions_burial_construction.RData") 3 | 4 | prop <- proportion_development_burial_construction 5 | 6 | long_prop <- prop %>% 7 | tidyr::spread( 8 | idea, proportion 9 | ) 10 | 11 | regions <- prop$region_name %>% unique() 12 | timesteps <- prop$timestep %>% unique() 13 | 14 | regions_grid <- 15 | expand.grid( 16 | regionA = regions, regionB = regions, time = timesteps, 17 | stringsAsFactors = FALSE 18 | ) %>% 19 | tibble::as.tibble() %>% 20 | dplyr::left_join( 21 | long_prop, 22 | by = c("regionA" = "region_name", "time" = "timestep") 23 | ) %>% 24 | dplyr::left_join( 25 | long_prop, 26 | by = c("regionB" = "region_name", "time" = "timestep"), 27 | suffix = c("_regionA", "_regionB") 28 | ) 29 | 30 | regions_grid <- regions_grid %>% 31 | dplyr::rowwise() %>% 32 | dplyr::mutate( 33 | sed = sed(c(flat_regionA, mound_regionA), c(flat_regionB, mound_regionB)) 34 | ) %>% 35 | dplyr::ungroup() %>% 36 | dplyr::select( 37 | regionA, regionB, time, sed 38 | ) 39 | 40 | save(regions_grid, file = "data_analysis/squared_euclidian_distance_over_time_burial_construction.RData") 41 | -------------------------------------------------------------------------------- /R/real_world_data_preparation/500_get_start_position_distribution.R: -------------------------------------------------------------------------------- 1 | #### burial type #### 2 | 3 | load( "data_analysis/development_proportions_burial_type.RData") 4 | 5 | start_proportion_burial_type <- proportion_development_burial_type %>% 6 | dplyr::filter(timestep == -2200) %>% 7 | tidyr::spread(idea, proportion) %>% 8 | dplyr::arrange(region_name) %>% 9 | magrittr::set_rownames(.$region_name) %>% 10 | dplyr::select(cremation, inhumation) %>% 11 | dplyr::rename( 12 | idea_1 = cremation, 13 | idea_2 = inhumation 14 | ) 15 | 16 | save( 17 | start_proportion_burial_type, 18 | file = "data_analysis/start_proportion_burial_type.RData" 19 | ) 20 | 21 | 22 | 23 | #### burial construction #### 24 | 25 | load("data_analysis/development_proportions_burial_construction.RData") 26 | 27 | start_proportion_burial_construction <- proportion_development_burial_construction %>% 28 | dplyr::filter(timestep == -2200) %>% 29 | tidyr::spread(idea, proportion) %>% 30 | dplyr::arrange(region_name) %>% 31 | magrittr::set_rownames(.$region_name) %>% 32 | dplyr::select(flat, mound) %>% 33 | dplyr::rename( 34 | idea_1 = flat, 35 | idea_2 = mound 36 | ) 37 | 38 | save( 39 | start_proportion_burial_construction, 40 | file = "data_analysis/start_proportion_burial_construction.RData" 41 | ) 42 | -------------------------------------------------------------------------------- /R/simulation/parameter_exploration/vertitrans/300_plot_results.R: -------------------------------------------------------------------------------- 1 | models <- pbapply::pblapply( 2 | list.files("../simulationdata/pe_vertitrans", full.names = TRUE), 3 | function(y) { 4 | read.csv(y) %>% tibble::as.tibble() 5 | } 6 | ) 7 | 8 | models_groups <- do.call(rbind, models) %>% 9 | base::split(.$model_group) 10 | 11 | load("data_simulation/pe_vertitrans.RData") 12 | 13 | library(ggplot2) 14 | plots <- cowplot::plot_grid( 15 | plotlist = lapply(models_groups, plot_by_group) %>% 16 | matrix(., 3, 5) %>% t %>% c(), 17 | labels = models_grid %>% base::split(.$model_group) %>% 18 | sapply(function(x){ 19 | rps <- x$unit_size_functions[[1]][[1]](0) 20 | cuiv <- x$cross_unit_proportion_child_of[1] 21 | cuih <- x$cross_unit_proportion_friend[1] 22 | paste0( 23 | LETTERS[x$model_group[1]], " - ", rps, ", v:", format(cuiv, scientific = FALSE), ", h:", cuih) 24 | }) %>% 25 | matrix(., 3, 5) %>% t %>% c(), 26 | label_x = 0, 27 | hjust = 0, 28 | label_size = 10, 29 | ncol = 5, 30 | nrow = 3, 31 | align = "v" 32 | ) 33 | 34 | plots %>% 35 | ggsave( 36 | "figures_plots/simulation_parameter_exploration/vertitrans.jpeg", 37 | plot = ., 38 | device = "jpeg", 39 | scale = 1, 40 | dpi = 300, 41 | width = 210, height = 297, units = "mm", 42 | limitsize = F 43 | ) 44 | -------------------------------------------------------------------------------- /R/real_world_data_preparation/250_region_pictograms.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/regions.RData") 2 | load("data_analysis/extended_area.RData") 3 | extended_area <- extended_area$geometry 4 | 5 | #### plot #### 6 | 7 | load("data_analysis/region_order.RData") 8 | load("data_analysis/region_colors.RData") 9 | 10 | path = "figures_plots/region_pictograms_colour/" 11 | 12 | for (i in 1:nrow(regions)) { 13 | 14 | one_region <- regions[regions$NAME == region_order[i], ] 15 | one_region_buffer <- one_region %>% 16 | sf::st_buffer(400000) 17 | 18 | one_region_geom <- one_region$geometry 19 | one_region_buffer_geom <- one_region_buffer$geometry 20 | 21 | one_region_name <- one_region$NAME %>% gsub(" ", "_", ., fixed = TRUE) 22 | 23 | png( 24 | filename = paste0(path, one_region_name, ".png"), 25 | width = 87*4, height = 100*4, units = "px", res = 300 26 | ) 27 | par(mar = c(0,0,0,0), 28 | pin = c(4,2), 29 | pty = "m", 30 | xaxs = "i", 31 | xaxt = 'n', 32 | xpd = FALSE, 33 | yaxs = "i", 34 | yaxt = 'n', 35 | bg = NA) 36 | plot(extended_area, border = NA , col = "grey85", lwd = 2) 37 | plot(one_region_buffer_geom, border = NA, col = scales::alpha(region_colors[i], 0.4), add = TRUE) 38 | plot(one_region_geom, border = NA, col = region_colors[i], add = TRUE) 39 | dev.off() 40 | 41 | } 42 | 43 | -------------------------------------------------------------------------------- /R/simulation/parameter_exploration/popsize_crossregions/300_plot_results.R: -------------------------------------------------------------------------------- 1 | models <- pbapply::pblapply( 2 | list.files("../simulationdata/pe_popsize_crossregions", full.names = TRUE), 3 | function(y) { 4 | read.csv(y) %>% tibble::as.tibble() 5 | } 6 | ) 7 | 8 | models_groups <- do.call(rbind, models) %>% 9 | base::split(.$model_group) 10 | 11 | load("data_simulation/pe_popsize_crossregions.RData") 12 | 13 | library(ggplot2) 14 | plots <- cowplot::plot_grid( 15 | plotlist = lapply(models_groups, plot_by_group) %>% 16 | matrix(., 3, 5) %>% t %>% c(), 17 | labels = models_grid %>% base::split(.$model_group) %>% 18 | sapply(function(x){ 19 | rps <- x$unit_size_functions[[1]][[1]](0) 20 | cuiv <- x$cross_unit_proportion_child_of[1] 21 | cuih <- x$cross_unit_proportion_friend[1] 22 | paste0( 23 | LETTERS[x$model_group[1]], " - ", rps, ", v:", format(cuiv, scientific = FALSE), ", h:", cuih) 24 | }) %>% 25 | matrix(., 3, 5) %>% t %>% c(), 26 | label_x = 0, 27 | hjust = 0, 28 | label_size = 10, 29 | ncol = 5, 30 | nrow = 3, 31 | align = "v" 32 | ) 33 | 34 | plots %>% 35 | ggsave( 36 | "figures_plots/simulation_parameter_exploration/popsize_crossregions.jpeg", 37 | plot = ., 38 | device = "jpeg", 39 | scale = 1, 40 | dpi = 300, 41 | width = 210, height = 297, units = "mm", 42 | limitsize = F 43 | ) 44 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/100_burial_type_sed.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/sed_function.RData") 2 | load("data_analysis/development_proportions_burial_type.RData") 3 | 4 | prop <- proportion_development_burial_type 5 | 6 | # proportion_development_burial_type %>% 7 | # tidyr::complete( 8 | # region_name, timestep, idea, 9 | # fill = list(proportion = as.integer(0)) 10 | # ) 11 | 12 | long_prop <- prop %>% 13 | tidyr::spread( 14 | idea, proportion 15 | ) 16 | 17 | regions <- prop$region_name %>% unique() 18 | timesteps <- prop$timestep %>% unique() 19 | 20 | regions_grid <- 21 | expand.grid( 22 | regionA = regions, regionB = regions, time = timesteps, 23 | stringsAsFactors = FALSE 24 | ) %>% 25 | tibble::as.tibble() %>% 26 | dplyr::left_join( 27 | long_prop, 28 | by = c("regionA" = "region_name", "time" = "timestep") 29 | ) %>% 30 | dplyr::left_join( 31 | long_prop, 32 | by = c("regionB" = "region_name", "time" = "timestep"), 33 | suffix = c("_regionA", "_regionB") 34 | ) 35 | 36 | regions_grid <- regions_grid %>% 37 | dplyr::rowwise() %>% 38 | dplyr::mutate( 39 | sed = sed(c(cremation_regionA, inhumation_regionA), c(cremation_regionB, inhumation_regionB)) 40 | ) %>% 41 | dplyr::ungroup() %>% 42 | dplyr::select( 43 | regionA, regionB, time, sed 44 | ) 45 | 46 | save(regions_grid, file = "data_analysis/squared_euclidian_distance_over_time_burial_type.RData") 47 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/110_burial_type_sed_region_matrix.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/squared_euclidian_distance_over_time_burial_type.RData") 2 | load("data_analysis/region_colors.RData") 3 | 4 | library(ggplot2) 5 | hu <- regions_grid %>% 6 | ggplot() + 7 | geom_line( 8 | aes(time, sed), 9 | alpha = 0.3, 10 | size = 0.5 11 | ) + 12 | geom_smooth( 13 | aes(time, sed, color = regionB), 14 | method = "loess", 15 | span = 0.3, 16 | size = 1.5 17 | ) + 18 | facet_grid( 19 | regionA ~ regionB, 20 | switch = "y", 21 | labeller = label_wrap_gen() 22 | ) + 23 | scale_x_continuous( 24 | breaks = c(-2000, -1500, -1000), 25 | limits = c(-2200, -800) 26 | ) + 27 | scale_y_continuous( 28 | limits = c(0, 2) 29 | ) + 30 | theme_bw() + 31 | scale_color_manual( 32 | guide = FALSE, 33 | values = region_colors 34 | ) + 35 | theme( 36 | axis.text = element_text(size = 10), 37 | axis.text.x = element_text(angle = 45, hjust = 1), 38 | axis.title = element_text(size = 15), 39 | strip.text = element_text(size = 9) 40 | ) + 41 | ylab("Squared Euclidian Distance") + 42 | xlab("Time") 43 | 44 | hu %>% 45 | ggsave( 46 | "figures_plots/sed/regions_regions_squared_euclidian_distance_burial_type.jpeg", 47 | plot = ., 48 | device = "jpeg", 49 | scale = 1, 50 | dpi = 300, 51 | width = 300, height = 300, units = "mm", 52 | limitsize = F 53 | ) 54 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/110_burial_construction_sed_region_matrix.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/squared_euclidian_distance_over_time_burial_construction.RData") 2 | load("data_analysis/region_colors.RData") 3 | 4 | library(ggplot2) 5 | hu <- regions_grid %>% 6 | ggplot() + 7 | geom_line( 8 | aes(time, sed), 9 | alpha = 0.3, 10 | size = 0.5 11 | ) + 12 | geom_smooth( 13 | aes(time, sed, color = regionB), 14 | method = "loess", 15 | span = 0.3, 16 | size = 1.5 17 | ) + 18 | facet_grid( 19 | regionA ~ regionB, 20 | switch = "y", 21 | labeller = label_wrap_gen() 22 | ) + 23 | scale_x_continuous( 24 | breaks = c(-2000, -1500, -1000), 25 | limits = c(-2200, -800) 26 | ) + 27 | scale_y_continuous( 28 | limits = c(0, 2) 29 | ) + 30 | theme_bw() + 31 | scale_color_manual( 32 | guide = FALSE, 33 | values = region_colors 34 | ) + 35 | theme( 36 | axis.text = element_text(size = 10), 37 | axis.text.x = element_text(angle = 45, hjust = 1), 38 | axis.title = element_text(size = 15), 39 | strip.text = element_text(size = 9) 40 | ) + 41 | ylab("Squared Euclidian Distance") + 42 | xlab("Time") 43 | 44 | hu %>% 45 | ggsave( 46 | "figures_plots/sed/regions_regions_squared_euclidian_distance_burial_construction.jpeg", 47 | plot = ., 48 | device = "jpeg", 49 | scale = 1, 50 | dpi = 300, 51 | width = 300, height = 300, units = "mm", 52 | limitsize = F 53 | ) 54 | -------------------------------------------------------------------------------- /R/simulation/sed/200_multiple_simulation_sed_create_matritzes.R: -------------------------------------------------------------------------------- 1 | load("data_simulation/sed_simulation_regions_grid.RData") 2 | 3 | ##### cut sed regions grid into timeslices #### 4 | 5 | modelid_time_regions_grid <- regions_grid %>% dplyr::mutate( 6 | time = base::cut( 7 | time, 8 | seq(-2200, -800, 200), labels = paste(seq(-2200, -1000, 200), seq(-2000, -800, 200), sep = " - "), 9 | include.lowest = TRUE, 10 | right = FALSE) 11 | ) %>% 12 | dplyr::group_by( 13 | model_group, model_id, time, regionA, regionB 14 | ) %>% 15 | dplyr::summarise( 16 | mean_sed = mean(sed, na.rm = TRUE) 17 | ) %>% 18 | dplyr::ungroup() %>% 19 | # that's dangerous... 20 | dplyr::mutate( 21 | mean_sed = tidyr::replace_na(mean_sed, 0) 22 | ) 23 | 24 | #### create list of matrizes from timesliced regions grid #### 25 | 26 | distance_matrizes_sed <- lapply( 27 | base::split(modelid_time_regions_grid, modelid_time_regions_grid$model_id), function(time_regions_grid) { 28 | lapply( 29 | base::split(time_regions_grid, time_regions_grid$time), function(x){ 30 | x %>% 31 | dplyr::select( 32 | -model_group, -model_id, -time 33 | ) %>% 34 | tidyr::spread(regionA, mean_sed) %>% 35 | dplyr::select( 36 | -regionB 37 | ) %>% 38 | as.matrix() 39 | } 40 | ) 41 | } 42 | ) 43 | 44 | save(distance_matrizes_sed, file = "data_simulation/sed_simulation_regions_timeslices_matrizes.RData") 45 | -------------------------------------------------------------------------------- /R/helper_functions/geom_grob.R: -------------------------------------------------------------------------------- 1 | library(ggplot2) 2 | library(tibble) 3 | library(gridExtra) 4 | library(grid) 5 | 6 | GeomCustom <- ggproto( 7 | "GeomCustom", 8 | Geom, 9 | setup_data = function(self, data, params) { 10 | data <- ggproto_parent(Geom, self)$setup_data(data, params) 11 | data 12 | }, 13 | 14 | draw_group = function(data, panel_scales, coord) { 15 | vp <- grid::viewport(x=data$x, y=data$y) 16 | g <- grid::editGrob(data$grob[[1]], vp=vp) 17 | ggplot2:::ggname("geom_custom", g) 18 | }, 19 | 20 | required_aes = c("grob","x","y") 21 | 22 | ) 23 | 24 | geom_custom <- function(mapping = NULL, 25 | data = NULL, 26 | stat = "identity", 27 | position = "identity", 28 | na.rm = FALSE, 29 | show.legend = NA, 30 | inherit.aes = FALSE, 31 | ...) { 32 | layer( 33 | geom = GeomCustom, 34 | mapping = mapping, 35 | data = data, 36 | stat = stat, 37 | position = position, 38 | show.legend = show.legend, 39 | inherit.aes = inherit.aes, 40 | params = list(na.rm = na.rm, ...) 41 | ) 42 | } 43 | 44 | # d <- tibble(x=1, f=rep(letters[1:11])) 45 | # gl <- lapply(1:4, function(c) rectGrob(gp=gpar(fill=c), width=0.2, height=0.2)) 46 | # dummy <- tibble(f=letters[1:4], grob = gl ) 47 | # 48 | # ggplot(d, aes(x,x)) + 49 | # facet_wrap(~f) + 50 | # geom_custom(data=dummy, aes(grob=grob), inherit.aes = FALSE, 51 | # x = 0.5, y=0.5) 52 | -------------------------------------------------------------------------------- /R/real_world_data_preparation/450_fit_bronze_into_regions.R: -------------------------------------------------------------------------------- 1 | #### load data #### 2 | 3 | load("data_analysis/regions.RData") 4 | load("data_analysis/bronze2.RData") 5 | load("data_analysis/region_order.RData") 6 | 7 | # transform to sf 8 | bronze_sf <- bronze2 %>% 9 | sf::st_as_sf( 10 | coords = c("lon", "lat"), crs = 4326 11 | ) %>% sf::st_transform("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 12 | 13 | 14 | 15 | #### dates per region #### 16 | 17 | # intersect and get region id per entry 18 | region_index_of_date <- bronze_sf %>% sf::st_intersects(regions) %>% 19 | sapply(function(z) if (length(z)==0) NA_integer_ else z[1]) 20 | 21 | dates_probability_per_year_and_region_list <- bronze2 %>% 22 | # add region information to bronze2 23 | dplyr::mutate( 24 | region_name = factor(regions$NAME[region_index_of_date], levels = region_order) 25 | ) %>% 26 | # remove entries without (outside of) regions 27 | dplyr::filter( 28 | !is.na(region_name) 29 | ) %>% 30 | # split datasets by region name 31 | split(.$region_name) 32 | 33 | save( 34 | dates_probability_per_year_and_region_list, 35 | file = "data_analysis/dates_probability_per_year_and_region_list.RData" 36 | ) 37 | 38 | # merge per-region data.frame list again to one dataframe 39 | dates_probability_per_year_and_region_df <- dates_probability_per_year_and_region_list %>% 40 | dplyr::bind_rows() 41 | 42 | save( 43 | dates_probability_per_year_and_region_df, 44 | file = "data_analysis/dates_probability_per_year_and_region_df.RData" 45 | ) 46 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/120_burial_type_sed_region_matrix_mean.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/squared_euclidian_distance_over_time_burial_type.RData") 2 | 3 | regions_grid_mean <- regions_grid %>% 4 | dplyr::group_by( 5 | regionA, regionB 6 | ) %>% 7 | dplyr::summarise( 8 | mean_sed = mean(sed, na.rm = T) 9 | ) 10 | 11 | save(regions_grid_mean, file = "data_analysis/regions_mean_sed_burial_type.RData") 12 | 13 | distance_matrix_burial_type <- regions_grid_mean %>% 14 | tidyr::spread(regionA, mean_sed) %>% 15 | dplyr::select( 16 | -regionB 17 | ) %>% 18 | as.matrix() 19 | 20 | save(distance_matrix_burial_type, file = "data_analysis/distance_matrix_burial_type.RData") 21 | 22 | regions_grid_mean$regionB <- forcats::fct_rev(regions_grid_mean$regionB) 23 | 24 | kur <- regions_grid_mean %>% 25 | ggplot() + 26 | geom_raster( 27 | aes( 28 | x = regionA, 29 | y = regionB, 30 | fill = mean_sed 31 | ) 32 | ) + 33 | geom_text( 34 | aes( 35 | x = regionA, 36 | y = regionB, 37 | label = round(mean_sed, 2) 38 | ) 39 | ) + 40 | scale_x_discrete(position = "top") + 41 | scale_fill_continuous( 42 | guide = FALSE, 43 | high = "#6d6d6d", low = "#FFFFFF" 44 | ) + 45 | theme_bw() + 46 | theme( 47 | axis.text.x = element_text(size = 10, angle = 45, vjust = 1, hjust = 0), 48 | axis.text.y = element_text(size = 10, angle = 45, vjust = 0, hjust = 1), 49 | axis.title = element_blank() 50 | ) 51 | 52 | kur %>% 53 | ggsave( 54 | "figures_plots/sed/regions_regions_mean_squared_euclidian_distance_burial_type.jpeg", 55 | plot = ., 56 | device = "jpeg", 57 | scale = 1, 58 | dpi = 300, 59 | width = 200, height = 200, units = "mm", 60 | limitsize = F 61 | ) 62 | -------------------------------------------------------------------------------- /R/real_world_analysis/general_observations/observations_description.R: -------------------------------------------------------------------------------- 1 | storage_file <- "data_text_elements/sf_desc.txt" 2 | 3 | #### graves_per_region #### 4 | 5 | load("data_analysis/graves_per_region.RData") 6 | gpr <- graves_per_region 7 | 8 | txtstorage::store("gpr size", nrow(gpr), storage_file) 9 | 10 | #### dates_per_region #### 11 | 12 | load("data_analysis/dates_per_region.RData") 13 | dpr <- dates_per_region 14 | 15 | txtstorage::store("dpr size", nrow(dpr), storage_file) 16 | 17 | txtstorage::store( 18 | c( 19 | "dpr sites amount", 20 | "dpr period amount", 21 | "dpr culture amount" 22 | ), 23 | c( 24 | dpr$site %>% unique %>% length(), 25 | dpr$period %>% unique %>% length(), 26 | dpr$culture %>% unique %>% length() 27 | ), 28 | storage_file 29 | ) 30 | 31 | material <- dpr$material %>% table(useNA = "always") %>% as.data.frame() 32 | 33 | txtstorage::store( 34 | c( 35 | "dpr material bone amount", 36 | "dpr material cremated bones amount", 37 | "dpr material charcoal wood amount", 38 | "dpr material other amount", 39 | "dpr material unknown amount" 40 | ), 41 | c( 42 | material$Freq[material$. %in% c("collagen, bone", "cremated bones", "dentin")] %>% sum, 43 | material$Freq[material$. %in% c("cremated bones")], 44 | material$Freq[material$. %in% c("bark", "charcoal", "wood")] %>% sum, 45 | material$Freq[!material$. %in% c("collagen, bone", "cremated bones", "dentin", "bark", "charcoal", "wood") & !is.na(material$.)] %>% sum, 46 | material$Freq[is.na(material$.)] 47 | ), 48 | storage_file 49 | ) 50 | 51 | dpr$species %>% table(useNA = "always") 52 | 53 | dprcrosstab <- table(dpr$burial_type, dpr$burial_construction) 54 | save( 55 | dprcrosstab, 56 | file = "data_text_elements/dprcrosstab.RData" 57 | ) 58 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/120_burial_construction_sed_region_matrix_mean.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/squared_euclidian_distance_over_time_burial_construction.RData") 2 | 3 | regions_grid_mean <- regions_grid %>% 4 | dplyr::group_by( 5 | regionA, regionB 6 | ) %>% 7 | dplyr::summarise( 8 | mean_sed = mean(sed, na.rm = T) 9 | ) 10 | 11 | save(regions_grid_mean, file = "data_analysis/regions_mean_sed_burial_construction.RData") 12 | 13 | distance_matrix_burial_construction <- regions_grid_mean %>% 14 | tidyr::spread(regionA, mean_sed) %>% 15 | dplyr::select( 16 | -regionB 17 | ) %>% 18 | as.matrix() 19 | 20 | save(distance_matrix_burial_construction, file = "data_analysis/distance_matrix_burial_construction.RData") 21 | 22 | regions_grid_mean$regionB <- forcats::fct_rev(regions_grid_mean$regionB) 23 | 24 | kur <- regions_grid_mean %>% 25 | ggplot() + 26 | geom_raster( 27 | aes( 28 | x = regionA, 29 | y = regionB, 30 | fill = mean_sed 31 | ) 32 | ) + 33 | geom_text( 34 | aes( 35 | x = regionA, 36 | y = regionB, 37 | label = round(mean_sed, 2) 38 | ) 39 | ) + 40 | scale_x_discrete(position = "top") + 41 | scale_fill_continuous( 42 | guide = FALSE, 43 | high = "#6d6d6d", low = "#FFFFFF" 44 | ) + 45 | theme_bw() + 46 | theme( 47 | axis.text.x = element_text(size = 10, angle = 45, vjust = 1, hjust = 0), 48 | axis.text.y = element_text(size = 10, angle = 45, vjust = 0, hjust = 1), 49 | axis.title = element_blank() 50 | ) 51 | 52 | kur %>% 53 | ggsave( 54 | "figures_plots/sed/regions_regions_mean_squared_euclidian_distance_burial_construction.jpeg", 55 | plot = ., 56 | device = "jpeg", 57 | scale = 1, 58 | dpi = 300, 59 | width = 200, height = 200, units = "mm", 60 | limitsize = F 61 | ) 62 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/350_general_sed_development_map_data.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/regions.RData") 2 | load("data_analysis/squared_euclidian_distance_over_timeblocks_burial_type.RData") 3 | burial_type_distance <- sed_spatial_distance %>% dplyr::mutate(context = "burial_type") 4 | load("data_analysis/squared_euclidian_distance_over_timeblocks_burial_construction.RData") 5 | burial_construction_distance <- sed_spatial_distance %>% dplyr::mutate(context = "burial_construction") 6 | 7 | distance <- rbind(burial_type_distance, burial_construction_distance) 8 | 9 | save(distance, file = "data_analysis/squared_euclidian_distance_over_timeblocks.RData") 10 | 11 | region_centers <- regions %>% 12 | sf::st_centroid() 13 | 14 | sfc_as_cols <- function(x, names = c("x","y")) { 15 | stopifnot(inherits(x,"sf") && inherits(sf::st_geometry(x),"sfc_POINT")) 16 | ret <- do.call(rbind,sf::st_geometry(x)) 17 | ret <- tibble::as_tibble(ret) 18 | stopifnot(length(names) == ncol(ret)) 19 | ret <- setNames(ret,names) 20 | dplyr::bind_cols(x,ret) 21 | } 22 | 23 | region_centers %>% 24 | sfc_as_cols() %>% 25 | dplyr::select( 26 | NAME, x, y 27 | ) 28 | 29 | distance_lines <- distance %>% 30 | dplyr::left_join( 31 | region_centers, 32 | by = c("regionA" = "NAME") 33 | ) %>% 34 | dplyr::left_join( 35 | region_centers, 36 | by = c("regionB" = "NAME"), 37 | suffix = c("_regionA", "_regionB") 38 | ) %>% 39 | dplyr::rowwise() %>% 40 | dplyr::mutate( 41 | x_a = sf::st_coordinates(geometry_regionA)[,1], 42 | y_a = sf::st_coordinates(geometry_regionA)[,2], 43 | x_b = sf::st_coordinates(geometry_regionB)[,1], 44 | y_b = sf::st_coordinates(geometry_regionB)[,2] 45 | ) %>% 46 | dplyr::ungroup() %>% 47 | dplyr::select( 48 | context, time, regionA, regionB, distance, mean_sed, x_a, y_a, x_b, y_b 49 | ) %>% 50 | dplyr::filter( 51 | regionA != regionB 52 | ) 53 | 54 | save(distance_lines, file = "data_analysis/sed_time_spatial_network.RData") 55 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/210_burial_type_sed_vs_spatial_distance_create_data.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/squared_euclidian_distance_over_time_burial_type.RData") 2 | load("data_analysis/distance_matrix_spatial_long.RData") 3 | load("data_analysis/region_order.RData") 4 | 5 | test <- regions_grid %>% 6 | dplyr::mutate( 7 | regionA = as.character(regionA), 8 | regionB = as.character(regionB) 9 | ) 10 | 11 | distance_matrix_spatial_long %<>% 12 | dplyr::mutate( 13 | regionA = as.character(regionA), 14 | regionB = as.character(regionB) 15 | ) 16 | 17 | test <- lapply( 18 | split(test, f = test$time), 19 | function(x) { 20 | mn <- pmin(x$regionA, x$regionB) 21 | mx <- pmax(x$regionA, x$regionB) 22 | int <- as.numeric(interaction(mn, mx)) 23 | x <- x[match(unique(int), int),] 24 | return(x) 25 | } 26 | ) %>% 27 | do.call(rbind, .) 28 | 29 | sed_spatial_distance <- test %>% dplyr::left_join( 30 | distance_matrix_spatial_long, by = c("regionA", "regionB") 31 | ) %>% 32 | dplyr::filter( 33 | distance != 0 34 | ) %>% 35 | dplyr::mutate( 36 | relation = paste(regionA, "+", regionB), 37 | time = base::cut( 38 | time, 39 | seq(-2200, -800, 200), labels = paste(seq(-2200, -1000, 200), seq(-2000, -800, 200), sep = " - "), 40 | include.lowest = TRUE, 41 | right = FALSE) 42 | ) %>% 43 | dplyr::group_by( 44 | time, regionA, regionB, distance 45 | ) %>% 46 | dplyr::summarise( 47 | mean_sed = mean(sed, na.rm = TRUE) 48 | ) %>% 49 | dplyr::ungroup() %>% 50 | dplyr::filter( 51 | !is.na(mean_sed) 52 | ) 53 | 54 | regions_factorA <- as.factor(sed_spatial_distance$regionA) 55 | sed_spatial_distance$regionA <- factor(regions_factorA, levels = region_order) 56 | 57 | regions_factorB <- as.factor(sed_spatial_distance$regionB) 58 | sed_spatial_distance$regionB <- factor(regions_factorB, levels = region_order) 59 | 60 | save(sed_spatial_distance, file = "data_analysis/squared_euclidian_distance_over_timeblocks_burial_type.RData") 61 | -------------------------------------------------------------------------------- /R/real_world_data_preparation/475_calculate_amount_timeseries.R: -------------------------------------------------------------------------------- 1 | #### calculate 2 | 3 | load("data_analysis/dates_probability_per_year_and_region_df.RData") 4 | 5 | amount_development_burial_type_without_zero <- dates_probability_per_year_and_region_df %>% 6 | dplyr::group_by(region_name, age, burial_type) %>% 7 | dplyr::rename( 8 | timestep = age, 9 | idea = burial_type 10 | ) %>% 11 | dplyr::tally() 12 | 13 | amount_development_burial_type <- amount_development_burial_type_without_zero %>% 14 | dplyr::right_join( 15 | expand.grid( 16 | region_name = unique(amount_development_burial_type_without_zero$region_name), 17 | idea = unique(amount_development_burial_type_without_zero$idea), 18 | timestep = -2200:-800, 19 | stringsAsFactors = FALSE 20 | ), 21 | by = c("region_name", "timestep", "idea") 22 | ) %>% 23 | dplyr::mutate( 24 | n = replace(n, is.na(n), 0) 25 | ) 26 | 27 | save( 28 | amount_development_burial_type, 29 | file = "data_analysis/development_amount_burial_type.RData" 30 | ) 31 | 32 | amount_development_burial_construction_without_zero <- dates_probability_per_year_and_region_df %>% 33 | dplyr::group_by(region_name, age, burial_construction) %>% 34 | dplyr::rename( 35 | timestep = age, 36 | idea = burial_construction 37 | ) %>% 38 | dplyr::tally() 39 | 40 | amount_development_burial_construction <- amount_development_burial_construction_without_zero%>% 41 | dplyr::right_join( 42 | expand.grid( 43 | region_name = unique(amount_development_burial_construction_without_zero$region_name), 44 | idea = unique(amount_development_burial_construction_without_zero$idea), 45 | timestep = -2200:-800, 46 | stringsAsFactors = FALSE 47 | ), 48 | by = c("region_name", "timestep", "idea") 49 | ) %>% 50 | dplyr::mutate( 51 | n = replace(n, is.na(n), 0) 52 | ) 53 | 54 | save( 55 | amount_development_burial_construction, 56 | file = "data_analysis/development_amount_burial_construction.RData" 57 | ) 58 | 59 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/210_burial_construction_sed_vs_spatial_distance_create_data.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/squared_euclidian_distance_over_time_burial_construction.RData") 2 | load("data_analysis/distance_matrix_spatial_long.RData") 3 | load("data_analysis/region_order.RData") 4 | 5 | test <- regions_grid %>% 6 | dplyr::mutate( 7 | regionA = as.character(regionA), 8 | regionB = as.character(regionB) 9 | ) 10 | 11 | distance_matrix_spatial_long %<>% 12 | dplyr::mutate( 13 | regionA = as.character(regionA), 14 | regionB = as.character(regionB) 15 | ) 16 | 17 | test <- lapply( 18 | split(test, f = test$time), 19 | function(x) { 20 | mn <- pmin(x$regionA, x$regionB) 21 | mx <- pmax(x$regionA, x$regionB) 22 | int <- as.numeric(interaction(mn, mx)) 23 | x <- x[match(unique(int), int),] 24 | return(x) 25 | } 26 | ) %>% 27 | do.call(rbind, .) 28 | 29 | sed_spatial_distance <- test %>% dplyr::left_join( 30 | distance_matrix_spatial_long, by = c("regionA", "regionB") 31 | ) %>% 32 | dplyr::filter( 33 | distance != 0 34 | ) %>% 35 | dplyr::mutate( 36 | relation = paste(regionA, "+", regionB), 37 | time = base::cut( 38 | time, 39 | seq(-2200, -800, 200), labels = paste(seq(-2200, -1000, 200), seq(-2000, -800, 200), sep = " - "), 40 | include.lowest = TRUE, 41 | right = FALSE) 42 | ) %>% 43 | dplyr::group_by( 44 | time, regionA, regionB, distance 45 | ) %>% 46 | dplyr::summarise( 47 | mean_sed = mean(sed, na.rm = TRUE) 48 | ) %>% 49 | dplyr::ungroup() %>% 50 | dplyr::filter( 51 | !is.na(mean_sed) 52 | ) 53 | 54 | regions_factorA <- as.factor(sed_spatial_distance$regionA) 55 | sed_spatial_distance$regionA <- factor(regions_factorA, levels = region_order) 56 | 57 | regions_factorB <- as.factor(sed_spatial_distance$regionB) 58 | sed_spatial_distance$regionB <- factor(regions_factorB, levels = region_order) 59 | 60 | save(sed_spatial_distance, file = "data_analysis/squared_euclidian_distance_over_timeblocks_burial_construction.RData") 61 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/130_burial_type_sed_regions.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/squared_euclidian_distance_over_time_burial_type.RData") 2 | load("data_analysis/region_colors.RData") 3 | 4 | schnu <- regions_grid %>% 5 | ggplot() + 6 | geom_smooth( 7 | aes(time, sed, color = regionB), 8 | method = "loess", 9 | span = 0.3 10 | ) + 11 | facet_wrap( 12 | ~regionA, 13 | nrow = 8 14 | ) + 15 | scale_x_continuous( 16 | breaks = c(-2200, -2000, -1500, -1000, -800), 17 | limits = c(-2500, -800) 18 | ) + 19 | scale_y_continuous( 20 | limits = c(0, 2) 21 | ) + 22 | theme_bw() + 23 | scale_color_manual( 24 | guide = FALSE, 25 | values = region_colors 26 | ) + 27 | theme( 28 | legend.position = "bottom", 29 | panel.grid.major.x = element_line(colour = "black", size = 0.3), 30 | axis.text = element_text(size = 15), 31 | axis.title = element_text(size = 15), 32 | strip.text.x = element_text(size = 13), 33 | legend.title = element_text(size = 15), 34 | legend.text = element_text(size = 15) 35 | ) + 36 | ylab("Squared Euclidian Distance") + 37 | xlab("Time") 38 | 39 | 40 | region_file_list <- unique(regions_grid$regionA) %>% gsub(" ", "_", ., fixed = TRUE) 41 | 42 | gl <- lapply(region_file_list, function(x) { 43 | img <- png::readPNG(paste0("figures_plots/region_pictograms_colour/", x, ".png")) 44 | g <- grid::rasterGrob( 45 | img, interpolate = TRUE, 46 | width = 0.14, height = 1.2 47 | ) 48 | }) 49 | dummy <- tibble::tibble(regionA = unique(regions_grid$regionA), grob = gl ) 50 | 51 | source("R/helper_functions/geom_grob.R") 52 | 53 | schnu <- schnu + 54 | geom_custom( 55 | data = dummy, 56 | aes(grob = grob), 57 | inherit.aes = FALSE, 58 | x = 0.1, y = 0.5 59 | ) 60 | 61 | schnu %>% 62 | ggsave( 63 | "figures_plots/sed/regions_squared_euclidian_distance_burial_type.jpeg", 64 | plot = ., 65 | device = "jpeg", 66 | scale = 1, 67 | dpi = 300, 68 | width = 210, height = 297, units = "mm", 69 | limitsize = F 70 | ) 71 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/130_burial_construction_sed_regions.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/squared_euclidian_distance_over_time_burial_construction.RData") 2 | load("data_analysis/region_colors.RData") 3 | 4 | schnu <- regions_grid %>% 5 | ggplot() + 6 | geom_smooth( 7 | aes(time, sed, color = regionB), 8 | method = "loess", 9 | span = 0.3 10 | ) + 11 | facet_wrap( 12 | ~regionA, 13 | nrow = 8 14 | ) + 15 | scale_x_continuous( 16 | breaks = c(-2200, -2000, -1500, -1000, -800), 17 | limits = c(-2500, -800) 18 | ) + 19 | scale_y_continuous( 20 | limits = c(0, 2) 21 | ) + 22 | theme_bw() + 23 | scale_color_manual( 24 | guide = FALSE, 25 | values = region_colors 26 | ) + 27 | theme( 28 | legend.position = "bottom", 29 | panel.grid.major.x = element_line(colour = "black", size = 0.3), 30 | axis.text = element_text(size = 15), 31 | axis.title = element_text(size = 15), 32 | strip.text.x = element_text(size = 13), 33 | legend.title = element_text(size = 15), 34 | legend.text = element_text(size = 15) 35 | ) + 36 | ylab("Squared Euclidian Distance") + 37 | xlab("Time") 38 | 39 | 40 | region_file_list <- unique(regions_grid$regionA) %>% gsub(" ", "_", ., fixed = TRUE) 41 | 42 | gl <- lapply(region_file_list, function(x) { 43 | img <- png::readPNG(paste0("figures_plots/region_pictograms_colour/", x, ".png")) 44 | g <- grid::rasterGrob( 45 | img, interpolate = TRUE, 46 | width = 0.14, height = 1.2 47 | ) 48 | }) 49 | dummy <- tibble::tibble(regionA = unique(regions_grid$regionA), grob = gl ) 50 | 51 | source("R/helper_functions/geom_grob.R") 52 | 53 | schnu <- schnu + 54 | geom_custom( 55 | data = dummy, 56 | aes(grob = grob), 57 | inherit.aes = FALSE, 58 | x = 0.1, y = 0.5 59 | ) 60 | 61 | schnu %>% 62 | ggsave( 63 | "figures_plots/sed/regions_squared_euclidian_distance_burial_construction.jpeg", 64 | plot = ., 65 | device = "jpeg", 66 | scale = 1, 67 | dpi = 300, 68 | width = 210, height = 297, units = "mm", 69 | limitsize = F 70 | ) 71 | 72 | -------------------------------------------------------------------------------- /R/simulation/sed/100_multiple_simulation_sed.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/region_order.RData") 2 | 3 | ##### read simulation output data ##### 4 | 5 | models <- pbapply::pblapply( 6 | list.files("../simulationdata/sed_simulation", full.names = TRUE), 7 | function(y) { 8 | read.csv(y) %>% tibble::as.tibble() 9 | } 10 | ) 11 | 12 | prop <- do.call(rbind, models) 13 | 14 | #### load sed function #### 15 | 16 | load("data_analysis/sed_function.RData") 17 | 18 | #### data preparation #### 19 | 20 | long_prop <- prop %>% 21 | tidyr::spread( 22 | idea, proportion 23 | ) 24 | 25 | regions_grid <- 26 | expand.grid( 27 | regionA = prop$region %>% unique(), 28 | regionB = prop$region %>% unique(), 29 | time = prop$timestep %>% unique(), 30 | model_id = prop$model_id %>% unique(), 31 | stringsAsFactors = FALSE 32 | ) %>% 33 | tibble::as.tibble() %>% 34 | dplyr::left_join( 35 | long_prop, 36 | by = c( 37 | "regionA" = "region", 38 | "time" = "timestep", 39 | "model_id" = "model_id" 40 | ) 41 | ) %>% 42 | dplyr::left_join( 43 | subset(long_prop, select=-c(model_group)), 44 | by = c( 45 | "regionB" = "region", 46 | "time" = "timestep", 47 | "model_id" = "model_id" 48 | ), 49 | suffix = c("_regionA", "_regionB") 50 | ) 51 | 52 | region_A <- mapply(c, regions_grid$idea_1_regionA, regions_grid$idea_2_regionA, SIMPLIFY = FALSE) 53 | region_B <- mapply(c, regions_grid$idea_1_regionB, regions_grid$idea_2_regionB, SIMPLIFY = FALSE) 54 | region_A_region_B <- mapply(list, region_A, region_B, SIMPLIFY = FALSE) 55 | 56 | regions_grid$sed <- unlist(pbapply::pblapply( 57 | region_A_region_B, function(x) { 58 | sed(x[[1]], x[[2]]) 59 | } 60 | )) 61 | 62 | regions_grid %<>% dplyr::select( 63 | regionA, regionB, time, sed, model_id, model_group 64 | ) 65 | 66 | regions_grid$regionA <- factor(regions_grid$regionA, levels = region_order) 67 | regions_grid$regionB <- factor(regions_grid$regionB, levels = region_order) 68 | 69 | save(regions_grid, file = "data_simulation/sed_simulation_regions_grid.RData") 70 | -------------------------------------------------------------------------------- /R/simulation/sed/300_multiple_simulation_sed_vs_spatial_distance_create_data.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/region_order.RData") 2 | load("data_simulation/sed_simulation_regions_grid.RData") 3 | load("data_analysis/distance_matrix_spatial_long.RData") 4 | 5 | #### half regions_grid -- removal of double entries #### 6 | 7 | regions_grid$regionA <- as.character(regions_grid$regionA) 8 | regions_grid$regionB <- as.character(regions_grid$regionB) 9 | 10 | regions_grid_half <- pbapply::pblapply( 11 | base::split(regions_grid, f = regions_grid$model_group), function(z) { 12 | lapply( 13 | base::split(z, f = regions_grid$model_id), function(y) { 14 | lapply( 15 | base::split(y, f = y$time), function(x) { 16 | mn <- pmin(x$regionA, x$regionB) 17 | mx <- pmax(x$regionA, x$regionB) 18 | int <- as.numeric(interaction(mn, mx)) 19 | x <- x[match(unique(int), int),] 20 | return(x) 21 | }) %>% 22 | do.call(rbind, .) 23 | }) %>% 24 | do.call(rbind, .) 25 | }) %>% 26 | do.call(rbind, .) 27 | 28 | regions_grid_half$regionA <- factor(regions_grid_half$regionA, levels = region_order) 29 | regions_grid_half$regionB <- factor(regions_grid_half$regionB, levels = region_order) 30 | 31 | #### combine spatial and cultural distance into one data.frame #### 32 | 33 | sed_spatial_distance <- regions_grid_half %>% dplyr::left_join( 34 | distance_matrix_spatial_long, by = c("regionA", "regionB") 35 | ) %>% 36 | dplyr::filter( 37 | distance != 0 38 | ) %>% 39 | dplyr::mutate( 40 | relation = paste(regionA, "+", regionB), 41 | time = base::cut( 42 | time, 43 | seq(-2200, -800, 200), labels = paste(seq(-2200, -1000, 200), seq(-2000, -800, 200), sep = " - "), 44 | include.lowest = TRUE, 45 | right = FALSE) 46 | ) %>% 47 | dplyr::group_by( 48 | model_id, model_group, time, regionA, regionB, distance 49 | ) %>% 50 | dplyr::summarise( 51 | mean_sed = mean(sed, na.rm = TRUE) 52 | ) %>% 53 | dplyr::ungroup() %>% 54 | dplyr::filter( 55 | !is.na(mean_sed) 56 | ) 57 | 58 | save( 59 | sed_spatial_distance, 60 | file = "data_simulation/sed_simulation_regions_timeslices_spatial_distance.RData" 61 | ) 62 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/300_burial_type_sed_vs_spatial_distance.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/mantel_sed_spatial_burial_type.RData") 2 | load("data_analysis/squared_euclidian_distance_over_timeblocks_burial_type.RData") 3 | load("data_analysis/region_order.RData") 4 | load("data_analysis/region_colors.RData") 5 | 6 | library(ggplot2) 7 | plu <- ggplot(sed_spatial_distance) + 8 | geom_boxplot( 9 | aes(x = distance, y = mean_sed, group = distance), 10 | width = 0.3 11 | ) + 12 | geom_point( 13 | aes(x = distance, y = mean_sed, color = regionA), 14 | size = 4, 15 | position = position_nudge(x = -0.4) 16 | ) + 17 | geom_point( 18 | aes(x = distance, y = mean_sed, color = regionB), 19 | size = 4, 20 | position = position_nudge(x = -0.31) 21 | ) + 22 | geom_text( 23 | data = mantel_test_results, 24 | aes( 25 | label = paste0("Mantel Test r: ", round(statistic, 3), ", p: ", signif), 26 | colour = ifelse(signif < 0.05, "h0canberejected", "h0cannotberejected") 27 | ), 28 | x = 2.7, y = 2.2, 29 | size = 6 30 | ) + 31 | facet_wrap(~time, nrow = 2) + 32 | theme_bw() + 33 | theme( 34 | plot.title = element_text(size = 30, face = "bold"), 35 | legend.position = "bottom", 36 | legend.title = element_blank(), 37 | legend.text = element_text(size = 20), 38 | strip.text.x = element_text(size = 20), 39 | axis.text = element_text(size = 20), 40 | axis.title = element_text(size = 20) 41 | ) + 42 | scale_color_manual( 43 | values = c( 44 | region_colors, 45 | "h0canberejected" = "red", 46 | "h0cannotberejected" = "black" 47 | ), 48 | breaks = region_order, 49 | labels = region_order 50 | ) + 51 | xlab("Spatial Distance Classes") + 52 | ylab("Squared Euclidian Distance") + 53 | ylim(0, 2.3) + 54 | guides( 55 | color = guide_legend(title = NULL, override.aes = list(size = 8, shape = 15), nrow = 2, byrow = TRUE), 56 | shape = FALSE, 57 | size = FALSE 58 | ) 59 | 60 | plu %>% 61 | ggsave( 62 | "figures_plots/sed/squared_euclidian_distance_vs_spatial_distance_burial_type.jpeg", 63 | plot = ., 64 | device = "jpeg", 65 | scale = 1, 66 | dpi = 300, 67 | width = 550, height = 280, units = "mm", 68 | limitsize = F 69 | ) 70 | 71 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/300_burial_construction_sed_vs_spatial_distance.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/mantel_sed_spatial_burial_construction.RData") 2 | load("data_analysis/squared_euclidian_distance_over_timeblocks_burial_construction.RData") 3 | load("data_analysis/region_order.RData") 4 | load("data_analysis/region_colors.RData") 5 | 6 | library(ggplot2) 7 | plu <- ggplot(sed_spatial_distance) + 8 | geom_boxplot( 9 | aes(x = distance, y = mean_sed, group = distance), 10 | width = 0.3 11 | ) + 12 | geom_point( 13 | aes(x = distance, y = mean_sed, color = regionA), 14 | size = 4, 15 | position = position_nudge(x = -0.4) 16 | ) + 17 | geom_point( 18 | aes(x = distance, y = mean_sed, color = regionB), 19 | size = 4, 20 | position = position_nudge(x = -0.31) 21 | ) + 22 | geom_text( 23 | data = mantel_test_results, 24 | aes( 25 | label = paste0("Mantel Test r: ", round(statistic, 3), ", p: ", signif), 26 | colour = ifelse(signif < 0.05, "h0canberejected", "h0cannotberejected") 27 | ), 28 | x = 2.7, y = 2.2, 29 | size = 6 30 | ) + 31 | facet_wrap(~time, nrow = 2) + 32 | theme_bw() + 33 | theme( 34 | plot.title = element_text(size = 30, face = "bold"), 35 | legend.position = "bottom", 36 | legend.title = element_blank(), 37 | legend.text = element_text(size = 20), 38 | strip.text.x = element_text(size = 20), 39 | axis.text = element_text(size = 20), 40 | axis.title = element_text(size = 20) 41 | ) + 42 | scale_color_manual( 43 | values = c( 44 | region_colors, 45 | "h0canberejected" = "red", 46 | "h0cannotberejected" = "black" 47 | ), 48 | breaks = region_order, 49 | labels = region_order 50 | ) + 51 | xlab("Spatial Distance Classes") + 52 | ylab("Squared Euclidian Distance") + 53 | ylim(0, 2.3) + 54 | guides( 55 | color = guide_legend(title = NULL, override.aes = list(size = 8, shape = 15), nrow = 2, byrow = TRUE), 56 | shape = FALSE, 57 | size = FALSE 58 | ) 59 | 60 | plu %>% 61 | ggsave( 62 | "figures_plots/sed/squared_euclidian_distance_vs_spatial_distance_burial_construction.jpeg", 63 | plot = ., 64 | device = "jpeg", 65 | scale = 1, 66 | dpi = 300, 67 | width = 550, height = 280, units = "mm", 68 | limitsize = F 69 | ) 70 | 71 | -------------------------------------------------------------------------------- /R/simulation/sed/500_multiple_simulation_sed_vs_spatial_distance.R: -------------------------------------------------------------------------------- 1 | library(magrittr) 2 | 3 | load("data_simulation/sed_simulation_regions_timeslices_spatial_distance.RData") 4 | sed_simulation <- sed_spatial_distance 5 | load("data_analysis/squared_euclidian_distance_over_timeblocks_burial_type.RData") 6 | sed_burial_type <- sed_spatial_distance %>% dplyr::mutate(model_group = "burial_type") 7 | load("data_analysis/squared_euclidian_distance_over_timeblocks_burial_construction.RData") 8 | sed_burial_construction <- sed_spatial_distance %>% dplyr::mutate(model_group = "burial_construction") 9 | 10 | sed_all <- sed_simulation %>% 11 | dplyr::select(-model_id) %>% 12 | rbind(sed_burial_type) %>% 13 | rbind(sed_burial_construction) 14 | 15 | sed_all <- sed_all %>% 16 | dplyr::filter(mean_sed != 0) 17 | 18 | #print(sed_all) 19 | 20 | library(ggplot2) 21 | plu <- ggplot(sed_all) + 22 | geom_boxplot( 23 | mapping = aes( 24 | x = as.factor(distance), 25 | y = mean_sed, 26 | fill = model_group 27 | ), 28 | width = 0.9 29 | ) + 30 | facet_wrap( 31 | nrow = 2, 32 | ~time 33 | ) + 34 | scale_fill_manual( 35 | name = "Real world context", 36 | values = c( 37 | "burial_type" = "#0072B2", 38 | "burial_construction" = "#009E73", 39 | "low equal interaction" = "#fb9a99", 40 | "low spatial interaction" = "#ffff33", 41 | "high equal interaction" = "#e31a1c", 42 | "high spatial interaction" = "#ff7f00" 43 | ) 44 | ) + 45 | theme_bw() + 46 | theme( 47 | plot.title = element_text(size = 30, face = "bold"), 48 | legend.position = "bottom", 49 | legend.title = element_text(size = 20, face = "bold"), 50 | legend.text = element_text(size = 20), 51 | strip.text.x = element_text(size = 20), 52 | axis.text = element_text(size = 20), 53 | axis.title = element_text(size = 20) 54 | ) + 55 | guides( 56 | fill = guide_legend(nrow = 3, byrow = TRUE) 57 | ) + 58 | xlab("Spatial Distance Classes") + 59 | ylab("Squared Euclidian Distance") + 60 | ylim(0, 2) + 61 | NULL 62 | 63 | plu %>% 64 | ggsave( 65 | "figures_plots/sed_simulation/squared_euclidian_distance_vs_spatial_distance_sim_multiple.jpeg", 66 | plot = ., 67 | device = "jpeg", 68 | scale = 1, 69 | dpi = 300, 70 | width = 550, height = 280, units = "mm", 71 | limitsize = F 72 | ) 73 | 74 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/600_general_sed_burial_type_vs_burial_construction.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/squared_euclidian_distance_over_timeblocks.RData") 2 | load("data_analysis/mantel_sed_spatial_burial_type_burial_construction.RData") 3 | load("data_analysis/region_order.RData") 4 | load("data_analysis/region_colors.RData") 5 | 6 | distance %<>% 7 | tidyr::spread(context, mean_sed) 8 | 9 | library(ggplot2) 10 | plu <- ggplot(distance) + 11 | geom_smooth( 12 | method = 'lm', 13 | mapping = aes(burial_type, burial_construction), 14 | color = "black", 15 | se = FALSE, 16 | fullrange = TRUE, 17 | size = 0.5 18 | ) + 19 | geom_point( 20 | aes(x = burial_type, y = burial_construction, color = regionA), 21 | size = 4, 22 | position = position_nudge(x = -0.03) 23 | ) + 24 | geom_point( 25 | aes(x = burial_type, y = burial_construction, color = regionB), 26 | size = 4, 27 | position = position_nudge(x = 0.03) 28 | ) + 29 | geom_text( 30 | data = mantel_test_results, 31 | aes( 32 | label = paste0("Mantel Test r: ", round(statistic, 3), ", p: ", signif), 33 | colour = ifelse(signif < 0.1, "h0canberejected", "h0cannotberejected") 34 | ), 35 | x = 1.1, y = 2.2, 36 | size = 6 37 | ) + 38 | facet_wrap(~time, nrow = 2) + 39 | theme_bw() + 40 | theme( 41 | plot.title = element_text(size = 30, face = "bold"), 42 | legend.position = "bottom", 43 | legend.title = element_blank(), 44 | legend.text = element_text(size = 20), 45 | strip.text.x = element_text(size = 20), 46 | axis.text = element_text(size = 20), 47 | axis.title = element_text(size = 20) 48 | ) + 49 | scale_color_manual( 50 | values = c( 51 | region_colors, 52 | "h0canberejected" = "red", 53 | "h0cannotberejected" = "black" 54 | ), 55 | breaks = region_order, 56 | labels = region_order 57 | ) + 58 | xlab("Squared Euclidian Distance Burial Type") + 59 | ylab("Squared Euclidian Distance Burial Construction") + 60 | ylim(0, 2.3) + 61 | guides( 62 | color = guide_legend(title = NULL, override.aes = list(size = 8, shape = 15), nrow = 2, byrow = TRUE), 63 | shape = FALSE, 64 | size = FALSE 65 | ) 66 | 67 | plu %>% 68 | ggsave( 69 | "figures_plots/sed/squared_euclidian_distance_burial_type_vs_burial_construction.jpeg", 70 | plot = ., 71 | device = "jpeg", 72 | scale = 1, 73 | dpi = 300, 74 | #width = 210, height = 297, units = "mm", 75 | width = 550, height = 280, units = "mm", 76 | limitsize = F 77 | ) 78 | -------------------------------------------------------------------------------- /R/real_world_data_preparation/050_prepare_spatial_data.R: -------------------------------------------------------------------------------- 1 | #### natural earth data #### 2 | 3 | # land_outline 4 | land_outline <- rnaturalearth::ne_download( 5 | scale = 50, type = 'land', category = 'physical' 6 | ) %>% sf::st_as_sf() 7 | save(land_outline, file = "data_geo/land_outline.RData") 8 | 9 | # countries 10 | countries <- rnaturalearth::ne_download( 11 | scale = 50, type = 'countries', category = 'cultural' 12 | ) %>% sf::st_as_sf() 13 | save(countries, file = "data_geo/countries.RData") 14 | 15 | # rivers 16 | rivers <- rnaturalearth::ne_download( 17 | scale = 50, type = 'rivers_lake_centerlines', category = 'physical' 18 | ) %>% sf::st_as_sf() 19 | save(rivers, file = "data_geo/rivers.RData") 20 | 21 | # lakes 22 | lakes <- rnaturalearth::ne_download( 23 | scale = 50, type = 'lakes', category = 'physical' 24 | ) %>% sf::st_as_sf() 25 | save(lakes, file = "data_geo/lakes.RData") 26 | 27 | 28 | 29 | #### research area #### 30 | 31 | # load manually crafted research area shape file, transform it to 32 | # EPSG:102013 and store the result 33 | 34 | research_area <- sf::st_read( 35 | "data_manually_prepared/research_area.shp" 36 | ) %>% sf::st_transform("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 37 | save(research_area, file = "data_analysis/research_area.RData") 38 | 39 | 40 | 41 | #### area #### 42 | 43 | # load natural earth data land outline shape, crop it approximately to 44 | # Europe, transform it to EPSG:102013, crop it to the research area and store the result 45 | 46 | land_outline_small <- land_outline %>% 47 | sf::st_crop(xmin = -20, ymin = 35, xmax = 35, ymax = 65) %>% 48 | sf::st_transform("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 49 | area <- sf::st_intersection(sf::st_buffer(land_outline_small, 0), research_area) 50 | save(area, file = "data_analysis/area.RData") 51 | 52 | 53 | 54 | #### extended area #### 55 | 56 | # crop land outline to bbox of 57 | 58 | # plot(land_outline$geometry) 59 | # plot(research_area$geometry, add = T, border = "blue") 60 | # plot(extended_area, add = T, border = "red") 61 | extended_research_area <- sf::st_bbox(research_area) %>% sf::st_as_sfc() 62 | extended_area <- sf::st_intersection(sf::st_buffer(land_outline_small, 0), extended_research_area) 63 | # plot(extended_area$geometry) 64 | # plot(research_area$geometry, add = T, border = "blue") 65 | # plot(extended_research_area, add = T, border = "red") 66 | save(extended_area, file = "data_analysis/extended_area.RData") 67 | -------------------------------------------------------------------------------- /R/real_world_analysis/development/burial_type_amount_development.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/development_amount_burial_type.RData") 2 | load("data_analysis/region_order.RData") 3 | 4 | amount_devel <- amount_development_burial_type 5 | 6 | regions_factor <- as.factor(amount_devel$region_name) 7 | amount_devel$region_name <- factor(regions_factor, levels = region_order) 8 | 9 | idea_factor <- as.factor(amount_devel$idea) 10 | amount_devel$idea <- factor(idea_factor, levels = rev(levels(idea_factor))) 11 | 12 | library(ggplot2) 13 | spu <- ggplot() + 14 | geom_area( 15 | data = amount_devel, 16 | aes(x = timestep, y = n, fill = idea), 17 | position = 'stack', 18 | linetype = "blank" 19 | ) + 20 | facet_wrap(~region_name, nrow = 8) + 21 | xlab("Time in years calBC") + 22 | ylab("Amount of 14C dates from burials") + 23 | labs(fill = "Ideas (mutually exclusive)") + 24 | theme_bw() + 25 | theme( 26 | legend.position = "bottom", 27 | panel.grid.major.x = element_line(colour = "black", size = 0.3), 28 | axis.text = element_text(size = 15), 29 | axis.title = element_text(size = 15), 30 | strip.text.x = element_text(size = 13), 31 | legend.title = element_text(size = 15, face = "bold"), 32 | legend.text = element_text(size = 15) 33 | ) + 34 | scale_fill_manual( 35 | values = c( 36 | "cremation" = "#D55E00", 37 | "inhumation" = "#0072B2", 38 | "mound" = "#CC79A7", 39 | "flat" = "#009E73", 40 | "unknown" = "grey85" 41 | ) 42 | ) + 43 | coord_cartesian( 44 | ylim = c(0, 80) 45 | ) + 46 | scale_x_continuous( 47 | breaks = c(-2200, -2000, -1500, -1000, -800), 48 | limits = c(-2500, -800) 49 | ) 50 | 51 | 52 | 53 | region_file_list <- unique(amount_devel$region_name) %>% gsub(" ", "_", ., fixed = TRUE) 54 | 55 | gl <- lapply(region_file_list, function(x) { 56 | img <- png::readPNG(paste0("figures_plots/region_pictograms_colour/", x, ".png")) 57 | g <- grid::rasterGrob( 58 | img, interpolate = TRUE, 59 | width = 0.14, height = 1.2 60 | ) 61 | }) 62 | dummy <- tibble::tibble(region_name = unique(amount_devel$region_name), grob = gl ) 63 | 64 | source("R/helper_functions/geom_grob.R") 65 | 66 | spu <- spu + 67 | geom_custom( 68 | data = dummy, 69 | aes(grob = grob), 70 | inherit.aes = FALSE, 71 | x = 0.1, y = 0.5 72 | ) 73 | 74 | spu %>% 75 | ggsave( 76 | "figures_plots/development/development_amount_regions_burial_type.jpeg", 77 | plot = ., 78 | device = "jpeg", 79 | scale = 1, 80 | dpi = 300, 81 | width = 210, height = 297, units = "mm", 82 | limitsize = F 83 | ) 84 | 85 | 86 | -------------------------------------------------------------------------------- /R/real_world_analysis/development/burial_construction_amount_development.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/development_amount_burial_construction.RData") 2 | load("data_analysis/region_order.RData") 3 | 4 | amount_devel <- amount_development_burial_construction 5 | 6 | regions_factor <- as.factor(amount_devel$region_name) 7 | amount_devel$region_name <- factor(regions_factor, levels = region_order) 8 | 9 | idea_factor <- as.factor(amount_devel$idea) 10 | amount_devel$idea <- factor(idea_factor, levels = rev(levels(idea_factor))) 11 | 12 | library(ggplot2) 13 | spu <- ggplot() + 14 | geom_area( 15 | data = amount_devel, 16 | aes(x = timestep, y = n, fill = idea), 17 | position = 'stack', 18 | linetype = "blank" 19 | ) + 20 | facet_wrap(~region_name, nrow = 8) + 21 | xlab("Time in years calBC") + 22 | ylab("Amount of 14C dates from burials") + 23 | labs(fill = "Ideas (mutually exclusive)") + 24 | theme_bw() + 25 | theme( 26 | legend.position = "bottom", 27 | panel.grid.major.x = element_line(colour = "black", size = 0.3), 28 | axis.text = element_text(size = 15), 29 | axis.title = element_text(size = 15), 30 | strip.text.x = element_text(size = 13), 31 | legend.title = element_text(size = 15, face = "bold"), 32 | legend.text = element_text(size = 15) 33 | ) + 34 | scale_fill_manual( 35 | values = c( 36 | "cremation" = "#D55E00", 37 | "inhumation" = "#0072B2", 38 | "mound" = "#CC79A7", 39 | "flat" = "#009E73", 40 | "unknown" = "grey85" 41 | ) 42 | ) + 43 | coord_cartesian( 44 | ylim = c(0, 80) 45 | ) + 46 | scale_x_continuous( 47 | breaks = c(-2200, -2000, -1500, -1000, -800), 48 | limits = c(-2500, -800) 49 | ) 50 | 51 | 52 | 53 | region_file_list <- unique(amount_devel$region_name) %>% gsub(" ", "_", ., fixed = TRUE) 54 | 55 | gl <- lapply(region_file_list, function(x) { 56 | img <- png::readPNG(paste0("figures_plots/region_pictograms_colour/", x, ".png")) 57 | g <- grid::rasterGrob( 58 | img, interpolate = TRUE, 59 | width = 0.14, height = 1.2 60 | ) 61 | }) 62 | dummy <- tibble::tibble(region_name = unique(amount_devel$region_name), grob = gl ) 63 | 64 | source("R/helper_functions/geom_grob.R") 65 | 66 | spu <- spu + 67 | geom_custom( 68 | data = dummy, 69 | aes(grob = grob), 70 | inherit.aes = FALSE, 71 | x = 0.1, y = 0.5 72 | ) 73 | 74 | spu %>% 75 | ggsave( 76 | "figures_plots/development/development_amount_regions_burial_construction.jpeg", 77 | plot = ., 78 | device = "jpeg", 79 | scale = 1, 80 | dpi = 300, 81 | width = 210, height = 297, units = "mm", 82 | limitsize = F 83 | ) 84 | 85 | 86 | -------------------------------------------------------------------------------- /R/real_world_analysis/general_maps/general_map.R: -------------------------------------------------------------------------------- 1 | list.files("data_geo", pattern = "*.RData", full.names = T) %>% lapply(load, .GlobalEnv) 2 | research_area <- sf::st_read("data_manually_prepared/research_area.shp") 3 | load("data_analysis/regions.RData") 4 | load("data_analysis/bronze1.RData") 5 | 6 | bronze1_sf <- bronze1 %>% sf::st_as_sf( 7 | coords = c("lon", "lat"), 8 | crs = 4326 9 | ) 10 | 11 | library(ggplot2) 12 | library(sf) 13 | 14 | xlimit <- c(-1600000, 1300000) 15 | ylimit <- c(800000, 3800000) 16 | 17 | hu <- ggplot() + 18 | geom_sf( 19 | data = land_outline, 20 | fill = "white", colour = "black", size = 0.4 21 | ) + 22 | geom_sf( 23 | data = rivers, 24 | fill = NA, colour = "black", size = 0.2 25 | ) + 26 | geom_sf( 27 | data = lakes, 28 | fill = NA, colour = "black", size = 0.2 29 | ) + 30 | geom_sf( 31 | data = bronze1_sf, 32 | mapping = aes( 33 | color = burial_type, 34 | shape = burial_construction, 35 | size = burial_construction 36 | ), 37 | show.legend = "point" 38 | ) + 39 | theme_bw() + 40 | coord_sf( 41 | xlim = xlimit, ylim = ylimit, 42 | crs = st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 43 | ) + 44 | scale_shape_manual( 45 | values = c( 46 | "flat" = "\u268A", 47 | "mound" = "\u25E0", 48 | "unknown" = "\u2715" 49 | ) 50 | ) + 51 | scale_size_manual( 52 | values = c( 53 | "flat" = 10, 54 | "mound" = 10, 55 | "unknown" = 5 56 | ) 57 | ) + 58 | scale_color_manual( 59 | values = c( 60 | "cremation" = "#D55E00", 61 | "inhumation" = "#0072B2", 62 | "mound" = "#CC79A7", 63 | "flat" = "#009E73", 64 | "unknown" = "darkgrey" 65 | ) 66 | ) + 67 | theme( 68 | plot.title = element_text(size = 30, face = "bold"), 69 | legend.position = "bottom", 70 | legend.title = element_text(size = 20, face = "bold"), 71 | axis.title = element_blank(), 72 | axis.text = element_text(size = 15), 73 | legend.text = element_text(size = 20), 74 | panel.grid.major = element_line(colour = "black", size = 0.3) 75 | ) + 76 | guides( 77 | color = guide_legend(title = "Burial type", override.aes = list(size = 10), nrow = 2, byrow = TRUE), 78 | shape = guide_legend(title = "Burial construction", override.aes = list(size = 10), nrow = 2, byrow = TRUE), 79 | size = FALSE 80 | ) 81 | 82 | hu %>% 83 | ggsave( 84 | "figures_plots/general_maps/general_map.jpeg", 85 | plot = ., 86 | device = "jpeg", 87 | scale = 1, 88 | dpi = 300, 89 | width = 350, height = 360, units = "mm", 90 | limitsize = F 91 | ) 92 | -------------------------------------------------------------------------------- /R/real_world_analysis/development/experimental_dymanic.R: -------------------------------------------------------------------------------- 1 | # load("../neomod_datapool/bronze_age/space_and_network/proportions_per_region_df.RData") 2 | # 3 | # proportion_per_region_df$timestep <- proportion_per_region_df$timestep * (-1) 4 | # 5 | # smooth_model <- function(df) { 6 | # smooth.spline(df$timestep, df$proportion, spar = 0.5) 7 | # } 8 | # 9 | # predict_spline <- function(df, model, deriv = 1) { 10 | # prediction <- predict(model, rev(df$timestep), deriv = deriv) 11 | # tibble::tibble( 12 | # timestep = prediction$x, 13 | # prediction = prediction$y 14 | # ) 15 | # } 16 | # 17 | # kuu <- proportion_per_region_df %>% 18 | # dplyr::filter( 19 | # idea != "mound" & idea != "inhumation" 20 | # ) %>% 21 | # dplyr::group_by(idea, region_name) %>% 22 | # tidyr::nest() %>% 23 | # dplyr::mutate( 24 | # spline_model = purrr::map( 25 | # data, .f = smooth_model 26 | # ) 27 | # ) %>% 28 | # dplyr::mutate( 29 | # spline_prediction = purrr::map2( 30 | # data, spline_model, .f = predict_spline 31 | # ) 32 | # ) %>% 33 | # tidyr::unnest(spline_prediction) 34 | # 35 | # kuu2 <- kuu %>% dplyr::filter( 36 | # idea != "flat" 37 | # ) 38 | # 39 | # library(ggplot2) 40 | # spu <- ggplot() + 41 | # geom_line( 42 | # data = kuu2, 43 | # aes(x = timestep, y = prediction) 44 | # ) + 45 | # facet_wrap(~region_name, nrow = 11) + 46 | # #scale_x_reverse() + 47 | # xlab("Time in years calBC") + 48 | # labs(fill = "Memes (mutually exclusive)") + 49 | # theme_bw() + 50 | # theme( 51 | # legend.position="bottom", 52 | # axis.title.y = element_blank(), 53 | # panel.grid.major.x = element_line(colour = "black", size = 0.3) 54 | # ) + 55 | # xlim(-2700, -500) 56 | # 57 | # region_file_list <- unique(kuu2$region_name) %>% gsub(" ", "_", ., fixed = TRUE) 58 | # 59 | # gl <- lapply(region_file_list, function(x) { 60 | # img <- png::readPNG(paste0("../neomod_datapool/bronze_age/region_pictograms/", x, ".png")) 61 | # g <- grid::rasterGrob( 62 | # img, interpolate = TRUE, 63 | # width = 0.06, height = 0.8 64 | # ) 65 | # }) 66 | # dummy <- tibble::tibble(region_name = unique(kuu2$region_name), grob = gl ) 67 | # 68 | # source("R/helper/geom_grob.R") 69 | # 70 | # spu <- spu + 71 | # geom_custom( 72 | # data = dummy, 73 | # aes(grob = grob), 74 | # inherit.aes = FALSE, 75 | # x = 0.07, y = 0.5 76 | # ) 77 | 78 | # spu %>% 79 | # ggsave( 80 | # #"/home/clemens/neomod/neomod_datapool/bronze_age/amount_development_regions_cremation_inhumation.jpeg", 81 | # "/home/clemens/neomod/neomod_datapool/bronze_age/derivative_proportion_cremation_1.jpeg", 82 | # plot = ., 83 | # device = "jpeg", 84 | # scale = 1, 85 | # dpi = 300, 86 | # width = 210, height = 297, units = "mm", 87 | # limitsize = F 88 | # ) 89 | -------------------------------------------------------------------------------- /R/real_world_analysis/development/burial_type_proportions_development.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/development_proportions_burial_type.RData") 2 | 3 | library(ggplot2) 4 | 5 | prop <- proportion_development_burial_type 6 | 7 | prop$idea <- as.factor(prop$idea) 8 | prop$idea <- factor(prop$idea , levels = rev(levels(prop$idea ))) 9 | 10 | hu <- ggplot() + 11 | geom_area( 12 | data = prop, 13 | mapping = aes(x = timestep, y = proportion, fill = idea), 14 | position = 'stack', 15 | linetype = "blank" 16 | #alpha = 0.6 17 | ) + 18 | # geom_line( 19 | # data = dplyr::filter(prop, idea == "cremation"), 20 | # mapping = aes(x = timestep, y = proportion), 21 | # color = "black", 22 | # size = 0.2 23 | # ) + 24 | # geom_rect( 25 | # aes(NULL, NULL, xmin = start, xmax = end), 26 | # ymin = 0, ymax = 1, 27 | # fill = "black", 28 | # alpha = 0.5, 29 | # color = NA, 30 | # data = amount_devel 31 | # ) + 32 | scale_alpha_continuous(range = c(0.0, 0.7)) + 33 | facet_wrap(~region_name, nrow = 8) + 34 | xlab("Time in years calBC") + 35 | ylab("Proportion of 14C dates from burials") + 36 | labs(fill = "Ideas (mutually exclusive)") + 37 | theme_bw() + 38 | theme( 39 | legend.position = "bottom", 40 | panel.grid.major.x = element_line(colour = "black", size = 0.3), 41 | axis.text = element_text(size = 15), 42 | axis.title = element_text(size = 15), 43 | strip.text.x = element_text(size = 13), 44 | legend.title = element_text(size = 15, face = "bold"), 45 | legend.text = element_text(size = 15) 46 | ) + 47 | scale_fill_manual( 48 | values = c( 49 | "cremation" = "#D55E00", 50 | "inhumation" = "#0072B2", 51 | "mound" = "#CC79A7", 52 | "flat" = "#009E73" 53 | ) 54 | ) + 55 | scale_y_continuous( 56 | breaks = c(0, 0.5, 1), 57 | labels = c("0%", "50%", "100%") 58 | ) + 59 | scale_x_continuous( 60 | breaks = c(-2200, -2000, -1500, -1000, -800), 61 | limits = c(-2500, -800) 62 | ) 63 | 64 | 65 | 66 | region_file_list <- unique(prop$region_name) %>% gsub(" ", "_", ., fixed = TRUE) 67 | 68 | gl <- lapply(region_file_list, function(x) { 69 | img <- png::readPNG(paste0("figures_plots/region_pictograms_colour/", x, ".png")) 70 | g <- grid::rasterGrob( 71 | img, interpolate = TRUE, 72 | width = 0.14, height = 1.2 73 | ) 74 | }) 75 | dummy <- tibble::tibble(region_name = unique(prop$region_name), grob = gl ) 76 | 77 | source("R/helper_functions/geom_grob.R") 78 | 79 | hu <- hu + 80 | geom_custom( 81 | data = dummy, 82 | aes(grob = grob), 83 | inherit.aes = FALSE, 84 | x = 0.1, y = 0.5 85 | ) 86 | 87 | hu %>% 88 | ggsave( 89 | "figures_plots/development/development_proportions_regions_burial_type.jpeg", 90 | plot = ., 91 | device = "jpeg", 92 | scale = 1, 93 | dpi = 300, 94 | width = 210, height = 297, units = "mm", 95 | limitsize = F 96 | ) 97 | 98 | -------------------------------------------------------------------------------- /R/real_world_analysis/development/burial_construction_proportions_development.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/development_proportions_burial_construction.RData") 2 | 3 | library(ggplot2) 4 | 5 | prop <- proportion_development_burial_construction 6 | 7 | prop$idea <- as.factor(prop$idea) 8 | prop$idea <- factor(prop$idea , levels = rev(levels(prop$idea ))) 9 | 10 | hu <- ggplot() + 11 | geom_area( 12 | data = prop, 13 | mapping = aes(x = timestep, y = proportion, fill = idea), 14 | position = 'stack', 15 | linetype = "blank" 16 | #alpha = 0.6 17 | ) + 18 | # geom_line( 19 | # data = dplyr::filter(prop, idea == "flat"), 20 | # mapping = aes(x = timestep, y = proportion), 21 | # color = "black", 22 | # size = 0.2 23 | # ) + 24 | # geom_rect( 25 | # aes(NULL, NULL, xmin = start, xmax = end), 26 | # ymin = 0, ymax = 1, 27 | # fill = "black", 28 | # alpha = 0.5, 29 | # color = NA, 30 | # data = amount_devel 31 | # ) + 32 | scale_alpha_continuous(range = c(0.0, 0.7)) + 33 | facet_wrap(~region_name, nrow = 8) + 34 | xlab("Time in years calBC") + 35 | ylab("Proportion of 14C dates from burials") + 36 | labs(fill = "Ideas (mutually exclusive)") + 37 | theme_bw() + 38 | theme( 39 | legend.position = "bottom", 40 | panel.grid.major.x = element_line(colour = "black", size = 0.3), 41 | axis.text = element_text(size = 15), 42 | axis.title = element_text(size = 15), 43 | strip.text.x = element_text(size = 13), 44 | legend.title = element_text(size = 15, face = "bold"), 45 | legend.text = element_text(size = 15) 46 | ) + 47 | scale_fill_manual( 48 | values = c( 49 | "cremation" = "#D55E00", 50 | "inhumation" = "#0072B2", 51 | "mound" = "#CC79A7", 52 | "flat" = "#009E73" 53 | ) 54 | ) + 55 | scale_y_continuous( 56 | breaks = c(0, 0.5, 1), 57 | labels = c("0%", "50%", "100%") 58 | ) + 59 | scale_x_continuous( 60 | breaks = c(-2200, -2000, -1500, -1000, -800), 61 | limits = c(-2500, -800) 62 | ) 63 | 64 | 65 | 66 | region_file_list <- unique(prop$region_name) %>% gsub(" ", "_", ., fixed = TRUE) 67 | 68 | gl <- lapply(region_file_list, function(x) { 69 | img <- png::readPNG(paste0("figures_plots/region_pictograms_colour/", x, ".png")) 70 | g <- grid::rasterGrob( 71 | img, interpolate = TRUE, 72 | width = 0.14, height = 1.2 73 | ) 74 | }) 75 | dummy <- tibble::tibble(region_name = unique(prop$region_name), grob = gl ) 76 | 77 | source("R/helper_functions/geom_grob.R") 78 | 79 | hu <- hu + 80 | geom_custom( 81 | data = dummy, 82 | aes(grob = grob), 83 | inherit.aes = FALSE, 84 | x = 0.1, y = 0.5 85 | ) 86 | 87 | hu %>% 88 | ggsave( 89 | "figures_plots/development/development_proportions_regions_burial_construction.jpeg", 90 | plot = ., 91 | device = "jpeg", 92 | scale = 1, 93 | dpi = 300, 94 | width = 210, height = 297, units = "mm", 95 | limitsize = F 96 | ) 97 | 98 | -------------------------------------------------------------------------------- /R/real_world_analysis/general_maps/general_map_research_area.R: -------------------------------------------------------------------------------- 1 | list.files("data_geo", pattern = "*.RData", full.names = T) %>% lapply(load, .GlobalEnv) 2 | research_area <- sf::st_read("data_manually_prepared/research_area.shp") 3 | load("data_analysis/regions.RData") 4 | load("data_analysis/bronze1.RData") 5 | 6 | bronze1_sf <- bronze1 %>% sf::st_as_sf( 7 | coords = c("lon", "lat"), 8 | crs = 4326 9 | ) 10 | 11 | library(ggplot2) 12 | library(sf) 13 | 14 | ex <- raster::extent(research_area %>% sf::st_transform(sf::st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs"))) 15 | 16 | xlimit <- c(ex[1], ex[2]) 17 | ylimit <- c(ex[3], ex[4]) 18 | 19 | hu <- ggplot() + 20 | geom_sf( 21 | data = land_outline, 22 | fill = "white", colour = "black", size = 0.4 23 | ) + 24 | geom_sf( 25 | data = rivers, 26 | fill = NA, colour = "black", size = 0.2 27 | ) + 28 | geom_sf( 29 | data = lakes, 30 | fill = NA, colour = "black", size = 0.2 31 | ) + 32 | geom_sf( 33 | data = research_area, 34 | fill = NA, colour = "red", size = 0.5 35 | ) + 36 | geom_sf( 37 | data = bronze1_sf, 38 | mapping = aes( 39 | color = burial_type, 40 | shape = burial_construction, 41 | size = burial_construction 42 | ), 43 | show.legend = "point" 44 | ) + 45 | theme_bw() + 46 | coord_sf( 47 | xlim = xlimit, ylim = ylimit, 48 | crs = st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 49 | ) + 50 | scale_shape_manual( 51 | values = c( 52 | "flat" = "\u268A", 53 | "mound" = "\u25E0", 54 | "unknown" = "\u2715" 55 | ) 56 | ) + 57 | scale_size_manual( 58 | values = c( 59 | "flat" = 10, 60 | "mound" = 10, 61 | "unknown" = 5 62 | ) 63 | ) + 64 | scale_color_manual( 65 | values = c( 66 | "cremation" = "#D55E00", 67 | "inhumation" = "#0072B2", 68 | "mound" = "#CC79A7", 69 | "flat" = "#009E73", 70 | "unknown" = "darkgrey" 71 | ) 72 | ) + 73 | theme( 74 | plot.title = element_text(size = 30, face = "bold"), 75 | legend.position = "bottom", 76 | legend.title = element_text(size = 20, face = "bold"), 77 | axis.title = element_blank(), 78 | axis.text = element_text(size = 15), 79 | legend.text = element_text(size = 20), 80 | panel.grid.major = element_line(colour = "black", size = 0.3) 81 | ) + 82 | guides( 83 | color = guide_legend(title = "Burial type", override.aes = list(size = 10), nrow = 2, byrow = TRUE), 84 | shape = guide_legend(title = "Burial construction", override.aes = list(size = 10), nrow = 2, byrow = TRUE), 85 | size = FALSE 86 | ) 87 | 88 | hu %>% 89 | ggsave( 90 | "figures_plots/general_maps/general_map_research_area.jpeg", 91 | plot = ., 92 | device = "jpeg", 93 | scale = 1, 94 | dpi = 300, 95 | width = 350, height = 320, units = "mm", 96 | limitsize = F 97 | ) 98 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/400_burial_type_sed_map.R: -------------------------------------------------------------------------------- 1 | list.files("data_geo", pattern = "*.RData", full.names = T) %>% lapply(load, .GlobalEnv) 2 | research_area <- sf::st_read("data_manually_prepared/research_area.shp") 3 | load("data_analysis/regions.RData") 4 | load("data_analysis/sed_time_spatial_network.RData") 5 | load("data_analysis/region_centers.RData") 6 | load("data_analysis/region_order.RData") 7 | load("data_analysis/region_colors.RData") 8 | 9 | ex <- raster::extent(regions %>% sf::st_transform(sf::st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs"))) 10 | xlimit <- c(ex[1] + 100000, ex[2] - 100000) 11 | ylimit <- c(ex[3], ex[4]) 12 | 13 | distance_lines %<>% dplyr::filter( 14 | context == "burial_type" 15 | ) 16 | 17 | library(ggplot2) 18 | library(sf) 19 | 20 | hu <- ggplot() + 21 | geom_sf( 22 | data = land_outline, 23 | fill = "white", colour = "black", size = 0.4 24 | ) + 25 | geom_sf( 26 | data = research_area, 27 | fill = NA, colour = "red", size = 0.5 28 | ) + 29 | geom_curve( 30 | data = distance_lines, 31 | mapping = aes( 32 | x = x_a, y = y_a, xend = x_b, yend = y_b, 33 | size = mean_sed 34 | ), 35 | alpha = 0.5, 36 | curvature = 0.2, 37 | colour = "black" 38 | ) + 39 | facet_wrap( 40 | nrow = 2, 41 | ~time 42 | ) + 43 | geom_sf( 44 | data = region_centers, 45 | mapping = aes( 46 | colour = NAME 47 | ), 48 | fill = NA, size = 12 49 | ) + 50 | theme_bw() + 51 | coord_sf( 52 | xlim = xlimit, ylim = ylimit, 53 | crs = st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 54 | ) + 55 | theme( 56 | plot.title = element_text(size = 30, face = "bold"), 57 | legend.position = "bottom", 58 | legend.title = element_text(size = 20, face = "bold"), 59 | axis.title = element_blank(), 60 | axis.text = element_blank(), 61 | legend.text = element_text(size = 20), 62 | panel.grid.major = element_line(colour = "black", size = 0.3), 63 | strip.text.x = element_text(size = 20) 64 | ) + 65 | guides( 66 | size = guide_legend(title = "Behavioural closeness"), 67 | alpha = FALSE, 68 | colour = FALSE 69 | ) + 70 | scale_size( 71 | trans = 'reverse', 72 | range = c(0.5, 3) 73 | ) + 74 | scale_color_manual( 75 | values = c( 76 | "cremation" = "#D55E00", 77 | "inhumation" = "#0072B2", 78 | "mound" = "#CC79A7", 79 | "flat" = "#009E73", 80 | "unknown" = "darkgrey", 81 | region_colors 82 | ), 83 | breaks = region_order, 84 | labels = region_order 85 | ) 86 | 87 | hu %>% 88 | ggsave( 89 | "figures_plots/sed/sed_map_research_area_timeslices_burial_type.jpeg", 90 | plot = ., 91 | device = "jpeg", 92 | scale = 1, 93 | dpi = 300, 94 | #width = 210, height = 297, units = "mm", 95 | width = 550, height = 280, units = "mm", 96 | limitsize = F 97 | ) 98 | -------------------------------------------------------------------------------- /R/real_world_analysis/sed/400_burial_construction_sed_map.R: -------------------------------------------------------------------------------- 1 | list.files("data_geo", pattern = "*.RData", full.names = T) %>% lapply(load, .GlobalEnv) 2 | research_area <- sf::st_read("data_manually_prepared/research_area.shp") 3 | load("data_analysis/regions.RData") 4 | load("data_analysis/sed_time_spatial_network.RData") 5 | load("data_analysis/region_centers.RData") 6 | load("data_analysis/region_order.RData") 7 | load("data_analysis/region_colors.RData") 8 | 9 | ex <- raster::extent(regions %>% sf::st_transform(sf::st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs"))) 10 | xlimit <- c(ex[1] + 100000, ex[2] - 100000) 11 | ylimit <- c(ex[3], ex[4]) 12 | 13 | distance_lines %<>% dplyr::filter( 14 | context == "burial_construction" 15 | ) 16 | 17 | library(ggplot2) 18 | library(sf) 19 | 20 | hu <- ggplot() + 21 | geom_sf( 22 | data = land_outline, 23 | fill = "white", colour = "black", size = 0.4 24 | ) + 25 | geom_sf( 26 | data = research_area, 27 | fill = NA, colour = "red", size = 0.5 28 | ) + 29 | geom_curve( 30 | data = distance_lines, 31 | mapping = aes( 32 | x = x_a, y = y_a, xend = x_b, yend = y_b, 33 | size = mean_sed 34 | ), 35 | alpha = 0.5, 36 | curvature = 0.2, 37 | colour = "black" 38 | ) + 39 | facet_wrap( 40 | nrow = 2, 41 | ~time 42 | ) + 43 | geom_sf( 44 | data = region_centers, 45 | mapping = aes( 46 | colour = NAME 47 | ), 48 | fill = NA, size = 12 49 | ) + 50 | theme_bw() + 51 | coord_sf( 52 | xlim = xlimit, ylim = ylimit, 53 | crs = st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 54 | ) + 55 | theme( 56 | plot.title = element_text(size = 30, face = "bold"), 57 | legend.position = "bottom", 58 | legend.title = element_text(size = 20, face = "bold"), 59 | axis.title = element_blank(), 60 | axis.text = element_blank(), 61 | legend.text = element_text(size = 20), 62 | panel.grid.major = element_line(colour = "black", size = 0.3), 63 | strip.text.x = element_text(size = 20) 64 | ) + 65 | guides( 66 | size = guide_legend(title = "Behavioural closeness"), 67 | alpha = FALSE, 68 | colour = FALSE 69 | ) + 70 | scale_size( 71 | trans = 'reverse', 72 | range = c(0.5, 3) 73 | ) + 74 | scale_color_manual( 75 | values = c( 76 | "cremation" = "#D55E00", 77 | "inhumation" = "#0072B2", 78 | "mound" = "#CC79A7", 79 | "flat" = "#009E73", 80 | "unknown" = "darkgrey", 81 | region_colors 82 | ), 83 | breaks = region_order, 84 | labels = region_order 85 | ) 86 | 87 | hu %>% 88 | ggsave( 89 | "figures_plots/sed/sed_map_research_area_timeslices_burial_construction.jpeg", 90 | plot = ., 91 | device = "jpeg", 92 | scale = 1, 93 | dpi = 300, 94 | #width = 210, height = 297, units = "mm", 95 | width = 550, height = 280, units = "mm", 96 | limitsize = F 97 | ) 98 | -------------------------------------------------------------------------------- /R/real_world_data_preparation/150_construct_circle_regions.R: -------------------------------------------------------------------------------- 1 | #### load spatial data #### 2 | 3 | load("data_analysis/research_area.RData") 4 | load("data_analysis/area.RData") 5 | 6 | #### define region circles #### 7 | 8 | region_circles <- tibble::tibble( 9 | geometry = sf::st_make_grid(area, 400000, what = "centers", offset = c(-900000,-130000)), 10 | ID = 1:length(geometry) 11 | ) %>% sf::st_as_sf() 12 | region_circles <- sf::st_intersection(region_circles, research_area) 13 | region_circles %<>% sf::st_buffer(dist = 240000) 14 | 15 | load("data_analysis/bronze17.RData") 16 | bronze17 %<>% sf::st_as_sf(coords = c("lon", "lat")) 17 | sf::st_crs(bronze17) <- 4326 18 | bronze17 %<>% sf::st_transform("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 19 | gu <- sf::st_intersection(bronze17, research_area) 20 | 21 | # library(ggplot2) 22 | # ggplot() + 23 | # geom_sf(data = area) + 24 | # geom_sf(data = region_circles, fill = NA) + 25 | # geom_sf(data = gu) 26 | 27 | schnu <- sf::st_intersection(gu, region_circles) 28 | 29 | # ggplot() + 30 | # geom_sf(data = area) + 31 | # geom_sf(data = region_circles, fill = NA) + 32 | # geom_sf(data = schnu) 33 | 34 | number_of_graves_per_circle <- schnu %>% 35 | dplyr::group_by(ID) %>% 36 | dplyr::summarise( 37 | n = n() 38 | ) 39 | 40 | regions_with_enough_graves <- number_of_graves_per_circle %>% 41 | dplyr::filter( 42 | n >= 60 43 | ) %$% 44 | ID 45 | 46 | graves_per_region <- schnu %>% dplyr::filter( 47 | ID %in% regions_with_enough_graves 48 | ) %>% sf::st_set_geometry(NULL) 49 | 50 | save( 51 | graves_per_region, 52 | file = "data_analysis/graves_per_region.RData" 53 | ) 54 | 55 | regions <- region_circles %>% 56 | dplyr::mutate( 57 | number_of_graves = number_of_graves_per_circle$n 58 | ) %>% 59 | dplyr::filter(ID %in% regions_with_enough_graves) 60 | 61 | 62 | # ggplot() + 63 | # geom_sf(data = area) + 64 | # geom_sf(data = regions, fill = NA) + 65 | # geom_sf(data = gu) 66 | 67 | # regions %>% 68 | # dplyr::mutate( 69 | # x = purrr::map_dbl(geometry, ~sf::st_centroid(.x)[[1]]), 70 | # y = purrr::map_dbl(geometry, ~sf::st_centroid(.x)[[2]]) 71 | # ) %>% 72 | # ggplot() + 73 | # geom_sf(data = area) + 74 | # geom_sf(fill = NA) + 75 | # geom_text(aes(x = x, y = y, label = ID)) 76 | 77 | regions$ID <- 1:nrow(regions) 78 | regions$NAME <- c( 79 | "Northeastern France", 80 | "Southern Germany", 81 | "Southeastern Central Europe", 82 | "England", "Benelux", 83 | "Northern Germany", 84 | "Poland", 85 | "Southern Scandinavia" 86 | ) 87 | 88 | # regions %>% 89 | # dplyr::mutate( 90 | # x = purrr::map_dbl(geometry, ~sf::st_centroid(.x)[[1]]), 91 | # y = purrr::map_dbl(geometry, ~sf::st_centroid(.x)[[2]]) 92 | # ) %>% 93 | # ggplot() + 94 | # geom_sf(data = area) + 95 | # geom_sf(fill = NA) + 96 | # geom_text(aes(x = x, y = y, label = NAME)) 97 | 98 | save(regions, file = "data_analysis/regions.RData") 99 | 100 | -------------------------------------------------------------------------------- /R/real_world_data_preparation/200_create_spatial_distance_matrix.R: -------------------------------------------------------------------------------- 1 | #### load regions data #### 2 | 3 | load("data_analysis/regions.RData") 4 | 5 | #### create distance information in tall format #### 6 | 7 | # find region centers 8 | region_centers <- regions %>% 9 | sf::st_centroid() 10 | 11 | distance_matrix_spatial_long <- region_centers %>% 12 | # calculate distance matrix 13 | sf::st_distance() %>% 14 | # normalize distance matrix 15 | magrittr::divide_by(min(.[. != min(.)])) %>% 16 | tibble::as.tibble() %>% 17 | # set correct names 18 | magrittr::set_colnames(region_centers$NAME) %>% 19 | dplyr::mutate(regionA = region_centers$NAME) %>% 20 | # wide matrix to tall data.frame 21 | tidyr::gather(key = regionB, value = distance, -regionA) %>% 22 | dplyr::mutate( 23 | distance = as.double(distance) 24 | ) %>% 25 | # creation of distance classes 26 | dplyr::mutate( 27 | distance = base::cut( 28 | distance, 29 | seq(0, 4, 0.4), paste(seq(0, 3.6, 0.4), seq(0.4, 4.0, 0.4), sep = "-"), 30 | include.lowest = TRUE, 31 | right = FALSE) 32 | ) %>% 33 | # rename actually relevant classes 34 | dplyr::mutate( 35 | distance = dplyr::case_when( 36 | distance == "0-0.4" ~ 0, 37 | distance == "0.8-1.2" ~ 1, 38 | distance == "1.2-1.6" ~ 2, 39 | distance == "2-2.4" ~ 3, 40 | distance == "2.8-3.2" ~ 4 41 | ) 42 | ) 43 | 44 | # remove duplicates 45 | mn <- pmin(as.character(distance_matrix_spatial_long$regionA), as.character(distance_matrix_spatial_long$regionB)) 46 | mx <- pmax(as.character(distance_matrix_spatial_long$regionA), as.character(distance_matrix_spatial_long$regionB)) 47 | int <- as.numeric(interaction(mn, mx)) 48 | distance_matrix_spatial_long_half <- distance_matrix_spatial_long[match(unique(int), int),] 49 | 50 | #### define factor order #### 51 | 52 | load("data_analysis/region_order.RData") 53 | 54 | regions_factorA <- as.factor(distance_matrix_spatial_long$regionA) 55 | distance_matrix_spatial_long$regionA <- factor(regions_factorA, levels = region_order) 56 | regions_factorB <- as.factor(distance_matrix_spatial_long$regionB) 57 | distance_matrix_spatial_long$regionB <- factor(regions_factorB, levels = region_order) 58 | 59 | regions_factorA <- as.factor(distance_matrix_spatial_long_half$regionA) 60 | distance_matrix_spatial_long_half$regionA <- factor(regions_factorA, levels = region_order) 61 | regions_factorB <- as.factor(distance_matrix_spatial_long_half$regionB) 62 | distance_matrix_spatial_long_half$regionB <- factor(regions_factorB, levels = region_order) 63 | 64 | #### transform distance information to wide format #### 65 | 66 | distance_matrix_spatial <- distance_matrix_spatial_long %>% 67 | tidyr::spread(regionA, distance) %>% 68 | dplyr::select( 69 | -regionB 70 | ) %>% 71 | as.matrix() 72 | 73 | #### writing files to file system #### 74 | 75 | save(distance_matrix_spatial_long_half, file = "data_analysis/distance_matrix_spatial_long_half.RData") 76 | save(distance_matrix_spatial_long, file = "data_analysis/distance_matrix_spatial_long.RData") 77 | save(distance_matrix_spatial, file = "data_analysis/distance_matrix_spatial.RData") 78 | -------------------------------------------------------------------------------- /R/real_world_analysis/var/var_test.R: -------------------------------------------------------------------------------- 1 | library(tseries) # for `adf.test()` 2 | library(dynlm) #for function `dynlm()` 3 | library(vars) # for function `VAR()` 4 | library(nlWaldTest) # for the `nlWaldtest()` function 5 | library(lmtest) #for `coeftest()` and `bptest()`. 6 | library(broom) #for `glance(`) and `tidy()` 7 | library(PoEdata) #for PoE4 datasets 8 | library(car) #for `hccm()` robust standard errors 9 | library(sandwich) 10 | library(forecast) 11 | 12 | load("data_analysis/development_proportions_burial_type.RData") 13 | load("data_analysis/development_proportions_burial_construction.RData") 14 | 15 | proportion_development_burial_type %<>% 16 | dplyr::mutate( 17 | region_name = gsub(" ", ".", region_name) 18 | ) 19 | 20 | bt <- proportion_development_burial_type %>% 21 | dplyr::filter(idea == "cremation") %>% 22 | dplyr::select(-idea) %>% 23 | tidyr::spread(region_name, proportion) %>% 24 | dplyr::select(-timestep) 25 | 26 | bt2_with_unit <- bt %>% 27 | dplyr::mutate( 28 | time_unit = c(lapply(1:30, function(x) { rep(x, 47) }) %>% unlist)[1:1401] 29 | ) %>% 30 | dplyr::group_by(time_unit) %>% 31 | dplyr::summarize_all(mean) 32 | 33 | library(ggplot2) 34 | bt2_with_unit %>% 35 | tidyr::gather(region, proportion, -time_unit) %>% 36 | ggplot() + 37 | geom_col(aes(x = as.factor(time_unit), y = proportion)) + 38 | facet_wrap(~region) 39 | 40 | bt2 <- bt2_with_unit %>% 41 | dplyr::select(-time_unit) 42 | 43 | ### 44 | 45 | bt_ts <- ts(bt, start = -2200, end = -800, frequency = 1) 46 | 47 | ts.plot(bt_ts, type = "l") 48 | 49 | adf <- lapply( 50 | bt_ts, 51 | function(x) { 52 | broom::tidy(tseries::adf.test(x)) 53 | } 54 | ) %>% 55 | dplyr::bind_rows(.id = "region") 56 | 57 | adf_diff <- lapply( 58 | bt_ts, 59 | function(x) { 60 | broom::tidy(tseries::adf.test(diff(x))) 61 | } 62 | ) %>% 63 | dplyr::bind_rows(.id = "region") 64 | 65 | regions <- proportion_development_burial_type$region_name %>% unique() 66 | forms <- expand.grid(regions, regions) %>% 67 | dplyr::mutate( 68 | form = paste0(Var1, "~", Var2) 69 | ) %$% 70 | form 71 | 72 | dynlm_results <- lapply( 73 | forms, 74 | function(x) { 75 | dynlm::dynlm(as.formula(x), data = bt_ts) 76 | } 77 | ) 78 | 79 | adf_residuals <- lapply( 80 | residuals, 81 | function(x) { 82 | tseries::adf.test(x) 83 | } 84 | ) 85 | 86 | residuals <- lapply( 87 | dynlm_results, 88 | function(x) { 89 | resid(x) 90 | } 91 | ) 92 | 93 | ### 94 | 95 | diffi <- sapply(bt2, diff) 96 | 97 | varfit <- vars::VAR(diffi, type = "both", p = 1) 98 | 99 | summary(varfit) 100 | 101 | acf(residuals(varfit)[,1]) 102 | acf(residuals(varfit)[,2]) 103 | acf(residuals(varfit)[,3]) 104 | acf(residuals(varfit)[,4]) 105 | acf(residuals(varfit)[,5]) 106 | acf(residuals(varfit)[,6]) 107 | acf(residuals(varfit)[,7]) 108 | acf(residuals(varfit)[,8]) 109 | 110 | acf(residuals(varfit)) 111 | 112 | 113 | impresp <- vars::irf(varfit) 114 | 115 | plot(impresp) 116 | 117 | plot(vars::fevd(varfit), col = terrain.colors(8)) 118 | 119 | causality(varfit, cause = "Austria.and.Czechia") 120 | -------------------------------------------------------------------------------- /R/real_world_analysis/general_maps/general_map_timeslices.R: -------------------------------------------------------------------------------- 1 | list.files("data_geo", pattern = "*.RData", full.names = T) %>% lapply(load, .GlobalEnv) 2 | research_area <- sf::st_read("data_manually_prepared/research_area.shp") 3 | load("data_analysis/regions.RData") 4 | load("data_analysis/bronze2.RData") 5 | 6 | bronze2_slices <- bronze2 %>% 7 | dplyr::filter( 8 | age %in% seq(-2200, -800, by = 200) 9 | ) %>% 10 | dplyr::mutate( 11 | age_slice = factor(age, levels = seq(-2200, -800, by = 200)) 12 | ) %>% sf::st_as_sf( 13 | coords = c("lon", "lat"), 14 | crs = 4326 15 | ) 16 | 17 | ex <- raster::extent(research_area %>% sf::st_transform(sf::st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs"))) 18 | xlimit <- c(ex[1], ex[2]) 19 | ylimit <- c(ex[3], ex[4]) 20 | 21 | library(ggplot2) 22 | library(sf) 23 | 24 | hu <- ggplot() + 25 | geom_sf( 26 | data = land_outline, 27 | fill = "white", colour = "black", size = 0.4 28 | ) + 29 | geom_sf( 30 | data = research_area, 31 | fill = NA, colour = "red", size = 0.5 32 | ) + 33 | geom_sf( 34 | data = bronze2_slices, 35 | mapping = aes( 36 | color = burial_type, 37 | shape = burial_construction, 38 | size = burial_construction, 39 | alpha = norm_dens 40 | ), 41 | show.legend = "point" 42 | ) + 43 | theme_bw() + 44 | coord_sf( 45 | xlim = xlimit, ylim = ylimit, 46 | crs = st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 47 | ) + 48 | scale_shape_manual( 49 | values = c( 50 | "flat" = "\u268A", 51 | "mound" = "\u25E0", 52 | "unknown" = "\u2715" 53 | ) 54 | ) + 55 | scale_size_manual( 56 | values = c( 57 | "flat" = 10, 58 | "mound" = 10, 59 | "unknown" = 5 60 | ) 61 | ) + 62 | scale_color_manual( 63 | values = c( 64 | "cremation" = "#D55E00", 65 | "inhumation" = "#0072B2", 66 | "mound" = "#CC79A7", 67 | "flat" = "#009E73", 68 | "unknown" = "darkgrey" 69 | ) 70 | ) + 71 | theme( 72 | plot.title = element_text(size = 30, face = "bold"), 73 | legend.position = "bottom", 74 | legend.title = element_text(size = 20, face = "bold"), 75 | axis.title = element_blank(), 76 | axis.text = element_blank(), 77 | legend.text = element_text(size = 20), 78 | panel.grid.major = element_line(colour = "black", size = 0.3), 79 | strip.text.x = element_text(size = 20) 80 | ) + 81 | guides( 82 | color = guide_legend(title = "Burial type", override.aes = list(size = 10), nrow = 2, byrow = TRUE), 83 | shape = guide_legend(title = "Burial construction", override.aes = list(size = 10), nrow = 2, byrow = TRUE), 84 | size = FALSE, 85 | alpha = FALSE 86 | ) + 87 | facet_wrap( 88 | nrow = 2, 89 | ~age_slice 90 | ) 91 | 92 | hu %>% 93 | ggsave( 94 | "figures_plots/general_maps/general_map_research_area_timeslices.jpeg", 95 | plot = ., 96 | device = "jpeg", 97 | scale = 1, 98 | dpi = 300, 99 | width = 550, height = 280, units = "mm", 100 | limitsize = F 101 | ) 102 | -------------------------------------------------------------------------------- /R/other_analysis/bronze_age_pseudoquant_development.R: -------------------------------------------------------------------------------- 1 | devel_table <- readr::read_csv("data_manually_prepared/burial_traditions_pseudo.csv") 2 | load("data_analysis/region_order.RData") 3 | 4 | regions_factor <- as.factor(devel_table$region) 5 | devel_table$region<- factor(regions_factor, levels = region_order) 6 | 7 | dt2 <- devel_table %>% 8 | tidyr::gather(idea, strength, cremation, inhumation, mound, flat) %>% 9 | dplyr::mutate( 10 | time = dplyr::case_when( 11 | period == "Early Bronze Age" ~ -2000, 12 | period == "Middle Bronze Age" ~ -1500, 13 | period == "Late Bronze Age" ~ -1000 14 | ) 15 | ) %>% 16 | dplyr::mutate( 17 | time = time + dplyr::case_when( 18 | idea == "cremation" ~ -100, 19 | idea == "inhumation" ~ -100, 20 | idea == "mound" ~ 100, 21 | idea == "flat" ~ 100 22 | ) 23 | ) 24 | 25 | idea_factor <- as.factor(dt2$idea) 26 | dt2$idea <- factor(idea_factor, levels = rev(levels(idea_factor))) 27 | 28 | dt2 %<>% dplyr::mutate( 29 | vis_strength = dplyr::case_when( 30 | strength == 1 ~ 15, 31 | strength == 2 ~ 50, 32 | strength == 3 ~ 85 33 | ) 34 | ) 35 | 36 | library(ggplot2) 37 | spu <- ggplot() + 38 | geom_bar( 39 | data = dt2, 40 | aes(x = time, y = vis_strength, fill = idea), 41 | stat = "identity", 42 | position = "stack" 43 | ) + 44 | facet_wrap(~region, nrow = 8) + 45 | xlab("Periods") + 46 | ylab("Perceived distribution") + 47 | labs(fill = "Ideas") + 48 | theme_bw() + 49 | theme( 50 | legend.position = "bottom", 51 | axis.text = element_text(size = 15), 52 | axis.title = element_text(size = 15), 53 | strip.text.x = element_text(size = 13), 54 | legend.title = element_text(size = 15, face = "bold"), 55 | legend.text = element_text(size = 15), 56 | axis.text.y = element_blank(), 57 | axis.ticks.y = element_blank() 58 | ) + 59 | scale_fill_manual( 60 | values = c( 61 | "cremation" = "#D55E00", 62 | "inhumation" = "#0072B2", 63 | "mound" = "#CC79A7", 64 | "flat" = "#009E73", 65 | "unknown" = "grey85" 66 | ) 67 | ) + 68 | scale_x_continuous( 69 | breaks = c(-2000, -1500, -1000), 70 | labels = c("Early Bronze Age", "Middle Bronze Age", "Late Bronze Age"), 71 | limits = c(-2500, -800) 72 | ) 73 | 74 | 75 | 76 | region_file_list <- unique(dt2$region) %>% gsub(" ", "_", ., fixed = TRUE) 77 | 78 | gl <- lapply(region_file_list, function(x) { 79 | img <- png::readPNG(paste0("figures_plots/region_pictograms_colour/", x, ".png")) 80 | g <- grid::rasterGrob( 81 | img, interpolate = TRUE, 82 | width = 0.14, height = 1.2 83 | ) 84 | }) 85 | dummy <- tibble::tibble(region = unique(dt2$region), grob = gl ) 86 | 87 | source("R/helper_functions/geom_grob.R") 88 | 89 | spu <- spu + 90 | geom_custom( 91 | data = dummy, 92 | aes(grob = grob), 93 | inherit.aes = FALSE, 94 | x = 0.1, y = 0.5 95 | ) 96 | 97 | spu %>% 98 | ggsave( 99 | "figures_plots/development/development_pseudoquant.jpeg", 100 | plot = ., 101 | device = "jpeg", 102 | scale = 1, 103 | dpi = 300, 104 | width = 210, height = 297, units = "mm", 105 | limitsize = F 106 | ) 107 | 108 | 109 | -------------------------------------------------------------------------------- /R/real_world_analysis/general_maps/general_map_regions_countries.R: -------------------------------------------------------------------------------- 1 | list.files("data_geo", pattern = "*.RData", full.names = T) %>% lapply(load, .GlobalEnv) 2 | research_area <- sf::st_read("data_manually_prepared/research_area.shp") 3 | load("data_analysis/bronze1.RData") 4 | load("data_analysis/regions.RData") 5 | load("data_analysis/region_order.RData") 6 | load("data_analysis/region_colors.RData") 7 | 8 | regions_name_points <- regions %>% 9 | dplyr::mutate( 10 | x = purrr::map_dbl(geometry, ~sf::st_centroid(.x)[[1]]), 11 | y = purrr::map_dbl(geometry, ~sf::st_centroid(.x)[[2]]) 12 | ) 13 | 14 | bronze1_sf <- bronze1 %>% sf::st_as_sf( 15 | coords = c("lon", "lat"), 16 | crs = 4326 17 | ) 18 | 19 | library(ggplot2) 20 | library(sf) 21 | 22 | ex <- raster::extent(research_area %>% sf::st_transform(sf::st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs"))) 23 | 24 | xlimit <- c(ex[1], ex[2]) 25 | ylimit <- c(ex[3], ex[4]) 26 | 27 | hu <- ggplot() + 28 | geom_sf( 29 | data = land_outline, 30 | fill = "white", colour = "black", size = 0.4 31 | ) + 32 | geom_sf( 33 | data = countries, 34 | fill = NA, colour = "black", size = 0.2 35 | ) + 36 | geom_sf( 37 | data = regions, 38 | mapping = aes( 39 | colour = NAME 40 | ), 41 | fill = NA, size = 2.5 42 | ) + 43 | geom_sf( 44 | data = bronze1_sf, 45 | mapping = aes( 46 | color = burial_type, 47 | shape = burial_construction, 48 | size = burial_construction 49 | ), 50 | show.legend = "point" 51 | ) + 52 | theme_bw() + 53 | coord_sf( 54 | xlim = xlimit, ylim = ylimit, 55 | crs = st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 56 | ) + 57 | scale_shape_manual( 58 | values = c( 59 | "flat" = "\u268A", 60 | "mound" = "\u25E0", 61 | "unknown" = "\u2715" 62 | ) 63 | ) + 64 | scale_size_manual( 65 | values = c( 66 | "flat" = 10, 67 | "mound" = 10, 68 | "unknown" = 5 69 | ) 70 | ) + 71 | scale_color_manual( 72 | values = c( 73 | "cremation" = "#D55E00", 74 | "inhumation" = "#0072B2", 75 | "mound" = "#CC79A7", 76 | "flat" = "#009E73", 77 | "unknown" = "darkgrey", 78 | region_colors 79 | ), 80 | breaks = region_order, 81 | labels = region_order 82 | ) + 83 | theme( 84 | plot.title = element_text(size = 30, face = "bold"), 85 | legend.position = "bottom", 86 | legend.title = element_text(size = 20, face = "bold"), 87 | axis.title = element_blank(), 88 | axis.text = element_text(size = 15), 89 | legend.text = element_text(size = 17), 90 | panel.grid.major = element_line(colour = "black", size = 0.3) 91 | ) + 92 | guides( 93 | color = guide_legend(title = NULL, override.aes = list(size = 8, shape = 15), nrow = 2, byrow = TRUE), 94 | shape = FALSE, 95 | size = FALSE 96 | ) 97 | 98 | hu %>% 99 | ggsave( 100 | "figures_plots/general_maps/general_map_regions_countries.jpeg", 101 | plot = ., 102 | device = "jpeg", 103 | scale = 1, 104 | dpi = 300, 105 | width = 350, height = 320, units = "mm", 106 | limitsize = F 107 | ) 108 | -------------------------------------------------------------------------------- /R/other_analysis/popgenerator_examples/generate_unit_comparison.R: -------------------------------------------------------------------------------- 1 | devtools::load_all("../popgenerator/R") 2 | 3 | time <- 1:1000 4 | testunitA_function <- function(t) {300} 5 | testunitB_function <- function(t) {500 + t/4} 6 | testunitC_function <- function(t) {800 + (0.04 * (t - 500))^2} 7 | #plot(time, testunitC_function(time)) 8 | 9 | testunitA <- methods::new( 10 | "unit_settings", 11 | time = time, 12 | unit_name = as.factor("testunitA"), 13 | unit_size_function = testunitA_function, 14 | age_distribution_function = function(x) {1 / (1 + 0.0004 * 0.7^(-7*log(x)))}, 15 | age_range = 1:90 16 | ) %>% 17 | generate_unit() %>% 18 | count_living_humans_over_time(time) %>% 19 | tibble::tibble( 20 | time = time, 21 | count = . 22 | ) 23 | 24 | testunitB <- methods::new( 25 | "unit_settings", 26 | time = time, 27 | unit_name = as.factor("testunitA"), 28 | unit_size_function = testunitB_function, 29 | age_distribution_function = function(x) {1 / (1 + 0.0004 * 0.7^(-7*log(x)))}, 30 | age_range = 1:90 31 | ) %>% 32 | generate_unit() %>% 33 | count_living_humans_over_time(time) %>% 34 | tibble::tibble( 35 | time = time, 36 | count = . 37 | ) 38 | 39 | testunitC <- methods::new( 40 | "unit_settings", 41 | time = time, 42 | unit_name = as.factor("testunitA"), 43 | unit_size_function = testunitC_function, 44 | age_distribution_function = function(x) {1 / (1 + 0.0004 * 0.7^(-7*log(x)))}, 45 | age_range = 1:90 46 | ) %>% 47 | generate_unit() %>% 48 | count_living_humans_over_time(time) %>% 49 | tibble::tibble( 50 | time = time, 51 | count = . 52 | ) 53 | 54 | library(ggplot2) 55 | hu <- ggplot() + 56 | geom_line( 57 | data = testunitA, 58 | mapping = aes(time, count) 59 | ) + 60 | geom_line( 61 | data = data.frame(time, count = testunitA_function(time)), 62 | mapping = aes(time, count), 63 | colour = "red" 64 | ) + 65 | geom_line( 66 | data = testunitB, 67 | mapping = aes(time, count) 68 | ) + 69 | geom_line( 70 | data = data.frame(time, count = testunitB_function(time)), 71 | mapping = aes(time, count), 72 | colour = "red" 73 | ) + 74 | geom_line( 75 | data = testunitC, 76 | mapping = aes(time, count) 77 | ) + 78 | geom_line( 79 | data = data.frame(time, count = testunitC_function(time)), 80 | mapping = aes(time, count), 81 | colour = "red" 82 | ) + 83 | theme( 84 | legend.position = "bottom", 85 | axis.text = element_text(size = 15), 86 | axis.title = element_text(size = 15), 87 | legend.title = element_text(size = 15, face = "bold"), 88 | legend.text = element_text(size = 15) 89 | ) + 90 | theme_bw() + 91 | annotate( 92 | geom = "text", 93 | x = 500, y = 900, 94 | label='PROOF ONLY', 95 | color = 'darkgrey', 96 | angle = 45, 97 | fontface='bold', size = 25, alpha = 0.5 98 | ) 99 | 100 | hu %>% 101 | ggsave( 102 | "figures_plots/popgenerator_examples/create_unit_population_size_development_comparison.jpeg", 103 | plot = ., 104 | device = "jpeg", 105 | scale = 1, 106 | dpi = 300, 107 | width = 297, height = 210, units = "mm", 108 | limitsize = F 109 | ) 110 | -------------------------------------------------------------------------------- /R/real_world_analysis/general_maps/general_map_research_area_regions.R: -------------------------------------------------------------------------------- 1 | list.files("data_geo", pattern = "*.RData", full.names = T) %>% lapply(load, .GlobalEnv) 2 | research_area <- sf::st_read("data_manually_prepared/research_area.shp") 3 | load("data_analysis/regions.RData") 4 | load("data_analysis/bronze1.RData") 5 | load("data_analysis/region_order.RData") 6 | load("data_analysis/region_colors.RData") 7 | 8 | regions_name_points <- regions %>% 9 | dplyr::mutate( 10 | x = purrr::map_dbl(geometry, ~sf::st_centroid(.x)[[1]]), 11 | y = purrr::map_dbl(geometry, ~sf::st_centroid(.x)[[2]]) 12 | ) 13 | 14 | bronze1_sf <- bronze1 %>% sf::st_as_sf( 15 | coords = c("lon", "lat"), 16 | crs = 4326 17 | ) 18 | 19 | library(ggplot2) 20 | library(sf) 21 | 22 | ex <- raster::extent(research_area %>% sf::st_transform(sf::st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs"))) 23 | 24 | xlimit <- c(ex[1], ex[2]) 25 | ylimit <- c(ex[3], ex[4]) 26 | 27 | hu <- ggplot() + 28 | geom_sf( 29 | data = land_outline, 30 | fill = "white", colour = "black", size = 0.4 31 | ) + 32 | geom_sf( 33 | data = rivers, 34 | fill = NA, colour = "black", size = 0.2 35 | ) + 36 | geom_sf( 37 | data = lakes, 38 | fill = NA, colour = "black", size = 0.2 39 | ) + 40 | geom_sf( 41 | data = regions, 42 | mapping = aes( 43 | colour = NAME 44 | ), 45 | fill = NA, size = 2.5 46 | ) + 47 | geom_sf( 48 | data = research_area, 49 | fill = NA, colour = "red", size = 0.5 50 | ) + 51 | geom_sf( 52 | data = bronze1_sf, 53 | mapping = aes( 54 | color = burial_type, 55 | shape = burial_construction, 56 | size = burial_construction 57 | ), 58 | show.legend = "point" 59 | ) + 60 | theme_bw() + 61 | coord_sf( 62 | xlim = xlimit, ylim = ylimit, 63 | crs = st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 64 | ) + 65 | scale_shape_manual( 66 | values = c( 67 | "flat" = "\u268A", 68 | "mound" = "\u25E0", 69 | "unknown" = "\u2715" 70 | ) 71 | ) + 72 | scale_size_manual( 73 | values = c( 74 | "flat" = 10, 75 | "mound" = 10, 76 | "unknown" = 5 77 | ) 78 | ) + 79 | scale_color_manual( 80 | values = c( 81 | "cremation" = "#D55E00", 82 | "inhumation" = "#0072B2", 83 | "mound" = "#CC79A7", 84 | "flat" = "#009E73", 85 | "unknown" = "darkgrey", 86 | region_colors 87 | ), 88 | breaks = region_order, 89 | labels = region_order 90 | ) + 91 | theme( 92 | plot.title = element_text(size = 30, face = "bold"), 93 | legend.position = "bottom", 94 | legend.title = element_text(size = 20, face = "bold"), 95 | axis.title = element_blank(), 96 | axis.text = element_text(size = 15), 97 | legend.text = element_text(size = 17), 98 | panel.grid.major = element_line(colour = "black", size = 0.3) 99 | ) + 100 | guides( 101 | color = guide_legend(title = NULL, override.aes = list(size = 8, shape = 15), nrow = 2, byrow = TRUE), 102 | shape = FALSE, 103 | size = FALSE 104 | ) 105 | 106 | hu %>% 107 | ggsave( 108 | "figures_plots/general_maps/general_map_research_area_regions.jpeg", 109 | plot = ., 110 | device = "jpeg", 111 | scale = 1, 112 | dpi = 300, 113 | width = 350, height = 320, units = "mm", 114 | limitsize = F 115 | ) 116 | -------------------------------------------------------------------------------- /R/simulation/population_graph_visualization/200_individual_population_network.R: -------------------------------------------------------------------------------- 1 | load("data_simulation/example_sim_pop.RData") 2 | load("data_simulation/example_sim_rel.RData") 3 | load("data_analysis/region_order.RData") 4 | 5 | pop_groups <- pop %>% 6 | dplyr::group_by(unit) %>% 7 | dplyr::mutate( 8 | timeblock = plyr::round_any(birth_time, 100) 9 | ) %>% 10 | dplyr::group_by(unit, timeblock) %>% 11 | dplyr::summarise( 12 | n = n() 13 | ) %>% 14 | dplyr::ungroup() 15 | 16 | frommer <- dplyr::left_join( 17 | rel[, c("from", "type")], 18 | pop, 19 | by = c("from" = "id") 20 | ) %>% 21 | dplyr::select( 22 | from, birth_time, unit, type 23 | ) %>% 24 | dplyr::rename( 25 | "from_birth_time" = "birth_time", 26 | "from_unit" = "unit" 27 | ) 28 | 29 | toer <- dplyr::left_join( 30 | rel[, c("to")], 31 | pop, 32 | by = c("to" = "id") 33 | ) %>% 34 | dplyr::select( 35 | to, birth_time, unit 36 | ) %>% 37 | dplyr::rename( 38 | "to_birth_time" = "birth_time", 39 | "to_unit" = "unit" 40 | ) 41 | 42 | rel2 <- cbind(frommer, toer) 43 | 44 | rel3 <- rel2 %>% 45 | dplyr::filter( 46 | from_unit != to_unit 47 | ) %>% 48 | dplyr::mutate( 49 | timeblock_from = plyr::round_any(from_birth_time, 100), 50 | timeblock_to = plyr::round_any(to_birth_time, 100) 51 | ) %>% 52 | dplyr::select( 53 | -from, -to, -from_birth_time, -to_birth_time 54 | ) 55 | 56 | rel4 <- rel3 %>% dplyr::group_by( 57 | from_unit, to_unit, timeblock_from, timeblock_to 58 | ) %>% 59 | dplyr::summarise( 60 | n = n(), 61 | type = type[1] 62 | ) %>% 63 | dplyr::ungroup() 64 | 65 | regions_factor <- as.factor(pop_groups$unit) 66 | pop_groups$unit <- factor(regions_factor, levels = region_order) 67 | 68 | library(ggplot2) 69 | pu <- ggplot() + 70 | geom_point( 71 | data = pop_groups, 72 | aes( 73 | x = timeblock, 74 | y = unit, 75 | size = n 76 | ) 77 | ) + 78 | geom_segment( 79 | data = rel4,#[rel4$type != "friend", ], 80 | aes( 81 | y = from_unit, yend = to_unit, 82 | x = timeblock_from, xend = timeblock_to, 83 | color = type, 84 | alpha = type 85 | ), 86 | size = 0.6 87 | ) + 88 | scale_color_manual( 89 | values = c( 90 | "child_of" = "red", 91 | "friend" = "blue" 92 | ), 93 | labels = c( 94 | "child_of" = "vertical", 95 | "friend" = "horizontal" 96 | ) 97 | ) + 98 | scale_alpha_manual( 99 | values = c( 100 | "child_of" = 0.4, 101 | "friend" = 0.1 102 | ), 103 | labels = c( 104 | "child_of" = "vertical", 105 | "friend" = "horizontal" 106 | ) 107 | ) + 108 | theme_bw() + 109 | scale_y_discrete(limits = rev(levels(pop_groups$unit))) + 110 | scale_x_continuous( 111 | breaks = seq(min(pop_groups$timeblock), max(pop_groups$timeblock), 100) 112 | ) + 113 | theme( 114 | panel.grid.major.y = element_line(size = 0.5, colour = "black"), 115 | axis.text.x = element_text(size = 10, angle = 45, vjust = 1, hjust = 1), 116 | axis.text.y = element_text(size = 10, angle = 45, vjust = 0, hjust = 1) 117 | ) + 118 | ylab(NULL) + 119 | xlab("timeblock in calBC") 120 | 121 | pu %>% 122 | ggsave( 123 | "figures_plots/simulation_population_graph/population_group_graph.jpeg", 124 | plot = ., 125 | device = "jpeg", 126 | scale = 1, 127 | dpi = 300, 128 | width = 297, height = 210, units = "mm", 129 | limitsize = F 130 | ) 131 | -------------------------------------------------------------------------------- /R/simulation/sed/050_run_simulation_sed.R: -------------------------------------------------------------------------------- 1 | library(magrittr) 2 | load("data_analysis/region_order.RData") 3 | 4 | #### prepare data #### 5 | 6 | # starting positions 7 | load("data_analysis/start_proportion_burial_type.RData") 8 | load("data_analysis/start_proportion_burial_construction.RData") 9 | start_proportion_5050 <- structure( 10 | list( 11 | idea_1 = c(.5, .5, .5, .5, .5, .5, .5, .5), 12 | idea_2 = c(.5, .5, .5, .5, .5, .5, .5, .5)), 13 | class = "data.frame", 14 | row.names = region_order) 15 | 16 | # distance matrizes 17 | load("data_analysis/distance_matrix_spatial.RData") 18 | load("data_analysis/distance_matrix_burial_type.RData") 19 | load("data_analysis/distance_matrix_burial_construction.RData") 20 | distance_matrix_equal <- distance_matrix_spatial %>% `[<-`(1) %>% `diag<-`(0) 21 | 22 | #### setup settings grid #### 23 | 24 | models_grid <- expand.grid( 25 | # general settings 26 | timeframe = list( 27 | -2200:-800 28 | ), 29 | # population settings 30 | unit_amount = c( 31 | 8 32 | ), 33 | unit_names = list( 34 | list( 35 | factor("Southeastern Central Europe", levels = region_order), 36 | factor("Poland", levels = region_order), 37 | factor("Southern Germany", levels = region_order), 38 | factor("Northeastern France", levels = region_order), 39 | factor("Northern Germany", levels = region_order), 40 | factor("Southern Scandinavia", levels = region_order), 41 | factor("Benelux", levels = region_order), 42 | factor("England", levels = region_order) 43 | ) 44 | ), 45 | unit_size_functions = list( 46 | list( 47 | "1" = function(t) {50}, 48 | "2" = function(t) {50}, 49 | "3" = function(t) {50}, 50 | "4" = function(t) {50}, 51 | "5" = function(t) {50}, 52 | "6" = function(t) {50}, 53 | "7" = function(t) {50}, 54 | "8" = function(t) {50} 55 | ) 56 | ), 57 | age_distribution_functions = c( 58 | function(x) {1 / (1 + 0.0004 * 0.7^(-7*log(x)))} 59 | ), 60 | age_ranges = list( 61 | 1:90 62 | ), 63 | # relations settings 64 | amounts_friends = c( 65 | 10 66 | ), 67 | unit_interaction_matrix = list( 68 | distance_matrix_equal, 69 | distance_matrix_spatial 70 | ), 71 | cross_unit_proportion_child_of = c( 72 | 0.002, 0.02 73 | ), 74 | cross_unit_proportion_friend = c( 75 | 0.01, 0.1 76 | ), 77 | weight_child_of = list( 78 | 50 79 | ), 80 | weight_friend = list( 81 | 10 82 | ), 83 | # ideas settings 84 | names = list( 85 | c("idea_1", "idea_2") 86 | ), 87 | start_distribution = list( 88 | start_proportion_5050 89 | ), 90 | strength = list( 91 | c(1, 1) 92 | ), 93 | stringsAsFactors = FALSE 94 | ) %>% tibble::as.tibble() %>% 95 | # remove unnecessary repetition 96 | dplyr::filter( 97 | 5 * cross_unit_proportion_child_of == cross_unit_proportion_friend 98 | ) %>% 99 | # add relevant model ids 100 | dplyr::mutate( 101 | model_group = c( 102 | "low equal interaction", 103 | "low spatial interaction", 104 | "high equal interaction", 105 | "high spatial interaction" 106 | ) 107 | ) %>% 108 | tidyr::uncount(100) %>% 109 | dplyr::mutate( 110 | model_id = 1:nrow(.) 111 | ) 112 | 113 | save(models_grid, file = "data_simulation/sed_simulation_model_grid.RData") 114 | 115 | #### run simulation #### 116 | 117 | #data_path <- "data_simulation/sed_simulation" 118 | data_path <- "../simulationdata/sed_simulation" 119 | popgenerator::run_simulation(models_grid, data_path) 120 | 121 | -------------------------------------------------------------------------------- /R/simulation/population_graph_visualization/100_example_simulation.R: -------------------------------------------------------------------------------- 1 | library(magrittr) 2 | load("data_analysis/region_order.RData") 3 | 4 | #### prepare data #### 5 | 6 | # starting positions 7 | load("data_analysis/start_proportion_burial_type.RData") 8 | load("data_analysis/start_proportion_burial_construction.RData") 9 | start_proportion_5050 <- structure( 10 | list( 11 | idea_1 = c(.5, .5, .5, .5, .5, .5, .5, .5), 12 | idea_2 = c(.5, .5, .5, .5, .5, .5, .5, .5)), 13 | class = "data.frame", 14 | row.names = region_order) 15 | 16 | # distance matrizes 17 | load("data_analysis/distance_matrix_spatial.RData") 18 | load("data_analysis/distance_matrix_burial_type.RData") 19 | load("data_analysis/distance_matrix_burial_construction.RData") 20 | distance_matrix_equal <- distance_matrix_spatial %>% `[<-`(1) %>% `diag<-`(0) 21 | 22 | #### setup settings grid #### 23 | 24 | models_grid <- expand.grid( 25 | # general settings 26 | timeframe = list( 27 | -2200:-800 28 | ), 29 | # population settings 30 | unit_amount = c( 31 | 8 32 | ), 33 | unit_names = list( 34 | list( 35 | factor("Southeastern Central Europe", levels = region_order), 36 | factor("Poland", levels = region_order), 37 | factor("Southern Germany", levels = region_order), 38 | factor("Northeastern France", levels = region_order), 39 | factor("Northern Germany", levels = region_order), 40 | factor("Southern Scandinavia", levels = region_order), 41 | factor("Benelux", levels = region_order), 42 | factor("England", levels = region_order) 43 | ) 44 | ), 45 | unit_size_functions = list( 46 | list( 47 | "1" = function(t) {50}, 48 | "2" = function(t) {50}, 49 | "3" = function(t) {50}, 50 | "4" = function(t) {50}, 51 | "5" = function(t) {50}, 52 | "6" = function(t) {50}, 53 | "7" = function(t) {50}, 54 | "8" = function(t) {50} 55 | ) 56 | ), 57 | age_distribution_functions = c( 58 | function(x) {1 / (1 + 0.0004 * 0.7^(-7*log(x)))} 59 | ), 60 | age_ranges = list( 61 | 1:90 62 | ), 63 | # relations settings 64 | amounts_friends = c( 65 | 10 66 | ), 67 | unit_interaction_matrix = list( 68 | distance_matrix_equal 69 | ), 70 | cross_unit_proportion_child_of = c( 71 | 0.02 72 | ), 73 | cross_unit_proportion_friend = c( 74 | 0.1 75 | ), 76 | weight_child_of = list( 77 | 50 78 | ), 79 | weight_friend = list( 80 | 10 81 | ), 82 | # ideas settings 83 | names = list( 84 | c("idea_1", "idea_2") 85 | ), 86 | start_distribution = list( 87 | start_proportion_5050 88 | ), 89 | strength = list( 90 | c(1, 1) 91 | ), 92 | stringsAsFactors = FALSE 93 | ) %>% tibble::as.tibble() %>% 94 | # add relevant model ids 95 | dplyr::mutate( 96 | model_group = 1:nrow(.) 97 | ) %>% 98 | dplyr::mutate( 99 | model_id = 1:nrow(.) 100 | ) 101 | 102 | save(models_grid, file = "data_simulation/example_sim.RData") 103 | 104 | #### run simulation #### 105 | 106 | # prepare populations 107 | population_settings <- popgenerator::init_population_settings(models_grid) 108 | populations <- popgenerator::generate_all_populations(population_settings) 109 | 110 | # prepare relations 111 | relations_settings <- popgenerator::init_relations_settings(models_grid, populations) 112 | rel <- popgenerator::generate_all_relations(relations_settings)[[1]] 113 | 114 | pop <- populations[[1]] 115 | 116 | save(pop, file = "data_simulation/example_sim_pop.RData") 117 | save(rel, file = "data_simulation/example_sim_rel.RData") 118 | -------------------------------------------------------------------------------- /R/real_world_analysis/movie/general_map_movie.R: -------------------------------------------------------------------------------- 1 | list.files("data_geo", pattern = "*.RData", full.names = T) %>% lapply(load, .GlobalEnv) 2 | research_area <- sf::st_read("data_manually_prepared/research_area.shp") 3 | load("data_analysis/regions.RData") 4 | load("data_analysis/bronze2.RData") 5 | 6 | ex <- raster::extent(research_area %>% sf::st_transform(sf::st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs"))) 7 | xlimit <- c(ex[1], ex[2]) 8 | ylimit <- c(ex[3], ex[4]) 9 | 10 | library(ggplot2) 11 | library(sf) 12 | 13 | #### movie #### 14 | 15 | for(i in seq(-2200, -800, 10)) { 16 | bronze2_fine_slices <- bronze2 %>% 17 | dplyr::filter( 18 | age == i 19 | ) %>% st_as_sf( 20 | coords = c("lon", "lat"), 21 | crs = 4326 22 | ) 23 | 24 | hu <- ggplot() + 25 | geom_sf( 26 | data = land_outline, 27 | fill = "white", colour = "black", size = 0.4 28 | ) + 29 | geom_sf( 30 | data = rivers, 31 | fill = NA, colour = "black", size = 0.2 32 | ) + 33 | geom_sf( 34 | data = lakes, 35 | fill = NA, colour = "black", size = 0.2 36 | ) + 37 | # geom_sf( 38 | # data = regions, 39 | # fill = NA, colour = "red", size = 0.5 40 | # ) + 41 | geom_sf( 42 | data = research_area, 43 | fill = NA, colour = "red", size = 0.5 44 | ) + 45 | geom_sf( 46 | data = bronze2_fine_slices, 47 | mapping = aes( 48 | color = burial_type, 49 | shape = burial_construction, 50 | size = burial_construction, 51 | alpha = norm_dens 52 | ), 53 | show.legend = "point" 54 | ) + 55 | theme_bw() + 56 | coord_sf( 57 | xlim = xlimit, ylim = ylimit, 58 | crs = st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 59 | ) + 60 | scale_shape_manual( 61 | values = c( 62 | "flat" = "\u268A", 63 | "mound" = "\u25E0", 64 | "unknown" = "\u2715" 65 | ) 66 | ) + 67 | scale_size_manual( 68 | values = c( 69 | "flat" = 10, 70 | "mound" = 10, 71 | "unknown" = 7.5 72 | ) 73 | ) + 74 | scale_color_manual( 75 | values = c( 76 | "cremation" = "#D55E00", 77 | "inhumation" = "#0072B2", 78 | "mound" = "#CC79A7", 79 | "flat" = "#009E73", 80 | "unknown" = "darkgrey" 81 | ) 82 | ) + 83 | theme( 84 | plot.title = element_text(size = 30, face = "bold"), 85 | legend.position = "bottom", 86 | legend.title = element_text(size = 20, face = "bold"), 87 | axis.title = element_blank(), 88 | axis.text = element_text(size = 15), 89 | legend.text = element_text(size = 20), 90 | panel.grid.major = element_line(colour = "black", size = 0.3) 91 | ) + 92 | guides( 93 | color = guide_legend(title = "Burial type", override.aes = list(size = 10), nrow = 2, byrow = TRUE), 94 | shape = guide_legend(title = "Burial construction", override.aes = list(size = 10), nrow = 2, byrow = TRUE), 95 | size = FALSE, 96 | alpha = FALSE 97 | ) + 98 | ggtitle(paste0(i, "calBC")) 99 | 100 | hu %>% 101 | ggsave( 102 | paste0("development_movie/frames/", 220 + (i/10) ,".jpeg"), 103 | plot = ., 104 | device = "jpeg", 105 | scale = 1, 106 | dpi = 300, 107 | width = 360, height = 350, units = "mm", 108 | limitsize = F 109 | ) 110 | 111 | } 112 | 113 | #ffmpeg -r 8 -vb 20M -i frames/%*.jpeg -vcodec libx264 -vf scale=1280:-2 -r 8 the_movie_3.mp4 114 | -------------------------------------------------------------------------------- /data_manually_prepared/regionen2017g.dbf: -------------------------------------------------------------------------------- 1 | u  A$IDN 2 | REGIONN 3 | LBLSIZENLBLCOLORCLBLBOLDNLBLITALICNLBLUNDERLNLBLSTRIKENLBLFONTCdLBLXNLBLYNLBLSCLMINN 4 | LBLSCLMAXN 5 | LBLALIGNHCLBLALIGNVCLBLROTNNAMEC2 11 11 0 0000 -370791.40487 6084580.26976 0 0 0.00000Great Britain and Ireland 10 10 0 0000 -119206.41494 4740241.39229 0 0 0.00000Catalonia 9 9 0 0000 731509.09963 6657025.35077 0 0 0.00000Northern Skandinavia 8 8 0 0000 796453.51922 6019652.14497 0 0 0.00000Southern Sweden and Danish Islands 7 7 0 0000 342540.77376 6178109.84610 0 0 0.00000Jutland 6 6 0 0000 717005.36480 5752868.88818 0 0 0.00000Northern Germany 5 5 0 0000 339178.85744 5598687.86339 0 0 0.00000Northeast France and Benelux 4 4 0 0000 1123588.76550 5727269.59002 0 0 0.00000Northern Poland 3 3 0 0000 640287.50142 5443356.22317 0 0 0.00000Southern Germany 2 2 0 0000 914711.58091 5125848.91350 0 0 0.00000Slovenia 1 1 0 0000 0.00000 0.00000 0 0 0.00000Hungary, Czechia and Slovakia  -------------------------------------------------------------------------------- /R/simulation/parameter_exploration/vertitrans/100_run_simulation.R: -------------------------------------------------------------------------------- 1 | library(magrittr) 2 | load("data_analysis/region_order.RData") 3 | 4 | #### prepare data #### 5 | 6 | # starting positions 7 | load("data_analysis/start_proportion_burial_type.RData") 8 | load("data_analysis/start_proportion_burial_construction.RData") 9 | start_proportion_5050 <- structure( 10 | list( 11 | idea_1 = c(.5, .5, .5, .5, .5, .5, .5, .5), 12 | idea_2 = c(.5, .5, .5, .5, .5, .5, .5, .5)), 13 | class = "data.frame", 14 | row.names = region_order) 15 | 16 | # distance matrizes 17 | load("data_analysis/distance_matrix_spatial.RData") 18 | load("data_analysis/distance_matrix_burial_type.RData") 19 | load("data_analysis/distance_matrix_burial_construction.RData") 20 | distance_matrix_equal <- distance_matrix_spatial %>% `[<-`(1) %>% `diag<-`(0) 21 | 22 | #### setup settings grid #### 23 | 24 | models_grid <- expand.grid( 25 | # general settings 26 | timeframe = list( 27 | 1:1400 28 | ), 29 | # population settings 30 | unit_amount = c( 31 | 8 32 | ), 33 | unit_names = list( 34 | list( 35 | factor("1", as.character(c(1,2,3,4,5,6,7,8))), 36 | factor("2", as.character(c(1,2,3,4,5,6,7,8))), 37 | factor("3", as.character(c(1,2,3,4,5,6,7,8))), 38 | factor("4", as.character(c(1,2,3,4,5,6,7,8))), 39 | factor("5", as.character(c(1,2,3,4,5,6,7,8))), 40 | factor("6", as.character(c(1,2,3,4,5,6,7,8))), 41 | factor("7", as.character(c(1,2,3,4,5,6,7,8))), 42 | factor("8", as.character(c(1,2,3,4,5,6,7,8))) 43 | ) 44 | ), 45 | unit_size_functions = list( 46 | list( 47 | "1" = function(t) {10}, 48 | "2" = function(t) {10}, 49 | "3" = function(t) {10}, 50 | "4" = function(t) {10}, 51 | "5" = function(t) {10}, 52 | "6" = function(t) {10}, 53 | "7" = function(t) {10}, 54 | "8" = function(t) {10} 55 | ), 56 | list( 57 | "1" = function(t) {50}, 58 | "2" = function(t) {50}, 59 | "3" = function(t) {50}, 60 | "4" = function(t) {50}, 61 | "5" = function(t) {50}, 62 | "6" = function(t) {50}, 63 | "7" = function(t) {50}, 64 | "8" = function(t) {50} 65 | ), 66 | list( 67 | "1" = function(t) {200}, 68 | "2" = function(t) {200}, 69 | "3" = function(t) {200}, 70 | "4" = function(t) {200}, 71 | "5" = function(t) {200}, 72 | "6" = function(t) {200}, 73 | "7" = function(t) {200}, 74 | "8" = function(t) {200} 75 | ) 76 | ), 77 | age_distribution_functions = c( 78 | function(x) {1 / (1 + 0.0004 * 0.7^(-7*log(x)))} 79 | ), 80 | age_ranges = list( 81 | 1:90 82 | ), 83 | # relations settings 84 | amounts_friends = c( 85 | 0 86 | ), 87 | unit_interaction_matrix = list( 88 | distance_matrix_equal 89 | ), 90 | cross_unit_proportion_child_of = c( 91 | 0, 0.002, 0.02, 0.1, 0.2 92 | ), 93 | cross_unit_proportion_friend = c( 94 | 0 95 | ), 96 | weight_child_of = list( 97 | 50 98 | ), 99 | weight_friend = list( 100 | 10 101 | ), 102 | # ideas settings 103 | names = list( 104 | c("idea_1", "idea_2") 105 | ), 106 | start_distribution = list( 107 | start_proportion_5050 108 | ), 109 | strength = list( 110 | c(1, 1) 111 | ), 112 | stringsAsFactors = FALSE 113 | ) %>% tibble::as.tibble() %>% 114 | # add relevant model ids 115 | dplyr::mutate( 116 | model_group = 1:nrow(.) 117 | ) %>% 118 | tidyr::uncount(8) %>% 119 | dplyr::mutate( 120 | model_id = 1:nrow(.) 121 | ) 122 | 123 | save(models_grid, file = "data_simulation/pe_vertitrans.RData") 124 | 125 | #### run simulation #### 126 | 127 | data_path <- "../simulationdata/pe_vertitrans" 128 | popgenerator::run_simulation(models_grid, data_path) 129 | 130 | -------------------------------------------------------------------------------- /R/simulation/parameter_exploration/popsize_crossregions/100_run_simulation.R: -------------------------------------------------------------------------------- 1 | library(magrittr) 2 | load("data_analysis/region_order.RData") 3 | 4 | #### prepare data #### 5 | 6 | # starting positions 7 | load("data_analysis/start_proportion_burial_type.RData") 8 | load("data_analysis/start_proportion_burial_construction.RData") 9 | start_proportion_5050 <- structure( 10 | list( 11 | idea_1 = c(.5, .5, .5, .5, .5, .5, .5, .5), 12 | idea_2 = c(.5, .5, .5, .5, .5, .5, .5, .5)), 13 | class = "data.frame", 14 | row.names = region_order) 15 | 16 | # distance matrizes 17 | load("data_analysis/distance_matrix_spatial.RData") 18 | load("data_analysis/distance_matrix_burial_type.RData") 19 | load("data_analysis/distance_matrix_burial_construction.RData") 20 | distance_matrix_equal <- distance_matrix_spatial %>% `[<-`(1) %>% `diag<-`(0) 21 | 22 | #### setup settings grid #### 23 | 24 | models_grid <- expand.grid( 25 | # general settings 26 | timeframe = list( 27 | 1:1400 28 | ), 29 | # population settings 30 | unit_amount = c( 31 | 8 32 | ), 33 | unit_names = list( 34 | list( 35 | factor("1", as.character(c(1,2,3,4,5,6,7,8))), 36 | factor("2", as.character(c(1,2,3,4,5,6,7,8))), 37 | factor("3", as.character(c(1,2,3,4,5,6,7,8))), 38 | factor("4", as.character(c(1,2,3,4,5,6,7,8))), 39 | factor("5", as.character(c(1,2,3,4,5,6,7,8))), 40 | factor("6", as.character(c(1,2,3,4,5,6,7,8))), 41 | factor("7", as.character(c(1,2,3,4,5,6,7,8))), 42 | factor("8", as.character(c(1,2,3,4,5,6,7,8))) 43 | ) 44 | ), 45 | unit_size_functions = list( 46 | list( 47 | "1" = function(t) {10}, 48 | "2" = function(t) {10}, 49 | "3" = function(t) {10}, 50 | "4" = function(t) {10}, 51 | "5" = function(t) {10}, 52 | "6" = function(t) {10}, 53 | "7" = function(t) {10}, 54 | "8" = function(t) {10} 55 | ), 56 | list( 57 | "1" = function(t) {50}, 58 | "2" = function(t) {50}, 59 | "3" = function(t) {50}, 60 | "4" = function(t) {50}, 61 | "5" = function(t) {50}, 62 | "6" = function(t) {50}, 63 | "7" = function(t) {50}, 64 | "8" = function(t) {50} 65 | ), 66 | list( 67 | "1" = function(t) {200}, 68 | "2" = function(t) {200}, 69 | "3" = function(t) {200}, 70 | "4" = function(t) {200}, 71 | "5" = function(t) {200}, 72 | "6" = function(t) {200}, 73 | "7" = function(t) {200}, 74 | "8" = function(t) {200} 75 | ) 76 | ), 77 | age_distribution_functions = c( 78 | function(x) {1 / (1 + 0.0004 * 0.7^(-7*log(x)))} 79 | ), 80 | age_ranges = list( 81 | 1:90 82 | ), 83 | # relations settings 84 | amounts_friends = c( 85 | 10 86 | ), 87 | unit_interaction_matrix = list( 88 | distance_matrix_equal 89 | ), 90 | cross_unit_proportion_child_of = c( 91 | 0, 0.002, 0.02, 0.1, 0.2 92 | ), 93 | cross_unit_proportion_friend = c( 94 | 0, 0.01, 0.1, 0.5, 1 95 | ), 96 | weight_child_of = list( 97 | 50 98 | ), 99 | weight_friend = list( 100 | 10 101 | ), 102 | # ideas settings 103 | names = list( 104 | c("idea_1", "idea_2") 105 | ), 106 | start_distribution = list( 107 | start_proportion_5050 108 | ), 109 | strength = list( 110 | c(1, 1) 111 | ), 112 | stringsAsFactors = FALSE 113 | ) %>% tibble::as.tibble() %>% 114 | # remove unnecessary repetition 115 | dplyr::filter( 116 | 5 * cross_unit_proportion_child_of == cross_unit_proportion_friend 117 | ) %>% 118 | # add relevant model ids 119 | dplyr::mutate( 120 | model_group = 1:nrow(.) 121 | ) %>% 122 | tidyr::uncount(8) %>% 123 | dplyr::mutate( 124 | model_id = 1:nrow(.) 125 | ) 126 | 127 | save(models_grid, file = "data_simulation/pe_popsize_crossregions.RData") 128 | 129 | #### run simulation #### 130 | 131 | data_path <- "../simulationdata/pe_popsize_crossregions" 132 | popgenerator::run_simulation(models_grid, data_path) 133 | 134 | -------------------------------------------------------------------------------- /R/simulation/parameter_exploration/startprop_distancemat/100_run_simulation.R: -------------------------------------------------------------------------------- 1 | library(magrittr) 2 | load("data_analysis/region_order.RData") 3 | 4 | #### prepare data #### 5 | 6 | # starting positions 7 | load("data_analysis/start_proportion_burial_type.RData") 8 | load("data_analysis/start_proportion_burial_construction.RData") 9 | start_proportion_5050 <- structure( 10 | list( 11 | idea_1 = c(.5, .5, .5, .5, .5, .5, .5, .5), 12 | idea_2 = c(.5, .5, .5, .5, .5, .5, .5, .5)), 13 | class = "data.frame", 14 | row.names = region_order) 15 | 16 | # distance matrizes 17 | load("data_analysis/distance_matrix_spatial.RData") 18 | load("data_analysis/distance_matrix_burial_type.RData") 19 | load("data_analysis/distance_matrix_burial_construction.RData") 20 | distance_matrix_equal <- distance_matrix_spatial %>% `[<-`(1) %>% `diag<-`(0) 21 | 22 | #### setup settings grid #### 23 | 24 | models_grid <- expand.grid( 25 | # general settings 26 | timeframe = list( 27 | 1:1400 28 | ), 29 | # population settings 30 | unit_amount = c( 31 | 8 32 | ), 33 | unit_names = list( 34 | list( 35 | factor("1", as.character(c(1,2,3,4,5,6,7,8))), 36 | factor("2", as.character(c(1,2,3,4,5,6,7,8))), 37 | factor("3", as.character(c(1,2,3,4,5,6,7,8))), 38 | factor("4", as.character(c(1,2,3,4,5,6,7,8))), 39 | factor("5", as.character(c(1,2,3,4,5,6,7,8))), 40 | factor("6", as.character(c(1,2,3,4,5,6,7,8))), 41 | factor("7", as.character(c(1,2,3,4,5,6,7,8))), 42 | factor("8", as.character(c(1,2,3,4,5,6,7,8))) 43 | ) 44 | ), 45 | unit_size_functions = list( 46 | list( 47 | "1" = function(t) {50}, 48 | "2" = function(t) {50}, 49 | "3" = function(t) {50}, 50 | "4" = function(t) {50}, 51 | "5" = function(t) {50}, 52 | "6" = function(t) {50}, 53 | "7" = function(t) {50}, 54 | "8" = function(t) {50} 55 | ) 56 | ), 57 | age_distribution_functions = c( 58 | function(x) {1 / (1 + 0.0004 * 0.7^(-7*log(x)))} 59 | ), 60 | age_ranges = list( 61 | 1:90 62 | ), 63 | # relations settings 64 | amounts_friends = c( 65 | 10 66 | ), 67 | unit_interaction_matrix = list( 68 | distance_matrix_equal, 69 | distance_matrix_spatial, 70 | distance_matrix_burial_type, 71 | distance_matrix_burial_construction 72 | ), 73 | cross_unit_proportion_child_of = c( 74 | 0.02 75 | ), 76 | cross_unit_proportion_friend = c( 77 | 0.1 78 | ), 79 | weight_child_of = list( 80 | 50 81 | ), 82 | weight_friend = list( 83 | 10 84 | ), 85 | # ideas settings 86 | names = list( 87 | c("idea_1", "idea_2") 88 | ), 89 | start_distribution = list( 90 | start_proportion_5050, 91 | start_proportion_burial_type, 92 | start_proportion_burial_construction 93 | ), 94 | strength = list( 95 | c(1, 1) 96 | ), 97 | stringsAsFactors = FALSE 98 | ) %>% tibble::as.tibble() %>% 99 | # remove unnecessary repetition 100 | dplyr::filter( 101 | 5 * cross_unit_proportion_child_of == cross_unit_proportion_friend 102 | ) %>% 103 | # add relevant model ids 104 | dplyr::mutate( 105 | model_group = c( 106 | "eq start, eq interaction", 107 | "eq start, sp interaction", 108 | "eq start, bt interaction", 109 | "eq start, bc interaction", 110 | "bt start, eq interaction", 111 | "bt start, sp interaction", 112 | "bt start, bt interaction", 113 | "bt start, bc interaction", 114 | "bc start, eq interaction", 115 | "bc start, sp interaction", 116 | "bc start, bt interaction", 117 | "bc start, bc interaction" 118 | ) 119 | ) %>% 120 | tidyr::uncount(8) %>% 121 | dplyr::mutate( 122 | model_id = 1:nrow(.) 123 | ) 124 | 125 | save(models_grid, file = "data_simulation/pe_startprop_distancemat.RData") 126 | 127 | #### run simulation #### 128 | 129 | data_path <- "../simulationdata/pe_startprop_distancemat" 130 | popgenerator::run_simulation(models_grid, data_path) 131 | 132 | -------------------------------------------------------------------------------- /R/other_analysis/bronze_age_chronology_gantt.R: -------------------------------------------------------------------------------- 1 | chronology <- readr::read_csv( 2 | "data_manually_prepared/bronze_age_chronology.csv" 3 | ) 4 | 5 | chronology %<>% dplyr::mutate( 6 | start_date = replace(start_date, is.na(start_date), -Inf), 7 | end_date = replace(end_date, is.na(end_date), Inf), 8 | label_pos = (start_date + end_date) / 2, 9 | unit_name = factor(as.factor(unit_name), levels = unique(as.factor(unit_name)[order(start_date)])), 10 | context_general = factor(as.factor(context_general), levels = c( 11 | "Central Europe", 12 | "France", 13 | "Scandinavia", 14 | "Netherlands", 15 | "Belgium", 16 | "Britain", 17 | "Irland" 18 | )), 19 | unit_general = factor(as.factor(unit_general), levels = c( 20 | "Neolithic", 21 | "Chalcolithic", 22 | "Early Bronze Age", 23 | "Middle Bronze Age", 24 | "Late Bronze Age", 25 | "Iron Age" 26 | )), 27 | sub_context = stringr::str_wrap(paste0(reference, "\n", ifelse(is.na(sub_context), "", sub_context)), width = 10) 28 | ) 29 | 30 | separators <- chronology %>% 31 | dplyr::select(-reference, -start_date_pre, -end_date_post, -unit_name, -label_pos, -unit_general) %>% 32 | tidyr::gather( 33 | unit, dates, -sub_context, -context_general 34 | ) 35 | 36 | line_width = 22 37 | 38 | library(ggplot2) 39 | hu <- ggplot() + 40 | geom_linerange( 41 | data = chronology, 42 | mapping = aes( 43 | x = sub_context, 44 | ymin = start_date_pre, 45 | ymax = start_date, 46 | group = unit_name 47 | ), 48 | size = line_width, 49 | color = "darkgrey" 50 | ) + 51 | geom_linerange( 52 | data = chronology, 53 | mapping = aes( 54 | x = sub_context, 55 | ymin = end_date, 56 | ymax = end_date_post, 57 | group = unit_name 58 | ), 59 | size = line_width, 60 | color = "darkgrey" 61 | ) + 62 | geom_linerange( 63 | data = chronology, 64 | mapping = aes( 65 | x = sub_context, 66 | ymin = start_date, 67 | ymax = end_date, 68 | group = unit_name, 69 | color = unit_general 70 | ), 71 | size = line_width 72 | ) + 73 | scale_color_manual( 74 | values = c( 75 | "Neolithic" = "grey", 76 | "Chalcolithic" = "#a6cee3", 77 | "Early Bronze Age" = "#1f78b4", 78 | "Middle Bronze Age" = "#b2df8a", 79 | "Late Bronze Age" = "#33a02c", 80 | "Iron Age" = "grey" 81 | ) 82 | ) + 83 | geom_point( 84 | data = separators, 85 | mapping = aes( 86 | x = sub_context, 87 | y = dates 88 | ), 89 | shape = 3, 90 | size = 1, 91 | position = position_dodge(preserve = "single", width = 0.8) 92 | ) + 93 | geom_point( 94 | data = separators, 95 | mapping = aes( 96 | x = sub_context, 97 | y = dates 98 | ), 99 | shape = 3, 100 | size = 1, 101 | position = position_dodge(preserve = "single", width = -0.8) 102 | ) + 103 | geom_text( 104 | data = chronology, 105 | mapping = aes( 106 | x = sub_context, 107 | y = label_pos, 108 | label = unit_name, 109 | group = unit_name 110 | ), 111 | size = 3 112 | ) + 113 | theme_bw() + 114 | xlab(NULL) + 115 | ylab(NULL) + 116 | scale_y_reverse( 117 | breaks = seq(-800, -2200, -200), 118 | limits = c(-700, -2500), 119 | sec.axis = dup_axis(name = NULL) 120 | ) + 121 | facet_grid(cols = vars(context_general), scales = "free_x", space = "free_x") + 122 | theme( 123 | legend.position = "bottom", 124 | legend.title = element_blank(), 125 | legend.text = element_text(size = 12), 126 | strip.text.x = element_text(size = 8), 127 | panel.grid.major.y = element_line(colour = "black", size = 0.3), 128 | axis.text = element_text(size = 10), 129 | axis.title = element_text(size = 15), 130 | legend.spacing.x = unit(.3, 'cm') 131 | ) + 132 | guides( 133 | color = guide_legend(nrow = 1, override.aes = list(size = 8)) 134 | ) 135 | 136 | hu %>% 137 | ggsave( 138 | paste0("figures_plots/chronology/bronze_age_europe_chronology.jpeg"), 139 | plot = ., 140 | device = "jpeg", 141 | scale = 1, 142 | dpi = 300, 143 | width = 297, height = 210, units = "mm", 144 | limitsize = F 145 | ) 146 | 147 | -------------------------------------------------------------------------------- /R/real_world_analysis/general_observations/observations_preparation.R: -------------------------------------------------------------------------------- 1 | storage_file <- "data_text_elements/sf_prep.txt" 2 | 3 | #### bronze #### 4 | load("data_analysis/bronze.RData") 5 | txtstorage::store("size bronze", nrow(bronze), storage_file) 6 | rm(bronze) 7 | 8 | 9 | 10 | #### bronze0 #### 11 | load("data_analysis/bronze0.RData") 12 | txtstorage::store("size bronze0", nrow(bronze0), storage_file) 13 | rm(bronze0) 14 | 15 | 16 | 17 | #### bronze05 #### 18 | load("data_analysis/bronze05.RData") 19 | txtstorage::store("size bronze05", nrow(bronze05), storage_file) 20 | txtstorage::store("bronze05 variable amount", ncol(bronze05), storage_file) 21 | rm(bronze05) 22 | 23 | 24 | 25 | #### bronze1 #### 26 | load("data_analysis/bronze1.RData") 27 | txtstorage::store("size bronze1", nrow(bronze1), storage_file) 28 | txtstorage::store("bronze1 variable amount", ncol(bronze1), storage_file) 29 | rm(bronze1) 30 | 31 | 32 | 33 | #### bronze15 #### 34 | 35 | load("data_analysis/bronze15.RData") 36 | 37 | # size 38 | txtstorage::store("size bronze15", nrow(bronze15), storage_file) 39 | 40 | # count indiviual labnrs 41 | labnrs_amount <- bronze15$labnr %>% unique() %>% length() 42 | txtstorage::store("bronze15 labnrs amount", labnrs_amount, storage_file) 43 | 44 | # count labnr duplicates without n/a labnrs 45 | labnr_doubles <- bronze15[!grepl('n/a', bronze15$labnr), ] %>% 46 | dplyr::group_by(labnr) %>% 47 | dplyr::filter(n() > 1) %>% 48 | nrow() 49 | txtstorage::store("bronze15 labnr doubles", labnr_doubles, storage_file) 50 | 51 | # count graves represented by multiple c14 dates 52 | multi_dates_one_grave <- bronze15 %>% 53 | dplyr::group_by(site, feature) %>% 54 | dplyr::filter(n() > 1) %>% 55 | nrow() 56 | txtstorage::store("bronze15 multi dates one grave", multi_dates_one_grave, storage_file) 57 | 58 | bronze15_burial_type_doubles <- bronze15 %>% 59 | dplyr::group_by(site, feature) %>% 60 | dplyr::filter(n() > 1) %>% 61 | dplyr::ungroup() %$% 62 | burial_type %>% table %>% 63 | unclass %>% 64 | paste(names(.), ., collapse = ", ", sep = ": ") 65 | txtstorage::store("bronze15 burial_type doubles", bronze15_burial_type_doubles, storage_file) 66 | 67 | bronze15_burial_construction_doubles <- bronze15 %>% 68 | dplyr::group_by(site, feature) %>% 69 | dplyr::filter(n() > 1) %>% 70 | dplyr::ungroup() %$% 71 | burial_construction %>% table %>% 72 | unclass %>% 73 | paste(names(.), ., collapse = ", ", sep = ": ") 74 | txtstorage::store("bronze15 burial_construction doubles", bronze15_burial_construction_doubles, storage_file) 75 | 76 | rm(bronze15) 77 | 78 | 79 | 80 | #### bronze16 #### 81 | 82 | load("data_analysis/bronze16.RData") 83 | 84 | # size 85 | txtstorage::store("size bronze16", nrow(bronze16), storage_file) 86 | 87 | # count the dates per feature - get max 88 | max_dates_per_grave <- bronze16[grepl("[0-9]", bronze16$feature), ] %>% 89 | dplyr::group_by(site, feature) %>% 90 | # dplyr::filter(n()>1) 91 | dplyr::summarise(n = n()) %>% 92 | # dplyr::arrange(desc(n)) %>% 93 | dplyr::ungroup() %$% 94 | max(n) 95 | txtstorage::store("bronze16 max dates per grave", max_dates_per_grave, storage_file) 96 | 97 | multi_dates_one_grave <- bronze16 %>% 98 | dplyr::group_by(site, feature) %>% 99 | dplyr::filter(n() > 1) 100 | txtstorage::store("bronze16 multi dates one grave", nrow(multi_dates_one_grave), storage_file) 101 | 102 | with_numbers_in_feature <- multi_dates_one_grave[grepl("[0-9]", multi_dates_one_grave$feature), ] 103 | txtstorage::store("bronze16 multi dates one grave with numbers", nrow(with_numbers_in_feature), storage_file) 104 | 105 | rm(bronze16) 106 | 107 | 108 | 109 | #### bronze17 #### 110 | load("data_analysis/bronze17.RData") 111 | txtstorage::store("size bronze17", nrow(bronze17), storage_file) 112 | 113 | 114 | 115 | #### regions #### 116 | load("data_analysis/regions.RData") 117 | load("data_analysis/region_order.RData") 118 | 119 | regions_graves_amounts <- regions %>% sf::st_set_geometry(NULL) %>% 120 | dplyr::mutate( 121 | region_name = factor(regions$NAME, levels = region_order) 122 | ) %>% 123 | dplyr::arrange(region_name) %$% 124 | paste(paste0("*", region_name, "*"), paste0("(", number_of_graves, ")"), collapse = ", ", sep = " ") 125 | txtstorage::store("regions graves amounts", regions_graves_amounts, storage_file) 126 | -------------------------------------------------------------------------------- /R/real_world_analysis/general_maps/general_map_regions_distance_network.R: -------------------------------------------------------------------------------- 1 | list.files("data_geo", pattern = "*.RData", full.names = T) %>% lapply(load, .GlobalEnv) 2 | research_area <- sf::st_read("data_manually_prepared/research_area.shp") 3 | load("data_analysis/regions.RData") 4 | load("data_analysis/distance_matrix_spatial_long.RData") 5 | load("data_analysis/region_order.RData") 6 | load("data_analysis/region_colors.RData") 7 | 8 | region_centers <- regions %>% 9 | sf::st_centroid() 10 | 11 | sfc_as_cols <- function(x, names = c("x","y")) { 12 | stopifnot(inherits(x,"sf") && inherits(sf::st_geometry(x),"sfc_POINT")) 13 | ret <- do.call(rbind,sf::st_geometry(x)) 14 | ret <- tibble::as_tibble(ret) 15 | stopifnot(length(names) == ncol(ret)) 16 | ret <- setNames(ret,names) 17 | dplyr::bind_cols(x,ret) 18 | } 19 | 20 | region_centers %>% 21 | sfc_as_cols() %>% 22 | dplyr::select( 23 | NAME, x, y 24 | ) 25 | 26 | save(region_centers, file = "data_analysis/region_centers.RData") 27 | 28 | distance_lines <- distance_matrix_spatial_long %>% 29 | dplyr::left_join( 30 | region_centers, 31 | by = c("regionA" = "NAME") 32 | ) %>% 33 | dplyr::left_join( 34 | region_centers, 35 | by = c("regionB" = "NAME"), 36 | suffix = c("_regionA", "_regionB") 37 | ) %>% 38 | dplyr::rowwise() %>% 39 | dplyr::mutate( 40 | x_a = st_coordinates(geometry_regionA)[,1], 41 | y_a = st_coordinates(geometry_regionA)[,2], 42 | x_b = st_coordinates(geometry_regionB)[,1], 43 | y_b = st_coordinates(geometry_regionB)[,2] 44 | ) %>% 45 | dplyr::ungroup() %>% 46 | dplyr::select( 47 | regionA, regionB, distance, x_a, y_a, x_b, y_b 48 | ) %>% 49 | dplyr::filter( 50 | regionA != regionB 51 | ) 52 | 53 | # remove duplicates 54 | mn <- pmin(distance_lines$regionA, distance_lines$regionB) 55 | mx <- pmax(distance_lines$regionA, distance_lines$regionB) 56 | int <- as.numeric(interaction(mn, mx)) 57 | distance_lines <- distance_lines[match(unique(int), int),] 58 | 59 | 60 | library(ggplot2) 61 | library(sf) 62 | 63 | ex <- raster::extent(regions %>% sf::st_transform(sf::st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs"))) 64 | 65 | xlimit <- c(ex[1], ex[2]) 66 | ylimit <- c(ex[3], ex[4]) 67 | 68 | hu <- ggplot() + 69 | geom_sf( 70 | data = land_outline, 71 | fill = "white", colour = "black", size = 0.4 72 | ) + 73 | geom_sf( 74 | data = rivers, 75 | fill = NA, colour = "black", size = 0.2 76 | ) + 77 | geom_sf( 78 | data = lakes, 79 | fill = NA, colour = "black", size = 0.2 80 | ) + 81 | geom_sf( 82 | data = research_area, 83 | fill = NA, colour = "red", size = 0.5 84 | ) + 85 | geom_curve( 86 | data = distance_lines, 87 | mapping = aes( 88 | x = x_a, y = y_a, xend = x_b, yend = y_b, 89 | size = distance 90 | ), 91 | alpha = 0.5, 92 | curvature = 0.2, 93 | colour = "black" 94 | ) + 95 | scale_size_continuous( 96 | name = "Spatial closeness", 97 | range = c(5, 0.5) 98 | ) + 99 | geom_sf( 100 | data = region_centers, 101 | mapping = aes( 102 | colour = NAME 103 | ), 104 | fill = NA, size = 16 105 | ) + 106 | theme_bw() + 107 | coord_sf( 108 | xlim = xlimit, ylim = ylimit, 109 | crs = st_crs("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 110 | ) + 111 | theme( 112 | plot.title = element_text(size = 30, face = "bold"), 113 | legend.position = "bottom", 114 | legend.title = element_text(size = 20, face = "bold"), 115 | # axis.title = element_blank(), 116 | axis.text = element_text(size = 15), 117 | legend.text = element_text(size = 20), 118 | panel.grid.major = element_line(colour = "black", size = 0.3) 119 | ) + 120 | guides( 121 | colour = FALSE, 122 | shape = FALSE 123 | ) + 124 | xlab("") + 125 | ylab("") + 126 | scale_color_manual( 127 | values = c( 128 | "cremation" = "#D55E00", 129 | "inhumation" = "#0072B2", 130 | "mound" = "#CC79A7", 131 | "flat" = "#009E73", 132 | "unknown" = "darkgrey", 133 | region_colors 134 | ), 135 | breaks = region_order, 136 | labels = region_order 137 | ) 138 | 139 | hu %>% 140 | ggsave( 141 | "figures_plots/general_maps/general_map_distance_network.jpeg", 142 | plot = ., 143 | device = "jpeg", 144 | scale = 1, 145 | dpi = 300, 146 | width = 350, height = 320, units = "mm", 147 | limitsize = F 148 | ) 149 | -------------------------------------------------------------------------------- /R/simulation/sed/600_multiple_simulation_sed_vs_spatial_distance_spearman.R: -------------------------------------------------------------------------------- 1 | library(magrittr) 2 | 3 | load("data_simulation/sed_simulation_mantel_sed_spatial.RData") 4 | mantel_simulations <- mantel_test_results %>% dplyr::mutate(model_id = as.integer(model_id)) 5 | load("data_simulation/sed_simulation_model_grid.RData") 6 | mantel_simulations %<>% dplyr::left_join(models_grid[, c("model_id", "model_group")], by = "model_id") 7 | load("data_analysis/mantel_sed_spatial_burial_type.RData") 8 | mantel_burial_type <- mantel_test_results 9 | load("data_analysis/mantel_sed_spatial_burial_construction.RData") 10 | mantel_burial_construction <- mantel_test_results 11 | 12 | mantel_burial_type %<>% 13 | dplyr::mutate( 14 | context = "burial_type" 15 | ) 16 | 17 | mantel_burial_construction %<>% 18 | dplyr::mutate( 19 | context = "burial_construction" 20 | ) 21 | 22 | mantel_real_world <- rbind(mantel_burial_type, mantel_burial_construction) 23 | 24 | library(ggplot2) 25 | 26 | plot_mantel <- function(title, mantel_simulations, mantel_real_world) { 27 | ju <- ggplot() + 28 | geom_hline( 29 | yintercept = 0, 30 | colour = "red", 31 | size = 2 32 | ) + 33 | geom_line( 34 | data = mantel_simulations, 35 | mapping = aes( 36 | x = time, 37 | y = statistic, 38 | group = model_id 39 | ), 40 | position = position_nudge(x = -0.25), 41 | size = 0.2, 42 | alpha = 0.2 43 | ) + 44 | geom_point( 45 | data = mantel_simulations, 46 | mapping = aes( 47 | x = time, 48 | y = statistic 49 | ), 50 | position = position_nudge(x = -0.25), 51 | size = 1 52 | ) + 53 | geom_point( 54 | data = mantel_real_world, 55 | mapping = aes( 56 | x = time, 57 | y = statistic, 58 | colour = context 59 | ), 60 | position = position_nudge(x = -0.25), 61 | size = 6 62 | ) + 63 | geom_line( 64 | data = mantel_real_world, 65 | mapping = aes( 66 | x = time, 67 | y = statistic, 68 | colour = context, 69 | group = context 70 | ), 71 | position = position_nudge(x = -0.25), 72 | size = 0.7 73 | ) + 74 | geom_boxplot( 75 | data = mantel_simulations, 76 | mapping = aes( 77 | x = time, 78 | y = statistic 79 | ), 80 | width = 0.2 81 | ) + 82 | geom_dotplot( 83 | data = mantel_simulations, 84 | mapping = aes( 85 | x = time, 86 | y = statistic, 87 | fill = base::cut( 88 | signif, 89 | breaks = c(0, 0.01, 0.05, 0.1, seq(0.2, 1, 0.1)), 90 | labels = c("< 0.01", "< 0.05", "< 0.1", rep("> 0.1", 9)) 91 | ) 92 | ), 93 | binaxis = "y", 94 | stackdir = "down", 95 | position = position_nudge(x = -0.4), 96 | dotsize = 0.5, 97 | binpositions = "all", 98 | method = "histodot", 99 | binwidth = 0.025 100 | ) + 101 | scale_fill_manual( 102 | name = "Mantel test significance level of simulation runs", 103 | values = c( 104 | "< 0.01" = "#800026", 105 | "< 0.05" = "#e31a1c", 106 | "< 0.1" = "#fd8d3c", 107 | "> 0.1" = "white" 108 | ) 109 | ) + 110 | scale_colour_manual( 111 | name = "Real world context", 112 | values = c( 113 | "burial_type" = "#0072B2", 114 | "burial_construction" = "#009E73" 115 | ) 116 | ) + 117 | theme_bw() + 118 | theme( 119 | legend.position = "bottom", 120 | axis.text = element_text(size = 15, angle = 45, hjust = 1), 121 | axis.title = element_text(size = 15), 122 | strip.text.x = element_text(size = 13), 123 | legend.title = element_text(size = 15, face = "bold"), 124 | legend.text = element_text(size = 15), 125 | legend.box = "vertical" 126 | ) + 127 | ylab("Spearman's rank correlation coefficient") + 128 | xlab("time blocks calBC") + 129 | ylim(c(-0.6, 0.75)) 130 | 131 | ju %>% 132 | ggsave( 133 | paste0("figures_plots/sed_simulation/", title, ".jpeg"), 134 | plot = ., 135 | device = "jpeg", 136 | scale = 1, 137 | dpi = 300, 138 | width = 300, height = 300, units = "mm", 139 | limitsize = F 140 | ) 141 | } 142 | 143 | variants <- c( 144 | "low equal interaction", 145 | "low spatial interaction", 146 | "high equal interaction", 147 | "high spatial interaction" 148 | ) %>% lapply( 149 | function(variant) { 150 | plot_mantel( 151 | variant %>% gsub(" ", "_", .), 152 | mantel_simulations %>% dplyr::filter(model_group == variant), 153 | mantel_real_world 154 | ) 155 | } 156 | ) 157 | 158 | 159 | -------------------------------------------------------------------------------- /R/real_world_data_preparation/460_calculate_proportions_timeseries.R: -------------------------------------------------------------------------------- 1 | load("data_analysis/dates_probability_per_year_and_region_list.RData") 2 | 3 | #### calculate per year, per region distribution of ideas #### 4 | 5 | # helper function 6 | fncols <- function(data, cname) { 7 | add <- cname[!cname %in% names(data)] 8 | if (length(add) != 0) {data[add] <- NA_real_} 9 | return(data) 10 | } 11 | 12 | # main loop 13 | proportion_per_region <- dates_probability_per_year_and_region_list %>% 14 | # apply per region data.frame 15 | pbapply::pblapply(function(x) { 16 | 17 | # in case of empty regions or regions with only unknown graves: NULL 18 | if (nrow(x) == 0 | 19 | (all(x$burial_type == "unknown") & 20 | all(x$burial_construction == "unknown"))) 21 | { 22 | 23 | res <- NULL 24 | 25 | # in case of unempty regions 26 | } else { 27 | 28 | #### burial_type: cremation vs. inhumation #### 29 | 30 | bt_basic <- x %>% 31 | dplyr::filter( 32 | burial_type != "unknown" 33 | ) 34 | 35 | if (nrow(bt_basic) == 0) { 36 | bt <- tibble::tibble( 37 | region_name = character(), 38 | age = integer(), 39 | cremation = double(), 40 | inhumation = double() 41 | ) 42 | } else { 43 | bt <- bt_basic %>% 44 | dplyr::group_by(age, burial_type) %>% 45 | dplyr::summarise( 46 | count = n(), region_name = .$region_name[1] 47 | ) %>% 48 | tidyr::spread( 49 | key = burial_type, value = count 50 | ) %>% 51 | fncols(c("cremation", "inhumation")) %>% 52 | dplyr::mutate_all(dplyr::funs(replace(., is.na(.), 0))) %>% 53 | dplyr::mutate( 54 | cremation = cremation/(cremation + inhumation) 55 | ) %>% 56 | dplyr::mutate( 57 | inhumation = 1 - cremation 58 | ) %>% 59 | dplyr::ungroup() 60 | } 61 | 62 | #### burial_type: mound vs. flat #### 63 | 64 | bc_basic <- x %>% 65 | dplyr::filter( 66 | burial_construction != "unknown" 67 | ) 68 | 69 | if (nrow(bc_basic) == 0) { 70 | bc <- tibble::tibble( 71 | region_name = character(), 72 | age = integer(), 73 | mound = double(), 74 | flat = double() 75 | ) 76 | } else { 77 | bc <- bc_basic %>% 78 | dplyr::group_by(age, burial_construction) %>% 79 | dplyr::summarise( 80 | count = n(), region_name = .$region_name[1] 81 | ) %>% 82 | tidyr::spread( 83 | key = burial_construction, value = count 84 | ) %>% 85 | fncols(c("mound", "flat")) %>% 86 | dplyr::mutate_all(dplyr::funs(replace(., is.na(.), 0))) %>% 87 | dplyr::mutate( 88 | mound = mound/(mound + flat) 89 | ) %>% 90 | dplyr::mutate( 91 | flat = 1 - mound 92 | ) %>% 93 | dplyr::ungroup() 94 | } 95 | 96 | # combine final result 97 | 98 | res <- dplyr::full_join( 99 | bt, bc, by = c("age", "region_name") 100 | ) %>% 101 | dplyr::mutate_all(dplyr::funs(replace(., is.na(.), 0))) 102 | 103 | } 104 | 105 | # complete result with 0 for years without information 106 | if (nrow(res) < 1401) { 107 | missing_ages <- c(-2200:-800)[!(c(-2200:-800) %in% res$age)] 108 | res <- rbind( 109 | res, 110 | tibble::tibble( 111 | region_name = res$region_name[1], 112 | age = missing_ages, 113 | cremation = 0, 114 | inhumation = 0, 115 | mound = 0, 116 | flat = 0 117 | ) 118 | ) 119 | } 120 | 121 | return(res) 122 | }) 123 | 124 | # merge per region information and transform to tall data.frame 125 | proportion_per_region_df <- proportion_per_region %>% 126 | do.call(rbind, .) %>% 127 | dplyr::rename( 128 | "timestep" = "age" 129 | ) %>% 130 | tidyr::gather( 131 | idea, proportion, -timestep, -region_name 132 | ) %>% 133 | dplyr::select( 134 | region_name, timestep, idea, proportion 135 | ) 136 | 137 | proportion_development_burial_type <- proportion_per_region_df %>% 138 | dplyr::filter(idea %in% c("cremation", "inhumation")) 139 | 140 | save( 141 | proportion_development_burial_type, 142 | file = "data_analysis/development_proportions_burial_type.RData" 143 | ) 144 | 145 | proportion_development_burial_construction <- proportion_per_region_df %>% 146 | dplyr::filter(idea %in% c("flat", "mound")) 147 | 148 | save( 149 | proportion_development_burial_construction, 150 | file = "data_analysis/development_proportions_burial_construction.RData" 151 | ) 152 | 153 | -------------------------------------------------------------------------------- /data_manually_prepared/bronze_age_chronology.csv: -------------------------------------------------------------------------------- 1 | reference,context_general,sub_context,unit_general,unit_name,start_date_pre,start_date,end_date,end_date_post 2 | Reinecke et al,Central Europe,,Neolithic,Neolithic,,-2500,-2150, 3 | Reinecke et al,Central Europe,,Early Bronze Age,Bz A1,,-2150,-2000, 4 | Reinecke et al,Central Europe,,Early Bronze Age,Bz A2,,-2000,-1580, 5 | Reinecke et al,Central Europe,,Middle Bronze Age,Bz B,,-1580,-1480, 6 | Reinecke et al,Central Europe,,Middle Bronze Age,Bz C1,,-1480,-1420, 7 | Reinecke et al,Central Europe,,Middle Bronze Age,Bz C2,,-1420,-1320, 8 | Reinecke et al,Central Europe,,Late Bronze Age,Bz D,,-1320,-1200, 9 | Reinecke et al,Central Europe,,Late Bronze Age,Ha A1,,-1200,-1120, 10 | Reinecke et al,Central Europe,,Late Bronze Age,Ha A2,,-1120,-1020, 11 | Reinecke et al,Central Europe,,Late Bronze Age,Ha B1,,-1020,-930, 12 | Reinecke et al,Central Europe,,Late Bronze Age,Ha B2/3,,-930,-800, 13 | Reinecke et al,Central Europe,,Iron Age,Iron Age,,-800,-700, 14 | Hatt,France,Central/Eastern France,Neolithic,Neolithic,,-2500,-2150, 15 | Hatt,France,Central/Eastern France,Early Bronze Age,Br. ancien I,,-2150,-1950, 16 | Hatt,France,Central/Eastern France,Early Bronze Age,Br. ancien II,,-1950,-1780, 17 | Hatt,France,Central/Eastern France,Early Bronze Age,Br. ancien III,,-1780,-1580, 18 | Hatt,France,Central/Eastern France,Middle Bronze Age,Br. moyen I,,-1580,-1450, 19 | Hatt,France,Central/Eastern France,Middle Bronze Age,Br. moyen II,,-1450,-1380, 20 | Hatt,France,Central/Eastern France,Middle Bronze Age,Br. moyen III,,-1380,-1300, 21 | Hatt,France,Central/Eastern France,Late Bronze Age,Br. final I,,-1300,-1200, 22 | Hatt,France,Central/Eastern France,Late Bronze Age,Br. final IIa,,-1200,-1120, 23 | Hatt,France,Central/Eastern France,Late Bronze Age,Br. final IIb,,-1120,-1020, 24 | Hatt,France,Central/Eastern France,Late Bronze Age,Br. final IIIa,,-1020,-950, 25 | Hatt,France,Central/Eastern France,Late Bronze Age,Br. final IIIb,,-950,-800, 26 | Hatt,France,Central/Eastern France,Iron Age,Iron Age,,-800,-700, 27 | Needham,Britain,Periods,Neolithic,Neolithic,,-2500,-2450, 28 | Needham,Britain,Periods,Chalcolithic,Period 1,,-2450,-2200,-2150 29 | Needham,Britain,Periods,Early Bronze Age,Period 2,-2200,-2150,-1950, 30 | Needham,Britain,Periods,Early Bronze Age,Period 3,,-1950,-1750,-1700 31 | Needham,Britain,Periods,Early Bronze Age,Period 4,-1750,-1700,-1550,-1500 32 | Needham,Britain,Periods,Middle Bronze Age,Period 5,-1550,-1500,-1140,-1100 33 | Needham,Britain,Periods,Late Bronze Age,Period 6,-1140,-1100,-950,-920 34 | Needham,Britain,Periods,Late Bronze Age,Period 7,-950,-920,-780, 35 | Needham,Britain,Periods,Iron Age,Iron Age,,-780,-700, 36 | Briard,France,Northwest/Atlantic France,Neolithic,Neolithic,,-2500,-1950, 37 | Briard,France,Northwest/Atlantic France,Early Bronze Age,Br. ancien I,,-1950,-1580, 38 | Briard,France,Northwest/Atlantic France,Middle Bronze Age,Br. moyen I, ,-1580,-1420, 39 | Briard,France,Northwest/Atlantic France,Middle Bronze Age,Br. moyen II,,-1420,-1300, 40 | Briard,France,Northwest/Atlantic France,Late Bronze Age,Br. final I,,-1300,-1120, 41 | Briard,France,Northwest/Atlantic France,Late Bronze Age,Br. final II,,-1120,-950, 42 | Briard,France,Northwest/Atlantic France,Late Bronze Age,Br. final III,,-950,-800, 43 | Briard,France,Northwest/Atlantic France,Iron Age,Iron Age,,-800,-700, 44 | Lanting / Van der Pflicht,Netherlands,C14,Neolithic,Neolithic,,-2500,-2020, 45 | Lanting / Van der Pflicht,Netherlands,C14,Early Bronze Age,Early BA,,-2020,-1580, 46 | Lanting / Van der Pflicht,Netherlands,C14,Middle Bronze Age,Middle BA,,-1580,-1220, 47 | Lanting / Van der Pflicht,Netherlands,C14,Late Bronze Age,Late BA,,-1220,-800, 48 | Lanting / Van der Pflicht,Netherlands,C14,Iron Age,Iron Age,,-800,-700, 49 | PoNL,Netherlands,traditional,Neolithic,Neolithic,,-2500,-2020, 50 | PoNL,Netherlands,traditional,Early Bronze Age,EBA,,-2020,-1800, 51 | PoNL,Netherlands,traditional,Middle Bronze Age,MBA A,,-1800,-1500, 52 | PoNL,Netherlands,traditional,Middle Bronze Age,MBA B,,-1500,-1100, 53 | PoNL,Netherlands,traditional,Late Bronze Age,LBA,,-1100,-800, 54 | PoNL,Netherlands,traditional,Iron Age,Iron Age,,-800,-700, 55 | De Laet,Belgium,,Neolithic,Neolithic,,-2500,-2020, 56 | De Laet,Belgium,,Early Bronze Age,EBA,,-2020,-1800, 57 | De Laet,Belgium,,Middle Bronze Age,MBA,,-1800,-1100, 58 | De Laet,Belgium,,Late Bronze Age,LBA,,-1100,-800, 59 | De Laet,Belgium,,Iron Age,Iron Age,,-800,-700, 60 | Eogan,Irland,,Neolithic,Neolithic,,-2500,-2450, 61 | Eogan,Irland,,Chalcolithic,Knocknagur,,-2450,-2130, 62 | Eogan,Irland,,Early Bronze Age,Killaha,,-2130,-1930, 63 | Eogan,Irland,,Early Bronze Age,Ballyvally,,-1930,-1730, 64 | Eogan,Irland,,Early Bronze Age,Derryniggin,,-1730,-1500, 65 | Eogan,Irland,,Middle Bronze Age,Killymaddy,,-1500,-1400, 66 | Eogan,Irland,,Middle Bronze Age,Bishopsland,,-1400,-1160,-1140 67 | Eogan,Irland,,Late Bronze Age,Roscommon,-1160,-1140,-930, 68 | Eogan,Irland,,Late Bronze Age,Dowris A,,-930,-800, 69 | Eogan,Irland,,Iron Age,Iron Age,,-800,-700, 70 | Needham,Britain,,Neolithic,Neolithic,,-2500,-2450, 71 | Needham,Britain,,Chalcolithic,MA I/II,,-2450,-2130, 72 | Needham,Britain,,Early Bronze Age,MA III,,-2130,-1950, 73 | Needham,Britain,,Early Bronze Age,MA IV ,,-1950,-1880, 74 | Needham,Britain,,Early Bronze Age,MA V ,,-1880,-1730, 75 | Needham,Britain,,Early Bronze Age,MA VI ,,-1730,-1500, 76 | Needham,Britain,,Middle Bronze Age,Acton 2,,-1500,-1400, 77 | Needham,Britain,,Middle Bronze Age,Taunton,,-1400,-1270,-1250 78 | Needham,Britain,,Middle Bronze Age,Penard,-1270,-1250,-1150,-1130 79 | Needham,Britain,,Late Bronze Age,Wilburton,-1150,-1130,-1020,-970 80 | Needham,Britain,,Late Bronze Age,Blackmoor,-1020,-970,-930,-900 81 | Needham,Britain,,Late Bronze Age,Ewart Park,-930,-900,-800, 82 | Needham,Britain,,Iron Age,Iron Age,,-800,-700, 83 | Montelius,Scandinavia,,Neolithic,Neolithic,,-2500,-1780, 84 | Montelius,Scandinavia,,Early Bronze Age,Per. IA,,-1780,-1580, 85 | Montelius,Scandinavia,,Early Bronze Age,Per. IB,,-1580,-1480, 86 | Montelius,Scandinavia,,Early Bronze Age,Per. II,,-1480,-1320, 87 | Montelius,Scandinavia,,Early Bronze Age,Per. III,,-1320,-1120, 88 | Montelius,Scandinavia,,Late Bronze Age,Per. IV,,-1120,-920, 89 | Montelius,Scandinavia,,Late Bronze Age,Per. V,,-920,-750, 90 | Montelius,Scandinavia,,Iron Age,Iron Age,,-750,-700, 91 | Carozza/Marcigny/Talon,France,,Neolithic,Neolithic,,-2500,-2300, 92 | Carozza/Marcigny/Talon,France,,Early Bronze Age,Br. ancien I,,-2300,-1800, 93 | Carozza/Marcigny/Talon,France,,Early Bronze Age,Br. ancien II,,-1800,-1600, 94 | Carozza/Marcigny/Talon,France,,Middle Bronze Age,Br. moyen I,,-1600,-1500, 95 | Carozza/Marcigny/Talon,France,,Middle Bronze Age,Br. moyen II,,-1500,-1350, 96 | Carozza/Marcigny/Talon,France,,Late Bronze Age,Br. final I,,-1350,-1250, 97 | Carozza/Marcigny/Talon,France,,Late Bronze Age,Br. final IIa,,-1250,-1150, 98 | Carozza/Marcigny/Talon,France,,Late Bronze Age,Br. final IIb,,-1150,-1050, 99 | Carozza/Marcigny/Talon,France,,Late Bronze Age,Br. final IIIa,,-1050,-950, 100 | Carozza/Marcigny/Talon,France,,Late Bronze Age,Br. final IIIb,,-950,-800, 101 | Carozza/Marcigny/Talon,France,,Iron Age,Iron Age,,-800,-700, 102 | Hawkes/Burgess/Gerloff,Britain,,Neolithic,Neolithic,,-2500,-2130, 103 | Hawkes/Burgess/Gerloff,Britain,,Early Bronze Age,EBA 1,,-2130,-1930, 104 | Hawkes/Burgess/Gerloff,Britain,,Early Bronze Age,EBA 2,,-1930,-1730, 105 | Hawkes/Burgess/Gerloff,Britain,,Early Bronze Age,EBA 3,,-1730,-1520, 106 | Hawkes/Burgess/Gerloff,Britain,,Middle Bronze Age,MBA 1,,-1520,-1400, 107 | Hawkes/Burgess/Gerloff,Britain,,Middle Bronze Age,MBA 2,,-1400,-1300, 108 | Hawkes/Burgess/Gerloff,Britain,,Middle Bronze Age,MBA 3,,-1300,-1170, 109 | Hawkes/Burgess/Gerloff,Britain,,Late Bronze Age,LBA 1,,-1170,-1050, 110 | Hawkes/Burgess/Gerloff,Britain,,Late Bronze Age,LBA 1-2,,-1050,-970, 111 | Hawkes/Burgess/Gerloff,Britain,,Late Bronze Age,LBA 2,,-970,-800, 112 | Hawkes/Burgess/Gerloff,Britain,,Late Bronze Age,LBA 3,,-800,-780, 113 | Hawkes/Burgess/Gerloff,Britain,,Iron Age,Iron Age,,-780,-700, 114 | -------------------------------------------------------------------------------- /R/real_world_data_preparation/100_prepare_c14_data.R: -------------------------------------------------------------------------------- 1 | library(magrittr) 2 | 3 | #### set constants #### 4 | 5 | # birth of libby 6 | bol <- 1950 7 | # 2sigma range probability threshold 8 | threshold <- (1 - 0.9545) / 2 9 | 10 | 11 | 12 | #### data download #### 13 | 14 | radonb <- c14bazAAR::get_RADONB() 15 | 16 | save(radonb, file = "data_analysis/radonb.RData") 17 | 18 | 19 | 20 | #### calibration #### 21 | 22 | load("data_analysis/radonb.RData") 23 | 24 | bronze <- radonb %>% 25 | tibble::as.tibble() %>% 26 | # remove dates without age 27 | dplyr::filter(!is.na(c14age) & !is.na(c14std)) %>% 28 | # remove dates outside of theoretical calibration range 29 | dplyr::filter(!(c14age < 71) & !(c14age > 46401)) 30 | 31 | bronze <- bronze %>% 32 | dplyr::mutate( 33 | # add list column with the age density distribution for every date 34 | calage_density_distribution = Bchron::BchronCalibrate( 35 | ages = bronze$c14age, 36 | ageSds = bronze$c14std, 37 | calCurves = rep("intcal13", nrow(bronze)), 38 | eps = 1e-06 39 | ) %>% 40 | # transform BchronCalibrate result to a informative tibble 41 | # this tibble includes the years, the density per year, 42 | # the normalized density per year and the information, 43 | # if this year is in the two_sigma range for the current date 44 | pbapply::pblapply( 45 | function(x) { 46 | x$densities %>% cumsum -> a # cumulated density 47 | bottom <- x$ageGrid[which(a <= threshold) %>% max] 48 | top <- x$ageGrid[which(a > 1-threshold) %>% min] 49 | tibble::tibble( 50 | age = x$ageGrid, 51 | dens_dist = x$densities, 52 | norm_dens = x$densities/max(x$densities), 53 | two_sigma = x$ageGrid >= bottom & x$ageGrid <= top 54 | ) 55 | } 56 | ) 57 | ) 58 | 59 | 60 | 61 | #### transform calBP age to calBC #### 62 | 63 | bronze$calage_density_distribution %<>% lapply( 64 | function(x) { 65 | x$age = -x$age + bol 66 | return(x) 67 | } 68 | ) 69 | 70 | save(bronze, file = "data_analysis/bronze.RData") 71 | 72 | # plot to check the calibration result 73 | # library(ggplot2) 74 | # bronze$calage_density_distribution[[3]] %>% 75 | # ggplot() + 76 | # geom_point(aes(age, norm_dens, color = two_sigma)) 77 | 78 | 79 | 80 | #### filter time #### 81 | 82 | load("data_analysis/bronze.RData") 83 | 84 | # add artifical id 85 | bronze <- bronze %>% 86 | dplyr::mutate( 87 | id = 1:nrow(.) 88 | ) 89 | 90 | # filter dates to only include dates in in time range of interest 91 | bronze0 <- bronze %>% 92 | dplyr::mutate( 93 | in_time_of_interest = 94 | purrr::map(calage_density_distribution, function(x){ 95 | any( 96 | x$age >= -2200 & 97 | x$age <= -800 & 98 | x$two_sigma 99 | ) 100 | } 101 | ) 102 | ) %>% 103 | dplyr::filter( 104 | in_time_of_interest == TRUE 105 | ) %>% 106 | dplyr::select(-in_time_of_interest) 107 | 108 | save(bronze0, file = "data_analysis/bronze0.RData") 109 | 110 | 111 | 112 | #### filter research question #### 113 | 114 | load("data_analysis/bronze0.RData") 115 | 116 | bronze05 <- bronze0 %>% 117 | # reduce variable selection to necessary information 118 | dplyr::select( 119 | -sourcedb, -c13val, -country, -shortref 120 | ) %>% 121 | # filter by relevant sitetypes 122 | dplyr::filter( 123 | sitetype %in% c( 124 | "Grave", "Grave (mound)", "Grave (flat) inhumation", 125 | "Grave (cremation)", "Grave (inhumation)", "Grave (mound) cremation", 126 | "Grave (mound) inhumation", "Grave (flat) cremation", "Grave (flat)", 127 | "cemetery" 128 | ) 129 | ) %>% 130 | # transform sitetype field to tidy data about burial_type and burial_construction 131 | dplyr::mutate( 132 | burial_type = ifelse( 133 | grepl("cremation", sitetype), "cremation", 134 | ifelse( 135 | grepl("inhumation", sitetype), "inhumation", 136 | "unknown" 137 | ) 138 | ), 139 | burial_construction = ifelse( 140 | grepl("mound", sitetype), "mound", 141 | ifelse( 142 | grepl("flat", sitetype), "flat", 143 | "unknown" 144 | ) 145 | ) 146 | ) %>% 147 | # reduce variable selection to necessary information 148 | dplyr::select( 149 | -sitetype 150 | ) 151 | 152 | save(bronze05, file = "data_analysis/bronze05.RData") 153 | 154 | 155 | 156 | #### remove dates without coordinates #### 157 | 158 | load("data_analysis/bronze05.RData") 159 | 160 | bronze1 <- bronze05 %>% dplyr::filter( 161 | !is.na(lat) & !is.na(lon) 162 | ) 163 | 164 | save(bronze1, file = "data_analysis/bronze1.RData") 165 | 166 | 167 | 168 | #### crop date selection to research area #### 169 | 170 | load("data_analysis/bronze1.RData") 171 | load("data_analysis/research_area.RData") 172 | 173 | # transform data to sf and the correct CRS 174 | bronze12 <- bronze1 %>% sf::st_as_sf(coords = c("lon", "lat")) 175 | sf::st_crs(bronze12) <- 4326 176 | bronze12 %<>% sf::st_transform("+proj=aea +lat_1=43 +lat_2=62 +lat_0=30 +lon_0=10 +x_0=0 +y_0=0 +ellps=intl +units=m +no_defs") 177 | 178 | # get dates within research area 179 | bronze15 <- sf::st_intersection(bronze12, research_area) %>% 180 | sf::st_set_geometry(NULL) %>% 181 | dplyr::select(-id.1) 182 | 183 | # add lon and lat columns again 184 | bronze15 %<>% 185 | dplyr::left_join( 186 | bronze1[, c("id", "lat", "lon")] 187 | ) 188 | 189 | save(bronze15, file = "data_analysis/bronze15.RData") 190 | 191 | 192 | 193 | #### remove labnr duplicates #### 194 | 195 | load("data_analysis/bronze15.RData") 196 | 197 | # identify dates without correct labnr 198 | ids_incomplete_labnrs <- bronze15$id[grepl('n/a', bronze15$labnr)] 199 | 200 | # remove labnr duplicates, except for those with incorrect labnrs 201 | duplicates_removed_bronze15_ids <- bronze15 %>% 202 | dplyr::filter( 203 | !(id %in% ids_incomplete_labnrs) 204 | ) %>% 205 | dplyr::select(-calage_density_distribution) %>% 206 | c14bazAAR::as.c14_date_list() %>% 207 | c14bazAAR::remove_duplicates() %$% 208 | id 209 | 210 | # merge removed selection with incorrect labnr selection 211 | bronze16 <- bronze15 %>% 212 | dplyr::filter( 213 | id %in% c(duplicates_removed_bronze15_ids, ids_incomplete_labnrs) 214 | ) 215 | 216 | save(bronze16, file = "data_analysis/bronze16.RData") 217 | 218 | 219 | 220 | #### merge dates of one grave #### 221 | 222 | load("data_analysis/bronze16.RData") 223 | 224 | # take a look at the dates per feature 225 | # bronze16 %>% 226 | # dplyr::group_by(site, feature) %>% 227 | # dplyr::filter(n()>1) 228 | 229 | # merge information 230 | bronze17 <- bronze16 %>% 231 | dplyr::group_by(site, feature) %>% 232 | dplyr::do(res = tibble::as_tibble(.)) %$% 233 | res %>% 234 | pbapply::pblapply(function(x){ 235 | 236 | # check if there are multiple dates for one feature and if there's 237 | # a Number the feature variable 238 | if (nrow(x) > 1 & grepl("[0-9]", x$feature[1])) { 239 | 240 | # remove list column and apply data.frame merging function 241 | res <- x %>% 242 | dplyr::select(-calage_density_distribution) %>% 243 | dplyr::group_by(site) %>% 244 | dplyr::summarise_all( 245 | .funs = dplyr::funs(c14bazAAR:::compare_and_combine_data_frame_values) 246 | ) %>% 247 | dplyr::ungroup() 248 | 249 | # combine density distribution data.frames 250 | res$calage_density_distribution <- list(x$calage_density_distribution %>% purrr::reduce( 251 | function(a, b) { 252 | dplyr::full_join(a, b, by = "age") %>% 253 | dplyr::transmute( 254 | age = age, 255 | dens_dist = purrr::map2_dbl(dens_dist.x, dens_dist.y, function(n, m){sum(n, m, na.rm = T)}), 256 | norm_dens = dens_dist/max(dens_dist), 257 | two_sigma = (two_sigma.x | two_sigma.y) %>% ifelse(is.na(.), FALSE, .) 258 | ) 259 | } 260 | )) 261 | 262 | return(res) 263 | } else { 264 | return(x) 265 | } 266 | 267 | }) %>% 268 | do.call(rbind, .) %>% 269 | # replace missing values (NA) in the major variables 270 | dplyr::mutate( 271 | burial_type = tidyr::replace_na(burial_type, "unknown"), 272 | burial_construction = tidyr::replace_na(burial_construction, "unknown") 273 | ) %>% 274 | # remove graves without coordinates 275 | dplyr::filter( 276 | !is.na(lat) & !is.na(lon) 277 | ) 278 | 279 | save(bronze17, file = "data_analysis/bronze17.RData") 280 | 281 | # compare results of group calibration with single date calibration 282 | # library(ggplot2) 283 | # ggplot() + 284 | # geom_line(data = a, mapping = aes(x = age, y = dens_dist), color = "green") + 285 | # geom_line(data = b, mapping = aes(x = age, y = dens_dist), color = "blue") + 286 | # geom_line(data = c, mapping = aes(x = age, y = dens_dist), color = "red") 287 | 288 | #### unnest dates #### 289 | 290 | load("data_analysis/bronze17.RData") 291 | 292 | # unnest calage_density_distribution to have per year information: 293 | # a diachron perspective 294 | bronze2 <- bronze17 %>% 295 | tidyr::unnest(calage_density_distribution) %>% 296 | dplyr::filter( 297 | two_sigma == TRUE 298 | ) %>% 299 | dplyr::filter( 300 | age >= -2200 & age <= -800 301 | ) %>% 302 | dplyr::arrange( 303 | desc(burial_construction) 304 | ) 305 | 306 | save(bronze2, file = "data_analysis/bronze2.RData") 307 | --------------------------------------------------------------------------------