├── 2019 ├── Week45_bike_walk │ ├── README.md │ ├── bikers_and_walkers.png │ └── 123.Rmd ├── Week46_cran │ ├── r.png │ ├── cran.png │ ├── r_log.png │ ├── test.jpeg │ ├── R_logo.png │ ├── R_logo.svg.png │ └── word_cloud.R ├── Week50_diseases │ ├── measles.gif │ ├── measles_mp4.mp4 │ └── diseases.R ├── Week41_Power_lifting │ ├── Max_lift.jpeg │ ├── README.md │ ├── max ever lifted.Rmd │ └── ipf.R ├── Week47_nz_birds │ ├── nz_bird_vote.png │ └── nz_birds.Rmd ├── Week49_parking_tickets │ ├── .DS_Store │ ├── Philly3.dbf │ ├── Philly3.shp │ ├── Philly3.shx │ ├── parking_tickets.png │ ├── parking_tickets_hours.png │ ├── Philly3.prj │ └── parking_tickets.R ├── 1_Week38_Number of Visitors │ ├── sun.png │ ├── cloud.png │ ├── stickman.png │ ├── National_Parks.png │ ├── README.md │ └── National Parks.R ├── Week51_adopted_dogs │ ├── total_breed.png │ ├── assets │ │ ├── ionicons.ttf │ │ ├── FontAwesome.otf │ │ └── academicons.ttf │ └── adopted_dogs.R ├── 2_Week39_SchoolDiversity │ ├── Ethnic_div.png │ ├── Ethnic_div_revised.png │ ├── School_Diversity.R │ └── School_Diversity_Updated.R ├── Week53_tidytuesday_tweets │ ├── mydata.RData │ └── tidytuesday_tweets.R ├── Week40_All the Pizza │ ├── Barstool_rating.png │ ├── README.md │ ├── BarstoolPizza.R │ └── Barstool_Top_2_Percent.R ├── Week43_Horror_Films │ ├── horror_movie_length.png │ ├── horror_for_blog_cache │ │ └── html │ │ │ ├── __packages │ │ │ ├── unnamed-chunk-1_3811b5e91d57400d166c352b3c42d1db.rdb │ │ │ ├── unnamed-chunk-1_3811b5e91d57400d166c352b3c42d1db.rdx │ │ │ └── unnamed-chunk-1_3811b5e91d57400d166c352b3c42d1db.RData │ ├── Horror_dis.R │ ├── horror_for_blog.Rmd │ └── horror_films.R ├── Week44_NYC_Squerrils │ ├── Central_park_squirrel.png │ └── Squirrels.Rmd └── Week42_Cars │ └── Cars.R ├── 2020 ├── week17_gdpr │ ├── hc.gif │ ├── lib │ │ ├── highcharts-7.0.1 │ │ │ ├── modules │ │ │ │ ├── overlapping-datalabels.js │ │ │ │ ├── streamgraph.js │ │ │ │ ├── full-screen.js │ │ │ │ ├── arrow-symbols.js │ │ │ │ ├── current-date-indicator.js │ │ │ │ ├── static-scale.js │ │ │ │ ├── price-indicator.js │ │ │ │ ├── oldie-polyfills.js │ │ │ │ ├── item-series.js │ │ │ │ ├── no-data-to-display.js │ │ │ │ ├── pareto.js │ │ │ │ ├── vector.js │ │ │ │ ├── bullet.js │ │ │ │ ├── funnel.js │ │ │ │ ├── cylinder.js │ │ │ │ ├── variwide.js │ │ │ │ ├── variable-pie.js │ │ │ │ ├── solid-gauge.js │ │ │ │ ├── histogram-bellcurve.js │ │ │ │ ├── drag-panes.js │ │ │ │ ├── windbarb.js │ │ │ │ ├── parallel-coordinates.js │ │ │ │ └── broken-axis.js │ │ │ ├── custom │ │ │ │ ├── reset.js │ │ │ │ ├── symbols-extra.js │ │ │ │ └── text-symbols.js │ │ │ ├── css │ │ │ │ └── motion.css │ │ │ └── plugins │ │ │ │ ├── tooltip-delay.js │ │ │ │ └── draggable-legend.js │ │ └── highchart-binding-0.7.0 │ │ │ └── highchart.js │ └── gdpr.R ├── week25-slavery.zip ├── week10_nhl │ ├── tt_nhl.gif │ ├── rsconnect │ │ ├── shinyapps.io │ │ │ └── amit-levinson │ │ │ │ └── nhl_df.dcf │ │ └── documents │ │ │ ├── knit.Rmd │ │ │ └── shinyapps.io │ │ │ │ └── amit-levinson │ │ │ │ ├── knit.dcf │ │ │ │ └── nhl_df.dcf │ │ │ └── nhl.Rmd │ │ │ └── shinyapps.io │ │ │ └── amit-levinson │ │ │ ├── Tidytuesday_nhl.dcf │ │ │ └── tidytuesday_week_10_nhl.dcf │ └── nhl.Rmd ├── week20_volcano │ ├── vc.png │ ├── vc2.png │ └── week20_volcano.R ├── week_40_b_t │ ├── note.png │ ├── week40.png │ ├── p_files │ │ ├── wordcloud2-0.0.1 │ │ │ └── wordcloud.css │ │ └── wordcloud2-binding-0.2.2 │ │ │ └── wordcloud2.js │ └── week40_beyonce-swift.R ├── week_41 │ ├── ball_plot.png │ └── week41_ncaa.R ├── week16_rapartists │ ├── rap.pdf │ ├── rap_points.png │ └── rapartists.R ├── week19_ac │ ├── animal_cross.png │ └── week10-ac.Rmd ├── week23_marble-races │ ├── mr.png │ └── marble-races.Rmd ├── week18_broadway │ └── broadway.gif ├── week51_ninja │ ├── week51_ninja.png │ └── ninja_warriors.R ├── week12_theoffice │ ├── tt_schrute.png │ └── the_office.R ├── week4_spotify_songs │ ├── spotify.png │ └── spotify_songs.R ├── week53_tweetdata │ ├── data_2020.png │ └── tweet_2020.R ├── week30-aus_animals │ ├── animal-aus.png │ └── animal-aus-line.png ├── week25-slavery │ ├── tt-week25-slaves.gif │ ├── week25-slavery.Rmd │ └── shiny-app │ │ └── app.R ├── week24-awards │ └── week24.Rmd ├── week29_astronaut │ └── week25_astronaut.R ├── week27-xmen │ └── week27-xmen.R ├── week13_tbi │ └── week13_tbi.R ├── week31_penguins │ └── week31_penguins.R ├── week11_college │ └── trial.R └── week14_beer_production │ └── beer_state.R ├── 2021 ├── week6_hbcu │ ├── hbcu.png │ └── hbcu.R ├── week29_scoobydoo │ ├── sd.png │ └── sd.R ├── week4_rkenya │ ├── rkenya.png │ └── rkenya.R ├── week3_tate │ └── Tate-artists.gif ├── week10_superbowl │ ├── superbowl.png │ └── superbowl.R ├── week2_transit-cost │ └── transit_cost.R ├── week18_ceo │ └── ceo.R └── week12_steam │ └── steam.R ├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ └── render-plot.yaml ├── extra ├── maps │ ├── County.dbf │ ├── County.sbn │ ├── County.sbx │ ├── County.shp │ ├── County.shx │ └── County.prj ├── packages-used.png └── packages-plot.R └── .gitignore /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^\.github$ 2 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /2019/Week45_bike_walk/README.md: -------------------------------------------------------------------------------- 1 | a Line i wrote >> README.md 2 | echo a Line i wrote 3 | -------------------------------------------------------------------------------- /extra/maps/County.dbf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/extra/maps/County.dbf -------------------------------------------------------------------------------- /extra/maps/County.sbn: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/extra/maps/County.sbn -------------------------------------------------------------------------------- /extra/maps/County.sbx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/extra/maps/County.sbx -------------------------------------------------------------------------------- /extra/maps/County.shp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/extra/maps/County.shp -------------------------------------------------------------------------------- /extra/maps/County.shx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/extra/maps/County.shx -------------------------------------------------------------------------------- /2019/Week46_cran/r.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week46_cran/r.png -------------------------------------------------------------------------------- /2020/week17_gdpr/hc.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week17_gdpr/hc.gif -------------------------------------------------------------------------------- /2020/week25-slavery.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week25-slavery.zip -------------------------------------------------------------------------------- /2021/week6_hbcu/hbcu.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2021/week6_hbcu/hbcu.png -------------------------------------------------------------------------------- /extra/packages-used.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/extra/packages-used.png -------------------------------------------------------------------------------- /2019/Week46_cran/cran.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week46_cran/cran.png -------------------------------------------------------------------------------- /2019/Week46_cran/r_log.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week46_cran/r_log.png -------------------------------------------------------------------------------- /2019/Week46_cran/test.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week46_cran/test.jpeg -------------------------------------------------------------------------------- /2020/week10_nhl/tt_nhl.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week10_nhl/tt_nhl.gif -------------------------------------------------------------------------------- /2020/week20_volcano/vc.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week20_volcano/vc.png -------------------------------------------------------------------------------- /2020/week_40_b_t/note.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week_40_b_t/note.png -------------------------------------------------------------------------------- /2020/week_41/ball_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week_41/ball_plot.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | *.Rproj 6 | .here 7 | README.Rmd 8 | extra/images/ -------------------------------------------------------------------------------- /2019/Week46_cran/R_logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week46_cran/R_logo.png -------------------------------------------------------------------------------- /2020/week20_volcano/vc2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week20_volcano/vc2.png -------------------------------------------------------------------------------- /2020/week_40_b_t/week40.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week_40_b_t/week40.png -------------------------------------------------------------------------------- /2021/week29_scoobydoo/sd.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2021/week29_scoobydoo/sd.png -------------------------------------------------------------------------------- /2021/week4_rkenya/rkenya.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2021/week4_rkenya/rkenya.png -------------------------------------------------------------------------------- /2019/Week46_cran/R_logo.svg.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week46_cran/R_logo.svg.png -------------------------------------------------------------------------------- /2020/week16_rapartists/rap.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week16_rapartists/rap.pdf -------------------------------------------------------------------------------- /2020/week19_ac/animal_cross.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week19_ac/animal_cross.png -------------------------------------------------------------------------------- /2020/week23_marble-races/mr.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week23_marble-races/mr.png -------------------------------------------------------------------------------- /2019/Week50_diseases/measles.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week50_diseases/measles.gif -------------------------------------------------------------------------------- /2020/week18_broadway/broadway.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week18_broadway/broadway.gif -------------------------------------------------------------------------------- /2020/week51_ninja/week51_ninja.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week51_ninja/week51_ninja.png -------------------------------------------------------------------------------- /2021/week3_tate/Tate-artists.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2021/week3_tate/Tate-artists.gif -------------------------------------------------------------------------------- /2019/Week50_diseases/measles_mp4.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week50_diseases/measles_mp4.mp4 -------------------------------------------------------------------------------- /2020/week12_theoffice/tt_schrute.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week12_theoffice/tt_schrute.png -------------------------------------------------------------------------------- /2020/week4_spotify_songs/spotify.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week4_spotify_songs/spotify.png -------------------------------------------------------------------------------- /2020/week53_tweetdata/data_2020.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week53_tweetdata/data_2020.png -------------------------------------------------------------------------------- /2021/week10_superbowl/superbowl.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2021/week10_superbowl/superbowl.png -------------------------------------------------------------------------------- /2019/Week41_Power_lifting/Max_lift.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week41_Power_lifting/Max_lift.jpeg -------------------------------------------------------------------------------- /2019/Week47_nz_birds/nz_bird_vote.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week47_nz_birds/nz_bird_vote.png -------------------------------------------------------------------------------- /2019/Week49_parking_tickets/.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week49_parking_tickets/.DS_Store -------------------------------------------------------------------------------- /2019/Week49_parking_tickets/Philly3.dbf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week49_parking_tickets/Philly3.dbf -------------------------------------------------------------------------------- /2019/Week49_parking_tickets/Philly3.shp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week49_parking_tickets/Philly3.shp -------------------------------------------------------------------------------- /2019/Week49_parking_tickets/Philly3.shx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week49_parking_tickets/Philly3.shx -------------------------------------------------------------------------------- /2020/week16_rapartists/rap_points.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week16_rapartists/rap_points.png -------------------------------------------------------------------------------- /2020/week30-aus_animals/animal-aus.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week30-aus_animals/animal-aus.png -------------------------------------------------------------------------------- /2019/1_Week38_Number of Visitors/sun.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/1_Week38_Number of Visitors/sun.png -------------------------------------------------------------------------------- /2019/Week51_adopted_dogs/total_breed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week51_adopted_dogs/total_breed.png -------------------------------------------------------------------------------- /2020/week25-slavery/tt-week25-slaves.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week25-slavery/tt-week25-slaves.gif -------------------------------------------------------------------------------- /2019/1_Week38_Number of Visitors/cloud.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/1_Week38_Number of Visitors/cloud.png -------------------------------------------------------------------------------- /2019/2_Week39_SchoolDiversity/Ethnic_div.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/2_Week39_SchoolDiversity/Ethnic_div.png -------------------------------------------------------------------------------- /2019/Week45_bike_walk/bikers_and_walkers.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week45_bike_walk/bikers_and_walkers.png -------------------------------------------------------------------------------- /2019/Week51_adopted_dogs/assets/ionicons.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week51_adopted_dogs/assets/ionicons.ttf -------------------------------------------------------------------------------- /2019/Week53_tidytuesday_tweets/mydata.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week53_tidytuesday_tweets/mydata.RData -------------------------------------------------------------------------------- /2020/week30-aus_animals/animal-aus-line.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2020/week30-aus_animals/animal-aus-line.png -------------------------------------------------------------------------------- /2019/1_Week38_Number of Visitors/stickman.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/1_Week38_Number of Visitors/stickman.png -------------------------------------------------------------------------------- /2019/Week40_All the Pizza/Barstool_rating.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week40_All the Pizza/Barstool_rating.png -------------------------------------------------------------------------------- /2019/Week43_Horror_Films/horror_movie_length.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week43_Horror_Films/horror_movie_length.png -------------------------------------------------------------------------------- /2019/Week49_parking_tickets/parking_tickets.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week49_parking_tickets/parking_tickets.png -------------------------------------------------------------------------------- /2019/Week51_adopted_dogs/assets/FontAwesome.otf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week51_adopted_dogs/assets/FontAwesome.otf -------------------------------------------------------------------------------- /2019/Week51_adopted_dogs/assets/academicons.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week51_adopted_dogs/assets/academicons.ttf -------------------------------------------------------------------------------- /2019/1_Week38_Number of Visitors/National_Parks.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/1_Week38_Number of Visitors/National_Parks.png -------------------------------------------------------------------------------- /2019/Week44_NYC_Squerrils/Central_park_squirrel.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week44_NYC_Squerrils/Central_park_squirrel.png -------------------------------------------------------------------------------- /2019/2_Week39_SchoolDiversity/Ethnic_div_revised.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/2_Week39_SchoolDiversity/Ethnic_div_revised.png -------------------------------------------------------------------------------- /2019/Week49_parking_tickets/parking_tickets_hours.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week49_parking_tickets/parking_tickets_hours.png -------------------------------------------------------------------------------- /extra/maps/County.prj: -------------------------------------------------------------------------------- 1 | GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]] -------------------------------------------------------------------------------- /2019/Week43_Horror_Films/horror_for_blog_cache/html/__packages: -------------------------------------------------------------------------------- 1 | base 2 | tidyverse 3 | ggplot2 4 | tibble 5 | tidyr 6 | readr 7 | purrr 8 | dplyr 9 | stringr 10 | forcats 11 | ggbeeswarm 12 | ggrepel 13 | extrafont 14 | -------------------------------------------------------------------------------- /2019/Week43_Horror_Films/horror_for_blog_cache/html/unnamed-chunk-1_3811b5e91d57400d166c352b3c42d1db.rdb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week43_Horror_Films/horror_for_blog_cache/html/unnamed-chunk-1_3811b5e91d57400d166c352b3c42d1db.rdb -------------------------------------------------------------------------------- /2019/Week43_Horror_Films/horror_for_blog_cache/html/unnamed-chunk-1_3811b5e91d57400d166c352b3c42d1db.rdx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week43_Horror_Films/horror_for_blog_cache/html/unnamed-chunk-1_3811b5e91d57400d166c352b3c42d1db.rdx -------------------------------------------------------------------------------- /2019/Week43_Horror_Films/horror_for_blog_cache/html/unnamed-chunk-1_3811b5e91d57400d166c352b3c42d1db.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AmitLevinson/TidyTuesday/HEAD/2019/Week43_Horror_Films/horror_for_blog_cache/html/unnamed-chunk-1_3811b5e91d57400d166c352b3c42d1db.RData -------------------------------------------------------------------------------- /2020/week10_nhl/rsconnect/shinyapps.io/amit-levinson/nhl_df.dcf: -------------------------------------------------------------------------------- 1 | name: nhl_df 2 | title: nhl_df 3 | username: 4 | account: amit-levinson 5 | server: shinyapps.io 6 | hostUrl: https://api.shinyapps.io/v1 7 | appId: 1897171 8 | bundleId: 2848129 9 | url: https://amit-levinson.shinyapps.io/nhl_df/ 10 | when: 1583267114.4286 11 | -------------------------------------------------------------------------------- /2020/week10_nhl/rsconnect/documents/knit.Rmd/shinyapps.io/amit-levinson/knit.dcf: -------------------------------------------------------------------------------- 1 | name: knit 2 | title: knit 3 | username: 4 | account: amit-levinson 5 | server: shinyapps.io 6 | hostUrl: https://api.shinyapps.io/v1 7 | appId: 1897193 8 | bundleId: 2851081 9 | url: https://amit-levinson.shinyapps.io/knit/ 10 | when: 1583341450.77608 11 | asMultiple: FALSE 12 | asStatic: FALSE 13 | -------------------------------------------------------------------------------- /2020/week10_nhl/rsconnect/documents/knit.Rmd/shinyapps.io/amit-levinson/nhl_df.dcf: -------------------------------------------------------------------------------- 1 | name: nhl_df 2 | title: nhl_df 3 | username: 4 | account: amit-levinson 5 | server: shinyapps.io 6 | hostUrl: https://api.shinyapps.io/v1 7 | appId: 1897171 8 | bundleId: 2848188 9 | url: https://amit-levinson.shinyapps.io/nhl_df/ 10 | when: 1583268032.59851 11 | asMultiple: FALSE 12 | asStatic: FALSE 13 | -------------------------------------------------------------------------------- /2020/week10_nhl/rsconnect/documents/nhl.Rmd/shinyapps.io/amit-levinson/Tidytuesday_nhl.dcf: -------------------------------------------------------------------------------- 1 | name: tidytuesday_nhl 2 | title: tidytuesday_nhl 3 | username: 4 | account: amit-levinson 5 | server: shinyapps.io 6 | hostUrl: https://api.shinyapps.io/v1 7 | appId: 1901999 8 | bundleId: 2855053 9 | url: https://amit-levinson.shinyapps.io/tidytuesday_nhl/ 10 | when: 1583439576.02881 11 | asMultiple: FALSE 12 | asStatic: FALSE 13 | -------------------------------------------------------------------------------- /2019/Week49_parking_tickets/Philly3.prj: -------------------------------------------------------------------------------- 1 | PROJCS["Albers",GEOGCS["GCS_GRS 1980(IUGG, 1980)",DATUM["D_unknown",SPHEROID["GRS80",6378137,298.257222101]],PRIMEM["Greenwich",0],UNIT["Degree",0.017453292519943295]],PROJECTION["Albers"],PARAMETER["standard_parallel_1",29.5],PARAMETER["standard_parallel_2",45.5],PARAMETER["latitude_of_origin",37.5],PARAMETER["central_meridian",-96],PARAMETER["false_easting",0],PARAMETER["false_northing",0],UNIT["Meter",1]] -------------------------------------------------------------------------------- /2020/week10_nhl/rsconnect/documents/nhl.Rmd/shinyapps.io/amit-levinson/tidytuesday_week_10_nhl.dcf: -------------------------------------------------------------------------------- 1 | name: tidytuesday_week_10_nhl 2 | title: tidytuesday_week_10_nhl 3 | username: 4 | account: amit-levinson 5 | server: shinyapps.io 6 | hostUrl: https://api.shinyapps.io/v1 7 | appId: 1910040 8 | bundleId: 2856460 9 | url: https://amit-levinson.shinyapps.io/tidytuesday_week_10_nhl/ 10 | when: 1583486239.21298 11 | asMultiple: FALSE 12 | asStatic: FALSE 13 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/overlapping-datalabels.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | 4 | (c) 2009-2018 Torstein Honsi 5 | 6 | License: www.highcharts.com/license 7 | */ 8 | (function(a){"object"===typeof module&&module.exports?module.exports=a:"function"===typeof define&&define.amd?define(function(){return a}):a("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(a){}); 9 | //# sourceMappingURL=overlapping-datalabels.js.map 10 | -------------------------------------------------------------------------------- /2020/week_40_b_t/p_files/wordcloud2-0.0.1/wordcloud.css: -------------------------------------------------------------------------------- 1 | 2 | .wcLabel { 3 | position: absolute; 4 | border: 2px solid #fff; 5 | box-shadow: 0 0 4px 0 #008; 6 | padding: 2px; 7 | /*margin: -4px 0 0 -4px;*/ 8 | pointer-events: none; } 9 | 10 | .wcSpan { 11 | position: absolute; 12 | top: 100%; 13 | left: 0; 14 | background-color: rgba(255, 255, 255, 0.8); 15 | color: #333; 16 | margin-top: 6px; 17 | padding: 0 0.5em; 18 | border-radius: 0.5em; 19 | white-space: nowrap; } 20 | -------------------------------------------------------------------------------- /2021/week2_transit-cost/transit_cost.R: -------------------------------------------------------------------------------- 1 | transit_cost <- read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-01-05/transit_cost.csv') 2 | 3 | 4 | transit_cost %>% 5 | filter(real_cost != 0) %>% 6 | mutate( 7 | length_work = as.numeric(end_year) - as.numeric(start_year), 8 | real_cost = as.numeric(real_cost)) %>% 9 | ggplot()+ 10 | geom_point(aes(x = length_work, y = stations)) 11 | scale_x_log10() 12 | 13 | class(transit_cost$real_cost) 14 | -------------------------------------------------------------------------------- /2019/Week45_bike_walk/123.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Untitled" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | orientation: columns 6 | vertical_layout: fill 7 | --- 8 | 9 | ```{r setup, include=FALSE} 10 | library(flexdashboard) 11 | ``` 12 | 13 | Column {data-width=650} 14 | ----------------------------------------------------------------------- 15 | 16 | ### Chart A 17 | 18 | ```{r} 19 | 20 | ``` 21 | 22 | Column {data-width=350} 23 | ----------------------------------------------------------------------- 24 | 25 | ### Chart B 26 | 27 | ```{r} 28 | 29 | ``` 30 | 31 | ### Chart C 32 | 33 | ```{r} 34 | 35 | ``` 36 | 37 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/custom/reset.js: -------------------------------------------------------------------------------- 1 | var HCDefaults = $.extend(true, {}, Highcharts.getOptions(), {}); 2 | 3 | function ResetHighchartsOptions() { 4 | // Fortunately, Highcharts returns the reference to defaultOptions itself 5 | // We can manipulate this and delete all the properties 6 | var defaultOptions = Highcharts.getOptions(); 7 | for (var prop in defaultOptions) { 8 | if (typeof defaultOptions[prop] !== 'function') delete defaultOptions[prop]; 9 | } 10 | // Fall back to the defaults that we captured initially, this resets the theme 11 | Highcharts.setOptions(HCDefaults); 12 | } 13 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/streamgraph.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | Streamgraph module 4 | 5 | (c) 2010-2018 Torstein Honsi 6 | 7 | License: www.highcharts.com/license 8 | */ 9 | (function(a){"object"===typeof module&&module.exports?module.exports=a:"function"===typeof define&&define.amd?define(function(){return a}):a("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(a){(function(a){a=a.seriesType;a("streamgraph","areaspline",{fillOpacity:1,lineWidth:0,marker:{enabled:!1},stacking:"stream"},{negStacks:!1,streamStacker:function(a,b,c){a[0]-=b.total/2;a[1]-=b.total/2;this.stackedYData[c]=a}})})(a)}); 10 | //# sourceMappingURL=streamgraph.js.map 11 | -------------------------------------------------------------------------------- /.github/workflows/render-plot.yaml: -------------------------------------------------------------------------------- 1 | name: Render library update 2 | 3 | on: [push] 4 | 5 | jobs: 6 | build: 7 | runs-on: macOS-latest 8 | if: "contains(github.event.head_commit.message, 'initial commit')" 9 | steps: 10 | - uses: actions/checkout@v2 11 | - uses: r-lib/actions/setup-r@v1 12 | - name: Install package dependencies 13 | run: 14 | Rscript -e "install.packages(c('tidyverse', 'showtext'))" 15 | - name: Render r plot file 16 | run: 17 | Rscript -e "source('extra/packages-plot.R')" 18 | - name: Commit results 19 | run: | 20 | git add extra/packages-used.png 21 | git commit -m 'Re-build library-plot' 22 | git push origin -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/full-screen.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | Advanced Highstock tools 4 | 5 | (c) 2010-2018 Highsoft AS 6 | Author: Torstein Honsi 7 | 8 | License: www.highcharts.com/license 9 | */ 10 | (function(b){"object"===typeof module&&module.exports?module.exports=b:"function"===typeof define&&define.amd?define(function(){return b}):b("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(b){(function(b){b.FullScreen=function(a){this.init(a.parentNode)};b.FullScreen.prototype={init:function(a){a.requestFullscreen?a.requestFullscreen():a.mozRequestFullScreen?a.mozRequestFullScreen():a.webkitRequestFullscreen?a.webkitRequestFullscreen():a.msRequestFullscreen&&a.msRequestFullscreen()}}})(b)}); 11 | //# sourceMappingURL=full-screen.js.map 12 | -------------------------------------------------------------------------------- /2020/week24-awards/week24.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Week-24" 3 | author: "Amit Levinson" 4 | date: "6/8/2020" 5 | output: html_document 6 | editor_options: 7 | chunk_output_type: console 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | knitr::opts_chunk$set(echo = TRUE) 12 | ``` 13 | 14 | ```{r} 15 | library(tidyverse) 16 | 17 | tuesdata <- tidytuesdayR::tt_load('2020-06-09') 18 | tuesdata <- tidytuesdayR::tt_load(2020, week = 24) 19 | firsts <- tuesdata$firsts 20 | ``` 21 | 22 | ```{r} 23 | firsts 24 | ``` 25 | 26 | ```{r} 27 | firsts %>% 28 | group_by(decade = 10 * (year %/% 10)) %>% 29 | filter(decade >= 1960) %>% 30 | ungroup() %>% 31 | ggplot(aes(x = decade, fill = category))+ 32 | geom_bar()+ 33 | coord_flip() 34 | ``` 35 | 36 | ```{r} 37 | science <- tuesdata$science 38 | ``` 39 | 40 | ```{r} 41 | science %>% 42 | count(occupation_s, sort = T) 43 | ``` 44 | 45 | 46 | -------------------------------------------------------------------------------- /2020/week_40_b_t/week40_beyonce-swift.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(tidytext) 3 | library(wordcloud2) 4 | library(htmlwidgets) 5 | 6 | # Load data 7 | beyonce_lyrics <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-09-29/beyonce_lyrics.csv') 8 | 9 | b_words <- beyonce_lyrics %>% 10 | # Unnest to single words 11 | unnest_tokens(word, line) %>% 12 | count(word, sort = T) %>% 13 | anti_join(stop_words) %>% 14 | filter(n > 4) %>% 15 | # normalize words 16 | mutate(n = n * 0.8, 17 | # Normalize really high freq words 18 | n = ifelse(n > 500, n - 300, n)) 19 | 20 | # Save as ojbect 21 | p <- wordcloud2(b_words, figPath = "2020/week_40_b_t/note.png", size = 1.8, color = "black") 22 | 23 | # Save as html, open and then save as image 24 | saveWidget(p, here::here("2020", "week_40_b_t", "p.html"),selfcontained = F) 25 | -------------------------------------------------------------------------------- /2020/week29_astronaut/week25_astronaut.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | 3 | tuesdata <- tidytuesdayR::tt_load('2020-07-14') 4 | tt <- tuesdata$astronauts 5 | 6 | tt %>% 7 | mutate(decade = year_of_mission %/% 10 * 10) %>% 8 | count(decade, nationality, sex) %>% 9 | group_by(decade) %>% 10 | mutate(pct = n / sum(n)*100) %>% 11 | ungroup() %>% 12 | ggplot(aes(x = decade, y= n, fill = sex))+ 13 | geom_col() 14 | 15 | 16 | tt %>% 17 | count(nationality, sort = T) 18 | 19 | 20 | ### Hours by year? 21 | 22 | tt %>% 23 | mutate(decade = year_of_mission %/% 10 * 10) %>% 24 | group_by(year_of_mission) %>% 25 | summarise(mean_h = mean(hours_mission)) %>% 26 | ggplot(aes(x = year_of_mission, y = mean_h))+ 27 | geom_line()+ 28 | theme_minimal() 29 | 30 | 31 | tt %>% 32 | group_by(name) %>% 33 | filter(n() > 2) %>% 34 | mutate(mean_h = mean(total_hrs_sum)) 35 | 36 | 37 | tt %>% 38 | group_by(name) %>% 39 | filter(n() > 5) %>% 40 | summarise(mean_h = mean(total_hrs_sum)) 41 | -------------------------------------------------------------------------------- /2020/week25-slavery/week25-slavery.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "week25_explore" 3 | author: "Amit Levinson" 4 | date: "6/20/2020" 5 | output: html_document 6 | editor_options: 7 | chunk_output_type: console 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | knitr::opts_chunk$set(echo = TRUE) 12 | ``` 13 | 14 | ```{r} 15 | library(shiny) 16 | library(here) 17 | 18 | slave_routes <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/slave_routes.csv') 19 | 20 | # blackpast <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/blackpast.csv') 21 | # census <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/census.csv') 22 | # african_names <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/african_names.csv') 23 | 24 | ``` 25 | 26 | 27 | ```{r} 28 | runApp(here("2020", "week25-slavery", "shiny-app")) 29 | ``` -------------------------------------------------------------------------------- /2019/Week40_All the Pizza/README.md: -------------------------------------------------------------------------------- 1 | ![](Barstool_rating.png) 2 | 3 | ## Power lifting 4 | 5 | In this [#TidyTuesday](https://github.com/rfordatascience/tidytuesday/tree/master/data/2019/2019-10-08) I plotted the max weight lifted throughout the years, and how do those max achievements distribute across participants. 6 | 7 | #### *New things I learned:* 8 | 9 | * `ggthemr` - I played around with the different theme templats in the package. it's a very nice go to and worth a try. 10 | * `dplyr::gather` - I never used this function and wanted to learn and give it a try. it helped gather the different activies to then split the distribution by. 11 | * `geom_curve` - I liked using it to point to a specific place. while it might be redundant here, I wanted to give it a try and use instead of another segment running down the distribution. 12 | 4. `geom_label_repel` - I tihnk this can work better with a scatter plot and might be kind of messy here, but i learned how to show labels only for *specific* values which was cool to learn. 13 | 14 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/css/motion.css: -------------------------------------------------------------------------------- 1 | /* $("div:has(#play-controls)").css({"position" : "relative"}) 2 | div:has(#play-controls) { 3 | position : relative; 4 | } 5 | */ 6 | 7 | .loading { 8 | margin-top: 10em; 9 | text-align: center; 10 | color: gray; 11 | } 12 | 13 | #play-controls { 14 | position: absolute; 15 | bottom: 0; 16 | text-align: center; 17 | min-width: 310px; 18 | max-width: 800px; 19 | margin: 0 auto; 20 | padding: 5px 0 1em 0; 21 | } 22 | 23 | #play-controls * { 24 | display: inline-block; 25 | vertical-align: middle; 26 | } 27 | 28 | #play-pause-button { 29 | color: #666666; 30 | width: 30px; 31 | height: 30px; 32 | text-align: center; 33 | font-size: 15px; 34 | cursor: pointer; 35 | border: 1px solid silver; 36 | border-radius: 3px; 37 | background: #f8f8f8; 38 | } 39 | 40 | #play-range { 41 | margin: 2.5%; 42 | width: 70%; 43 | } 44 | 45 | #play-output { 46 | color: #666666; 47 | font-family: Arial, Helvetica, sans-serif; 48 | } 49 | -------------------------------------------------------------------------------- /2020/week27-xmen/week27-xmen.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(tidytext) 3 | library(igraph) 4 | library(ggraph) 5 | covers <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-30/covers.csv') 6 | 7 | 8 | covers 9 | 10 | chars_df <- covers %>% 11 | #split according to space between words, used specific regex to keep names complete 12 | mutate(char = str_split(characters_visualized,"\r\n")) %>% 13 | # unnest the new list column 14 | unnest(char) %>% 15 | select(issue, char) %>% 16 | group_by(issue) %>% 17 | # create new column to further expand 18 | mutate(char2 = char) %>% 19 | # create combinations using expand 20 | expand(char, char2) %>% 21 | #filter identical words 22 | filter(char != char2) %>% 23 | ungroup() %>% 24 | mutate(dual_char = paste0(char, " & ", char2)) %>% 25 | add_count(dual_char, name = "n", sort = T) 26 | 27 | 28 | 29 | 30 | new <- chars_df %>% 31 | expand(word, word2) 32 | 33 | ?expand.grid 34 | 35 | ?complete 36 | 37 | library(ggraph) 38 | 39 | 40 | -------------------------------------------------------------------------------- /2020/week13_tbi/week13_tbi.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | 3 | tbi_age <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-24/tbi_age.csv') 4 | tbi_year <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-24/tbi_year.csv') 5 | 6 | 7 | summary(tbi_age) 8 | glimpse(tbi_age) 9 | View(tbi_age) 10 | 11 | tbi_year %>% 12 | ggplot(aes(x = year, y = rate_est))+ 13 | geom_col()+ 14 | facet_grid(injury_mechanism ~ type) 15 | 16 | 17 | 18 | tbi_year %>% 19 | filter(type == "Deaths", year =="2014") %>% 20 | count(, wt= number_est) %>% 21 | summarise(mean(n)) 22 | 23 | tbi_year %>% 24 | count(type) 25 | 26 | 27 | 28 | tbi_age %>% 29 | count(age_group) 30 | 31 | tbi_age %>% 32 | filter(type == "Emergency Department Visit", age_group != "0-17") %>% 33 | count(injury_mechanism, wt = rate_est, sort = T) 34 | 35 | tbi_military <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-24/tbi_military.csv') 36 | 37 | 38 | glimpse(tbi_military) 39 | 40 | tbi_military %>% 41 | ggplot(aes(x = )) 42 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/arrow-symbols.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | Arrow Symbols 4 | 5 | (c) 2017-2018 Lars A. V. Cabrera 6 | 7 | License: www.highcharts.com/license 8 | */ 9 | (function(f){"object"===typeof module&&module.exports?module.exports=f:"function"===typeof define&&define.amd?define(function(){return f}):f("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(f){(function(a){a.SVGRenderer.prototype.symbols.arrow=function(d,b,a,c){return["M",d,b+c/2,"L",d+a,b,"L",d,b+c/2,"L",d+a,b+c]};a.SVGRenderer.prototype.symbols["arrow-half"]=function(d,b,e,c){return a.SVGRenderer.prototype.symbols.arrow(d,b,e/2,c)};a.SVGRenderer.prototype.symbols["triangle-left"]=function(a, 10 | b,e,c){return["M",a+e,b,"L",a,b+c/2,"L",a+e,b+c,"Z"]};a.SVGRenderer.prototype.symbols["arrow-filled"]=a.SVGRenderer.prototype.symbols["triangle-left"];a.SVGRenderer.prototype.symbols["triangle-left-half"]=function(d,b,e,c){return a.SVGRenderer.prototype.symbols["triangle-left"](d,b,e/2,c)};a.SVGRenderer.prototype.symbols["arrow-filled-half"]=a.SVGRenderer.prototype.symbols["triangle-left-half"]})(f)}); 11 | //# sourceMappingURL=arrow-symbols.js.map 12 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/current-date-indicator.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | CurrentDateIndicator 4 | 5 | (c) 2010-2018 Lars A. V. Cabrera 6 | 7 | License: www.highcharts.com/license 8 | */ 9 | (function(c){"object"===typeof module&&module.exports?module.exports=c:"function"===typeof define&&define.amd?define(function(){return c}):c("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(c){(function(c){var e=c.addEvent,h=c.PlotLineOrBand,f=c.merge,g={currentDateIndicator:!0,color:"#ccd6eb",width:2,label:{format:"%a, %b %d %Y, %H:%M",formatter:void 0,rotation:0,style:{fontSize:"10px"}}};e(c.Axis,"afterSetOptions",function(){var b=this.options,a=b.currentDateIndicator;a&&("object"=== 10 | typeof a?(a.label&&a.label.format&&(a.label.formatter=void 0),a=f(g,a)):a=f(g),a.value=new Date,b.plotLines||(b.plotLines=[]),b.plotLines.push(a))});e(h,"render",function(){var b=this.options,a,d;b.currentDateIndicator&&b.label&&(a=b.label.format,d=b.label.formatter,b.value=new Date,b.label.text="function"===typeof d?d(this):c.dateFormat(a,new Date),this.label&&this.label.attr({text:b.label.text}))})})(c)}); 11 | //# sourceMappingURL=current-date-indicator.js.map 12 | -------------------------------------------------------------------------------- /2019/Week41_Power_lifting/README.md: -------------------------------------------------------------------------------- 1 | ![](Max_lift.jpeg) 2 | 3 | ## Power lifting 4 | 5 | In this [#TidyTuesday](https://github.com/rfordatascience/tidytuesday/tree/master/data/2019/2019-10-08) I plotted the max weight lifted throughout the years, and how do those max achievements distribute across participants. 6 | 7 | 8 | #### *New things I learned:* 9 | 10 | * `library(ggthemr)` - I played around with the different theme templats in the package. it's a very nice go to and worth a try. 11 | 12 | * `library(gridExtra)` - a very useful package to integrate differnet plots together. this enabled me to display both the max achievments throuout the years, and next to it a more in depth level of how those achievements distribute across participants. it was very easy to use and saves the propportions of the graph to nicely fit together. 13 | 14 | * `dplyr::gather` - I never used this function and wanted to learn and give it a try. it helped gather the different activies to then split the distribution by. 15 | 16 | * `legend.justification` `direction` and `spacing.x` - i learned these cool operators to play with the legend. it enabled me to place the legend in the top left corner, remove the background with the `legend.key`. really useful! 17 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/static-scale.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | StaticScale 4 | 5 | (c) 2016-2018 Torstein Honsi, Lars A. V. Cabrera 6 | 7 | License: www.highcharts.com/license 8 | */ 9 | (function(a){"object"===typeof module&&module.exports?module.exports=a:"function"===typeof define&&define.amd?define(function(){return a}):a("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(a){(function(c){var a=c.Chart,f=c.pick;c.addEvent(c.Axis,"afterSetOptions",function(){this.horiz||!c.isNumber(this.options.staticScale)||this.chart.options.chart.height||(this.staticScale=this.options.staticScale)});a.prototype.adjustHeight=function(){"adjustHeight"!==this.redrawTrigger&&((this.axes|| 10 | []).forEach(function(a){var b=a.chart,g=!!b.initiatedScale&&b.options.animation,d=a.options.staticScale,e;a.staticScale&&c.defined(a.min)&&(e=f(a.unitLength,a.max+a.tickInterval-a.min)*d,e=Math.max(e,d),d=e-b.plotHeight,1<=Math.abs(d)&&(b.plotHeight=e,b.redrawTrigger="adjustHeight",b.setSize(void 0,b.chartHeight+d,g)),a.series.forEach(function(a){(a=a.sharedClipKey&&b[a.sharedClipKey])&&a.attr({height:b.plotHeight})}))}),this.initiatedScale=!0);this.redrawTrigger=null};c.addEvent(a,"render",a.prototype.adjustHeight)})(a)}); 11 | //# sourceMappingURL=static-scale.js.map 12 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/price-indicator.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | Advanced Highstock tools 4 | 5 | (c) 2010-2018 Highsoft AS 6 | Author: Torstein Honsi 7 | 8 | License: www.highcharts.com/license 9 | */ 10 | (function(a){"object"===typeof module&&module.exports?module.exports=a:"function"===typeof define&&define.amd?define(function(){return a}):a("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(a){(function(a){var f=a.addEvent,k=a.merge,l=a.isArray;f(a.Series,"afterRender",function(){var a=this.options,d=a.lastVisiblePrice,c=a.lastPrice;if((d||c)&&"highcharts-navigator-series"!==a.id){var f=this.xAxis,b=this.yAxis,m=b.crosshair,n=b.cross,p=b.crossLabel,e=this.points,g=this.xData[this.xData.length- 11 | 1],h=this.yData[this.yData.length-1];c&&c.enabled&&(b.crosshair=b.options.crosshair=a.lastPrice,b.cross=this.lastPrice,c=l(h)?h[3]:h,b.drawCrosshair(null,{x:g,y:c,plotX:f.toPixels(g,!0),plotY:b.toPixels(c,!0)}),this.lastPrice=this.yAxis.cross,this.lastPrice.y=c);d&&d.enabled&&(d=e[e.length-1].x===g?1:2,b.crosshair=b.options.crosshair=k({color:"transparent"},a.lastVisiblePrice),b.cross=this.lastVisiblePrice,a=e[e.length-d],b.drawCrosshair(null,a),this.lastVisiblePrice=b.cross,this.lastVisiblePrice.y= 12 | a.y,this.crossLabel&&this.crossLabel.destroy(),this.crossLabel=b.crossLabel);b.crosshair=m;b.cross=n;b.crossLabel=p}})})(a)}); 13 | //# sourceMappingURL=price-indicator.js.map 14 | -------------------------------------------------------------------------------- /2019/Week41_Power_lifting/max ever lifted.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "winner_names" 3 | author: "Amit Levinson" 4 | date: "10/11/2019" 5 | editor_options: 6 | chunk_output_type: console 7 | --- 8 | 9 | ```{r setup, include=FALSE} 10 | knitr::opts_chunk$set(echo = TRUE) 11 | ``` 12 | 13 | 14 | ```{r} 15 | library(tidyverse) 16 | theme_set(theme_light()) 17 | 18 | ipf_lifts <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-08/ipf_lifts.csv") 19 | glimpse(ipf_lifts) 20 | ipf_lifts %>% 21 | count(equipment) 22 | 23 | ``` 24 | 25 | 26 | 27 | ```{r} 28 | df <- ipf_lifts %>% 29 | mutate(year = as.numeric(format(date, '%Y'))) %>% 30 | select(-date) %>% 31 | gather(activity, weight, best3squat_kg:best3deadlift_kg) %>% 32 | mutate(activity = recode(activity, "best3bench_kg" = "Bench", 33 | "best3deadlift_kg" = "Deadlift", "best3squat_kg" = "Squat")) %>% 34 | filter(place != "DD" & place != "DQ" & !is.na(weight)) 35 | ``` 36 | 37 | Now let's create our dataset according to 1st place weight from 2000-2019 38 | ```{r} 39 | highest <- df %>% 40 | group_by(sex, activity, meet_name) %>% 41 | filter(weight == max(weight)) %>% 42 | group_by(activity) %>% 43 | mutate(meet_name = fct_reorder(meet_name, weight)) 44 | 45 | g <- ggplot(highest, aes(x = year, y = weight))+ 46 | geom_col(aes(fill = activity))+ 47 | coord_flip()+ 48 | facet_grid(activity ~ sex) 49 | 50 | g 51 | 52 | count_name <- win %>% 53 | group_by(sex, meet_name) %>% 54 | summarise(total = n()) 55 | 56 | ``` 57 | 58 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/oldie-polyfills.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | Old IE (v6, v7, v8) array polyfills for Highcharts v7+. 4 | 5 | (c) 2010-2018 Highsoft AS 6 | Author: Torstein Honsi 7 | 8 | License: www.highcharts.com/license 9 | */ 10 | (function(e){"object"===typeof module&&module.exports?module.exports=e:"function"===typeof define&&define.amd?define(function(){return e}):e("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(e){(function(){Array.prototype.forEach||(Array.prototype.forEach=function(d,b){for(var a=0,c=this.length;a { 6 | 7 | const generatePointKey = (point) => { 8 | return point.category + " " + point.series.name + ": " + point.x + " " + point.y; 9 | }; 10 | 11 | const result = points.map(generatePointKey).join(', '); 12 | 13 | return result; 14 | } 15 | 16 | H.wrap(H.Tooltip.prototype, 'refresh', function(proceed) { 17 | let seriesName; 18 | 19 | if (Array.isArray(arguments[ 1 ])) { 20 | // Can be array in case that, it's shared tooltip 21 | seriesName = generatePointsUniqueKey(arguments[ 1 ]); 22 | } else { 23 | seriesName = arguments[ 1 ].series.name; 24 | } 25 | 26 | const delayForDisplay = this.chart.options.tooltip.delayForDisplay ? this.chart.options.tooltip.delayForDisplay : 1000; 27 | 28 | if (timerId[ seriesName ]) { 29 | clearTimeout(timerId[ seriesName ]); 30 | delete timerId[ seriesName ]; 31 | } 32 | 33 | timerId[ seriesName ] = window.setTimeout(function() { 34 | let pointOrPoints = this.refreshArguments[ 0 ]; 35 | 36 | if (pointOrPoints === this.chart.hoverPoint || $.inArray(this.chart.hoverPoint, pointOrPoints) > -1) { 37 | proceed.apply(this.tooltip, this.refreshArguments); 38 | } 39 | 40 | }.bind({ 41 | refreshArguments: Array.prototype.slice.call(arguments, 1), 42 | chart: this.chart, 43 | tooltip: this 44 | }), delayForDisplay); 45 | 46 | }); 47 | 48 | }(Highcharts)); -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/custom/text-symbols.js: -------------------------------------------------------------------------------- 1 | /* Highcharts plugin to handle text symbols */ 2 | (function (H) { 3 | function symbolWrap(proceed, symbol, x, y, w, h, options) { 4 | if (symbol.indexOf('text:') === 0) { 5 | var text = unescape(JSON.parse('"\\u' + symbol.split(':')[1] + '"')), 6 | svgElem = this.text(text, x, y) 7 | .attr({ 8 | translateY: h, 9 | translateX: -1 10 | }) 11 | .css({ 12 | fontFamily: 'FontAwesome', 13 | fontSize: h * 2 14 | }); 15 | 16 | if (svgElem.renderer.isVML) { 17 | svgElem.fillSetter = function (value, key, element) { 18 | element.style.color = H.Color(value).get('rgb'); 19 | }; 20 | } 21 | return svgElem; 22 | } 23 | return proceed.apply(this, [].slice.call(arguments, 1)); 24 | } 25 | H.wrap(H.SVGRenderer.prototype, 'symbol', symbolWrap); 26 | if (H.VMLRenderer) { 27 | H.wrap(H.VMLRenderer.prototype, 'symbol', symbolWrap); 28 | } 29 | 30 | // Load the font for SVG files also 31 | /* 32 | H.wrap(H.Chart.prototype, 'getSVG', function (proceed) { 33 | var svg = proceed.call(this); 34 | svg = '' + 36 | svg; 37 | return svg; 38 | }); 39 | */ 40 | }(Highcharts)); 41 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/item-series.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | 4 | Item series type for Highcharts 5 | 6 | (c) 2010-2018 Torstein Honsi 7 | 8 | License: www.highcharts.com/license 9 | */ 10 | (function(c){"object"===typeof module&&module.exports?module.exports=c:"function"===typeof define&&define.amd?define(function(){return c}):c("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(c){(function(f){var c=f.extend,u=f.pick,r=f.seriesType;r("item","column",{itemPadding:.2,marker:{symbol:"circle",states:{hover:{},select:{}}}},{drawPoints:function(){var b=this,v=b.chart.renderer,l=this.options.marker,m=this.yAxis.transA*b.options.itemPadding,n=this.borderWidth%2?.5:1;this.points.forEach(function(a){var d, 11 | e,g,h,k;d=a.marker||{};var w=d.symbol||l.symbol,r=u(d.radius,l.radius),p,t,x="rect"!==w,q;a.graphics=g=a.graphics||{};k=a.pointAttr?a.pointAttr[a.selected?"selected":""]||b.pointAttr[""]:b.pointAttribs(a,a.selected&&"select");delete k.r;b.chart.styledMode&&(delete k.stroke,delete k["stroke-width"]);if(null!==a.y)for(a.graphic||(a.graphic=v.g("point").add(b.group)),h=a.y,t=u(a.stackY,a.y),p=Math.min(a.pointWidth,b.yAxis.transA-m),d=t;d>t-a.y;d--)e=a.barX+(x?a.pointWidth/2-p/2:0),q=b.yAxis.toPixels(d, 12 | !0)+m/2,b.options.crisp&&(e=Math.round(e)-n,q=Math.round(q)+n),e={x:e,y:q,width:Math.round(x?p:a.pointWidth),height:Math.round(p),r:r},g[h]?g[h].animate(e):g[h]=v.symbol(w).attr(c(e,k)).add(a.graphic),g[h].isActive=!0,h--;f.objectEach(g,function(a,b){a.isActive?a.isActive=!1:(a.destroy(),delete a[b])})})}});f.SVGRenderer.prototype.symbols.rect=function(b,c,l,m,n){return f.SVGRenderer.prototype.symbols.callout(b,c,l,m,n)}})(c)}); 13 | //# sourceMappingURL=item-series.js.map 14 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/no-data-to-display.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | Plugin for displaying a message when there is no data visible in chart. 4 | 5 | (c) 2010-2018 Highsoft AS 6 | Author: Oystein Moseng 7 | 8 | License: www.highcharts.com/license 9 | */ 10 | (function(c){"object"===typeof module&&module.exports?module.exports=c:"function"===typeof define&&define.amd?define(function(){return c}):c("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(c){(function(d){var c=d.seriesTypes,e=d.Chart.prototype,f=d.getOptions(),g=d.extend;g(f.lang,{noData:"No data to display"});f.noData={position:{x:0,y:0,align:"center",verticalAlign:"middle"},style:{fontWeight:"bold",fontSize:"12px",color:"#666666"}};"bubble gauge heatmap pie sankey treemap waterfall".split(" ").forEach(function(b){c[b]&& 11 | (c[b].prototype.hasData=function(){return!!this.points.length})});d.Series.prototype.hasData=function(){return this.visible&&void 0!==this.dataMax&&void 0!==this.dataMin};e.showNoData=function(b){var a=this.options;b=b||a&&a.lang.noData;a=a&&a.noData;!this.noDataLabel&&this.renderer&&(this.noDataLabel=this.renderer.label(b,0,0,null,null,null,a.useHTML,null,"no-data"),this.styledMode||this.noDataLabel.attr(a.attr).css(a.style),this.noDataLabel.add(),this.noDataLabel.align(g(this.noDataLabel.getBBox(), 12 | a.position),!1,"plotBox"))};e.hideNoData=function(){this.noDataLabel&&(this.noDataLabel=this.noDataLabel.destroy())};e.hasData=function(){for(var b=this.series||[],a=b.length;a--;)if(b[a].hasData()&&!b[a].options.isInternal)return!0;return this.loadingShown};d.addEvent(d.Chart,"render",function(){this.hasData()?this.hideNoData():this.showNoData()})})(c)}); 13 | //# sourceMappingURL=no-data-to-display.js.map 14 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/pareto.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | 4 | Pareto series type for Highcharts 5 | 6 | (c) 2010-2018 Sebastian Bochan 7 | 8 | License: www.highcharts.com/license 9 | */ 10 | (function(b){"object"===typeof module&&module.exports?module.exports=b:"function"===typeof define&&define.amd?define(function(){return b}):b("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(b){var e=function(f){var b=f.Series,d=f.addEvent;return{init:function(){b.prototype.init.apply(this,arguments);this.initialised=!1;this.baseSeries=null;this.eventRemovers=[];this.addEvents()},setDerivedData:f.noop,setBaseSeries:function(){var a=this.chart,c=this.options.baseSeries;this.baseSeries= 11 | c&&(a.series[c]||a.get(c))||null},addEvents:function(){var a=this,c;c=d(this.chart,"afterLinkSeries",function(){a.setBaseSeries();a.baseSeries&&!a.initialised&&(a.setDerivedData(),a.addBaseSeriesEvents(),a.initialised=!0)});this.eventRemovers.push(c)},addBaseSeriesEvents:function(){var a=this,c,b;c=d(a.baseSeries,"updatedData",function(){a.setDerivedData()});b=d(a.baseSeries,"destroy",function(){a.baseSeries=null;a.initialised=!1});a.eventRemovers.push(c,b)},destroy:function(){this.eventRemovers.forEach(function(a){a()}); 12 | b.prototype.destroy.apply(this,arguments)}}}(b);(function(b,e){var d=b.correctFloat,a=b.seriesType;b=b.merge;a("pareto","line",{zIndex:3},b(e,{setDerivedData:function(){if(1% 9 | mutate(t_year = year(created_at), 10 | t_week = week(created_at)) %>% 11 | group_by(screen_name, t_year, t_week) %>% 12 | summarise(n = n()) %>% 13 | ungroup() %>% 14 | filter(t_year >= 2019 & t_year < 2020) %>% 15 | mutate(t_week_date = as.Date(paste(2019, t_week, 1, sep = "-"),"%Y-%U-%u")) #thanks to a stack overflow for this response 16 | 17 | 18 | ggplot(data = df) + 19 | geom_path(aes(x = t_week_date, y = n, color = screen_name), size = 1)+ 20 | scale_x_date(date_breaks = "1 month", date_labels = "%b")+ 21 | labs(title = "Israeli political candidates weekly tweets throughout 2019", x = NULL, y = NULL)+ 22 | theme_ipsum_rc()+ 23 | geom_text(data = df %>% filter(t_week_date %in% as.Date(c("2019-04-08", "2019-09-16")) & screen_name == "netanyahu"), 24 | aes(x = t_week_date, y = 100, label = c("First elections\nApr 9, 2019", "Second Elections\n Sep 17, 2019")), hjust = -0.1)+ 25 | geom_vline(xintercept = as.Date(c("2019-04-08", "2019-09-16")), linetype = "dashed", size = 1, alpha = 7/10)+ 26 | scale_color_discrete(name = "Candidate", breaks = c("netanyahu", "gantzbe"), labels = c("Benjamin Netanyahu (previous PM)","Benny Gantz"))+ 27 | theme( 28 | legend.background = element_blank(), 29 | legend.key.size = unit(1.5, "line"), 30 | legend.title = element_blank(), 31 | legend.text = element_text(size = 11), 32 | legend.position = "top", 33 | panel.grid = element_blank() 34 | ) 35 | 36 | ggsave("elections.png", width = 10, height = 6) 37 | save(tmls, df, file = "mydata.RData") 38 | load("mydata.RData") 39 | -------------------------------------------------------------------------------- /2020/week_40_b_t/p_files/wordcloud2-binding-0.2.2/wordcloud2.js: -------------------------------------------------------------------------------- 1 | HTMLWidgets.widget({ 2 | 3 | name: 'wordcloud2', 4 | 5 | type: 'output', 6 | 7 | initialize: function(el, width, height) { 8 | var newCanvas = document.createElement("canvas"); 9 | newCanvas.height = height; 10 | newCanvas.width = width; 11 | newCanvas.id = "canvas"; 12 | 13 | el.appendChild(newCanvas); 14 | newlabel(el); 15 | return(el.firstChild); 16 | }, 17 | renderValue: function(el, x, instance) { 18 | // parse gexf data 19 | listData=[]; 20 | for(var i=0; i% 15 | unnest_tokens(word, text) %>% 16 | inner_join(get_sentiments("bing")) %>% 17 | count(sentiment, word, sort = T) %>% 18 | filter(!grepl("like", word)) %>% 19 | group_by(sentiment) %>% 20 | top_n(10) %>% 21 | ungroup() %>% 22 | mutate(word = str_to_title(word), 23 | n = ifelse(sentiment == "negative", -n, n), 24 | word = reorder(word, n)) 25 | 26 | ggplot(sentiment_user_review, aes(x = n, y = word, fill = sentiment))+ 27 | geom_col(show.legend = F)+ 28 | scale_x_continuous(breaks = seq(-300,1200,300))+ 29 | theme_pomological()+ 30 | scale_fill_manual(values = c(positive = "#919c4c", negative = "#c03728"))+ 31 | labs(title = paste0("Users top 10 Positive and Negative sentiments of Animal Crossing reviews"), subtitle = "Sentiment analysis excludes the word 'like' which appears 1300+ times in different contexts", caption = "Data: Villager DB | @Amit_Levinson",x = NULL, y = NULL)+ 32 | theme(text = element_text(size = 18, family = "Roboto Condensed", color = "#a89985"), 33 | plot.title = element_markdown(size = 28, hjust = 0, face = "bold"), 34 | plot.caption = element_text(size = 10), 35 | panel.border = element_blank(), 36 | axis.text.y = element_text(size = 18), 37 | axis.text.x = element_text(size = 14), 38 | plot.margin = margin(3,2,2,2, "mm")) 39 | 40 | ggsave("animal_cross.png", width = 16, height = 12, dpi = 320) 41 | ``` 42 | 43 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/vector.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | Vector plot series module 4 | 5 | (c) 2010-2018 Torstein Honsi 6 | 7 | License: www.highcharts.com/license 8 | */ 9 | (function(c){"object"===typeof module&&module.exports?module.exports=c:"function"===typeof define&&define.amd?define(function(){return c}):c("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(c){(function(d){var c=d.seriesType;c("vector","scatter",{lineWidth:2,marker:null,rotationOrigin:"center",states:{hover:{lineWidthPlus:1}},tooltip:{pointFormat:"\x3cb\x3e[{point.x}, {point.y}]\x3c/b\x3e\x3cbr/\x3eLength: \x3cb\x3e{point.length}\x3c/b\x3e\x3cbr/\x3eDirection: \x3cb\x3e{point.direction}\u00b0\x3c/b\x3e\x3cbr/\x3e"}, 10 | vectorLength:20},{pointArrayMap:["y","length","direction"],parallelArrays:["x","y","length","direction"],pointAttribs:function(a,b){var c=this.options;a=a.color||this.color;var d=this.options.lineWidth;b&&(a=c.states[b].color||a,d=(c.states[b].lineWidth||d)+(c.states[b].lineWidthPlus||0));return{stroke:a,"stroke-width":d}},markerAttribs:d.noop,getSymbol:d.noop,arrow:function(a){a=a.length/this.lengthMax*this.options.vectorLength/20;var b={start:10*a,center:0,end:-10*a}[this.options.rotationOrigin]|| 11 | 0;return["M",0,7*a+b,"L",-1.5*a,7*a+b,0,10*a+b,1.5*a,7*a+b,0,7*a+b,0,-10*a+b]},translate:function(){d.Series.prototype.translate.call(this);this.lengthMax=d.arrayMax(this.lengthData)},drawPoints:function(){var a=this.chart;this.points.forEach(function(b){var c=b.plotX,d=b.plotY;a.isInsidePlot(c,d,a.inverted)?(b.graphic||(b.graphic=this.chart.renderer.path().add(this.markerGroup)),b.graphic.attr({d:this.arrow(b),translateX:c,translateY:d,rotation:b.direction}).attr(this.pointAttribs(b))):b.graphic&& 12 | (b.graphic=b.graphic.destroy())},this)},drawGraph:d.noop,animate:function(a){a?this.markerGroup.attr({opacity:.01}):(this.markerGroup.animate({opacity:1},d.animObject(this.options.animation)),this.animate=null)}})})(c)}); 13 | //# sourceMappingURL=vector.js.map 14 | -------------------------------------------------------------------------------- /2021/week18_ceo/ceo.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | library(ggplot2) 3 | library(tidytext) 4 | library(tidylo) 5 | 6 | departures <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-04-27/departures.csv') 7 | 8 | departures %>% 9 | count(fyear, departure_code) %>% View() 10 | ggplot(aes(x = fyear, y = n, group = departure_code))+ 11 | geom_line() 12 | 13 | 14 | notes_departures <- departures %>% 15 | unnest_tokens(text, notes, token = "words") 16 | 17 | log_notes <- notes_departures %>% 18 | filter(!is.na(departure_code)) %>% 19 | count(departure_code, text, sort = T) 20 | # bind_log_odds(departure_code, bigram, n) %>% 21 | # arrange(-log_odds_weighted) 22 | 23 | log_notes %>% 24 | anti_join(stop_words, by = c("text" = "word")) %>% 25 | group_by(text) %>% 26 | filter(sum(n) >= 10) %>% 27 | ungroup() %>% 28 | pivot_wider(names_from = departure_code, values_from = n, values_fill = 0) %>% 29 | mutate(across(where(is.numeric), list(~(. + 1) / (sum(.) + 1)))) %>% 30 | 31 | mutate(logratio = log(David / Julia)) %>% 32 | arrange(desc(logratio)) 33 | 34 | # 35 | # as.matrix() %>% 36 | # psych::pca(nfactors = 8) 37 | 38 | library(tidyr) 39 | log_notes %>% 40 | anti_join(stop_words, by = c("bigram" = "word")) %>% 41 | group_by(departure_code) %>% 42 | top_n(10) %>% 43 | ungroup %>% 44 | mutate(bigram = reorder(bigram, log_odds_weighted)) %>% 45 | ggplot(aes(bigram, log_odds_weighted, fill = departure_code)) + 46 | geom_col(show.legend = FALSE) + 47 | facet_wrap(~departure_code, scales = "free") + 48 | coord_flip() + 49 | labs(x = NULL) 50 | 51 | 52 | word_ratios <- tidy_tweets %>% 53 | filter(!str_detect(word, "^@")) %>% 54 | count(word, person) %>% 55 | group_by(word) %>% 56 | filter(sum(n) >= 10) %>% 57 | ungroup() %>% 58 | pivot_wider(names_from = person, values_from = n, values_fill = 0) %>% 59 | mutate_if(is.numeric, list(~(. + 1) / (sum(.) + 1))) %>% 60 | mutate(logratio = log(David / Julia)) %>% 61 | arrange(desc(logratio)) -------------------------------------------------------------------------------- /2019/1_Week38_Number of Visitors/README.md: -------------------------------------------------------------------------------- 1 | ![National Parks](https://user-images.githubusercontent.com/55328033/65224542-0e52c600-dacc-11e9-8f60-5a12421f2728.png) 2 | 3 | # Average number of visitors to national parks 4 | 5 | In this Tidytuesday i attempted at displaying the distribution for number of average visitors at national parks. Since it was my first attempt at plotting in R i tried to keep it simple. However, once i got into the graphing i found it too addicting and decided to create a nice outdoor scenery. Frankly, the idea for the background came after realizing the distribution looks like a mountain and from there I just played with the background theme. 6 | The implementation of icons and some background is inspired by Ariane Aumaitre's [#Tidytuesday](https://github.com/aaumaitre/tidytuesday/tree/master/Amusement%20Parks). 7 | 8 | #### Challenges i encountered: 9 | - Finding the appropriate graph - i used geom_step but later encountered geom_path which i think is a better fit (I'll keep at as is to have something nice to look back at :)). I started by using geom_col but it wasn't neatly displayed so stuck with geom_step. to overcome the challenge of the step (it's pretty sharply cut) i filled the inside and made it transparent. 10 | - I also wanted to show the Museums distribution inside that of the natioanl parks. however i was having trouble with *gather* function to aggregate it under number of visitors and factored by museum/parks. It might not even be the adequate function, anyway I'll try grouping next time! 11 | 12 | 13 | #### Things that helped me: 14 | - Icons are from www.pixabay.com and are free to use. the important note is to take **png** files that can be implemented easily (where the background is transparent). 15 | - This is my first project i synched with GitHub. It wasn't easy but not too complicated either, figured it out with [HappygitwithR](https://happygitwithr.com/). 16 | - I created this readme through a cool Template you can find [here](https://dillinger.io/). Hopefully next time i'll be able to do so through R Markdown :) 17 | 18 | *Let me know if you have any tips, suggestions and comments - would love to know!* 19 | -------------------------------------------------------------------------------- /extra/packages-plot.R: -------------------------------------------------------------------------------- 1 | library(purrr) 2 | library(stringr) 3 | library(dplyr) 4 | library(ggplot2) 5 | library(showtext) 6 | 7 | font_add_google("Roboto Condensed", "Roboto") 8 | showtext_auto() 9 | 10 | # Read all R and Rmd files 11 | files <- list.files( pattern = "\\.R$|.Rmd$", recursive = TRUE) 12 | 13 | # Remove the packages-plot.R file 14 | files <- files[!str_detect(files, "packages-plot.R")] 15 | 16 | # Get names 17 | file_names <- str_extract(files, '[^/]+(?=\\.)') 18 | 19 | #Read all files 20 | file_lines <- map(files, readLines) 21 | 22 | # Get the names 23 | names(file_lines) <- file_names 24 | 25 | # Get packages with regex 26 | file_packages <- map_dfr(file_lines, ~ tibble(package_name = str_extract(.x, "((?<=library\\().+(?=\\))|\\w+(?=::))")),.id = "tidytuesday") %>% 27 | filter(!is.na(package_name))%>% 28 | distinct(tidytuesday, package_name) 29 | 30 | 31 | # Plot 32 | file_packages %>% 33 | count(package_name, sort = T) %>% 34 | mutate(package_name = factor(package_name, levels = rev(package_name))) %>% 35 | slice(1:15) %>% 36 | ggplot()+ 37 | geom_col(aes(y= package_name, x = n), fill = "gray45")+ 38 | labs(title = "Frequently used packages in #Tidytuesday", 39 | subtitle = "Plot is rendered on every 'initial commit' to this repository, showing my 15 most frequently\nused packages in #TidyTuesday", 40 | x = "Number of times used", y = "Package name", 41 | caption = paste0("Total scripts: ", length(file_names), 42 | "\nLast updated ",format(Sys.Date(), "%b %d, %Y")))+ 43 | theme_minimal()+ 44 | theme( 45 | text = element_text(family = "Roboto"), 46 | plot.title = element_text(size = 20), 47 | plot.title.position = "plot", 48 | plot.subtitle = element_text(size = 13, color = "gray20"), 49 | plot.caption = element_text(color = "gray30", face = "italic"), 50 | axis.title = element_text(color = "gray40", size = 12), 51 | axis.text.x = element_text(size = 10), 52 | axis.text.y = element_text(size = 12), 53 | panel.grid.major.y = element_blank(), 54 | plot.margin = unit(c(4,2,2,4), "mm") 55 | ) 56 | 57 | ggsave("extra/packages-used.png", width = 8, height = 5) -------------------------------------------------------------------------------- /2020/week31_penguins/week31_penguins.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(highcharter) 3 | 4 | penguins <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-07-28/penguins.csv') 5 | 6 | penguins_column <- penguins %>% 7 | group_by(species) %>% 8 | summarise(across(c(bill_length_mm, body_mass_g), .fns = list(~ mean(.x, na.rm = T), ~ sd(.x, na.rm = T)), .names = "{col}_fn{fn}")) 9 | 10 | penguins_drilldown <- penguins %>% 11 | select(species, bill_length_mm, body_mass_g) %>% 12 | group_nest(species) %>% 13 | mutate(id = species, 14 | type = 'column') 15 | 16 | dat_boxplot <- data_to_boxplot(penguins, bill_length_mm, group_var = species, drilldown = species) 17 | 18 | 19 | highchart() %>% 20 | hc_xAxis(type = "category", color = "grey") %>% 21 | hc_add_series_list(dat_boxplot) %>% 22 | hc_drilldown(allowPointDrilldown = TRUE, 23 | series = list_parse(penguins_drilldown)) 24 | 25 | ?data_to_boxplot() 26 | hchart(dat_boxplot, "boxplot", hcaes(x = bill_length_mm, name = species)) 27 | 28 | library(highcharter) 29 | data(gapminder, package = "gapminder") 30 | 31 | gapminder_column, 32 | "boxplot", 33 | hcaes(x = continent, y = pop, name = continent, drilldown = continent), 34 | name = "Population", 35 | colorByPoint = TRUE 36 | 37 | 38 | gapminder2007 <- gapminder %>% 39 | filter(year == max(year)) %>% 40 | select(-year) %>% 41 | mutate(pop = pop/1e6) %>% 42 | arrange(desc(pop)) 43 | 44 | 45 | gapminder_column <- gapminder2007 %>% 46 | group_by(continent) %>% 47 | summarise( 48 | lifeExp = weighted.mean(lifeExp, pop), 49 | gdpPercap = weighted.mean(gdpPercap, pop), 50 | pop = sum(pop) 51 | ) %>% 52 | mutate_if(is.numeric, round) %>% 53 | arrange(desc(pop)) %>% 54 | mutate(continent = fct_inorder(continent)) 55 | 56 | gapminder_drilldown <- gapminder2007 %>% 57 | group_nest(continent) %>% 58 | mutate( 59 | id = continent, 60 | type = "column", 61 | # in the drilldown we'll give the mapping via creating the columns 62 | data = map(data, mutate, name = country, y = pop), 63 | data = map(data, list_parse) 64 | ) 65 | -------------------------------------------------------------------------------- /2019/Week51_adopted_dogs/adopted_dogs.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(treemapify) 3 | library(RColorBrewer) 4 | library(showtext) 5 | 6 | #load data 7 | dog_descriptions <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-12-17/dog_descriptions.csv') 8 | 9 | dog_sum <- dog_descriptions %>% 10 | group_by(breed_primary) %>% 11 | #getting total number of dogs per breed 12 | summarise(n = n()) %>% 13 | arrange(desc(n)) %>% 14 | #Filtering to have labels only for breeds with count >600 15 | mutate(name_label = case_when(n >600 ~ breed_primary, 16 | TRUE ~ ""), 17 | #Adding another row for label name of breeds with long names 18 | name_label = case_when(name_label == "American Staffordshire Terrier" ~ "American Staffordshire \n Terrier", 19 | name_label == "Australian Cattle Dog / Blue Heeler" ~ "Australian Cattle Dog /\n Blue Heeler", 20 | TRUE ~ name_label)) 21 | 22 | #Add google font 23 | font_add_google("IBM Plex Sans", "IBM Plex Sans") 24 | #having the font show 25 | showtext_auto() 26 | devtools::install_github("clauswilke/ggtext") 27 | 28 | ggplot(data = dog_sum,aes(area = n, fill = n, label = name_label))+ 29 | #Creates the treemap - note the start function for positioning the first box 30 | geom_treemap(fill = "gray75", color = "white",start = "topleft")+ 31 | #Adding the text on the boxes 32 | geom_treemap_text(color = "black", place = "centre", size = 42, start = "topleft", family = "IBM Plex Sans")+ 33 | labs(title = "Dog breeds for adoption in the US", subtitle = paste0("Only breeds with more than 600 counts are displayed"), 34 | caption = "Data: The Pudding | @Amit_Levinson")+ 35 | theme(text = element_text(family = "IBM Plex Sans"), 36 | plot.title = element_text(size = 60, face = "bold"), 37 | plot.subtitle = element_text(size = 36), 38 | plot.caption = element_text(size = 26, face = "italic")) 39 | #plot.margin = margin(0.7,0.7,0.7,0.7,"mm")) 40 | 41 | #Saving plot 42 | ggsave("total_breed.png", width = 10, height = 6) 43 | 44 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/bullet.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | 4 | Bullet graph series type for Highcharts 5 | 6 | (c) 2010-2018 Kacper Madej 7 | 8 | License: www.highcharts.com/license 9 | */ 10 | (function(c){"object"===typeof module&&module.exports?module.exports=c:"function"===typeof define&&define.amd?define(function(){return c}):c("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(c){(function(e){var c=e.pick,n=e.isNumber,v=e.relativeLength,p=e.seriesType,g=e.seriesTypes.column.prototype;p("bullet","column",{targetOptions:{width:"140%",height:3,borderWidth:0},tooltip:{pointFormat:'\x3cspan style\x3d"color:{series.color}"\x3e\u25cf\x3c/span\x3e {series.name}: \x3cb\x3e{point.y}\x3c/b\x3e. Target: \x3cb\x3e{point.target}\x3c/b\x3e\x3cbr/\x3e'}}, 11 | {pointArrayMap:["y","target"],parallelArrays:["x","y","target"],drawPoints:function(){var a=this,k=a.chart,q=a.options,p=q.animationLimit||250;g.drawPoints.apply(this);a.points.forEach(function(b){var g=b.options,h,d=b.targetGraphic,l=b.target,m=b.y,r,t,f,u;n(l)&&null!==l?(f=e.merge(q.targetOptions,g.targetOptions),t=f.height,h=b.shapeArgs,r=v(f.width,h.width),u=a.yAxis.translate(l,!1,!0,!1,!0)-f.height/2-.5,h=a.crispCol.apply({chart:k,borderWidth:f.borderWidth,options:{crisp:q.crisp}},[h.x+h.width/ 12 | 2-r/2,u,r,t]),d?(d[k.pointCount% 18 | select(season,episode, text) %>% 19 | unnest_tokens(bigram, text, token = "ngrams", n = 2) %>% 20 | separate(bigram, into = c("word1", "word2"), sep = " ", remove = FALSE) %>% 21 | # remove stop words: 22 | filter(!word1 %in% stop_words$word, 23 | !word2 %in% stop_words$word, 24 | # filter bigram with the same word: 25 | word1 != word2) %>% 26 | # filter words like hey, yeah, mmm from the regex above: 27 | filter(!str_detect(word1, str_pattern), 28 | !str_detect(word2, str_pattern)) %>% 29 | count(word1, word2, sort = T) %>% 30 | slice(1:30) %>% 31 | # Prepare the data for plotting from the {igraph} 32 | graph_from_data_frame() 33 | 34 | # adding arrows: 35 | p_arrow <- arrow(type = "closed", length = unit(.10, "inches")) 36 | 37 | # plot from the {ggraph} 38 | ggraph(office_bigram, layout = "fr")+ 39 | geom_edge_link(aes(edge_alpha = n), arrow = p_arrow, end_cap =circle(.04, "inches"), show.legend = FALSE)+ 40 | geom_node_point(color = "lightblue", size = 3)+ 41 | geom_node_text(aes(label = name), vjust = 1, hjust = 1)+ 42 | labs(title = "Top 30 frequent bigrams throughout 'The office'", 43 | caption = paste0("bigrams (pair of words) with dupliacted words, stop words and words such as 'yeah', 'uh', mm' were removed. \n", 44 | "Darker arrows indicate a higher frequency. Data from: R schrute package | @Amit_Levinson"))+ 45 | theme_void()+ 46 | theme( 47 | plot.title = element_text(family = "Roboto Condensed", face= "bold", hjust = 0.5, size = 20), 48 | plot.caption = element_text(face = "italic", family = "Roboto Condensed", hjust = 0.01)) 49 | 50 | # Save 51 | ggsave("tt_schrute.png", width = 10, height = 6) 52 | 53 | 54 | # This was made along with the fantastic tidytext book for text analysis 55 | # Check it out here: 56 | # https://www.tidytextmining.com/ -------------------------------------------------------------------------------- /2019/Week47_nz_birds/nz_birds.Rmd: -------------------------------------------------------------------------------- 1 | output: html_document 2 | editor_options: 3 | chunk_output_type: console 4 | 5 | ```{r setup, include=FALSE} 6 | knitr::opts_chunk$set(echo = TRUE) 7 | ``` 8 | 9 | ```{r} 10 | library(tidyverse) 11 | library(lubridate) 12 | library(ggthemes) 13 | library(viridis) 14 | library(extrafont) 15 | nz_bird <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-11-19/nz_bird.csv") 16 | ``` 17 | 18 | ```{r} 19 | glimpse(nz_bird) 20 | 21 | 22 | #create a new df 23 | by_date_hour <- 24 | nz_bird %>% 25 | #extract day of the week - apparently there were exactly two times of each day (14 days total) 26 | mutate(day_of_week = weekdays(date)) %>% 27 | group_by (day_of_week, hour) %>% 28 | #the count/5 is to get the number of voters, each person voted 5 times ( should be a total of 43460/5)). 29 | summarise(count = n()/5) %>% 30 | ungroup() %>% 31 | #reordering factor levels to fit the weekday scehdule 32 | mutate(day_of_week = ordered(day_of_week, levels = c("Sunday","Saturday","Friday", "Thursday", "Wednesday","Tuesday", "Monday"))) 33 | 34 | #Let's see how many voted on Monday? 35 | by_date_hour %>% 36 | arrange(desc(count)) 37 | 38 | 39 | #Plot! 40 | g <- ggplot(by_date_hour, aes(x = hour,y= day_of_week, fill =count))+ 41 | geom_tile(color = "white", size = 0.1)+ 42 | #This creates an equal ration for the squares of 1:1 43 | coord_equal()+ 44 | #Good color scale emphasizing the highest number 45 | scale_fill_viridis(name = "# Voters")+ 46 | labs(x = NULL, y = NULL, title = "NZ Bird of the Year Voting Distribution across day and time", 47 | subtitle = "Sunday night's tiredness generates Monday noon's peak diversion interest?", caption = "Data: Dragonfly Data Science | @Amit_Levinson")+ 48 | #Wanted to display all hours of the day 49 | scale_x_continuous(breaks = seq(0,23,1))+ 50 | theme_tufte() 51 | 52 | g+ 53 | theme(text = element_text(family = "Microsoft Tai Le"), 54 | axis.ticks = element_blank(), 55 | axis.text = element_text(size = 14), 56 | plot.caption = element_text(size = 8, face = "italic"), 57 | plot.title = element_text(size = 20), 58 | plot.subtitle = element_text(size = 14) 59 | ) 60 | 61 | ggsave("nz_bird_vote.png", width =10, height = 6) 62 | ``` 63 | 64 | -------------------------------------------------------------------------------- /2019/1_Week38_Number of Visitors/National Parks.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(png) 3 | library(gridGraphics) 4 | 5 | park_visits <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-09-17/national_parks.csv") 6 | 7 | park_visits$year <- as.integer(park_visits$year,na.omit = T) 8 | park_visits$visitors <- as.integer(park_visits$visitors,na.omit = T) 9 | park_visits$unit_type <- as.factor(park_visits$unit_type) 10 | 11 | #cleaning the data 12 | National_parks <- park_visits %>% 13 | filter(unit_type == "National Park") %>% 14 | group_by(year) %>% 15 | mutate(average_per_year = mean(visitors)) %>% 16 | select(year, average_per_year) %>% 17 | summarise(Visitors_Parks = mean(average_per_year)) %>% 18 | mutate(Visitors_Parks = Visitors_Parks/1000) %>% 19 | na.omit 20 | 21 | #preparing icons for later insertion; 22 | img1 <- readPNG("sun.png") 23 | fig1 <- rasterGrob(img1) 24 | 25 | img2 <- readPNG("cloud.png") 26 | fig2 <- rasterGrob(img2) 27 | 28 | img2a <- readPNG("cloud.png") 29 | fig2a <- rasterGrob(img2a) 30 | 31 | img3 <- readPNG("stickman.png") 32 | fig3 <- rasterGrob(img3) 33 | 34 | #plotting 35 | ggplot(National_parks, mapping = aes(x = year, y = Visitors_Parks)) + 36 | geom_step(color = "green4") + 37 | geom_linerange(data = National_parks, aes(x = year, ymin = 0, ymax = Visitors_Parks), 38 | color = 'green4') + 39 | #adding labels: 40 | labs(x = "", y = " ", title = "Visitors in National Parks", 41 | subtitle = "Average per year (Thousands)", caption = "data from: data.world | AmitL")+ 42 | 43 | #changing background for a nice clear sky 44 | theme(panel.background = element_rect(fill = 'lightskyblue2', color = 'lightblue', size = 0.5), 45 | panel.grid.major = element_line(color = 'white', linetype = 'dashed'), 46 | panel.grid.minor = element_blank(), 47 | axis.line = element_line(size = 0.1, linetype = "solid", colour = "black")) + 48 | 49 | #playing with some icons 50 | annotation_custom(fig2, xmin=1975, xmax=1985, ymin=1100, ymax=1400) + 51 | annotation_custom(fig2a, xmin=1925, xmax=1935, ymin=900, ymax=1200) + 52 | annotation_custom(fig1, xmin=1899, xmax=1920, ymin=1200, ymax=1400)+ 53 | annotation_custom(fig3, xmin=1915, xmax=1925, ymin=50, ymax=200) 54 | 55 | ggsave("National Parks.png", width = 10, height = 5) -------------------------------------------------------------------------------- /2019/Week42_Cars/Cars.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | 3 | big_epa_cars <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-15/big_epa_cars.csv") 4 | 5 | str(big_epa_cars) 6 | view(big_epa_cars) 7 | 8 | 9 | ford <- 10 | big_epa_cars %>% 11 | group_by(make, model) %>% 12 | filter(make =="Ford") %>% 13 | count(n()) 14 | 15 | V_class <- 16 | big_epa_cars %>% 17 | select(VClass, barrels08, fuelCost08,city08, highway08, co2TailpipeGpm, fuelCost08) %>% 18 | group_by(VClass) %>% 19 | summarise(meancity = mean(city08), meanhighway = mean(highway08), meanco2 = mean(co2TailpipeGpm), 20 | n = n()) %>% 21 | arrange(desc(n)) 22 | 23 | 24 | fuel_type <- 25 | big_epa_cars %>% 26 | select(year, model, make, VClass, barrels08, fuelCost08,city08, highway08, co2TailpipeGpm, fuelCost08) %>% 27 | group_by(make,year) %>% 28 | summarise(MPG = mean(barrels08),n = n()) %>% 29 | arrange(desc(n)) 30 | 31 | filter(n >= 100) 32 | 33 | compact_cars <- 34 | big_epa_cars %>% 35 | select(year, model, make, VClass, barrels08, fuelCost08,city08, highway08, co2TailpipeGpm, fuelCost08) %>% 36 | group_by(VClass) %>% 37 | mutate(pricepermile = fuelCost08/15000) %>% 38 | summarise(Highway = mean(highway08), City = mean(city08), pricepermile = mean(pricepermile), 39 | n = n()) %>% 40 | arrange(desc(n)) 41 | 42 | 43 | meancities <- mean(compact_cars$City) 44 | meanhighway <- mean(compact_cars$Highway) 45 | 46 | 47 | sd_cities <- sd(compact_cars$City) 48 | sd_cities 49 | 50 | dis_from_mean_fuel <- 51 | compact_cars %>% 52 | mutate(Milesforcity = City - meancities, Mileforhighway = Highway - meanhighway) %>% 53 | select(VClass, Milesforcity, Mileforhighway) 54 | 55 | 56 | 57 | 58 | arrange(desc(n, CO2_Average)) 59 | 60 | 61 | 62 | gather("catgeories", "Value", 2:3) 63 | 64 | p <- compact_cars %>% 65 | ggplot(aes(x = make, y = Value))+ 66 | geom_bar(stat = "identity") 67 | 68 | p+ facet_grid(. ~ catgeories) 69 | 70 | 71 | meancity = mean(city08), meanhighway = mean(highway08) 72 | 73 | group_by(year) %>% 74 | summarise(n= n()) 75 | 76 | over_1000 <- big_epa_cars %>% 77 | group_by(make) %>% 78 | count() %>% 79 | arrange(desc(n)) 80 | 81 | mean_make <- big_epa_cars %>% 82 | group_by(make) %>% 83 | summarise(mea = mean(co2TailpipeGpm, na.rm = T)) 84 | 85 | -------------------------------------------------------------------------------- /2020/week51_ninja/ninja_warriors.R: -------------------------------------------------------------------------------- 1 | # Read data 2 | ninja_warrior <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-12-15/ninja_warrior.csv') 3 | library(dplyr) 4 | library(ggraph) 5 | library(igraph) 6 | library(ggtext) 7 | library(extrafont) 8 | 9 | # Create an object to pass to a network graph 10 | obstacle_order <- ninja_warrior %>% 11 | group_by(season, location, round_stage) %>% 12 | # Create a 'from' and 'to' columns for network graph 13 | mutate(to = lead(obstacle_name), 14 | # Aggregate to have some sort of count 15 | arc_name = paste0(obstacle_name, "-", to)) %>% 16 | ungroup() %>% 17 | select(from = obstacle_name, to, arc_name) %>% 18 | filter(!is.na(to)) %>% 19 | add_count(arc_name, sort = T) %>% 20 | select(-arc_name) 21 | 22 | # Count how many are under 2 occurrences 23 | obstacle_order %>% 24 | count(n, sort = T) %>% 25 | group_by(under_2 = n <=2) %>% 26 | summarise(total = sum(nn)) %>% 27 | mutate(prop = total/sum(total)) # ~68% of two-sequence obstacles occur only once or twice 28 | 29 | # Plot 30 | graph_from_data_frame(obstacle_order) %>% 31 | ggraph(layout= 'linear', circular = TRUE)+ 32 | geom_edge_arc(aes(color = ifelse(n<=2, "Under 2 combinations", "more than two")), show.legend = FALSE, edge_width = 0.3)+ 33 | #geom_node_point(size = 1, color = "gray55", fill = NA)+ 34 | scale_edge_color_manual(values = c("Under 2 combinations"= "#26677f", "more than two" ="#89374f")) + 35 | labs(title = "Randomness in Ninja-Warrior obstacle courses", 36 | subtitle = "Each arc represents the transition from one obstacle to another in a ninja-warrior obstacle course. Majority of
obstacle transitions (i.e. an arc) occur only once or twice throughout stages, seasons and locations. For example,
transitioning from 'Jumping Bars' to a 'Cargo Climb' occurs only in the Semi-Finals of season 1 in Venice.")+ 37 | theme( 38 | text = element_text(family = "Roboto Condensed"), 39 | plot.title = element_text(size = 22, face = "bold"), 40 | plot.subtitle = element_markdown(size = 13), 41 | plot.background = element_rect(fill = "gray90", color = "gray55"), 42 | panel.background = element_rect(fill = "gray90"), 43 | plot.margin = margin(4,4,2,4, "mm") 44 | ) 45 | 46 | # Save 47 | ggsave("2020/week51_ninja/week51_ninja.png", width = 10, height = 8) -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/funnel.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | Highcharts funnel module 4 | 5 | (c) 2010-2018 Torstein Honsi 6 | 7 | License: www.highcharts.com/license 8 | */ 9 | (function(a){"object"===typeof module&&module.exports?module.exports=a:"function"===typeof define&&define.amd?define(function(){return a}):a("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(a){(function(a){var p=a.seriesType,D=a.seriesTypes,H=a.noop,E=a.pick;p("funnel","pie",{animation:!1,center:["50%","50%"],width:"90%",neckWidth:"30%",height:"100%",neckHeight:"25%",reversed:!1,size:!0,dataLabels:{connectorWidth:1},states:{select:{color:"#cccccc",borderColor:"#000000"}}},{animate:H, 10 | translate:function(){var d=function(b,a){return/%$/.test(b)?a*parseInt(b,10)/100:parseInt(b,10)},a=0,f=this.chart,e=this.options,c=e.reversed,v=e.ignoreHiddenPoint,t=f.plotWidth,f=f.plotHeight,q=0,p=e.center,g=d(p[0],t),r=d(p[1],f),D=d(e.width,t),k,w,l=d(e.height,f),x=d(e.neckWidth,t),F=d(e.neckHeight,f),y=r-l/2+l-F,d=this.data,A,B,E="left"===e.dataLabels.position?1:0,C,m,G,u,h,z,n;this.getWidthAt=w=function(b){var a=r-l/2;return b>y||l===F?x:x+(D-x)*(1-(b-a)/(l-F))};this.getX=function(b,a,d){return g+ 11 | (a?-1:1)*(w(c?2*r-b:b)/2+d.labelDistance)};this.center=[g,r,l];this.centerX=g;d.forEach(function(b){v&&!1===b.visible||(a+=b.y)});d.forEach(function(b){n=null;B=a?b.y/a:0;m=r-l/2+q*l;h=m+B*l;k=w(m);C=g-k/2;G=C+k;k=w(h);u=g-k/2;z=u+k;m>y?(C=u=g-x/2,G=z=g+x/2):h>y&&(n=h,k=w(y),u=g-k/2,z=u+k,h=y);c&&(m=2*r-m,h=2*r-h,null!==n&&(n=2*r-n));A=["M",C,m,"L",G,m,z,h];null!==n&&A.push(z,n,u,n);A.push(u,h,"Z");b.shapeType="path";b.shapeArgs={d:A};b.percentage=100*B;b.plotX=g;b.plotY=(m+(n||h))/2;b.tooltipPos= 12 | [g,b.plotY];b.slice=H;b.half=E;v&&!1===b.visible||(q+=B)})},sortByAngle:function(a){a.sort(function(a,d){return a.plotY-d.plotY})},drawDataLabels:function(){var a=this.data,p=this.options.dataLabels.distance,f,e,c,v=a.length,t,q;for(this.center[2]-=2*p;v--;)c=a[v],e=(f=c.half)?1:-1,q=c.plotY,c.labelDistance=E(c.options.dataLabels&&c.options.dataLabels.distance,p),this.maxLabelDistance=Math.max(c.labelDistance,this.maxLabelDistance||0),t=this.getX(q,f,c),c.labelPosition={natural:{x:0,y:q},"final":{}, 13 | alignment:f?"right":"left",connectorPosition:{breakAt:{x:t+(c.labelDistance-5)*e,y:q},touchingSliceAt:{x:t+c.labelDistance*e,y:q}}};D.pie.prototype.drawDataLabels.call(this)}});p("pyramid","funnel",{neckWidth:"0%",neckHeight:"0%",reversed:!0})})(a)}); 14 | //# sourceMappingURL=funnel.js.map 15 | -------------------------------------------------------------------------------- /2021/week6_hbcu/hbcu.R: -------------------------------------------------------------------------------- 1 | library(here) 2 | library(ggplot2) 3 | library(dplyr) 4 | library(tidyr) 5 | library(ggtext) 6 | library(extrafont) 7 | library(waffle) 8 | 9 | 10 | hbcu <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-02-02/hbcu_all.csv') 11 | 12 | # a little data manipulation: 13 | hbcu_tidy <- hbcu %>% 14 | pivot_longer(cols = Males:Females, names_to = "gender", values_to = "enrolled") %>% 15 | mutate(enrolled = round(enrolled / 1000, 0)) %>% 16 | # unfortunately no data for 1985 :( 17 | filter(Year %% 5 == 0) 18 | 19 | hbcu_tidy %>% 20 | ggplot()+ 21 | geom_pictogram(aes(values = enrolled, label = "gender", color = gender), n_rows = 10, flip = TRUE, size = 4, family = "Font Awesome 5 Free Solid")+ 22 | facet_wrap(~ Year, nrow = 1, strip.position = "bottom")+ 23 | scale_label_pictogram(name = NULL, values = c("graduation-cap"))+ 24 | scale_y_continuous(breaks = c(10,20,30), labels = paste0(seq(100,300,100), "k"))+ 25 | scale_color_manual(values = c("#72BC79", "gray70"))+ 26 | coord_equal()+ 27 | labs(title = "Student Enrollment in Historically Black Colleges and Universities (HBCU)", 28 | subtitle = "HBCU institution enrollment since the 1980s. Much of this increase results from greater female participation than **men**.

29 | = 1,000 students", 30 | caption = "\nData: Data.World | @Amit_Levinson")+ 31 | theme_minimal(base_family = "Mukta Medium")+ 32 | theme(legend.position = "none", 33 | plot.subtitle = element_markdown(size = 20, family = "Mukta Light"), 34 | plot.title = element_markdown(size = 26), 35 | plot.caption = element_text(size = 11, color = "gray45", face = "italic"), 36 | axis.text.x = element_blank(), 37 | axis.text.y = element_text(size = 13, color = "gray50"), 38 | strip.text = element_text(size = 14, color = "gray35"), 39 | panel.grid.minor.x = element_blank(), 40 | panel.grid.major.x = element_blank(), 41 | panel.grid.minor.y = element_blank(), 42 | panel.grid.major.y = element_line(color = "gray85", linetype = "dashed"), 43 | plot.margin = margin (4,4,4,4, "mm")) 44 | #ggsave(here("extra","images", "progress", "2021-week6", paste0(format(Sys.time(), "%Y%m%d_%H%M%S"), ".png")), type = 'cairo', height = 4, width = 6) 45 | 46 | 47 | ggsave(here("2021", "week6_hbcu", "hbcu.png"), width = 16, height = 12) 48 | -------------------------------------------------------------------------------- /2020/week11_college/trial.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | tuition_cost <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-10/tuition_cost.csv') 3 | tuition_income <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-10/tuition_income.csv') 4 | salary_potential <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-10/salary_potential.csv') 5 | historical_tuition <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-10/historical_tuition.csv') 6 | diversity_school <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-10/diversity_school.csv') 7 | 8 | tuition_cost %>% 9 | group_by(state, type) %>% 10 | summarise(avg_tuition = mean(in_state_tuition)) %>% 11 | arrange(-avg_tuition) 12 | 13 | tuition_income 14 | 15 | 16 | tuition_cost 17 | 18 | new <- salary_potential %>% 19 | mutate(diff = abs(mid_career_pay-early_career_pay)) 20 | 21 | 22 | salary_potential %>% 23 | right_join(tuition_income) 24 | 25 | 26 | historical_tuition %>% 27 | mutate(new_year = str_extract(year, pattern = "\\d{4}")) %>% 28 | #filter(tuition_type == "All Constant") %>% 29 | ggplot(aes(x = new_year, y= tuition_cost, group = type, color = type))+ 30 | geom_line()+ 31 | facet_wrap(~ tuition_type) 32 | ?facet_wrap 33 | View() 34 | count(new_year) 35 | 36 | ?str_extract 37 | separate(col = year, into = "new_year", sep = "([1-9])\\1\\1\\1\\1") 38 | 39 | ?separate 40 | 41 | ggplot(aes(x = stem_percent, make_world_better_percent))+ 42 | geom_point() 43 | 44 | max(salary_potential$make_world_better_percent, na.rm = T) 45 | 46 | summarise(avg_p = mean(make_world_better_percent)) %>% 47 | 48 | 49 | View() 50 | arrange(-avg_p) 51 | 52 | right_join(tuition_cost, by = "name") 53 | 54 | cor.test(new$mid_career_pay, new$make_world_better_percent) 55 | ggplot(salary_potential,aes(mid_career_pay, make_world_better_percent, fill = ifelse(rank < 40, "red", "black")))+ 56 | geom_point() 57 | 58 | ?cor.test 59 | tuition_cost 60 | 61 | historical_tuition %>% 62 | count(year) 63 | 64 | 65 | 66 | tuition_cost %>% 67 | right_join(diversity_school) %>% 68 | mutate(id = row_number()) %>% 69 | pivot_wider(names_from = "category", values_from = "enrollment") %>% 70 | select(c(1,2,4,"total_enrollment":"Total Minority")) 71 | View() 72 | ?pivot_wider 73 | View() 74 | 75 | diversity_school %>% 76 | drop_na() %>% 77 | pivot_wider(names_from = "category", values_from = "enrollment") 78 | -------------------------------------------------------------------------------- /2020/week14_beer_production/beer_state.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | 3 | beer_states <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-31/beer_states.csv') 4 | 5 | 6 | # Exploring --------------------------------------------------------------- 7 | 8 | glimpse(beer_states) 9 | 10 | beer_states %>% 11 | filter(state != "total") %>% 12 | ggplot(aes(x = year, y = barrels, color = state))+ 13 | geom_line(show.legend = FALSE)+ 14 | facet_wrap(~ type, scales = "free_y")+ 15 | scale_y_continuous(breaks = breaks_extended(8)) 16 | 17 | # Let's look at how much does the top value in kegs and barrels compare to other states in 2019 -------- 18 | kegs_2019 <- beer_states %>% 19 | filter(state != "total",year == "2019", type == "Kegs and Barrels") 20 | 21 | # Leading kegs and barrels maker: 22 | ca <- kegs_2019 %>% 23 | arrange(-barrels) %>% 24 | slice(1) 25 | 26 | # All other states summing up +-: 27 | state_list <- kegs_2019 %>% 28 | arrange(barrels) %>% 29 | slice(1:36) 30 | 31 | new_kegs <- rbind(ca, state_list) %>% 32 | # add criteria for only CA: 33 | mutate(ca = ifelse(state == "CA", "CA", "Not CA"), 34 | barrels = barrels/10000) 35 | 36 | new_kegs %>% 37 | ggplot(aes(label = ca, values = barrels))+ 38 | geom_pictogram(n_rows = 10,aes(color = ca), size = 0.33, flip = TRUE)+ 39 | scale_color_manual(name = NULL, 40 | values = "#c68958", "#a40000", 41 | labels = c("CA", "Other"))+ 42 | scale_label_pictogram(name = NULL, 43 | values = c("beer", "beer"), 44 | labels = c("CA", "Other"))+ 45 | coord_equal()+ 46 | theme_minimal()+ 47 | theme_enhance_waffle() 48 | 49 | 50 | install_fa_fonts() 51 | ?scale_label_pictogram 52 | library(waffle) 53 | devtools::install_github("hrbrmstr/waffle") 54 | ?geom_pictogram 55 | ?facet_wrap 56 | extrafont::font_import() 57 | 58 | 59 | beer_states %>% 60 | 61 | View(beer_states) 62 | 63 | library(scales) 64 | ?scales 65 | count(state) 66 | beer_states 67 | 68 | brewer_size <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-31/brewer_size.csv') 69 | brewer_size %>% 70 | count(year) 71 | 72 | brewing_materials <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-31/brewing_materials.csv') 73 | 74 | brewing_materials %>% 75 | count(year) 76 | View(brewing_materials) 77 | pivot_longer(cols = month_current:month_prior_year, = material_type) %>% 78 | ggplot(aes(x = year, y = value))+ 79 | geom_line()+ 80 | facet_wrap(~ name) 81 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/cylinder.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | Highcharts cylinder module 4 | 5 | (c) 2010-2018 Kacper Madej 6 | 7 | License: www.highcharts.com/license 8 | */ 9 | (function(h){"object"===typeof module&&module.exports?module.exports=h:"function"===typeof define&&define.amd?define(function(){return h}):h("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(h){(function(e){var h=e.charts,k=e.color,q=e.deg2rad,r=e.perspective,t=e.seriesType,g=e.Renderer.prototype,u=g.cuboidPath;t("cylinder","column",{},{},{shapeType:"cylinder"});e=e.merge(g.elements3d.cuboid,{parts:["top","bottom","front","back"],pathType:"cylinder",fillSetter:function(a){this.singleSetterForParts("fill", 10 | null,{front:a,back:a,top:k(a).brighten(.1).get(),bottom:k(a).brighten(-.1).get()});this.color=this.fill=a;return this}});g.elements3d.cylinder=e;g.cylinder=function(a){return this.element3d("cylinder",a)};g.cylinderPath=function(a){var b=h[this.chartIndex],c=u.call(this,a),d=!c.isTop,e=!c.isFront,f=this.getCylinderEnd(b,a);a=this.getCylinderEnd(b,a,!0);return{front:this.getCylinderFront(f,a),back:this.getCylinderBack(f,a),top:f,bottom:a,zIndexes:{top:d?3:0,bottom:d?0:3,front:e?2:1,back:e?1:2,group:c.zIndexes.group}}}; 11 | g.getCylinderFront=function(a,b){a=a.slice(0,a.simplified?9:17);a.push("L");b.simplified?(a=a.concat(b.slice(7,9)).concat(b.slice(3,6)).concat(b.slice(0,3)),a[a.length-3]="L"):a.push(b[15],b[16],"C",b[13],b[14],b[11],b[12],b[8],b[9],"C",b[6],b[7],b[4],b[5],b[1],b[2]);a.push("Z");return a};g.getCylinderBack=function(a,b){var c=["M"];b.simplified?(c=c.concat(a.slice(7,12)),c.push("L",a[1],a[2])):c=c.concat(a.slice(15));c.push("L");b.simplified?c=c.concat(b.slice(1,3)).concat(b.slice(9,12)).concat(b.slice(6, 12 | 9)):c.push(b[29],b[30],"C",b[27],b[28],b[25],b[26],b[22],b[23],"C",b[20],b[21],b[18],b[19],b[15],b[16]);c.push("Z");return c};g.getCylinderEnd=function(a,b,c){var d=Math.min(b.width,b.depth)/2,e=q*(a.options.chart.options3d.beta-90);c=b.y+(c?b.height:0);var f=.5519*d,g=b.width/2+b.x,h=b.depth/2+b.z,l=[{x:0,y:c,z:d},{x:f,y:c,z:d},{x:d,y:c,z:f},{x:d,y:c,z:0},{x:d,y:c,z:-f},{x:f,y:c,z:-d},{x:0,y:c,z:-d},{x:-f,y:c,z:-d},{x:-d,y:c,z:-f},{x:-d,y:c,z:0},{x:-d,y:c,z:f},{x:-f,y:c,z:d},{x:0,y:c,z:d}],k=Math.cos(e), 13 | p=Math.sin(e),m,n;l.forEach(function(a,b){m=a.x;n=a.z;l[b].x=m*k-n*p+g;l[b].z=n*k+m*p+h});a=r(l,a,!0);2.5>Math.abs(a[3].y-a[9].y)?(a=this.toLinePath([a[0],a[3],a[6],a[9]],!0),a.simplified=!0):a=this.getCurvedPath(a);return a};g.getCurvedPath=function(a){var b=["M",a[0].x,a[0].y],c=a.length-2,d;for(d=1;d% 13 | count(pkg_name,version,sort = T) 14 | options(digits = 0) 15 | 16 | cran_code 17 | 18 | #New attempt 19 | clean_avg <- cran_code %>% 20 | add_count(language) %>% 21 | filter(n > 20) %>% 22 | group_by(language) %>% 23 | summarise(count = n(), 24 | avg = median(code)) %>% 25 | mutate(language = fct_reorder(language, avg)) %>% 26 | arrange(desc(avg)) 27 | 28 | clean_avg 29 | 30 | 31 | 32 | ggplot(clean_avg, aes(x = language, y = avg))+ 33 | geom_segment(aes(x = language, xend = language, y= 0, yend = avg), color = "grey45")+ 34 | geom_point(aes(size = count), color = "coral1")+ 35 | coord_flip()+ 36 | labs(title = "Median number of code lines from programming languages used in R packages", subtitle = "Point size represents frequency of programming language across packages. Only languages used in more than \n15 packages are displayed.", 37 | y = "Median lines of code" ,x = "Programming language", colour = "Language Frequecy")+ 38 | theme_cowplot(font_size = 12)+ 39 | theme( 40 | panel.grid.minor.y = element_blank(), 41 | panel.grid.major.y = element_blank(), 42 | legend.title = element_blank(), 43 | plot.background = element_rect(fill = "ivory") 44 | #panel.grid.minor = element_blank() 45 | ) 46 | 47 | #Try ggridges? 48 | ggplot(iris, aes(x = Sepal.Length, y = Species)) + geom_density_ridges2() 49 | 50 | clean_ggridges <- 51 | cran_code %>% 52 | add_count(language) %>% 53 | filter(n >2000) %>% 54 | mutate (code_new = log(code), 55 | language = as.factor(language)) 56 | 57 | str(clean_ggridges$language) 58 | 59 | clean_ggridges 60 | clean_ggridges %>% 61 | count(language) 62 | 63 | library(ggridges) 64 | 65 | ggplot(clean_ggridges, aes(x = code, y = language))+ 66 | geom_density_ridges2(rel_min_height = ) 67 | 68 | 69 | 70 | 71 | 72 | ggsave("cran.png", width =10, height = 6) 73 | 74 | theme_set(theme_cowplot()) 75 | library(cowplot) 76 | 77 | view(filtered) 78 | high <- cran_code %>% 79 | arrange(desc(code)) 80 | view(clean_avg) 81 | 82 | clean <- cran_code %>% 83 | group_by(language) %>% 84 | summarise(count = n()) %>% 85 | filter(language != "R") %>% 86 | arrange(desc(count)) 87 | 88 | view(clean) 89 | clean 90 | wordcloud2(clean, size = 1.6) 91 | wordcloud2(clean, size = 1.5, figPath = "test.jpeg") 92 | 93 | letterCloud(clean,"R") 94 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/variwide.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | Highcharts variwide module 4 | 5 | (c) 2010-2018 Torstein Honsi 6 | 7 | License: www.highcharts.com/license 8 | */ 9 | (function(c){"object"===typeof module&&module.exports?module.exports=c:"function"===typeof define&&define.amd?define(function(){return c}):c("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(c){(function(d){var c=d.addEvent,p=d.seriesType,n=d.seriesTypes,l=d.pick;p("variwide","column",{pointPadding:0,groupPadding:0},{pointArrayMap:["y","z"],parallelArrays:["x","y","z"],processData:function(a){this.totalZ=0;this.relZ=[];n.column.prototype.processData.call(this,a);(this.xAxis.reversed?this.zData.slice().reverse(): 10 | this.zData).forEach(function(a,m){this.relZ[m]=this.totalZ;this.totalZ+=a},this);this.xAxis.categories&&(this.xAxis.variwide=!0,this.xAxis.zData=this.zData)},postTranslate:function(a,h,m){var e=this.xAxis,b=this.relZ;a=e.reversed?b.length-a:a;var d=e.reversed?-1:1,k=e.len,c=this.totalZ,e=a/b.length*k,f=(a+d)/b.length*k,g=l(b[a],c)/c*k,b=l(b[a+d],c)/c*k;m&&(m.crosshairWidth=b-g);return g+(h-e)*(b-g)/(f-e)},translate:function(){var a=this.options.crisp,h=this.xAxis;this.options.crisp=!1;n.column.prototype.translate.call(this); 11 | this.options.crisp=a;var d=this.chart.inverted,e=this.borderWidth%2/2;this.points.forEach(function(b,a){var c;h.variwide?(c=this.postTranslate(a,b.shapeArgs.x,b),a=this.postTranslate(a,b.shapeArgs.x+b.shapeArgs.width)):(c=b.plotX,a=h.translate(b.x+b.z,0,0,0,1));this.options.crisp&&(c=Math.round(c)-e,a=Math.round(a)-e);b.shapeArgs.x=c;b.shapeArgs.width=a-c;b.plotX=(c+a)/2;d?b.tooltipPos[1]=h.len-b.shapeArgs.x-b.shapeArgs.width/2:b.tooltipPos[0]=b.shapeArgs.x+b.shapeArgs.width/2},this)}},{isValid:function(){return d.isNumber(this.y, 12 | !0)&&d.isNumber(this.z,!0)}});d.Tick.prototype.postTranslate=function(a,c,d){var e=this.axis,b=a[c]-e.pos;e.horiz||(b=e.len-b);b=e.series[0].postTranslate(d,b);e.horiz||(b=e.len-b);a[c]=e.pos+b};c(d.Axis,"afterDrawCrosshair",function(a){this.variwide&&this.cross&&this.cross.attr("stroke-width",a.point&&a.point.crosshairWidth)});c(d.Axis,"afterRender",function(){var a=this;!this.horiz&&this.variwide&&this.chart.labelCollectors.push(function(){return a.tickPositions.map(function(c,d){c=a.ticks[c].label; 13 | c.labelrank=a.zData[d];return c})})});c(d.Tick,"afterGetPosition",function(a){var c=this.axis,d=c.horiz?"x":"y";c.variwide&&(this[d+"Orig"]=a.pos[d],this.postTranslate(a.pos,d,this.pos))});d.wrap(d.Tick.prototype,"getLabelPosition",function(a,c,d,e,b,n,k,l){var f=Array.prototype.slice.call(arguments,1),g=b?"x":"y";this.axis.variwide&&"number"===typeof this[g+"Orig"]&&(f[b?0:1]=this[g+"Orig"]);f=a.apply(this,f);this.axis.variwide&&this.axis.categories&&this.postTranslate(f,g,l);return f})})(c)}); 14 | //# sourceMappingURL=variwide.js.map 15 | -------------------------------------------------------------------------------- /2019/Week50_diseases/diseases.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(maps) 3 | library(gganimate) 4 | library(ggthemes) 5 | library(extrafont) 6 | library(viridis) 7 | 8 | diseases <- read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-12-10/diseases.csv") 9 | 10 | #Ok, let's go with Measles and see how many we have each year: 11 | #diseases %>% 12 | # filter(disease == "Measles") %>% 13 | # group_by(year) %>% 14 | # summarise(total_year = sum(count)) %>% 15 | # View() 16 | 17 | #The vaccine was introduced in the 1960s - That's why the sudden drop. 18 | #I'll plot untill 1980, however there are are more cases afterwards - 19 | #for e.g a small peak between 1989-1991 20 | 21 | measles <- diseases %>% 22 | #filter only Measles and until the year 1980 23 | filter(disease %in% "Measles" , year <=1980) %>% 24 | #changing states to lower cases for joining with the map df 25 | mutate(region = tolower(state), 26 | #turning number of observed cases to thousands 27 | count = count/1000) 28 | 29 | #Load the US state map 30 | states <- map_data("state") 31 | 32 | #Join together and discard irrelevant columns 33 | states_disease <- left_join(states, measles) %>% 34 | select(-c(6,10,12)) 35 | 36 | #Making sure all states were joined properly: 37 | # states_disease %>% 38 | # group_by(year) %>% 39 | # summarise(total = sum (count)) %>% 40 | # View() 41 | 42 | #Plot 43 | 44 | #plotting the outline for the map 45 | plot <- ggplot(states_disease, aes(x= long, y = lat, group = group, fill = count))+ 46 | geom_polygon(color = "gray90", size = 0.1)+ 47 | #these specific values give the map a nice projection 48 | coord_map(projection = "albers", lat0 = 39, lat1 = 45)+ 49 | #scale_fill_gradientn(colors = jet.colors(16))+ 50 | scale_fill_viridis(name = "# Cases observed\n(thousands)")+ 51 | theme_map()+ 52 | labs(title = "U.S. Incidence of Measles 1928-1980", 53 | subtitle = "{closest_state}", 54 | caption = "Data: Tycho Project | @Amit_Levinson")+ 55 | theme(text = element_text(family = "Microsoft Tai Le"), 56 | plot.title = element_text(size = 18), 57 | plot.subtitle = element_text(size = 18, face = "bold.italic"), 58 | plot.caption = element_text(size = 10, face = "italic"), 59 | legend.title = element_text(size = 14, hjust = 0, vjust = 0.8), 60 | legend.title.align = 0.5, 61 | legend.position = "bottom", 62 | legend.text = element_text(size = 8))+ 63 | #actual animation of plot: 64 | transition_states(year, transition_length = 1, state_length = 2) 65 | 66 | #saving the animation and giving the last frame some extra time: 67 | anim_save("measles.gif", animation = plot, duration = 10, 68 | nframes = 2 * length(unique(states_disease$year)) + 8, 69 | end_pause = 8) 70 | -------------------------------------------------------------------------------- /2020/week16_rapartists/rapartists.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(ggalt) 3 | library(ggtext) 4 | library(RColorBrewer) 5 | library(extrafont) 6 | 7 | rankings <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-04-14/rankings.csv') 8 | 9 | # Get data frame of artists that are playing alone 10 | df_points_alone <- rankings %>% 11 | filter(!str_detect(artist, "ft\\. |& | and ")) %>% 12 | group_by(artist) %>% 13 | mutate(count_alone = n(), 14 | mean_alone = mean(points)) %>% 15 | distinct(artist, mean_alone, count_alone) 16 | 17 | # Get data frame for artists that are playing together 18 | df_points_together <- rankings %>% 19 | filter(str_detect(artist,"ft\\. | & | and")) %>% 20 | separate(artist, sep = " ft\\. | & | and ", into = c("artist_1", "artist_2", "artist_3", "artist_4")) %>% 21 | pivot_longer(cols = artist_1:artist_4, values_to = "artist") %>% 22 | drop_na() %>% 23 | select(artist, points) %>% 24 | group_by(artist) %>% 25 | mutate(count_together = n(), 26 | mean_together = mean(points)) %>% 27 | distinct(artist, mean_together, count_together) 28 | 29 | # Join the tables: 30 | df_join <- inner_join(df_points_alone, df_points_together) 31 | 32 | # Look at table with more than two observations: 33 | # df_join_under_2 <- df_join %>% 34 | # filter(count_alone >= 2 , count_together >= 2) 35 | 36 | # Choose color palette 37 | brewer.pal(n = 8, name = "Dark2") 38 | 39 | ggplot(df_join, aes(x = mean_alone, xend = mean_together, y = fct_reorder(artist, mean_alone)))+ 40 | # use `geom_dumbbell` from the ggalt package for a dumbbll plot 41 | geom_dumbbell(color = "gray70", size = 2, colour_x = "#1B9E77", colour_xend = "#D95F02")+ 42 | labs(title = "Artists' points for songs recorded together with others vs songs recorded alone", 43 | subtitle = "Out of the 301 BBC Music song list, 27 artists have songs recorded alone and songs recorded together with other artists. Half of\nthem have more than two records alone and two together. For example, The Notorious B.I.G has 4 songs alone and 4 songs together.", 44 | caption = "Data: BBC Music | @Amit_Levinson", 45 | x = "Mean points")+ 46 | theme_minimal()+ 47 | theme(text = element_text(family = "Roboto Condensed"), 48 | axis.line = element_blank(), 49 | axis.title.y = element_blank(), 50 | axis.text = element_text(size = 11), 51 | panel.grid.minor = element_blank(), 52 | panel.grid.major.y = element_blank(), 53 | plot.title = element_markdown(face= "bold", size = 18), 54 | plot.subtitle = element_text(color = "gray55"), 55 | plot.caption = element_text(size = 8, face = "italic")) 56 | 57 | ggsave("rap_points.png", width = 11, height = 8, dpi = 720) 58 | -------------------------------------------------------------------------------- /2019/Week40_All the Pizza/BarstoolPizza.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(janitor) 3 | library(ggrepel) 4 | library(ggthemr) 5 | library(ggthemes) 6 | ggthemr("flat", layout="clear", spacing=2) 7 | ggthemr_reset() 8 | 9 | pbarstool <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-01/pizza_barstool.csv") 10 | 11 | #cleaning and renaming data 12 | pbarstool <- pbarstool %>% 13 | clean_names() %>% 14 | rename( 15 | total_average = review_stats_all_average_score, 16 | community_average = review_stats_community_average_score, 17 | critic_average = review_stats_critic_average_score, 18 | dave_average = review_stats_dave_average_score, 19 | community_count = review_stats_community_count, 20 | critic_count = review_stats_critic_count, 21 | ) %>% 22 | mutate(s_deviation = sd(c(community_average, dave_average, critic_average))) %>% 23 | gather("which_group", "score", community_average:dave_average) %>% 24 | mutate(which_group = factor(which_group, levels = c("dave_average", "critic_average", "community_average"))) %>% 25 | 26 | 27 | 28 | #Filtering down to Resturants with ratings from all three groups 29 | pcooked <- pbarstool %>% select(name, price_level, provider_rating, community_average, critic_average, 30 | dave_average, community_count, critic_count, total_average) %>% 31 | filter(community_average != 0 & dave_average != 0 & critic_average != 0) %>% 32 | group_by(name) %>% 33 | mutate(s_deviation = sd(c(community_average, dave_average, critic_average))) %>% 34 | gather("which_group", "score", community_average:dave_average) %>% 35 | mutate(which_group = factor(which_group, levels = c("dave_average", "critic_average", "community_average"))) %>% 36 | arrange(desc(s_deviation)) 37 | 38 | 39 | #taking most differentiated ratings 40 | anomalies <- pcooked %>% 41 | filter(s_deviation >= 2) %>% 42 | ungroup() %>% 43 | #re ordering labels so that dave's ratings is on the left 44 | mutate(plot_label = ifelse(which_group == "dave_average", name, "")) 45 | 46 | 47 | p <- ggplot(anomalies, aes(which_group, Score, group = name))+ 48 | geom_point(shape = 19, size = 3, color = "brown")+ 49 | geom_path(color = "black", size = 0.75, linejoin = "mitre", linetype = 1, alpha = 0.5)+ 50 | labs(title = "Pizzaerias with highest difference in rating", 51 | caption = "*data is not weighted | Data from: | AmitL", 52 | x = NULL, y = "Score") 53 | 54 | 55 | p + 56 | theme( 57 | plot.background = element_blank(), 58 | panel.background = element_rect(fill= "white"), 59 | axis.ticks.x=element_blank(), 60 | axis.line = element_line(size = 1, linetype = "solid", colour = "black") 61 | ) + 62 | geom_label_repel(aes(label = plot_label), 63 | point.padding = unit(1, "lines"), 64 | segment.color = 'black', 65 | segment.size = 1, 66 | nudge_x = -2 67 | ) 68 | 69 | 70 | view(pcooked) 71 | 72 | 73 | -------------------------------------------------------------------------------- /2020/week4_spotify_songs/spotify_songs.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(stopwords) 3 | library(tidytext) 4 | library(textdata) 5 | library(scales) 6 | library(showtext) 7 | 8 | #Read the data 9 | spotify_songs <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-01-21/spotify_songs.csv') 10 | 11 | #unnesting words 12 | word_track <- spotify_songs %>% 13 | select(track_name) %>% 14 | unnest_tokens(word, track_name) %>% 15 | select(word) 16 | 17 | #searching for sentiment matches 18 | word_count <- word_track %>% 19 | count(word, sort = T) %>% 20 | #Matching with sentiment date.frame 21 | inner_join(get_sentiments("bing")) %>% 22 | #reordering factor acording to frequency 23 | mutate(word = fct_reorder(word, n)) %>% 24 | #If you decide to use 'nrc' sentiment, not neccessary for 'bing' 25 | filter(sentiment %in% c("positive", "negative"), word != "feat") %>% 26 | #groupiing so we can slice the top 15 from each group 27 | group_by(sentiment) %>% 28 | slice(1:15) 29 | 30 | #Let's add a fun font for the plot: 31 | font_add_google("Boogaloo", "Boogaloo") 32 | showtext_auto() 33 | 34 | ggplot(word_count,aes(word, n))+ 35 | #Create the bars to match spotify logo 36 | geom_col(fill = "black")+ 37 | coord_flip()+ 38 | #'free_y' helps in organizing the facet_wrap neatly 39 | facet_wrap(. ~ sentiment,scales = "free_y")+ 40 | #creating a log10 scale 41 | scale_y_log10(breaks = c(1,10,100,1000), 42 | labels = trans_format("log10", math_format(10^.x)))+ 43 | labs(title = "Song Title Sentiment Analysis", 44 | subtitle = paste0("Analysis was conducted on 5,000 songs from spotify.", 45 | " Top 15 most frequent words are shown."), 46 | caption = "Data: @kaylinquest | plot: @Amit_Levinson")+ 47 | theme_minimal()+ 48 | theme(text = element_text(family = "Boogaloo"), 49 | axis.title = element_blank(), 50 | axis.text.y = element_text(size = 32), 51 | axis.text.x = element_text(size = 26), 52 | strip.text = element_text(size = 30), 53 | plot.caption = element_text(size = 18, face = "italic"), 54 | plot.title = element_text(size = 46), 55 | plot.subtitle = element_text(size = 26), 56 | #adding a nice background to match spotify logo 57 | panel.background = element_rect(fill = "lightgreen"), 58 | plot.background = element_rect(fill = "lightgreen"), 59 | panel.grid.major = element_line(color = "grey70", size = 0.2), 60 | panel.grid.minor = element_line(color = "grey70", size = 0.2)) 61 | 62 | ggsave("spotify.png", height = 4, width = 6) 63 | 64 | #instead of the unnest_token you can use the stringr::str_extract_all approach 65 | #(for some reason it gives us 10 less words, plus it seems a little more complicated): 66 | 67 | #word_track_stringr <- tibble(word = unlist(stringr::str_extract_all(spotify_songs$track_name, boundary("word")))) -------------------------------------------------------------------------------- /2019/Week40_All the Pizza/Barstool_Top_2_Percent.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(janitor) 3 | library(ggrepel) 4 | 5 | pbarstool <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-01/pizza_barstool.csv") 6 | 7 | #cleaning and renaming data 8 | pbarstool <- pbarstool %>% 9 | clean_names() %>% 10 | rename( 11 | total_average = review_stats_all_average_score, 12 | community_count = review_stats_community_count, 13 | ) 14 | #filtering to pizzaerias > 0 & and have more than 10 votes from community 15 | p_cooked <- pbarstool %>% select(name, community_count, total_average) %>% 16 | filter(total_average != 0 & community_count >= 10) %>% 17 | mutate(percents = ntile (total_average , 50)) 18 | 19 | 20 | g <- ggplot(p_cooked, aes(x = total_average))+ 21 | geom_area(stat = "bin", color = "black", fill = "lightpink")+ 22 | scale_x_continuous(name="Rating", breaks=seq(0,10,1)) + 23 | scale_y_continuous(name="Number of pizzerias",breaks = seq(0,30,10))+ 24 | 25 | #adding Median line 26 | geom_segment(aes(x = median(total_average),y = 0, xend = median(total_average), yend = 21), color = "dodgerblue2", size = 1, linetype = "dashed")+ 27 | annotate("text", x = median(p_cooked$total_average)-0.08, y = 1.5, label = "Median", color = "black", angle = 90)+ 28 | 29 | #adding top 2% segment 30 | #geom_segment(aes(x = min(total_average[percents == 50]), y = 0, xend = min(total_average[percents == 50]), yend = 10), color = "dodgerblue2", linetype = "dashed", size = 1)+ 31 | annotate("text", x = 8.6, y = 6, label = "Pizzerias ranked \n in top 2%", color = "black", fontface = 2)+ 32 | geom_curve(aes(x = 8.75, y = 6, xend = 9, yend = 2), 33 | colour = "#555555", curvature = -.6, size = .8, 34 | arrow = arrow(length = unit(0.03, "npc"))) + 35 | 36 | #adding Pizzeria labels for top 2% 37 | geom_label_repel(data = subset(p_cooked, percents == 50), 38 | aes(label = name, y = 2), 39 | fontface = 'bold', 40 | color = "mediumpurple", 41 | xlim=c(8,9), 42 | ylim=c(0,15) 43 | )+ 44 | labs(x = "", y = " ", title = "Pizzerias rating distribution", 45 | subtitle = "", caption = "Only pizzerias with > 10 votes are shown \n Data: 'Barstool Sports' | AmitL") 46 | 47 | #plot background 48 | g+theme_minimal()+ 49 | theme(plot.background = element_rect(fill = "gray92"), 50 | plot.title = element_text(size = 19, face = "italic", vjust = -4, hjust = 0.1), 51 | plot.caption = element_text(face = "italic"), 52 | axis.text.x = element_text(size = 12, face = "bold"), 53 | axis.text.y = element_text(size = 12, face = "bold"), 54 | axis.title.x = element_text(color = "black", size = 16,face = "plain"), 55 | axis.title.y = element_text(color = "black", size = 16,face = "plain") 56 | ) 57 | 58 | ggsave("Barstool_rating.png", width =10, height = 6) 59 | -------------------------------------------------------------------------------- /2020/week_41/week41_ncaa.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(gggibbous) 3 | library(scales) 4 | library(extrafont) 5 | library(here) 6 | 7 | tournament <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-10-06/tournament.csv') 8 | 9 | # Extract the champion from each year 10 | champs <- tournament %>% 11 | group_by(year) %>% 12 | filter(tourney_finish == "Champ") %>% 13 | select(year, school) %>% 14 | mutate(champ = TRUE) 15 | 16 | # Extract the maximum number of games won each year 17 | max_w <- tournament %>% 18 | group_by(year) %>% 19 | filter(full_w == max(full_w)) %>% 20 | select(year, school) 21 | 22 | joined <- left_join(max_w, champs) %>% 23 | group_by(year) %>% 24 | # If there are no champions for max points per year this should amount to NA, 25 | # if there is a champion (1 per year) it should amount to 1. 26 | summarise(champ = sum(champ)) %>% 27 | # Count how many from each category 28 | count(champ) %>% 29 | mutate(pct = n/sum(n), 30 | champ = ifelse(champ == 1, "Yes", "No"), 31 | right = c(TRUE, FALSE), 32 | nudge = c(0.05, -0.05)) 33 | 34 | t_family <- "Roboto Condensed" 35 | 36 | ggplot(joined, aes(x= 1, y = 1))+ 37 | geom_moon(aes(ratio = pct, right = right, fill = right), size = 140, show.legend = FALSE)+ 38 | # Add 54% annotations 39 | annotate("text", y = 1.025, x = 1.017, label = percent(joined[[1,3]]), color = "black", size = 8, family = t_family)+ 40 | annotate("text", y = 0.99, x = 1.01, label = "of tournaments,\nthe NCAA champion\nteam had the most\nor tied wins", color = "black", size = 5, hjust = 0, family = t_family)+ 41 | # Add the 46% annotations 42 | annotate("text", y = 1.025, x = 0.9575, label = percent(joined[[2,3]]), color = "orange", size = 8, family = t_family)+ 43 | annotate("text", y = 0.99, x = 0.95, label = "of tournaments,\nlosing teams\nhad more wins\nthan the champion", color = "orange", size = 5, hjust = 0, family = t_family)+ 44 | scale_fill_manual(values = c("black", "Orange"))+ 45 | # Create boundaries so that we can add the above annotations 46 | xlim(0.9,1.1)+ 47 | ylim(0.9,1.1)+ 48 | labs(title = "Wins don't guarantee the NCAA championship", 49 | subtitle = "To win the NCAA division I women's basketball championship, it's not enough to only collect the most number of wins.\nIn only 54% (20 years) of tournaments the champion team achieved or tied with the most wins for that year.\nIn 46% (17 years) other teams in the tournament surpassed the champion in total number of wins.\n", caption = "Data: FiveThirtyEight\nVisualization: @Amit_Levinson")+ 50 | theme_void()+ 51 | theme( 52 | text = element_text(family = "Roboto Condensed"), 53 | plot.title = element_text(hjust = 0.5, size = 22), 54 | plot.subtitle = element_text(color = "gray35", hjust = 0.5), 55 | plot.caption = element_text(hjust = 0, color = "gray35"), 56 | plot.margin = margin(4,4,4,4, unit = "mm")) 57 | 58 | ggsave("ball_plot.png", path = here("2020", "week_41"), dpi = 320) 59 | 60 | 61 | -------------------------------------------------------------------------------- /2020/week53_tweetdata/tweet_2020.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(lubridate) 3 | library(rvest) 4 | library(glue) 5 | library(ggtext) 6 | library(extrafont) 7 | 8 | # Read the #tidytuesday tweet collection 9 | tt <- read_csv("https://github.com/rfordatascience/tidytuesday/blob/master/tidytuesday_tweets/data.csv?raw=true") 10 | 11 | # Clean data for this year and get the week number 12 | data_2020 <- tt %>% 13 | filter(created_at > "2020-01-01 00:00:00" & !is.na(media_url)) %>% 14 | mutate(week_count = week(created_at)) 15 | 16 | week_count <- data_2020 %>% 17 | count(week_count, sort = T) 18 | 19 | # Get week numbers I participated in 20 | amit_participate_in <- data_2020 %>% 21 | filter(str_detect(screen_name, "Amit_Levinson")) %>% 22 | count(week_count) %>% 23 | pull(week_count) 24 | 25 | # Get full info for the week (name of the data, date, etc.) 26 | week_name <- read_html("https://github.com/rfordatascience/tidytuesday") %>% 27 | html_node("table") %>% 28 | html_table() 29 | 30 | # Join week count and name to get more info 31 | week_data_full <- left_join(week_count, week_name, by = c("week_count" = "Week")) %>% 32 | # Create the axis categories and use ggtext for lighter data info 33 | mutate(name = glue("{Data}
({month(Date, label = TRUE)}, {day(Date)})"), 34 | al_participated = ifelse(week_count %in% amit_participate_in, "yes", "no"), 35 | # Fix a few weeks I posted in but in the following week :( 36 | al_participated = case_when( 37 | # Didn't participate in the IKEA week 38 | week_count == 45 ~ "no", 39 | # Did participate in the Measles week 40 | week_count == 9 ~"yes", 41 | TRUE ~ al_participated)) %>% 42 | slice(1:15) 43 | 44 | ggplot(week_data_full)+ 45 | geom_col(aes(y = fct_reorder(name, n), x = n, fill = al_participated), show.legend = FALSE)+ 46 | labs(title = "#Tidytuesday weeks with the most contributions", 47 | subtitle = "Only tweets containing photos were aggregated. Highlighted are weeks I participated in.
Caveat: individuals might\npost their analysis in following week from the original data.", 48 | x = "Number of #TidyTuesday tweets (with photos)", y = "Data (Date)\n", caption = "Data: Tidytuesday & Thomas Mock\n visualization: @Amit_Levinson")+ 49 | scale_fill_manual(values = c("yes" = "#453F78", "no" = "gray55"))+ 50 | theme_minimal()+ 51 | theme( 52 | text = element_text(family = "Roboto Condensed"), 53 | plot.title = element_text(size = 16), 54 | plot.title.position = "plot", 55 | plot.subtitle = element_markdown(size = 12, color = "gray25"), 56 | plot.caption = element_text(size = 8, color = "gray35"), 57 | axis.text.y = element_markdown(hjust = 0, size = 10), 58 | axis.text.x = element_text(size = 8), 59 | axis.title = element_text(size = 10, color = "gray45"), 60 | plot.margin = margin(4,2,2,4, "mm")) 61 | 62 | 63 | ggsave("2020/week53_tweetdata/data_2020.png", width = 9, height = 7) 64 | -------------------------------------------------------------------------------- /2021/week4_rkenya/rkenya.R: -------------------------------------------------------------------------------- 1 | library(sf) 2 | library(ggplot2) 3 | library(here) 4 | library(dplyr) 5 | library(stringr) 6 | library(RColorBrewer) 7 | library(extrafont) 8 | # devtools::install_github("Shelmith-Kariuki/rKenyaCensus") 9 | library(rKenyaCensus) 10 | library(ggtext) 11 | 12 | gender <- rKenyaCensus::V1_T2.2 13 | 14 | # Get map, convert it to sf and clean the County column 15 | kenya_plot_crs <- st_as_sf(KenyaCounties_SHP) %>% 16 | st_transform(4326) %>% 17 | mutate(County = as.character(County), 18 | County = str_to_title(County)) 19 | 20 | # Look at Men to women ratio 21 | kenya_plot <- gender %>% 22 | mutate(dif = (Male/Total)*100) %>% 23 | arrange(dif) %>% 24 | right_join(kenya_plot_crs) 25 | 26 | # Colors to use and label values 27 | RColorBrewer::brewer.pal(11, "BrBG") 28 | 29 | # Add Kenya in title with colors 30 | kenya_html <- "KENYA" 31 | 32 | # Add labels to the plot 33 | label_df <- data.frame( 34 | label = c("
More men", 35 | "More women"), 36 | x = c(41.05, 33.7), 37 | y = c(1.35, -2), 38 | hjust = c(0,0) 39 | ) 40 | 41 | ggplot(kenya_plot)+ 42 | geom_sf(aes(geometry = geometry, fill = dif))+ 43 | scale_fill_distiller(type = "div",palette = "BrBG", name = "Percentage Men", breaks = c(45,50,55), 44 | limit = c(45,55), labels = c("45%", "Even", "55%"), 45 | guide = guide_colourbar(title.position = "top"))+ 46 | geom_richtext(data = label_df, aes(x = x, y = y, label = label, hjust = hjust),label.color = NA, label.padding = grid::unit(rep(0, 4), "pt"), fill = NA, size = 7)+ 47 | # Add arrow to Siaya 48 | annotate(geom = "curve", x = 33.65, xend = 34.2 , y = -1.8, yend = -0.0621, 49 | curvature =-.2, color = "#35978F", size = 0.75, arrow = arrow(length = unit(1.5, "mm")))+ 50 | # ADD arrow to Garissa 51 | annotate(geom = "curve", x = 41.1, xend = 40.8 , y = 1, yend = -0.1, 52 | curvature =-.2, color = "#8C510A", size = 0.75, arrow = arrow(length = unit(1.5, "mm")))+ 53 | coord_sf(xlim = c(33.8, 42), clip = 'off')+ 54 | labs(title = paste0("Gender Distribution in Counties Across ",kenya_html), 55 | caption = "Data: RKenyaCensus\n@Amit_Levinson")+ 56 | theme_void()+ 57 | theme( 58 | text = element_text(family = "IBM Plex Sans"), 59 | plot.title.position = "plot", 60 | plot.title = element_markdown(face = "bold", size = 22), 61 | plot.caption = element_text(size = 9, face = 'italic', color = 'gray25'), 62 | legend.direction = 'horizontal', 63 | legend.position=c(0.2,0.13), 64 | legend.background = element_blank(), 65 | legend.title.align = 0, 66 | legend.title = element_markdown(size = 13, color = "gray35"), 67 | legend.text = element_text(size = 11, color = "gray25"), 68 | legend.key.size = unit(8,"mm"), 69 | plot.margin = margin(6,2,6,2, "mm")) 70 | 71 | ggsave(here("2021", "week4_rkenya", "rkenya.png"), width = 11, height = 11) -------------------------------------------------------------------------------- /2019/2_Week39_SchoolDiversity/School_Diversity.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(stringr) 3 | 4 | df <- read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-09-24/school_diversity.csv") 5 | 6 | #count(df, d_Locale_Txt) 7 | 8 | #created a list of residency types to change 9 | citycheck <- c("city-large|city-midsize|city-small") 10 | ruralcheck <- c("rural-distant|rural-fringe|rural-remote") 11 | suburbancheck <- c("suburban-large|suburban-midsize|suburban-small") 12 | towncheck <- c("town-distant|town-fringe|town-remote") 13 | 14 | #aggregated all the residency types to one. Used the Base R since i was having 15 | #trouble piping it 16 | df$d_Locale_Txt <- str_replace_all(df$d_Locale_Txt, citycheck, "City") 17 | df$d_Locale_Txt <- str_replace_all(df$d_Locale_Txt, ruralcheck, "Rural") 18 | df$d_Locale_Txt <- str_replace_all(df$d_Locale_Txt,suburbancheck, "Suburban") 19 | df$d_Locale_Txt <- str_replace_all(df$d_Locale_Txt,towncheck, "Town") 20 | 21 | #creating data set for schools and calculating percents: 22 | byyear <- df %>% group_by(LEAID) %>% 23 | mutate(n = length(LEAID), diverse = as.factor(diverse)) %>% 24 | rename(Geogliving = d_Locale_Txt, year = SCHOOL_YEAR) %>% 25 | filter(n == 2) %>% 26 | group_by(year, diverse, Geogliving) %>% 27 | summarise(total = length(diverse)) %>% 28 | na.omit %>% 29 | ungroup() %>% 30 | group_by(year, Geogliving) %>% 31 | mutate(percent = total/sum(total)*100, year[year == "1994-1995"] = 1994, 32 | year[year == "2016-2017"] = 2016) 33 | 34 | byyear$year[byyear$year == "1994-1995"] <- 1994 35 | byyear$year[byyear$year == "2016-2017"] <- 2016 36 | 37 | 38 | #plotting a stacked bar plot 39 | p <- ggplot(byyear, aes(factor(year), y = percent, fill = diverse)) + 40 | geom_bar(stat = "identity") + 41 | scale_y_continuous(labels = function(x) paste0(x, "%"))+ 42 | facet_grid(. ~ Geogliving)+ 43 | scale_fill_manual(values = c("Diverse" = "green4", "Extremely undiverse" = "tomato3", "Undiverse" = "tan2")) 44 | 45 | 46 | #adjusting theme 47 | p + theme( 48 | strip.text = element_text( 49 | size = 17, color = "black", face = "bold.italic"), 50 | strip.background = element_blank(), 51 | plot.background = element_rect(fill = "gray92"), 52 | panel.background = element_blank(), 53 | panel.grid.major = element_blank(), 54 | panel.grid.minor = element_blank(), 55 | plot.title = element_text(size = 19, face = "italic"), 56 | plot.subtitle = element_text(size = 11, face = "italic"), 57 | plot.caption = element_text(size = 10), 58 | axis.title=element_blank(), 59 | axis.ticks.x=element_blank(), 60 | axis.text.x = element_text(size = 16), 61 | axis.text.y = element_text(size = 11), 62 | legend.position = "bottom", 63 | legend.title = element_blank(), 64 | legend.text = element_text(size = 14), 65 | legend.background = element_blank() 66 | ) + 67 | labs(title = "School ethnic diversity levels across residency types", 68 | subtitle = "Percentage of schools", 69 | caption = "Data: The Washington Post | AmitL") 70 | 71 | ggsave("Ethnic_div.png", width =10, height = 6) 72 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/variable-pie.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | 4 | Variable Pie module for Highcharts 5 | 6 | (c) 2010-2018 Grzegorz Blachliski 7 | 8 | License: www.highcharts.com/license 9 | */ 10 | (function(c){"object"===typeof module&&module.exports?module.exports=c:"function"===typeof define&&define.amd?define(function(){return c}):c("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(c){(function(c){var q=c.pick,r=c.arrayMin,t=c.arrayMax,w=c.seriesType,x=c.seriesTypes.pie.prototype;w("variablepie","pie",{minPointSize:"10%",maxPointSize:"100%",zMin:void 0,zMax:void 0,sizeBy:"area",tooltip:{pointFormat:'\x3cspan style\x3d"color:{point.color}"\x3e\u25cf\x3c/span\x3e {series.name}\x3cbr/\x3eValue: {point.y}\x3cbr/\x3eSize: {point.z}\x3cbr/\x3e'}}, 11 | {pointArrayMap:["y","z"],parallelArrays:["x","y","z"],redraw:function(){this.center=null;x.redraw.call(this,arguments)},zValEval:function(a){return"number"!==typeof a||isNaN(a)?null:!0},calculateExtremes:function(){var a=this.chart,c=this.options,d;d=this.zData;var l=Math.min(a.plotWidth,a.plotHeight)-2*(c.slicedOffset||0),g={},a=this.center||this.getCenter();["minPointSize","maxPointSize"].forEach(function(a){var b=c[a],d=/%$/.test(b),b=parseInt(b,10);g[a]=d?l*b/100:2*b});this.minPxSize=a[3]+g.minPointSize; 12 | this.maxPxSize=Math.max(Math.min(a[2],g.maxPointSize),a[3]+g.minPointSize);d.length&&(a=q(c.zMin,r(d.filter(this.zValEval))),d=q(c.zMax,t(d.filter(this.zValEval))),this.getRadii(a,d,this.minPxSize,this.maxPxSize))},getRadii:function(a,c,d,l){var g=0,e,b=this.zData,k=b.length,m=[],p="radius"!==this.options.sizeBy,h=c-a;for(g;g=c?e=l/2:(e=01.5*Math.PI?b-=2*Math.PI:b<-Math.PI/2&&(b+=2*Math.PI);f.slicedTranslation={translateX:Math.round(Math.cos(b)*l),translateY:Math.round(Math.sin(b)*l)};e=Math.cos(b)*a[2]/2;v=Math.sin(b)*a[2]/2;k=Math.cos(b)*n;n*=Math.sin(b);f.tooltipPos=[a[0]+.7*e,a[1]+.7*v];f.half=b<-Math.PI/2||b>Math.PI/2?1:0;f.angle=b;e=Math.min(g, 15 | f.labelDistance/5);f.labelPosition={natural:{x:a[0]+k+Math.cos(b)*f.labelDistance,y:a[1]+n+Math.sin(b)*f.labelDistance},"final":{},alignment:f.half?"right":"left",connectorPosition:{breakAt:{x:a[0]+k+Math.cos(b)*e,y:a[1]+n+Math.sin(b)*e},touchingSliceAt:{x:a[0]+k,y:a[1]+n}}}}}})})(c)}); 16 | //# sourceMappingURL=variable-pie.js.map 17 | -------------------------------------------------------------------------------- /2019/Week43_Horror_Films/Horror_dis.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(stringr) 3 | library(ggbeeswarm) 4 | library(ggrepel) 5 | library(extrafont) 6 | library(ggthemr) 7 | ggthemr("flat dark", type = 'outer') 8 | 9 | horror_movies <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-22/horror_movies.csv") 10 | 11 | #Let's clean the data frame 12 | rating_length <- horror_movies %>% 13 | #I first want to have the minutes as numeric value 14 | mutate(movie_length = as.numeric(str_replace(movie_run_time," min", ""))) %>% 15 | #once we did that, let's remove all NA's 16 | filter(!is.na(movie_length) & !is.na(review_rating)) %>% 17 | #choosing the specific variables needed 18 | select(title, review_rating, movie_length) %>% 19 | #creating length categories of the movies 20 | mutate(length_cat = 21 | ifelse(movie_length <80, "Under 1:20", 22 | ifelse(movie_length >=80 & movie_length < 100, "1:20-1:40", "1:40+")), 23 | #Now let's reorder the factor level 24 | length_cat = factor(length_cat, levels = c("Under 1:20","1:20-1:40", "1:40+"))) 25 | 26 | #creating a subset data frame with only top 3 rated for each group 27 | top_3 <- 28 | rating_length %>% 29 | group_by(length_cat) %>% 30 | top_n(n = 3, wt = review_rating) %>% 31 | #The titles had the year they were released, this created a messey display on the plot 32 | mutate(title = str_replace(title, " \\(.*\\)", "")) 33 | 34 | 35 | s <- ggplot(rating_length, aes(y = review_rating, x = length_cat))+ 36 | #Creating a beeswarm plot 37 | geom_quasirandom(alpha = 0.7, width = 0.3)+ 38 | labs(x= "Length (in hours)",y= "Rating", title = "Prefer the shorter or longer horror movies?", 39 | subtitle = "Only a slight advantage in ratings exists for the longer horror movies; Points represent mean rating \nvalue for each category. Titles and duration for top 3 rated movies in each category are displayed", 40 | caption = "Data: imdb.com | @Amit_Levinson")+ 41 | #Adding a point representing the Mean value 42 | stat_summary(fun.y = "mean", geom = "point", size = 3, color = "black") + 43 | #Adding a line to show the difference in mean 44 | stat_summary(fun.y = "mean", geom = "line", aes(group = 1), color = "black", 45 | size = 1.3)+ 46 | #Let's add the movie titles for top 3 47 | geom_text_repel(top_3, 48 | mapping = aes(label = paste0(title, "\n(", movie_length, " min)")), 49 | family = "Miriam", color = "white", 50 | segment.size = 0.8, 51 | arrow = arrow(length = unit(0.01, 'npc')), 52 | point.padding = unit(0.8, 'lines'), 53 | box.padding = unit(0.9, 'lines')) 54 | 55 | #Just adding the theme and a specific non-formal text for the occasion 56 | s +theme(text=element_text(family = "MV Boli"), 57 | axis.text = element_text(size = 11), 58 | plot.title = element_text(size = 18), 59 | plot.subtitle = element_text(size = 12) 60 | ) 61 | 62 | #Save the plot 63 | ggsave("horror_movie_length.png", width =10, height = 6) 64 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/solid-gauge.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | Solid angular gauge module 4 | 5 | (c) 2010-2018 Torstein Honsi 6 | 7 | License: www.highcharts.com/license 8 | */ 9 | (function(l){"object"===typeof module&&module.exports?module.exports=l:"function"===typeof define&&define.amd?define(function(){return l}):l("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(l){(function(f){var l=f.pInt,u=f.pick,q=f.isNumber,w=f.wrap,v;w(f.Renderer.prototype.symbols,"arc",function(a,g,d,c,f,b){a=a(g,d,c,f,b);b.rounded&&(c=((b.r||c)-b.innerR)/2,b=["A",c,c,0,1,1,a[12],a[13]],a.splice.apply(a,[a.length-1,0].concat(["A",c,c,0,1,1,a[1],a[2]])),a.splice.apply(a,[11,3].concat(b))); 10 | return a});v={initDataClasses:function(a){var g=this.chart,d,c=0,r=this.options;this.dataClasses=d=[];a.dataClasses.forEach(function(b,h){b=f.merge(b);d.push(b);b.color||("category"===r.dataClassColor?(h=g.options.colors,b.color=h[c++],c===h.length&&(c=0)):b.color=f.color(r.minColor).tweenTo(f.color(r.maxColor),h/(a.dataClasses.length-1)))})},initStops:function(a){this.stops=a.stops||[[0,this.options.minColor],[1,this.options.maxColor]];this.stops.forEach(function(a){a.color=f.color(a[1])})},toColor:function(a, 11 | g){var d=this.stops,c,f,b=this.dataClasses,h,e;if(b)for(e=b.length;e--;){if(h=b[e],c=h.from,d=h.to,(void 0===c||a>=c)&&(void 0===d||a<=d)){f=h.color;g&&(g.dataClass=e);break}}else{this.isLog&&(a=this.val2lin(a));a=1-(this.max-a)/(this.max-this.min);for(e=d.length;e--&&!(a>d[e][0]););c=d[e]||d[e+1];d=d[e+1]||c;a=1-(d[0]-a)/(d[0]-c[0]||1);f=c.color.tweenTo(d.color,a)}return f}};f.seriesType("solidgauge","gauge",{colorByPoint:!0},{translate:function(){var a=this.yAxis;f.extend(a,v);!a.dataClasses&&a.options.dataClasses&& 12 | a.initDataClasses(a.options);a.initStops(a.options);f.seriesTypes.gauge.prototype.translate.call(this)},drawPoints:function(){var a=this,g=a.yAxis,d=g.center,c=a.options,r=a.chart.renderer,b=c.overshoot,h=q(b)?b/180*Math.PI:0,e;q(c.threshold)&&(e=g.startAngleRad+g.translate(c.threshold,null,null,null,!0));this.thresholdAngleRad=u(e,g.startAngleRad);a.points.forEach(function(b){var e=b.graphic,k=g.startAngleRad+g.translate(b.y,null,null,null,!0),t=l(u(b.options.radius,c.radius,100))*d[2]/200,m=l(u(b.options.innerRadius, 13 | c.innerRadius,60))*d[2]/200,n=g.toColor(b.y,b),p=Math.min(g.startAngleRad,g.endAngleRad),q=Math.max(g.startAngleRad,g.endAngleRad);"none"===n&&(n=b.color||a.color||"none");"none"!==n&&(b.color=n);k=Math.max(p-h,Math.min(q+h,k));!1===c.wrap&&(k=Math.max(p,Math.min(q,k)));p=Math.min(k,a.thresholdAngleRad);k=Math.max(k,a.thresholdAngleRad);k-p>2*Math.PI&&(k=p+2*Math.PI);b.shapeArgs=m={x:d[0],y:d[1],r:t,innerR:m,start:p,end:k,rounded:c.rounded};b.startR=t;e?(t=m.d,e.animate(f.extend({fill:n},m)),t&&(m.d= 14 | t)):(b.graphic=e=r.arc(m).attr({fill:n,"sweep-flag":0}).add(a.group),a.chart.styledMode||("square"!==c.linecap&&e.attr({"stroke-linecap":"round","stroke-linejoin":"round"}),e.attr({stroke:c.borderColor||"none","stroke-width":c.borderWidth||0})));e&&e.addClass(b.getClassName(),!0)})},animate:function(a){a||(this.startAngleRad=this.thresholdAngleRad,f.seriesTypes.pie.prototype.animate.call(this,a))}})})(l)}); 15 | //# sourceMappingURL=solid-gauge.js.map 16 | -------------------------------------------------------------------------------- /2019/2_Week39_SchoolDiversity/School_Diversity_Updated.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(stringr) 3 | library(forcats) 4 | 5 | df <- read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-09-24/school_diversity.csv") 6 | 7 | #count(df, d_Locale_Txt) 8 | 9 | #created a list of residency types to change 10 | citycheck <- c("city-large|city-midsize|city-small") 11 | ruralcheck <- c("rural-distant|rural-fringe|rural-remote") 12 | suburbancheck <- c("suburban-large|suburban-midsize|suburban-small") 13 | towncheck <- c("town-distant|town-fringe|town-remote") 14 | 15 | #aggregated all the residency types to one. Used the Base R since i was having 16 | #trouble piping it 17 | df$d_Locale_Txt <- str_replace_all(df$d_Locale_Txt, citycheck, "City") 18 | df$d_Locale_Txt <- str_replace_all(df$d_Locale_Txt, ruralcheck, "Rural") 19 | df$d_Locale_Txt <- str_replace_all(df$d_Locale_Txt,suburbancheck, "Suburban") 20 | df$d_Locale_Txt <- str_replace_all(df$d_Locale_Txt,towncheck, "Town") 21 | 22 | #creating data set for schools and calculating percents: 23 | byyear <- df %>% group_by(LEAID) %>% 24 | mutate(n = length(LEAID), diverse = factor(diverse)) %>% 25 | rename(Geogliving = d_Locale_Txt, year = SCHOOL_YEAR) %>% 26 | filter(n == 2) %>% 27 | group_by(year, diverse, Geogliving) %>% 28 | summarise(total = length(diverse)) %>% 29 | na.omit %>% 30 | ungroup() %>% 31 | group_by(year, Geogliving) %>% 32 | mutate(percent = total/sum(total)*100) %>% 33 | fct_relevel(diverse, "Extremely undiverse", "Undiverse", "Diverse") %>% 34 | fct_relevel(Geogliving, "City", "Suburban", "Town", "Rural") #decided to change levels after suggestions 35 | 36 | 37 | byyear$year[byyear$year == "1994-1995"] <- 1994 38 | byyear$year[byyear$year == "2016-2017"] <- 2016 39 | 40 | 41 | #plotting a stacked bar plot 42 | p <- ggplot(byyear, aes(factor(year), y = percent, fill = diverse)) + 43 | geom_bar(stat = "identity") + 44 | scale_y_continuous(labels = function(x) paste0(x, "%"))+ 45 | facet_grid(. ~ Geogliving)+ 46 | scale_fill_brewer (palette = "Set2")#changed color for color-blind friendly 47 | 48 | #adjusting theme 49 | p + theme( 50 | strip.text = element_text( 51 | size = 15, color = "black", face = "bold.italic"), 52 | strip.background = element_blank(), 53 | plot.background = element_rect(fill = "gray92"), 54 | panel.background = element_blank(), 55 | panel.grid.major = element_blank(), 56 | panel.grid.minor = element_blank(), 57 | plot.title = element_text(size = 19, face = "italic"), 58 | plot.subtitle = element_text(size = 11, face = "italic"), 59 | plot.caption = element_text(size = 10), 60 | axis.title=element_blank(), 61 | axis.ticks.x=element_blank(), 62 | axis.text.x = element_text(size = 16), 63 | axis.text.y = element_text(size = 11), 64 | legend.position = "bottom", 65 | legend.title = element_blank(), 66 | legend.text = element_text(size = 14), 67 | legend.background = element_blank() 68 | ) + 69 | labs(title = "School ethnic diversity levels across residency types", 70 | subtitle = "Percentage of schools", 71 | caption = "Data: The Washington Post | AmitL") 72 | 73 | ggsave("Ethnic_div_revised.png", width =10, height = 6) 74 | -------------------------------------------------------------------------------- /2021/week29_scoobydoo/sd.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | library(tidyr) 3 | library(ggplot2) 4 | library(ggstream) 5 | library(ggstream) 6 | library(lubridate) 7 | library(stringr) 8 | library(ggrepel) 9 | library(ggtext) 10 | library(extrafont) 11 | 12 | 13 | scoobydoo <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-07-13/scoobydoo.csv') 14 | 15 | 16 | sayings_agg <- scoobydoo %>% 17 | pivot_longer(cols = c(jeepers, jinkies, my_glasses, zoinks:scooby_doo_where_are_you) , names_to = "saying") %>% 18 | select(network, season, date_aired, saying, value) %>% 19 | mutate(value = as.numeric(na_if(x = value, y = "NULL"))) %>% 20 | group_by(date_year = year(date_aired), saying) %>% 21 | # Average number of quotes per aired episode 22 | summarise(n_episodes = n(), 23 | total_said = sum(value)/n(), 24 | .groups = 'drop') 25 | 26 | sayings_clean <- sayings_agg %>% 27 | mutate(saying = str_replace_all(saying, "_", " "), 28 | saying = str_to_sentence(saying), 29 | saying = ifelse(str_detect(saying, "Scooby"), "Scooby doo\nwhere are you", saying)) 30 | 31 | # Color palette 32 | scooby_color_palette <- c("#128a84", "#79af30", "#bb5c37", "#4b0055", "black", "#C19C72") 33 | # Give color palette names of groups 34 | names(scooby_color_palette) <- unique(sayings_clean$saying) 35 | 36 | sayings_labels <- sayings_clean %>% 37 | filter(date_year == min(date_year)) %>% 38 | mutate(y_pos = c(-1.05,1.25,1.1,1,-1.15,0.2)) 39 | 40 | 41 | ggplot(data = sayings_clean, aes(x= date_year, y = total_said, fill = saying, group = saying, label = saying))+ 42 | geom_stream(extra_span = .2, sorting = "onset")+ 43 | # Add white lines for missing values 44 | geom_segment(data = filter(sayings_clean, is.na(total_said)), aes(x = date_year, xend = date_year, y = -10, yend = 10), color = "white", size = 1, alpha = 0.7)+ 45 | scale_x_continuous(breaks = seq(1970,2020,10), labels = c("1970", "80s", "90s", "2000", "10s", "20s"), limits = c(1966,2021))+ 46 | geom_text_repel(data = sayings_labels, aes(x = date_year, y = y_pos, color = saying), 47 | fontface = "bold", xlim = c(1965,1967), hjust = 0, size = 3, 48 | direction = "y", segment.alpha = 0.5)+ 49 | scale_fill_manual(values = scooby_color_palette)+ 50 | scale_color_manual(values = scooby_color_palette)+ 51 | guides(color = "none", fill = "none")+ 52 | labs( 53 | title = "Scooby Doo Quotes", 54 | subtitle = "Average number of Scooby Doo quotes across episodes (or movies) aired that year. For example, 'Zoinks' was noted an
average of 3 times across 36 episodes in 1981, whereas 14 times in the one episode aired in 1998.White lines represent
missing values for that year.", 55 | caption = "Data: | Visualization: @Amit_Levinson" 56 | )+ 57 | theme_void()+ 58 | theme( 59 | text = element_text(family = "Raleway"), 60 | plot.title = element_text(size = 18, family = "Flowers Kingdom"), 61 | axis.text.x = element_text(color = "gray15", size = 10), 62 | plot.subtitle = element_markdown(lineheight = 1.1), 63 | plot.caption = element_text(color = 'gray35', vjust = -2), 64 | plot.margin = margin(4,4,4,8), 65 | plot.background = element_rect(fill = "white", color = NA) 66 | )+ 67 | coord_fixed(clip = 'off') 68 | 69 | 70 | ggsave("sd.png", width = 11, height = 7) 71 | 72 | 73 | -------------------------------------------------------------------------------- /2020/week17_gdpr/gdpr.R: -------------------------------------------------------------------------------- 1 | # Load packages and prepare data ----------------------------------------------------------- 2 | library(tidyverse) # for data wrangling 3 | library(highcharter) # See below for a useful tutorial to work with highcharter maps 4 | library(scales) # creating a Euro value scale 5 | library(RColorBrewer) # Choosing a color palette 6 | library(htmlwidgets) # Saving our html file 7 | 8 | # Get Tidytuesday data: 9 | gdpr_violations <- readr::read_tsv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-04-21/gdpr_violations.tsv') 10 | glimpse(gdpr_violations) 11 | 12 | # Check map from Highchart if we need another column to join by 13 | get_data_from_map(download_map_data("custom/europe")) %>% 14 | glimpse() 15 | 16 | # Function to turn our values into Euro character in our final analysis 17 | euro <- dollar_format(prefix = "", suffix = "\u20ac") 18 | 19 | # Manipulate data --------------------------------------------------------- 20 | gdpr <- gdpr_violations %>% 21 | filter(price != 0) %>% 22 | group_by(name) %>% 23 | summarise(count = n(), 24 | median_gdpr = median(price)) %>% 25 | ungroup() %>% 26 | # Reformat our values for nice display 27 | mutate(price_eur = euro(median_gdpr)) 28 | # Create map -------------------------------------------------------------- 29 | 30 | price_map <- hcmap(map = "custom/europe", 31 | data = gdpr, 32 | value = "median_gdpr", # value that our gradient scale will be mapped by 33 | joinBy = c("name", "name")) %>% # Join our data by column that match 34 | hc_mapNavigation(enabled = TRUE) %>% 35 | hc_legend(layout = 'horizontal', 36 | align = 'center', 37 | valueDecimals = 0) %>% 38 | hc_tooltip(formatter = JS("function() { 39 | return ('
Country: ' +this.point.name + 40 | '
Total issued: ' + this.point.count + 41 | '
Median fine: '+ this.point.price_eur)}")) 42 | 43 | # Look at the color color list to retrieve Minimum and Maxium: 44 | brewer.pal(name = "YlOrRd", n = 9) 45 | 46 | # Add color, title and credits: 47 | price_map <- price_map %>% 48 | hc_colorAxis(minColor = "#FFFFCC", maxColor = "#800026") %>% 49 | hc_title(text = "General Data Protection Regulation median fines") %>% 50 | hc_subtitle(text = "Data excludes violations of zero value fines") %>% 51 | hc_credits(enabled = TRUE, 52 | text = "Data: Privacy Affairs | @Amit_Levinson", 53 | href = "https://github.com/AmitLevinson/TidyTuesday/tree/master/2020/week17_gdpr") 54 | 55 | 56 | # Fine tuning of fonts and theme: 57 | my_theme <- hc_theme(chart = list(backgroundColor = "white"), 58 | title = list(style = list(fontFamily = "Roboto Condensed")), 59 | subtitle = list(style = list(fontFamily = "Roboto Condensed", color = "gray")), 60 | legend = list(itemStyle = list(fontFamily = "Roboto Condensed")), 61 | itemHoverStyle = list(color = "gray")) 62 | 63 | final_map <- price_map %>% 64 | hc_add_theme(my_theme) 65 | 66 | saveWidget(final_map, "hc_gdpr.html", selfcontained = TRUE, title = "Tidytuesday GDPR violations", knitrOptions = list(out.width = 40)) 67 | 68 | # Please check out the following blog post for a thourough explanation to use maps in {highcharter}: 69 | # https://kcuilla.netlify.app/post/maps-in-r/ -------------------------------------------------------------------------------- /2019/Week43_Horror_Films/horror_for_blog.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Horror Films" 3 | author: "Amit Levinson" 4 | date: "10/23/2019" 5 | output: html_document 6 | editor_options: 7 | chunk_output_type: console 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | knitr::opts_chunk$set(echo = TRUE, warning=FALSE) 12 | ``` 13 | 14 | Today's TidyTuesday analysis is on horror films rated on IMDb.com. 15 | Let's start by loading the packages we'll need and load our file: 16 | 17 | ```{r } 18 | library(tidyverse) 19 | library(stringr) 20 | library(ggbeeswarm) 21 | library(ggrepel) 22 | library(extrafont) 23 | horror_movies <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-22/horror_movies.csv") 24 | ``` 25 | 26 | Great. let's have a look at our data 27 | ```{r glimpse} 28 | glimpse(horror_movies) 29 | ``` 30 | 31 | So I want to look at the rating of the movie in accordance to its length. Do longer horror movies rate higher than shorter ones? 32 | The `movie_run_time` is structured as a character and not a numeric value. it contains both our minutes value and a string character of 'min'. we want to eliminate the 'min' part, rendering it suitable for a numeric value: 33 | 34 | ```{r} 35 | rating_length <- horror_movies %>% 36 | mutate(movie_length = as.numeric(str_replace(movie_run_time,"min", ""))) %>% 37 | filter(!is.na(movie_length) & !is.na(review_rating)) 38 | ``` 39 | 40 | `stringr::str_replace` is a great function for removing strings and characters. after removing it, i wanted to make sure it's rendered numeric so I used `as.numeric`.\n 41 | 42 | Let's look at how the ratings distribute across movie length: 43 | 44 | ```{r} 45 | rating_length %>% 46 | ggplot(aes(x = movie_length, y = review_rating))+ 47 | geom_point()+ 48 | geom_smooth(method = "lm", se = FALSE) 49 | ``` 50 | 51 | OK, so we see some sort of a pattern, but it;s not that evident. it might be worth dividing the data frame into groups of duraiton intervals and looking at differences across groups, since in longer movies we'd expect a higher rating. 52 | Let's try dividing it into three groups: 53 | 54 | ```{r} 55 | rating_length <- rating_length %>% 56 | #creating length categories of the movies 57 | mutate(length_cat = 58 | ifelse(movie_length <80, "Under 1:20", 59 | ifelse(movie_length >=80 & movie_length < 100, "1:20-1:40", "1:40+")), 60 | #Now let's reorder the factor level 61 | length_cat = factor(length_cat, levels = c("Under 1:20","1:20-1:40", "1:40+"))) %>% 62 | select(title, review_rating, movie_length, length_cat) 63 | ``` 64 | 65 | and now for the plot: 66 | 67 | ```{r} 68 | ggplot(rating_length, aes(y = review_rating, x = length_cat))+ 69 | #Creating a beeswarm plot 70 | geom_quasirandom(alpha = 0.7, width = 0.3) 71 | ``` 72 | 73 | Hmm, so this shows a little more of a pattern, but not much. I used the `beeswarm package` that can efficiently shows the scatter on a factorial level. I encountered this at [Christian Burkhart blog post](https://ggplot2tutor.com/powerlifting/squats/) analyzing the #TidyTuesday data set on powerlifting. 74 | Turning to the plot, the average seems kind of equal, plus the middle group (1:20-1:40) has much more values, so it's not necessarily definite that the correlation exists. However, I like the way the top ranked movies distant themsevls from the rest of the distribution, plus there does seem like a little difference acorss groups. 75 | 76 | let's try labeling those top 3 for each group, plus drawing the average point for each distribution: 77 | 78 | ```{r} 79 | ``` 80 | 81 | -------------------------------------------------------------------------------- /2019/Week41_Power_lifting/ipf.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(ggthemr) 3 | library(gridExtra) 4 | ggthemr('grape') 5 | 6 | #loading data 7 | ipf_lifts <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-08/ipf_lifts.csv") 8 | 9 | #cleaning the data 10 | df <- ipf_lifts %>% 11 | mutate(year = as.numeric(format(date, '%Y'))) %>% 12 | select(-event, -division, -federation, -date) %>% 13 | gather(activity, weight, best3squat_kg:best3deadlift_kg) %>% 14 | group_by(year) 15 | 16 | #filtering to obtain max weight lifted 17 | max_score_all <- df %>% 18 | group_by(sex, activity, year) %>% 19 | filter(place != "DD" & place != "DQ" & !is.na(weight) & weight == max(weight, na.rm = T), 20 | year >= 1980) %>% 21 | ungroup() %>% 22 | group_by (name) %>% 23 | mutate(activity = recode(activity, "best3bench_kg" = "Bench", 24 | "best3deadlift_kg" = "Deadlift", "best3squat_kg" = "Squat"), 25 | sex = recode(sex, "F" = "Female", 'M' = "Male")) %>% 26 | arrange(desc(year)) 27 | 28 | #checking to see if the amount of max makes sense. the max 29 | #function had some ties in some cases, but i decided to leave it as is and 30 | #give the participants their respect :) 31 | check <- max_score_all %>% 32 | group_by(year) %>% 33 | summarise(total = n()) 34 | 35 | #plotting the first graph 36 | g_max <- ggplot(max_score_all, aes(x = year, y = weight, color = activity,shape = activity))+ 37 | geom_point()+ 38 | geom_line(aes(color = activity), size = 1)+ 39 | facet_grid(. ~ sex)+ 40 | labs(y = "Weight (kg)", x = NULL, 41 | title = "Max weight lifted across all of IPF tournaments",caption = "Data from: Open Powerlifting | AmitL")+ 42 | theme( 43 | plot.caption = element_text(hjust = 0, size = 8, face= "italic"), 44 | plot.title = element_text(size = 18), 45 | strip.text = element_text( 46 | size = 14, face = "bold"), 47 | legend.position='top', 48 | legend.justification='left', 49 | legend.direction='horizontal', 50 | legend.title = element_blank(), 51 | legend.text = element_text(size = 12), 52 | legend.spacing.x = unit(0.4, 'cm'), 53 | legend.background = element_blank(), 54 | legend.key = element_blank(), 55 | legend.key.size = unit(2,"line") 56 | ) 57 | 58 | #aggregating number of max achieved 59 | competition_name <- max_score_all %>% 60 | group_by(sex, name) %>% 61 | summarise(n = n()) %>% 62 | group_by(sex, n) %>% 63 | summarise(total = n()) 64 | 65 | #plotting number of max achieved 66 | g_rewin <- ggplot(competition_name, aes(x = n, y= total, fill = sex)) + 67 | geom_bar(stat = "identity")+ 68 | facet_grid(sex ~ .)+ 69 | scale_x_continuous(breaks = seq(0,12,1))+ 70 | scale_y_continuous(breaks = seq(0,50,5))+ 71 | labs(y= "# of participants achieving that max", x = "Number of max achieved", 72 | title = "How do the max \nachievements \ndistribute \nacross participants?", 73 | subtitle = "", 74 | caption = "")+ 75 | theme( 76 | strip.text = element_blank(), 77 | plot.title = element_text(size = 12), 78 | legend.title = element_blank(), 79 | legend.position='top', 80 | legend.background = element_rect(fill = "transparent"), 81 | legend.box.background = element_rect(fill = "transparent"), 82 | legend.spacing.x = unit(0.4, 'cm'), 83 | legend.text = element_text(size = 12), 84 | ) 85 | 86 | #binding the two graphs and plotting with the one bigger than the other. 87 | g <- arrangeGrob(g_max, g_rewin, nrow = 1, widths = c(2,0.75)) 88 | ggsave(g, filename = "Max_lift.jpeg", width =10, height = 6) 89 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/plugins/draggable-legend.js: -------------------------------------------------------------------------------- 1 | /** 2 | * Highcharts plugin for dragging a legend by its title 3 | * 4 | * Author: Torstein Hønsi 5 | * License: MIT License 6 | * Version: 1.3.9 7 | * Requires: Highcharts 3.0+ 8 | * 9 | * Usage: Set draggable:true and floating:true in the legend options. The legend 10 | * preserves is alignment after dragging. For example if it is aligned to the right, 11 | * if will keep the same distance to the right edge even after chart resize or 12 | * when exporting to a different size. 13 | */ 14 | (function (H) { 15 | var addEvent = H.addEvent; 16 | 17 | H.wrap(H.Chart.prototype, 'init', function (proceed) { 18 | proceed.apply(this, Array.prototype.slice.call(arguments, 1)); 19 | 20 | var chart = this, 21 | legend = chart.legend, 22 | title = legend.title, 23 | options = legend.options, 24 | isDragging, 25 | downX, 26 | downY, 27 | optionsX, 28 | optionsY, 29 | currentX, 30 | currentY; 31 | 32 | 33 | function pointerDown(e) { 34 | e = chart.pointer.normalize(e); 35 | downX = e.chartX; 36 | downY = e.chartY; 37 | optionsX = options.x; 38 | optionsY = options.y; 39 | currentX = legend.group.attr('translateX'); 40 | currentY = legend.group.attr('translateY'); 41 | isDragging = true; 42 | } 43 | 44 | function pointerMove(e) { 45 | if (isDragging) { 46 | e = chart.pointer.normalize(e); 47 | var draggedX = e.chartX - downX, 48 | draggedY = e.chartY - downY; 49 | 50 | // Stop touch-panning the page 51 | e.preventDefault(); 52 | 53 | // Do the move is we're inside the chart 54 | if ( 55 | currentX + draggedX > 0 && 56 | currentX + draggedX + legend.legendWidth < chart.chartWidth && 57 | currentY + draggedY > 0 && 58 | currentY + draggedY + legend.legendHeight < chart.chartHeight 59 | ) { 60 | 61 | options.x = optionsX + draggedX; 62 | options.y = optionsY + draggedY; 63 | legend.group.placed = false; // prevent animation 64 | legend.group.align(H.extend({ 65 | width: legend.legendWidth, 66 | height: legend.legendHeight 67 | }, options), true, 'spacingBox'); 68 | legend.positionCheckboxes(); 69 | } 70 | if (chart.pointer.selectionMarker) { 71 | chart.pointer.selectionMarker = chart.pointer.selectionMarker.destroy(); 72 | } 73 | 74 | } 75 | } 76 | 77 | function pointerUp() { 78 | isDragging = false; 79 | } 80 | 81 | if (options.draggable && title) { 82 | 83 | title.css({ cursor: 'move' }); 84 | 85 | // Mouse events 86 | addEvent(title.element, 'mousedown', pointerDown); 87 | addEvent(chart.container, 'mousemove', pointerMove); 88 | addEvent(document, 'mouseup', pointerUp); 89 | 90 | // Touch events 91 | addEvent(title.element, 'touchstart', pointerDown); 92 | addEvent(chart.container, 'touchmove', pointerMove); 93 | addEvent(document, 'touchend', pointerUp); 94 | 95 | } 96 | }); 97 | }(Highcharts)); -------------------------------------------------------------------------------- /2019/Week49_parking_tickets/parking_tickets.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(lubridate) 3 | library(patchwork) 4 | library(ggmap) 5 | library(RColorBrewer) 6 | library(extrafont) 7 | 8 | #I saved the dataset as a csv in order to read it easily 9 | tickets <- read_csv("dataset.csv") 10 | 11 | #getting Phily map from google's API 12 | phil_map <- get_map( 13 | "Philadelphia, Pennsylvania", 14 | zoom = 12, 15 | maptype = "terrain", 16 | source = "google") 17 | 18 | #First plot 19 | p <- ggmap(phil_map)+ 20 | #Creating a density 'cloud' instead of too many points 21 | stat_density_2d(data = tickets, aes (x = lon, y= lat, fill = stat(level)), 22 | geom = "polygon", 23 | alpha = .2, 24 | bins = 100, 25 | )+ 26 | #Brewing the scale color from default 27 | scale_fill_gradientn(name = "# Tickets", colors = brewer.pal(7, "YlOrRd"))+ 28 | theme_void()+ 29 | labs(title = "Philadelphia parking tickets issued in 2017") 30 | 31 | p <- p + theme(text = element_text(family = "Times New Roman"), 32 | plot.title = element_text(size = 23, hjust = 0.5, face = "bold"), 33 | panel.border = element_rect(color = "black", size = 1.5, fill = NA), 34 | legend.position = "bottom") 35 | 36 | # Second plot ------------------------------------------------------------- 37 | 38 | #Let's aggregate tickets by the hour they were issued 39 | by_hour <- 40 | tickets %>% 41 | mutate(hour = hour(issue_datetime)) %>% 42 | group_by(hour) %>% 43 | summarise(total_fine = n()) 44 | 45 | #Merging 0 and 24 hour. Otherwise it'll end at 23:00 (11 pm) 46 | first_hours <- by_hour %>% 47 | filter(hour == 0) %>% 48 | mutate(hour = 24) 49 | 50 | #Now binding the df so that 24 is identical to 0, see Below for Christian's blog 51 | #On solving the issue by binding the additional row 52 | hour_ext <- by_hour %>% 53 | rbind(first_hours) 54 | 55 | p2 <- ggplot(by_hour, aes(hour, y= total_fine))+ 56 | #I initially did a polygon but find the geom_bar a little nicer 57 | #for a 'clock plot' 58 | #geom_polygon(fill = "#009688", group = 1, alpha = 0.8)+ 59 | #geom_point(color = "#99d5cf", size = 0.1)+ 60 | geom_bar(aes(x = hour, y = total_fine, fill = total_fine),stat = "identity")+ 61 | #going for a same color scheme - dark red for a higher value 62 | scale_fill_gradientn(colors = brewer.pal(7, "YlOrRd"))+ 63 | scale_x_continuous(breaks = seq(0,24,by = 1))+ 64 | labs(x = NULL, y= NULL, title = "Number of tickets by hour of day", 65 | caption = "Data: Open Data Philly | @Amit_Levinson")+ 66 | #turn the geom_bar to a circular plot 67 | coord_polar()+ 68 | theme_minimal()+ 69 | theme(text = element_text(family = "Times New Roman", face = "bold"), 70 | plot.title = element_text(size = 21, hjust = 0.5), 71 | plot.caption = element_text(size = 10, face = "italic"), 72 | plot.background = element_blank(), #(color = "black", size = 1.5), 73 | axis.text = element_text(size = 12), 74 | axis.text.y = element_blank(), 75 | legend.position = "none", 76 | plot.margin = unit(c(0.3,0.3,0.3,0.3), "cm")) 77 | p2 78 | #Using the new patchwork package to bind the two plots! 79 | g <- p + p2 80 | g 81 | 82 | ggsave(g, filename = "parking_tickets_hours.png", width = 12, height = 10) 83 | 84 | #Thanks to Christian's blog about creating a ploygon to plot on a 'clock plot'. 85 | #I decided to focus on a geom_bar instead but it's still a great guide! 86 | #https://ggplot2tutor.com/radar-chart/radar-chart-whatsapp/ 87 | #Thanks to this blog where i learned about using stat_density_2d on a ggmap: 88 | #https://cfss.uchicago.edu/notes/raster-maps-with-ggmap/ 89 | -------------------------------------------------------------------------------- /2019/Week43_Horror_Films/horror_films.R: -------------------------------------------------------------------------------- 1 | setwd("C:/Users/amitl/OneDrive/Extra/R/TidyTuesday/Week43_Horror_Films") 2 | library(tidyverse) 3 | library(lubridate) 4 | library(stringr) 5 | library(ggimage) 6 | library(gridGraphics) 7 | library(grid) 8 | library(png) 9 | library(ggrepel) 10 | 11 | 12 | horror_movies <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-22/horror_movies.csv") 13 | 14 | rating_length <- horror_movies %>% 15 | mutate(movie_length = as.numeric(str_replace(movie_run_time," min", ""))) %>% 16 | filter(!is.na(movie_length) & !is.na(review_rating)) %>% 17 | mutate(new_date = lubridate::dmy(release_date), 18 | year = ifelse(is.na(new_date), release_date,year(new_date))) %>% 19 | select(title, release_country, review_rating, movie_length, language, year) %>% 20 | mutate(length_cat = ifelse(movie_length<90, "Under 90 min", ifelse(movie_length>=90 & movie_length <120, "90-120 minutes", "Over 2 hours"))) 21 | str(rating_length$review_rating) 22 | 23 | avg_review <- mean(rating_length$review_rating, na.rm = T) 24 | 25 | top_1 <- rating_length %>% 26 | mutate(average_rating = mean(review_rating), 27 | label = paste0(title, "\n(", language, ")")) %>% 28 | arrange(desc(review_rating)) %>% 29 | filter(movie_length <=90 & 30 | review_rating >= quantile(review_rating, 0.995) | 31 | review_rating <= quantile(review_rating, 0.005)) 32 | 33 | movie_length <=90 & movie_length >= 60 & 34 | review_rating >= quantile(review_rating, 0.975)) 35 | 36 | #review_rating >= quantile (review_rating, 0.99) & 37 | #movie_length >30 38 | #image for the plot 39 | top_1$tombstone <- "tomb3.png" 40 | 41 | p <- ggplot(top_1 ,(aes(x = movie_length, y = review_rating)))+ 42 | geom_image(aes(image = tombstone), size = 0.05)+ 43 | geom_point()+ 44 | scale_x_continuous(limits = c(60,90), breaks = seq(60,90,15), 45 | labels = c("60 minutes", "1 hour", "1.5 hours"), 46 | name = "Movie length")+ 47 | geom_label_repel(top_1, mapping = aes(label = title), xlim=c(60,65), 48 | force = 50, direction = "y") 49 | 50 | 51 | p 52 | 53 | aes(label = name, y = 2), 54 | fontface = 'bold', 55 | color = "mediumpurple", 56 | xlim=c(8,9), 57 | ylim=c(0,15)) 58 | 59 | geom_text(aes(label = label), nudge_y = 0.22, hjust = 0, 60 | nudge_x = -1.6, 61 | fontface= "bold") 62 | 63 | p 64 | 65 | 66 | 67 | movie_length = as.numeric(movie_length)) %>% 68 | f 69 | 70 | str(horror_movies$movie_length) 71 | 72 | mean(horror_movies$movie_length) 73 | 74 | clean_dates <- horror_movies %>% 75 | mutate(new_date = lubridate::dmy(release_date), 76 | year = ifelse(is.na(new_date), release_date,year(new_date)) 77 | ) 78 | 79 | 80 | clean_dates %>% group_by(year) %>% 81 | count(year) 82 | 83 | 84 | clean_dates$year <- ifelse(is.na(clean_dates$new_date), year(clean_dates$new_date),clean_dates$release_date) 85 | 86 | 87 | year <- as.numeric(format(date,'%Y')) 88 | 89 | mutate(new_date[new_date == NA] = release_date) 90 | 91 | mutate(Answer = ifelse(max(Answer, na.rm=TRUE)== -Inf, NA, 92 | as.integer(max(Answer, na.rm=TRUE)))) 93 | 94 | NAs <- clean_dates %>% 95 | filter(is.na(new_date)) %>% 96 | group_by(release_date) %>% 97 | summarise(n = n()) 98 | 99 | 100 | str(clean_dates) 101 | 102 | 103 | 104 | mutate(date_release = as.Date(release_date, format = "%d-%B-%y")) %>% 105 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/histogram-bellcurve.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | 4 | (c) 2010-2018 Highsoft AS 5 | Author: Sebastian Domas 6 | 7 | License: www.highcharts.com/license 8 | */ 9 | (function(b){"object"===typeof module&&module.exports?module.exports=b:"function"===typeof define&&define.amd?define(function(){return b}):b("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(b){var f=function(a){var b=a.Series,g=a.addEvent;return{init:function(){b.prototype.init.apply(this,arguments);this.initialised=!1;this.baseSeries=null;this.eventRemovers=[];this.addEvents()},setDerivedData:a.noop,setBaseSeries:function(){var l=this.chart,a=this.options.baseSeries;this.baseSeries= 10 | a&&(l.series[a]||l.get(a))||null},addEvents:function(){var a=this,b;b=g(this.chart,"afterLinkSeries",function(){a.setBaseSeries();a.baseSeries&&!a.initialised&&(a.setDerivedData(),a.addBaseSeriesEvents(),a.initialised=!0)});this.eventRemovers.push(b)},addBaseSeriesEvents:function(){var a=this,b,e;b=g(a.baseSeries,"updatedData",function(){a.setDerivedData()});e=g(a.baseSeries,"destroy",function(){a.baseSeries=null;a.initialised=!1});a.eventRemovers.push(b,e)},destroy:function(){this.eventRemovers.forEach(function(a){a()}); 11 | b.prototype.destroy.apply(this,arguments)}}}(b);(function(a,b){function g(a){return function(c){for(var d=1;a[d]<=c;)d++;return a[--d]}}var l=a.objectEach,k=a.seriesType,e=a.correctFloat,q=a.isNumber,p=a.arrayMax,r=a.arrayMin;a=a.merge;var h={"square-root":function(a){return Math.round(Math.sqrt(a.options.data.length))},sturges:function(a){return Math.ceil(Math.log(a.options.data.length)*Math.LOG2E)},rice:function(a){return Math.ceil(2*Math.pow(a.options.data.length,1/3))}};k("histogram","column", 12 | {binsNumber:"square-root",binWidth:void 0,pointPadding:0,groupPadding:0,grouping:!1,pointPlacement:"between",tooltip:{headerFormat:"",pointFormat:'\x3cspan style\x3d"font-size: 10px"\x3e{point.x} - {point.x2}\x3c/span\x3e\x3cbr/\x3e\x3cspan style\x3d"color:{point.color}"\x3e\u25cf\x3c/span\x3e {series.name} \x3cb\x3e{point.y}\x3c/b\x3e\x3cbr/\x3e'}},a(b,{setDerivedData:function(){var a=this.derivedData(this.baseSeries.yData,this.binsNumber(),this.options.binWidth);this.setData(a,!1)},derivedData:function(a, 13 | d,b){var c=p(a),h=r(a),n=[],m={},k=[],f;b=this.binWidth=e(q(b)?b||1:(c-h)/d);for(d=h;d% 24 | group_by(season) %>% 25 | summarise(total_goals = sum(goals)/n_distinct(player)) %>% 26 | mutate(player = "Average") %>% 27 | select(player, everything()) 28 | ``` 29 | 30 | Column {.sidebar width=10} 31 | ----------------------------------------------------------------------- 32 | 33 | #### **Please select the player you wish to see statistics about:** 34 | 35 | ```{r} 36 | selectInput("player", label = NULL, choices = unique(game_goals$player)) 37 | ``` 38 | 39 | Column {data-width=500} 40 | ----------------------------------------------------------------------- 41 | 42 | ```{r} 43 | data_year <- reactive({ 44 | game_goals %>% 45 | filter(player == input$player) %>% 46 | group_by(player, season) %>% 47 | summarise( 48 | total_goals = sum(goals) 49 | ) %>% 50 | ungroup() %>% 51 | rbind(average_goals) %>% 52 | add_count(season) %>% 53 | filter(n >= 2) %>% 54 | mutate(player = factor(player, c(input$player, "Average"), labels = c(input$player, "Average across players"))) 55 | }) 56 | 57 | data_year_scales <- reactive({data.frame( 58 | "min_scale_x" = min(data_year()$season), 59 | "max_scale_x" = max(data_year()$season), 60 | "max_scale_y" = max(data_year()$total_goals)) 61 | }) 62 | 63 | renderPlot({ 64 | ggplot(data = data_year(), aes(x= season, y = total_goals, color = player))+ 65 | geom_line(size = 0.8)+ 66 | scale_x_continuous(breaks = seq(data_year_scales()$min_scale_x, data_year_scales()$max_scale_x, 2))+ 67 | scale_y_continuous(breaks = seq(0,data_year_scales()$max_scale_y,10), limits = c(0,data_year_scales()$max_scale_y+10))+ 68 | scale_color_manual(values = c("#0072B2","gray70"))+ 69 | labs(x = "Season", y = "Goals per season", title = glue("Total goals in a season for {input$player}"))+ 70 | theme( 71 | text = element_text(family = "Miriam"), 72 | panel.grid.minor = element_blank(), 73 | plot.title = element_text(size = 20), 74 | legend.position = "top", 75 | legend.title = element_blank() 76 | ) 77 | }) 78 | ``` 79 | 80 | Column {data-width=350} 81 | ----------------------------------------------------------------------- 82 | 83 | ```{r} 84 | data_ha_wl <- reactive({ 85 | game_goals %>% 86 | pivot_longer(cols= c(goals:assists), names_to = "long_points") %>% 87 | filter(player == input$player) %>% 88 | group_by(long_points) %>% 89 | summarise(total = sum(value)) 90 | }) 91 | 92 | renderPlot({ 93 | ggplot(data = data_ha_wl(),(aes(x = long_points, y = total,fill = long_points)))+ 94 | geom_bar(position = "stack", stat = "identity")+ 95 | labs(x = NULL, y= "Total points", title = glue("Point distribution across games for {input$player}"))+ 96 | scale_x_discrete(labels = c("Assists", "Goals"))+ 97 | scale_y_continuous(breaks = seq(0, max(data_ha_wl()$total),100), limits = c(0,max(data_ha_wl()$total +10)))+ 98 | theme( 99 | legend.position = "none", 100 | plot.title = element_text(size = 14), 101 | text = element_text(family = "Miriam") 102 | ) 103 | }) 104 | ``` 105 | 106 | -------------------------------------------------------------------------------- /2020/week23_marble-races/marble-races.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Marble Races" 3 | author: "Amit Levinson" 4 | date: "6/1/2020" 5 | output: html_document 6 | editor_options: 7 | chunk_output_type: console 8 | --- 9 | 10 | ```{r} 11 | library(tidyverse) 12 | library(extrafont) 13 | library(ggtext) 14 | library(here) 15 | ``` 16 | 17 | Getting data: 18 | 19 | ```{r} 20 | tuesdata <- tidytuesdayR::tt_load('2020-06-02') 21 | marbles <- tuesdata$marbles 22 | 23 | tidytuesdayR::readme(tuesdata) 24 | ``` 25 | 26 | ```{r} 27 | glimpse(marbles) 28 | ``` 29 | 30 | Exploring players time distribution across games for each team? 31 | 32 | ```{r} 33 | marbles %>% 34 | group_by(team_name, marble_name) %>% 35 | summarise(mean_time = mean(avg_time_lap)) %>% 36 | ungroup() %>% 37 | ggplot()+ 38 | geom_point(aes(x= mean_time, y= team_name)) 39 | ``` 40 | 41 | Maybe the cummulative points for each team? Yes! 42 | 43 | ```{r} 44 | cumsum_marbles <- marbles %>% 45 | # Make sure filtered to only teams (and not individual players) 46 | distinct(team_name, date, points, race) %>% 47 | #remove observations with na points 48 | filter(!is.na(points), str_detect(race, "S1R\\d")) %>% 49 | group_by(team_name) %>% 50 | # Transform date to date column 51 | mutate(date = as.Date(date, format = "%d-%B-%y"), 52 | # Make pnts cummulative 53 | cum_pnts = cumsum(points), 54 | highlight = case_when(team_name == "Savage Speeders" ~ "savage", 55 | team_name == "Hazers" ~ "hazers", 56 | TRUE ~ "n"), 57 | # Have the Savage Speeders with a line break (too long of a name) 58 | team_name = ifelse(team_name == "Savage Speeders", "Savage\nSpeeders", team_name)) %>% 59 | arrange(-cum_pnts) %>% 60 | ungroup() 61 | 62 | 63 | #plot 64 | ggplot(data = cumsum_marbles, aes(x = date, y = cum_pnts, group = team_name, color = highlight))+ 65 | geom_line(size = 1.15, show.legend = FALSE)+ 66 | #Provide specific colors for the high-points teams 67 | scale_color_manual(values = c("savage" = "#4184A4","hazers" ="#FDBCB4", "n" = "grey90"))+ 68 | scale_x_date(breaks = "1 week", date_labels = "%b-%d")+ 69 | scale_y_continuous(breaks = seq(0,100,20))+ 70 | # Provide some extra space for the geom_text 71 | coord_cartesian(clip = 'off')+ 72 | # Add text only to relevant highlight points and the last date 73 | geom_text(data = subset(cumsum_marbles, highlight != "n" & date == max(date)), aes(label = team_name), size = 3.25, hjust = 0, fontface = "bold", show.legend = FALSE)+ 74 | # Add labs using ggtext in the subtitle 75 | labs(x = "Date (2020)", y = "Cummulative Points", title = "Marbles Rolling to Victory", subtitle = "Marble races have never been more exciting with Jelle’s Marble Race. Currently operating as a Youtube channel, the platform
offers weekly marble races that'll will keep you on your toes. Data from season one shows a close match between the two
teams the Savage Speeders and Hazers.", 76 | caption = "Data: Jelle's Marble Runs | @Amit_Levinson")+ 77 | theme(text = element_text(family = "Roboto Condensed"), 78 | plot.title = element_text(size = 20, face = "bold"), 79 | plot.subtitle = element_markdown(size = 13, color = "grey35"), 80 | panel.grid = element_blank(), 81 | axis.text = element_text(color = "grey50", size = 10), 82 | axis.title = element_text(color = "grey50", size = 10), 83 | plot.caption = element_text(color = "grey50", size = 8), 84 | axis.ticks = element_blank(), 85 | panel.background = element_blank(), 86 | plot.margin = margin(2,3,2,2,"mm")) 87 | 88 | # Save 89 | ggsave(here("2020", "week23_marble-races" ,"mr.png"), width = 11, height = 6, dpi = 600) 90 | ``` -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/drag-panes.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | Drag-panes module 4 | 5 | (c) 2010-2018 Highsoft AS 6 | Author: Kacper Madej 7 | 8 | License: www.highcharts.com/license 9 | */ 10 | (function(g){"object"===typeof module&&module.exports?module.exports=g:"function"===typeof define&&define.amd?define(function(){return g}):g("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(g){(function(b){var g=b.hasTouch,x=b.merge,u=b.wrap,y=b.isNumber,e=b.addEvent,v=b.relativeLength,z=b.objectEach,m=b.Axis,w=b.Pointer;x(!0,m.prototype.defaultYAxisOptions,{minLength:"10%",maxLength:"100%",resize:{controlledAxis:{next:[],prev:[]},enabled:!1,cursor:"ns-resize",lineColor:"#cccccc",lineDashStyle:"Solid", 11 | lineWidth:4,x:0,y:0}});b.AxisResizer=function(a){this.init(a)};b.AxisResizer.prototype={init:function(a,c){this.axis=a;this.options=a.options.resize;this.render();c||this.addMouseEvents()},render:function(){var a=this.axis,c=a.chart,d=this.options,b=d.x,e=d.y,k=Math.min(Math.max(a.top+a.height+e,c.plotTop),c.plotTop+c.plotHeight),l={};c.styledMode||(l={cursor:d.cursor,stroke:d.lineColor,"stroke-width":d.lineWidth,dashstyle:d.lineDashStyle});this.lastPos=k-e;this.controlLine||(this.controlLine=c.renderer.path().addClass("highcharts-axis-resizer")); 12 | this.controlLine.add(a.axisGroup);d=c.styledMode?this.controlLine.strokeWidth():d.lineWidth;l.d=c.renderer.crispLine(["M",a.left+b,k,"L",a.left+a.width+b,k],d);this.controlLine.attr(l)},addMouseEvents:function(){var a=this,c=a.controlLine.element,d=a.axis.chart.container,b=[],t,k,l;a.mouseMoveHandler=t=function(c){a.onMouseMove(c)};a.mouseUpHandler=k=function(c){a.onMouseUp(c)};a.mouseDownHandler=l=function(c){a.onMouseDown(c)};b.push(e(d,"mousemove",t),e(d.ownerDocument,"mouseup",k),e(c,"mousedown", 13 | l));g&&b.push(e(d,"touchmove",t),e(d.ownerDocument,"touchend",k),e(c,"touchstart",l));a.eventsToUnbind=b},onMouseMove:function(a){a.touches&&0===a.touches[0].pageX||!this.grabbed||(this.hasDragged=!0,this.updateAxes(this.axis.chart.pointer.normalize(a).chartY-this.options.y))},onMouseUp:function(a){this.hasDragged&&this.updateAxes(this.axis.chart.pointer.normalize(a).chartY-this.options.y);this.grabbed=this.hasDragged=this.axis.chart.activeResizer=null},onMouseDown:function(){this.axis.chart.pointer.reset(!1, 14 | 0);this.grabbed=this.axis.chart.activeResizer=!0},updateAxes:function(a){var c=this,d=c.axis.chart,b=c.options.controlledAxis,e=0===b.next.length?[d.yAxis.indexOf(c.axis)+1]:b.next,b=[c.axis].concat(b.prev),k=[],l=!1,g=d.plotTop,m=d.plotHeight,q=g+m,p;a=Math.max(Math.min(a,q),g);p=a-c.lastPos;1>p*p||([b,e].forEach(function(b,e){b.forEach(function(b,h){var f=(b=y(b)?d.yAxis[b]:e||h?d.get(b):b)&&b.options,n,r;f&&"navigator-y-axis"!==f.id&&(h=b.top,r=Math.round(v(f.minLength,m)),n=Math.round(v(f.maxLength, 15 | m)),e?(p=a-c.lastPos,f=Math.round(Math.min(Math.max(b.len-p,r),n)),h=b.top+p,h+f>q&&(n=q-f-h,a+=n,h+=n),hq&&(f=m)),f===r&&(l=!0),k.push({axis:b,options:{top:Math.round(h),height:f}})):(f=Math.round(Math.min(Math.max(a-h,r),n)),f===n&&(l=!0),a=h+f,k.push({axis:b,options:{height:f}})))})}),l||(k.forEach(function(a){a.axis.update(a.options,!1)}),d.redraw(!1)))},destroy:function(){var a=this;delete a.axis.resizer;this.eventsToUnbind&&this.eventsToUnbind.forEach(function(a){a()});a.controlLine.destroy(); 16 | z(a,function(b,d){a[d]=null})}};m.prototype.keepProps.push("resizer");e(m,"afterRender",function(){var a=this.resizer,c=this.options.resize;c&&(c=!1!==c.enabled,a?c?a.init(this,!0):a.destroy():c&&(this.resizer=new b.AxisResizer(this)))});e(m,"destroy",function(a){!a.keepEvents&&this.resizer&&this.resizer.destroy()});u(w.prototype,"runPointActions",function(a){this.chart.activeResizer||a.apply(this,Array.prototype.slice.call(arguments,1))});u(w.prototype,"drag",function(a){this.chart.activeResizer|| 17 | a.apply(this,Array.prototype.slice.call(arguments,1))})})(g)}); 18 | //# sourceMappingURL=drag-panes.js.map 19 | -------------------------------------------------------------------------------- /2020/week20_volcano/week20_volcano.R: -------------------------------------------------------------------------------- 1 | library(extrafont) 2 | library(tidyverse) 3 | library(RColorBrewer) 4 | library(scales) 5 | 6 | volcano <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-12/volcano.csv') 7 | eruptions <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-12/eruptions.csv') 8 | 9 | names_annotation <- c("Etna", "Asosan", "Tambora", "Fournaise, Piton de la") 10 | 11 | volcano_loc_n <- eruptions %>% 12 | distinct(volcano_name, eruption_number, .keep_all = T) %>% 13 | filter(eruption_category == "Confirmed Eruption") %>% 14 | count(volcano_name, sort = T, name = "n_explosions") %>% 15 | inner_join(volcano) %>% 16 | mutate(highlight_point = ifelse(volcano_name %in% names_annotation, "yes", "no")) 17 | 18 | 19 | volcano_loc_n %>% 20 | ggplot(data = ., aes(x = population_within_5_km, y= n_explosions, label = volcano_name))+ 21 | geom_point(color = "#E31A1C", alpha = 3/10, size = 4)+ 22 | geom_point(data = subset(volcano_loc_n, highlight_point == "yes"), color = "#E31A1C", size = 4)+ 23 | scale_x_log10(labels = comma)+ 24 | coord_cartesian(clip = 'off')+ 25 | labs(title = "Living with volcanoes", 26 | subtitle = "Number of confirmed volcano eruptions with population (log scale) currently living within a 5 kilomoter distance.\nRecorded eruptions range from thousands of years back until a month ago, varying in their degree of explosion.", 27 | caption = "Source: Smithsonian | @Amit_Levinson", 28 | y = "Number of eruptions", 29 | x = "\nPopulation (log) within 5 km")+ 30 | theme(text = element_text(family = "Roboto Condensed"), 31 | #plot.title = element_markdown(color = "#FB9A99"), 32 | plot.title = element_text(face = "bold", size = 45), 33 | plot.subtitle = element_text(size = 16, color = "grey10"), 34 | plot.caption = element_text(size = 9, color = "grey25"), 35 | plot.background = element_rect(fill = "grey50"), 36 | panel.background = element_rect(fill = "grey50"), 37 | panel.grid = element_blank(), 38 | axis.text = element_text(color = "grey25", size = 12), 39 | axis.title = element_text(color = "grey15", size = 14, hjust = 1), 40 | axis.ticks = element_blank(), 41 | plot.margin = margin(4,4,2,4, unit = "mm") 42 | )+ 43 | annotate(geom = "curve", x = 45, xend = 72, y = 191, yend = 196, 44 | curvature = -.2,color = "grey35", size = 0.75, arrow = arrow(length = unit(1.5, "mm")))+ 45 | annotate("text", x = 42, y = 180, label = "Etna (Italy), one of the world's most\nactive volcanoes, erupted 196 times. Today\n78 people live within 5km.", 46 | color = "grey20", hjust = 0, size = 5, family = "JetBrains Mono")+ 47 | annotate(geom = "curve", x = 105000, xend = 59000, y = 190, yend =189, 48 | curvature = .2, color = "grey35", size = 0.75, arrow = arrow(length = unit(1.5, "mm")))+ # Fournaise 49 | annotate(geom = "curve", x = 105000, xend = 80000, y = 179, yend = 171, 50 | curvature = -.2, color = "grey35", size = 0.75, arrow = arrow(length = unit(1.5, "mm")))+ # Asosan 51 | annotate("text", x = 111000, y = 187, label = "Piton de la Fournaise (top) and\nAsosan (bottom) are both highly\nactive volcanoes that erupted ~190\ntimes. Today some 55,000 people\nlive within 5km from each volcano.", 52 | color = "grey20", hjust = 0, family = "JetBrains Mono", size = 5)+ 53 | annotate(geom = "curve", x = 3000, xend = 4000, y = 70, yend = 9, 54 | curvature = .2, color = "grey35", size = 0.9, arrow = arrow(length = unit(1.5, "mm")))+ 55 | annotate("text", x = 3000, y = 80, label = "Tambora's (Indonesia) 1815 eruption was the most\npowerful eruption recorded in human history.\nToday 4156 people live within 5km.", 56 | color = "grey20", hjust = 0, size = 5, family = "JetBrains Mono") 57 | 58 | ggsave("vc.png", width = 16, height = 10, dpi = 1020) 59 | 60 | 61 | -------------------------------------------------------------------------------- /2019/Week44_NYC_Squerrils/Squirrels.Rmd: -------------------------------------------------------------------------------- 1 | output: html_document 2 | editor_options: 3 | chunk_output_type: console 4 | --- 5 | 6 | ```{r setup, include=FALSE} 7 | knitr::opts_chunk$set(echo = TRUE) 8 | ``` 9 | 10 | 11 | ```{r} 12 | nyc_squirrels <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-29/nyc_squirrels.csv") 13 | library(tidyverse) 14 | library(extrafont) 15 | library(ggalt) 16 | library(ggthemr) 17 | ggthemr("light") 18 | 19 | view(nyc_squirrels) 20 | ``` 21 | 22 | ```{r} 23 | 24 | activity_df <- nyc_squirrels %>% 25 | #Gathering the different activities to one column 26 | gather(key = "activity", value = "condition", c(running:foraging, kuks:runs_from))%>% 27 | #Filtering activities recorded as false or na 28 | filter(condition != FALSE & !is.na(condition)) %>% 29 | #changing activitiy to a factor level 30 | mutate(activity = as.factor(activity)) %>% 31 | group_by(activity, shift) %>% 32 | #total number of activities per shift 33 | summarise(total = n()) %>% 34 | ungroup() %>% 35 | #In order to create the geom_dumbbell we need to spread our points: 36 | spread(shift, total) %>% 37 | #let's calculate the difference to which we'll reorder the factors by 38 | mutate(difference = PM-AM) %>% 39 | #relooking at the data.frame 40 | arrange(desc(difference)) 41 | 42 | #We'll use these labels for the plot instead of teh variable names 43 | y_labels <- c("Climbing","Kukking", "Moaning", "Indifferent", "Quaaing","Flaging tail", "Approaching", "Chasing", "Twiching tail", "Running", "Running away", "Eating", "Foraging") 44 | 45 | #plott 46 | g <- ggplot(activity_df,aes(x = AM, xend = PM, y = fct_reorder(activity ,difference)))+ 47 | #Using geom_dumbbell form the ggalt package 48 | geom_dumbbell(colour = "grey60", size = 2, 49 | colour_x = "#F7BC08", colour_xend = "#395B74")+ 50 | #Changing y level and other labels 51 | scale_y_discrete(label = y_labels)+ 52 | labs(x = "Number of Squirrels doing that activity", y = "Observed activity", title = "What are squirrels observed doing in central park?", 53 | subtitle = paste0(sum(activity_df$AM), " central park squirrel's activities were observed by the AM shift, and a total of ", sum(activity_df$PM), " activities \nwere observed by the PM shift - Apparently some squirrels were 'multi-tasking'"), caption = "Data: Squirrel Census | @Amit_Levinson")+ 54 | #Adding AM to the points where the AM number is lower than the PM 55 | geom_text(aes(x = AM, y= activity), label = ifelse(activity_df$difference > 0, "AM", " "), size = 3.5, position = position_nudge(x = -16), colour = ifelse(activity_df$difference > 0, "#F7BC08", "#395B74"))+ 56 | #Adding PM to the points where the PM number is higher than the AM 57 | geom_text(aes(x= PM, y= activity),label = ifelse(activity_df$difference >0, "PM", ""), size = 3.5,position = position_nudge(x = 16), colour = ifelse(activity_df$difference > 0 , "#395B74", "#F7BC08"))+ 58 | #Because we had two factors with opposite values than the others, we had to 59 | #do the same only opposite 60 | geom_text(aes(x = AM, y= activity), label = ifelse(activity_df$difference < 0, "AM", " "), size = 3.5,position = position_nudge(x = 16), colour = ifelse(activity_df$difference <0, "#F7BC08", "#395B74"))+ 61 | #And again for the PM group: 62 | geom_text(aes(x= PM, y= activity),label = ifelse(activity_df$difference <0, "PM", ""), size = 3.5,position = position_nudge(x = -16), colour = ifelse(activity_df$difference < 0 , "#395B74", "#F7BC08")) 63 | 64 | #Adding a theme: 65 | g +theme( 66 | text=element_text(family = "Microsoft Tai Le"), 67 | plot.title = element_text(size = 20, face = "bold"), 68 | plot.subtitle = element_text(size = 13), 69 | plot.caption = element_text(size = 8,face = "italic"), 70 | axis.text.x = element_text(size = 14), 71 | axis.text.y = element_text(size = 11) 72 | ) 73 | 74 | ggsave("Central_park_squirrel.png", width =10, height = 6) 75 | 76 | ``` 77 | -------------------------------------------------------------------------------- /2021/week10_superbowl/superbowl.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | library(ggplot2) 3 | library(here) 4 | library(ggtext) 5 | library(patchwork) 6 | library(extrafont) 7 | 8 | youtube <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-03-02/youtube.csv') 9 | # dir.create("extra/images/progress/2021-week10") # Directory for images showing the process 10 | 11 | # Exploratory 12 | skimr::skim(youtube) 13 | 14 | 15 | # First plot of all brands except our outlier ----------------------------- 16 | 17 | p1 <- youtube %>% 18 | # Filter out the highest value (doritos) 19 | arrange(view_count) %>% 20 | slice(1:(nrow(.)-1)) %>% 21 | ggplot(aes(x = brand, y = view_count))+ 22 | geom_jitter(width = 0.25, size = 0.8) + 23 | # Create breaks including a dot dot dot 24 | scale_y_continuous(limits = c(0,4e7), breaks = seq(0, 4e7, 1e7), labels = c(seq(0,30,10), ".\n."))+ 25 | theme_minimal()+ 26 | labs(title = "Brands' Super Bowl Commercials View Count", 27 | subtitle = "Each point represents an aired commercial YouTube view count. Majority of advertising content is characterized\nby 0-10 million views, with a few commercials gaining more than 20 million views. Data is based on \"233 ads\nfrom the 10 brands that aired the most spots in all 21 Super Bowls (FiveThirtyEight)\". Several commercials were\nmissing view counts.", 28 | x = "\nBrand name", 29 | y = "\n\nViews (millions)", 30 | caption = "Data: FiveThirtyEight\nVisualization: @Amit_Levinson")+ 31 | theme(text = element_text(family = "IBM Plex Sans"), 32 | panel.grid.minor = element_blank(), 33 | panel.grid.major.x = element_blank(), 34 | plot.title = element_text(size = 28, hjust = 0, vjust = 3, face = "bold", family = "Bodoni MT"), 35 | plot.caption = element_text(size = 10, color = "gray35"), 36 | plot.subtitle = element_text(size = 14, color = "gray25", vjust = 6), 37 | axis.title.y = element_text(size = 11, color = "gray35"), 38 | axis.title.x = element_text(size = 14, color = "gray35"), 39 | axis.text.x = element_text(size = 14, color = "gray30"), 40 | axis.text.y = element_text(size = 11, color = "gray30")) 41 | 42 | # # Section two of only Doritors' commercial ------------------------------ 43 | 44 | # Label for the doritors commercial: 45 | doritos_label <- data.frame( 46 | x = 4.48, 47 | y = 163500000, 48 | label = "Doritos' 2012 *Sling Baby* has more
than **170 million** YouTube views") 49 | 50 | 51 | p2 <- youtube %>% 52 | # Keep all groups so that the point aligns on x-axis 53 | group_by(brand) %>% 54 | top_n(n = 1, wt = view_count) %>% 55 | ungroup() %>% 56 | # Remove values for all groups 57 | mutate(view_count = ifelse(brand == "Doritos", view_count, NA), 58 | # Convert the brand to numeric for easier plotting of curve arrow 59 | id = as.numeric(factor(brand))) %>% 60 | ggplot(aes(x = id, y = view_count))+ 61 | geom_point(size = 0.8)+ 62 | # Start breaks where previous plot ends, though I don't think it matters 63 | scale_y_continuous(limits = c(3e7,1.8e8))+ 64 | # Remove everything 65 | theme_void()+ 66 | theme(plot.margin = margin(4,2,2,2,"mm"))+ 67 | annotate(geom = "curve", x = 4.5, xend = 4.03, y = 170000000, yend = 176350200, curvature = .2, color = "grey45", size = 0.65, arrow = arrow(length = unit(1.25,"mm")))+ 68 | geom_richtext(data = doritos_label, aes(x = x, y = y,label =label), fill = NA, label.color = NA, hjust = 0,family = "IBM Plex Sans Light", size = 3.5) 69 | 70 | 71 | # Combining plots --------------------------------------------------------- 72 | 73 | # Combine, give extra space for the top plot to highlight the distance 74 | p2/p1+ 75 | plot_layout(height = c(2,1))+ 76 | ggsave(here("extra","images", "progress", "2021-week10", paste0(format(Sys.time(), "%Y%m%d_%H%M%S"), ".png")), type = 'cairo', height = 8, width = 13) 77 | 78 | ggsave(here("2021","week10_superbowl", "superbowl.png"), type = 'cairo', height = 8, width = 13) 79 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/windbarb.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | Wind barb series module 4 | 5 | (c) 2010-2018 Torstein Honsi 6 | 7 | License: www.highcharts.com/license 8 | */ 9 | (function(k){"object"===typeof module&&module.exports?module.exports=k:"function"===typeof define&&define.amd?define(function(){return k}):k("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(k){var z=function(f){var k=f.defined,r=f.seriesTypes,d=f.stableSort;return{getPlotBox:function(){return f.Series.prototype.getPlotBox.call(this.options.onSeries&&this.chart.get(this.options.onSeries)||this)},translate:function(){r.column.prototype.translate.apply(this);var c=this.options,e=this.chart, 10 | b=this.points,a=b.length-1,g,f,h=c.onSeries,h=h&&e.get(h),c=c.onKey||"y",y=h&&h.options.step,p=h&&h.points,m=p&&p.length,u=e.inverted,n=this.xAxis,v=this.yAxis,w=0,l,x,q,t;if(h&&h.visible&&m)for(w=(h.pointXOffset||0)+(h.barW||0)/2,g=h.currentDataGrouping,x=p[m-1].x+(g?g.totalRange:0),d(b,function(b,a){return b.x-a.x}),c="plot"+c[0].toUpperCase()+c.substr(1);m--&&b[a]&&!(l=p[m],g=b[a],g.y=l.y,l.x<=g.x&&void 0!==l[c]&&(g.x<=x&&(g.plotY=l[c],l.xa)););b.forEach(function(a,c){var d;a.plotX+=w;if(void 0===a.plotY||u)0<=a.plotX&&a.plotX<=n.len?u?(a.plotY=n.translate(a.x,0,1,0,1),a.plotX=k(a.y)?v.translate(a.y,0,0,0,1):0):a.plotY=e.chartHeight-n.bottom-(n.opposite?n.height:0)+n.offset-v.top:a.shapeArgs={};(f=b[c-1])&&f.plotX===a.plotX&&(void 0===f.stackIndex&&(f.stackIndex=0),d=f.stackIndex+1);a.stackIndex=d});this.onSeries=h}}}(k);(function(f,k){var r=f.seriesType;r("windbarb","column", 12 | {lineWidth:2,onSeries:null,states:{hover:{lineWidthPlus:0}},tooltip:{pointFormat:'\x3cspan style\x3d"color:{point.color}"\x3e\u25cf\x3c/span\x3e {series.name}: \x3cb\x3e{point.value}\x3c/b\x3e ({point.beaufort})\x3cbr/\x3e'},vectorLength:20,yOffset:-20,xOffset:0},{pointArrayMap:["value","direction"],parallelArrays:["x","value","direction"],beaufortName:"Calm;Light air;Light breeze;Gentle breeze;Moderate breeze;Fresh breeze;Strong breeze;Near gale;Gale;Strong gale;Storm;Violent storm;Hurricane".split(";"), 13 | beaufortFloor:[0,.3,1.6,3.4,5.5,8,10.8,13.9,17.2,20.8,24.5,28.5,32.7],trackerGroups:["markerGroup"],pointAttribs:function(d,c){var e=this.options;d=d.color||this.color;var b=this.options.lineWidth;c&&(d=e.states[c].color||d,b=(e.states[c].lineWidth||b)+(e.states[c].lineWidthPlus||0));return{stroke:d,"stroke-width":b}},markerAttribs:function(){},getPlotBox:k.getPlotBox,windArrow:function(d){var c=1.943844*d.value,e,b=this.options.vectorLength/20,a=-10;if(d.isNull)return[];if(0===d.beaufortLevel)return this.chart.renderer.symbols.circle(-10* 14 | b,-10*b,20*b,20*b);d=["M",0,7*b,"L",-1.5*b,7*b,0,10*b,1.5*b,7*b,0,7*b,0,-10*b];e=(c-c%50)/50;if(0 15 | e.value);b++);e.beaufortLevel=b-1;e.beaufort=c[b-1]})},drawPoints:function(){var d=this.chart,c=this.yAxis,e=d.inverted,b=this.options.vectorLength/2;this.points.forEach(function(a){var g=a.plotX,f=a.plotY;d.isInsidePlot(g,0,!1)?(a.graphic||(a.graphic=this.chart.renderer.path().add(this.markerGroup)),a.graphic.attr({d:this.windArrow(a),translateX:g+this.options.xOffset,translateY:f+this.options.yOffset,rotation:a.direction}).attr(this.pointAttribs(a))):a.graphic&&(a.graphic=a.graphic.destroy());a.tooltipPos= 16 | [g+this.options.xOffset+(e&&!this.onSeries?b:0),f+this.options.yOffset-(e?0:b+c.pos-d.plotTop)]},this)},animate:function(d){d?this.markerGroup.attr({opacity:.01}):(this.markerGroup.animate({opacity:1},f.animObject(this.options.animation)),this.animate=null)},invertGroups:f.noop},{isValid:function(){return f.isNumber(this.value)&&0<=this.value}})})(k,z)}); 17 | //# sourceMappingURL=windbarb.js.map 18 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/parallel-coordinates.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | 4 | Support for parallel coordinates in Highcharts 5 | 6 | (c) 2010-2018 Pawel Fus 7 | 8 | License: www.highcharts.com/license 9 | */ 10 | (function(e){"object"===typeof module&&module.exports?module.exports=e:"function"===typeof define&&define.amd?define(function(){return e}):e("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(e){(function(b){function e(a){var c=this.series&&this.series.chart,h=a.apply(this,Array.prototype.slice.call(arguments,1)),k,e,d;c&&c.hasParallelCoordinates&&!m(h.formattedValue)&&(d=c.yAxis[this.x],k=d.options,c=(e=q(k.tooltipValueFormat,k.labels.format))?b.format(e,n(this,{value:this.y}),c.time): 11 | d.isDatetimeAxis?c.time.dateFormat(c.time.resolveDTLFormat(k.dateTimeLabelFormats[d.tickPositions.info.unitName]).main,this.y):k.categories?k.categories[this.y]:this.y,h.formattedValue=h.point.formattedValue=c);return h}var r=b.Axis,p=b.Chart,x=b.Series.prototype,y=p.prototype,t=b.Axis.prototype,f=b.addEvent,q=b.pick,u=b.wrap,l=b.merge,z=b.erase,v=b.splat,n=b.extend,m=b.defined,A=b.arrayMin,B=b.arrayMax,w={lineWidth:0,tickLength:0,opposite:!0,type:"category"};b.setOptions({chart:{parallelCoordinates:!1, 12 | parallelAxes:{lineWidth:1,title:{text:"",reserveSpace:!1},labels:{x:0,y:4,align:"center",reserveSpace:!1},offset:0}}});f(p,"init",function(a){a=a.args[0];var c=v(a.yAxis||{}),h=c.length,b=[];if(this.hasParallelCoordinates=a.chart&&a.chart.parallelCoordinates){for(this.setParallelInfo(a);h<=this.parallelInfo.counter;h++)b.push({});a.legend||(a.legend={});void 0===a.legend.enabled&&(a.legend.enabled=!1);l(!0,a,{boost:{seriesThreshold:Number.MAX_VALUE},plotOptions:{series:{boostThreshold:Number.MAX_VALUE}}}); 13 | a.yAxis=c.concat(b);a.xAxis=l(w,v(a.xAxis||{})[0])}});f(p,"update",function(a){a=a.options;a.chart&&(m(a.chart.parallelCoordinates)&&(this.hasParallelCoordinates=a.chart.parallelCoordinates),this.hasParallelCoordinates&&a.chart.parallelAxes&&(this.options.chart.parallelAxes=l(this.options.chart.parallelAxes,a.chart.parallelAxes),this.yAxis.forEach(function(a){a.update({},!1)})))});n(y,{setParallelInfo:function(a){var c=this;a=a.series;c.parallelInfo={counter:0};a.forEach(function(a){a.data&&(c.parallelInfo.counter= 14 | Math.max(c.parallelInfo.counter,a.data.length-1))})}});t.keepProps.push("parallelPosition");f(r,"afterSetOptions",function(a){var c=this.chart,b=["left","width","height","top"];c.hasParallelCoordinates&&(c.inverted&&(b=b.reverse()),this.isXAxis?this.options=l(this.options,w,a.userOptions):(this.options=l(this.options,this.chart.options.chart.parallelAxes,a.userOptions),this.parallelPosition=q(this.parallelPosition,c.yAxis.length),this.setParallelPosition(b,this.options)))});f(r,"getSeriesExtremes", 15 | function(a){if(this.chart&&this.chart.hasParallelCoordinates&&!this.isXAxis){var c=this.parallelPosition,b=[];this.series.forEach(function(a){a.visible&&m(a.yData[c])&&b.push(a.yData[c])});this.dataMin=A(b);this.dataMax=B(b);a.preventDefault()}});n(t,{setParallelPosition:function(a,c){var b=(this.parallelPosition+.5)/(this.chart.parallelInfo.counter+1);this.chart.polar?c.angle=360*b:(c[a[0]]=100*b+"%",this[a[1]]=c[a[1]]=0,this[a[2]]=c[a[2]]=null,this[a[3]]=c[a[3]]=null)}});u(x,"bindAxes",function(a){if(this.chart.hasParallelCoordinates){var c= 16 | this;this.chart.axes.forEach(function(a){c.insert(a.series);a.isDirty=!0});c.xAxis=this.chart.xAxis[0];c.yAxis=this.chart.yAxis[0]}else a.apply(this,Array.prototype.slice.call(arguments,1))});f(b.Series,"afterTranslate",function(){var a=this.chart,c=this.points,b=c&&c.length,e=Number.MAX_VALUE,f,d,g;if(this.chart.hasParallelCoordinates){for(g=0;g% 18 | distinct(voyage_id, n_slaves_arrived, .keep_all = TRUE) %>% 19 | # Aggregate by decade 20 | mutate(decade = year_arrival %/% 10 *10, 21 | # change the 'port unknown' message 22 | place_of_purchase = str_replace(place_of_purchase, ".?, port unspecified" , " (Port unknown)")) 23 | 24 | # Choose to display only top 30 locations 25 | choices <- aggregated_df %>% 26 | group_by(place_of_purchase) %>% 27 | summarise(total_slaves = sum(n_slaves_arrived, na.rm =T), .group = "drop") %>% 28 | arrange(-total_slaves) %>% 29 | slice(1:30) %>% 30 | pull(place_of_purchase) 31 | 32 | 33 | # The app interface ------------------------------------------------------- 34 | ui <- fluidPage( 35 | 36 | tags$head( 37 | tags$style("label{font-family: Roboto Condensed;}") 38 | ), 39 | # App title ---- 40 | titlePanel("Slavery history"), 41 | 42 | # Sidebar layout with input and output definitions ---- 43 | sidebarLayout( 44 | sidebarPanel( 45 | selectInput("var", label = "Choose a location", 46 | choices = choices, selected = "Ambriz")), 47 | 48 | # Main panel for displaying outputs ---- 49 | mainPanel( 50 | # Plot 1 51 | plotOutput("bar"), 52 | # Plot 2 53 | plotOutput("igraph") 54 | ) 55 | ) 56 | ) 57 | 58 | 59 | 60 | # The backend of the app -------------------------------------------------- 61 | 62 | server <- function(input, output) { 63 | #Plot one bar plot 64 | output$bar <- renderPlot({ 65 | bar_plot_df <- aggregated_df %>% 66 | group_by(decade, place_of_purchase) %>% 67 | summarise(total_slaves = sum(n_slaves_arrived, na.rm = T), .groups = "drop") %>% 68 | filter(!is.na(total_slaves), decade >= 1600) %>% 69 | # Highlight the input$var 70 | mutate(highlight = case_when( 71 | place_of_purchase == input$var ~ "y", 72 | TRUE ~ "n")) 73 | 74 | ggplot(bar_plot_df, aes(x = decade, y = total_slaves, fill = highlight))+ 75 | geom_bar(stat = "identity", show.legend = FALSE)+ 76 | labs(x = "Decade", y= NULL, title = glue("Number of slaves taken from {input$var}"))+ 77 | scale_y_continuous(labels = scales::label_comma())+ 78 | scale_fill_manual(values = c("y" = "#003366", n = "grey90"))+ 79 | theme_classic()+ 80 | theme( 81 | text = element_text(family = "Roboto Condensed"), 82 | axis.ticks = element_blank(), 83 | panel.border = element_blank(), 84 | axis.text = element_text(size = 10, color = "grey70"), 85 | axis.title = element_text(size = 10, color = "grey50"), 86 | axis.line = element_blank(), 87 | plot.title = element_markdown(size = 14, face = "bold"), 88 | # Align plot nicely to the top-left 89 | plot.title.position = "plot" 90 | ) 91 | 92 | }) 93 | # Plot two network arc graph 94 | output$igraph <- renderPlot({ 95 | graph <- aggregated_df %>% 96 | filter(decade >= 1800) %>% 97 | count(decade, place_of_purchase, port_arrival, sort = T) %>% 98 | # Highlight the input$var 99 | mutate(highlight = ifelse(place_of_purchase == input$var, "y", "n")) %>% 100 | select(from = place_of_purchase, to = port_arrival, n, highlight) %>% 101 | drop_na() %>% 102 | graph_from_data_frame() 103 | 104 | ggraph(graph, layout = 'linear') + 105 | geom_edge_arc(aes(color = highlight, alpha = highlight), show.legend = FALSE)+ 106 | scale_edge_color_manual(values = c("y" = "#003366", "n"= "grey90"))+ 107 | # Override arcs that hide the blue lines 108 | scale_edge_alpha_manual(values = c("y" = 1, "n" = 0.1))+ 109 | labs(title = glue("Ports slaves were taken to from {input$var}"), caption = "From 1800'")+ 110 | theme_void()+ 111 | theme(plot.title = element_markdown(size = 14, family = "Roboto Condensed", face = "bold")) 112 | }) 113 | } 114 | 115 | shinyApp(ui = ui, server = server) 116 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highcharts-7.0.1/modules/broken-axis.js: -------------------------------------------------------------------------------- 1 | /* 2 | Highcharts JS v7.0.1 (2018-12-19) 3 | 4 | (c) 2009-2018 Torstein Honsi 5 | 6 | License: www.highcharts.com/license 7 | */ 8 | (function(g){"object"===typeof module&&module.exports?module.exports=g:"function"===typeof define&&define.amd?define(function(){return g}):g("undefined"!==typeof Highcharts?Highcharts:void 0)})(function(g){(function(f){function g(){return Array.prototype.slice.call(arguments,1)}function t(b){b.apply(this);this.drawBreaks(this.xAxis,["x"]);this.drawBreaks(this.yAxis,p(this.pointArrayMap,["y"]))}var m=f.addEvent,p=f.pick,r=f.wrap,w=f.extend,x=f.isArray,u=f.fireEvent,n=f.Axis,y=f.Series;w(n.prototype, 9 | {isInBreak:function(b,c){var d=b.repeat||Infinity,e=b.from,a=b.to-b.from;c=c>=e?(c-e)%d:d-(e-c)%d;return b.inclusive?c<=a:c=b)break;else if(a.isInBreak(c,b)){e-=b-c.from;break}return e}function e(b){var c,d;for(d=0;d=b);d++)c.tok;)l-=f;for(;la.to||f>a.from&&ga.from&&ga.from&&g>a.to&&gb&&(b=c);e--;)d[e+1].x-d[e].x>b&&(c=(d[e].x+d[e+1].x)/2,d.splice(e+1,0,{isNull:!0,x:c}),this.options.stacking&&(c=a.stacks[this.stackKey][c]=new f.StackItem(a,a.options.stackLabels,!1,c,this.stack),c.total=0));return this.getGraphPath(d)};r(f.seriesTypes.column.prototype,"drawPoints",t);r(f.Series.prototype,"drawPoints",t)})(g)}); 17 | //# sourceMappingURL=broken-axis.js.map 18 | -------------------------------------------------------------------------------- /2020/week17_gdpr/lib/highchart-binding-0.7.0/highchart.js: -------------------------------------------------------------------------------- 1 | HTMLWidgets.widget({ 2 | 3 | name: 'highchart', 4 | 5 | type: 'output', 6 | 7 | initialize: function(el, width, height) { 8 | 9 | return { 10 | // TODO: add instance fields as required 11 | }; 12 | 13 | }, 14 | 15 | renderValue: function(el, x, instance) { 16 | 17 | if(x.debug) { 18 | window.xclone = JSON.parse(JSON.stringify(x)); 19 | window.elclone = $(el); 20 | console.log(el); 21 | console.log("hc_opts", x.hc_opts); 22 | console.log("theme", x.theme); 23 | console.log("conf_opts", x.conf_opts); 24 | } 25 | 26 | if(x.fonts !== undefined) { 27 | 28 | x.fonts = ((typeof(x.fonts) == "string") ? [x.fonts] : x.fonts); 29 | 30 | x.fonts.forEach(function(s){ 31 | /* http://stackoverflow.com/questions/4724606 */ 32 | var urlfont = 'https://fonts.googleapis.com/css?family=' + s; 33 | if (!$("link[href='" + urlfont + "']").length) { 34 | $('').appendTo("head"); 35 | } 36 | 37 | }); 38 | 39 | } 40 | 41 | ResetHighchartsOptions(); 42 | 43 | if(x.theme !== null) { 44 | 45 | if(x.debug) console.log("adding THEME"); 46 | 47 | Highcharts.setOptions(x.theme); 48 | 49 | } 50 | 51 | if((x.theme && x.theme.chart.divBackgroundImage !== undefined) | 52 | (x.hc_opts.chart && x.hc_opts.chart.divBackgroundImage !== undefined)) { 53 | 54 | if(x.debug) console.log("adding BackgroundImage"); 55 | 56 | var bkgrnd = x.theme.chart.divBackgroundImage || x.hc_opts.chart.divBackgroundImage; 57 | 58 | Highcharts.wrap(Highcharts.Chart.prototype, "getContainer", function (proceed) { 59 | 60 | proceed.call(this); 61 | 62 | $("#" + el.id).css("background-image", "url(" + bkgrnd + ")"); 63 | $("#" + el.id).css("-webkit-background-size", "cover"); 64 | $("#" + el.id).css("-moz-background-size", "cover"); 65 | $("#" + el.id).css("-o-background-size", "cover"); 66 | $("#" + el.id).css("background-size", "cover"); 67 | 68 | }); 69 | 70 | } 71 | 72 | Highcharts.setOptions(x.conf_opts); 73 | 74 | if(x.type == "chart") { 75 | if(x.debug) console.log("charting CHART"); 76 | $("#" + el.id).highcharts(x.hc_opts); 77 | } else if (x.type == "stock") { 78 | if(x.debug) console.log("charting STOCK"); 79 | $("#" + el.id).highcharts('StockChart', x.hc_opts); 80 | } else if (x.type == "map"){ 81 | if(x.debug) console.log("charting MAP"); 82 | 83 | x.hc_opts.series = x.hc_opts.series.map(function(e){ 84 | if(e.geojson === true) { 85 | if(x.debug) console.log("geojson\n\t", e.type, "\n\t", typeof(e.series)); 86 | e.data = Highcharts.geojson(e.data, e.type); 87 | } 88 | return e; 89 | }); 90 | 91 | $("#" + el.id).highcharts('Map', x.hc_opts); 92 | 93 | if(x.hc_opts.mapNavigation !== undefined && x.hc_opts.mapNavigation.enabled === true){ 94 | /* if have navigation option and enabled true: http://stackoverflow.com/questions/7600454 */ 95 | $("#" + el.id).bind( 'mousewheel DOMMouseScroll', function ( e ) { 96 | var e0 = e.originalEvent, 97 | delta = e0.wheelDelta || -e0.detail; 98 | this.scrollTop += ( delta < 0 ? 1 : -1 ) * 30; 99 | e.preventDefault(); 100 | 101 | }); 102 | 103 | } 104 | 105 | } 106 | 107 | if(x.hc_opts.motion !== undefined) { 108 | 109 | $("#" + el.id).css({"position" : "relative" }); 110 | 111 | if(x.debug) console.log("setting MOTION options"); 112 | 113 | var pc = $($("#" + el.id).find("#play-controls")[0]); 114 | 115 | var ct = x.theme.chart; 116 | 117 | if(ct.backgroundColor !== undefined) $(pc.find("#play-pause-button")[0]).css({backgroundColor : x.theme.chart.backgroundColor}); 118 | if(ct.style !== undefined) $(pc.find("#play-output")[0]).css(x.theme.chart.style); 119 | if(ct.style !== undefined && ct.style.color !== undefined) $(pc.find("#play-pause-button")[0]).css({color : x.theme.chart.style.color}); 120 | 121 | 122 | } 123 | 124 | }, 125 | 126 | resize: function(el, width, height, instance) { 127 | 128 | /* http://stackoverflow.com/questions/18445784/ */ 129 | var chart = $("#" +el.id).highcharts(); 130 | var w = chart.renderTo.clientWidth; 131 | var h = chart.renderTo.clientHeight; 132 | chart.setSize(w, h); 133 | 134 | } 135 | 136 | }); 137 | -------------------------------------------------------------------------------- /2021/week12_steam/steam.R: -------------------------------------------------------------------------------- 1 | library(readr) 2 | library(ggplot2) 3 | library(dplyr) 4 | games <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-03-16/games.csv') 5 | 6 | games_processed <- games %>% 7 | mutate( 8 | avg_peak_perc = parse_number(avg_peak_perc), 9 | year_month = as.Date(paste0(year,"-", match(month, month.name), "-1")) 10 | ) %>% 11 | add_count(gamename) %>% 12 | group_by(gamename) %>% 13 | filter(n >= 12 & min(avg) > 1e3, avg_peak_perc > 0) %>% 14 | arrange(gamename, year_month) %>% 15 | group_by(gamename) %>% 16 | mutate(month_since_start = 1:n(), 17 | avg_total = mean(avg), 18 | high_peak = max(peak)/avg_total) %>% 19 | ungroup() 20 | 21 | # dir.create("extra/images/progress/2021-week12") # Directory for images showing the process 22 | 23 | games_quart <- games_processed %>% 24 | filter(!gamename %in% c("PLAYERUNKNOWN'S BATTLEGROUNDS", "Dota 2" )) %>% 25 | #mutate(jump = peak - min(avg)) %>% 26 | distinct(gamename, avg_total) %>% 27 | mutate(quart = cut(avg_total, quantile(unique(.$avg_total), probs = 0:4/4), labels = seq(1,4,1), include.lowest = TRUE)) %>% 28 | distinct(gamename, quart) %>% 29 | select(gamename, quart) %>% 30 | inner_join(games_processed) 31 | 32 | 33 | highlighted_peaks <- games_quart %>% 34 | distinct(gamename, peak, .keep_all = TRUE) %>% 35 | group_by(quart) %>% 36 | arrange(-avg_total) %>% 37 | distinct(gamename) %>% 38 | slice(1:4) %>% 39 | pull(gamename) 40 | 41 | games_quart %>% 42 | count(quart, sort = T) 43 | 44 | games_plot <- games_quart %>% 45 | mutate(highlight = ifelse(gamename %in% highlighted_peaks, "yes", "no")) %>% 46 | arrange(desc(highlight), gamename) %>% 47 | mutate(id = group_indices(., gamename)) 48 | 49 | one_line <- games_plot %>% 50 | filter(quart == 4) %>% 51 | filter(gamename %in% highlighted_peaks) 52 | 53 | 54 | 55 | several_lines <- games_plot %>% 56 | filter(quart == 4) %>% 57 | filter(!gamename %in% highlighted_peaks) %>% 58 | select(Gamename = gamename, everything()) 59 | 60 | ggplot(one_line, aes(x = month_since_start, y = avg)) + 61 | geom_line(data = several_lines, aes(group = Gamename),color = "gray80")+ 62 | geom_line(aes(color = gamename))+ 63 | facet_wrap(~gamename)+ 64 | # facet_wrap(. ~ gamename, scales = "free") %>% 65 | ggsave(paste0(format(Sys.time(), "%Y%m%d_%H%M%S"), ".png"), path = "extra/images/progress/2021-week12", type = 'cairo', height = 8, width = 13) 66 | 67 | 68 | games_quart %>% 69 | filter(quart == 4) %>% 70 | ggplot() + 71 | geom_line(aes(x = month_since_start, y = avg, group = gamename, color = ifelse(gamename %in% highlighted_peaks, "yes", "no")))+ 72 | #facet_wrap(. ~ gamename, scales = "free")+ 73 | scale_color_manual(values = c("yes" = "red", "no" = "gray55")) 74 | 75 | #facet_wrap(. ~ distinct(), scales = "free")+ 76 | 77 | 78 | . 79 | 80 | # New? -------------------------------------------------------------------- 81 | 82 | 83 | games_processed <- games %>% 84 | mutate( 85 | avg_peak_perc = parse_number(avg_peak_perc), 86 | year_month = as.Date(paste0(year,"-", match(month, month.name), "-1")) 87 | ) %>% 88 | add_count(gamename) %>% 89 | filter(n >= 12 & avg > 1e3, avg_peak_perc > 0) %>% 90 | arrange(gamename, year_month) %>% 91 | group_by(gamename) %>% 92 | mutate(month_since_start = 1:n()) %>% 93 | 94 | mod <- ~ glm(cbind(avg, max(peak) - avg) ~ month_since_start, ., family = "binomial") 95 | library(tidyr) 96 | library(purrr) 97 | library(broom) 98 | 99 | slopes <- games_processed %>% 100 | nest(-gamename) %>% 101 | mutate(model = map(data, mod)) %>% 102 | mutate(model = map(model, tidy)) %>% 103 | unnest(model) %>% 104 | filter(term == "month_since_start") %>% 105 | arrange(-estimate) 106 | 107 | slope_names <- slopes %>% 108 | pull(gamename) %>% 109 | .[1:10] 110 | 111 | games_processed %>% 112 | filter(gamename %in% slope_names) %>% 113 | #mutate(highlight = ifelse(gamename %in% slope_names, "yes", "no")) %>% 114 | ggplot() + 115 | geom_line(aes(x = month_since_start, y = avg, group = gamename))+ 116 | scale_color_manual(values = c("yes" = "red", "no"= "gray55")) 117 | 118 | games_processed %>% 119 | group_by(gamename) %>% 120 | filter(month_since_start == max(month_since_start)) %>% 121 | ungroup() %>% 122 | ggplot()+ 123 | geom_point(aes(x = month_since_start, y = avg_total)) 124 | ggsave(paste0(format(Sys.time(), "%Y%m%d_%H%M%S"), ".png"), path = "extra/images/progress/2021-week12", type = 'cairo', height = 8, width = 13) 125 | 126 | 127 | library(ggforce) 128 | 129 | tbl <- data.frame( 130 | x0 = seq(1:1000), 131 | y0 = seq(1:1000), 132 | r = seq(1:1000), 133 | id = sample(1:10, size = 1000, prob = 1:10/10, replace= TRUE) 134 | ) 135 | 136 | ggplot(tbl)+ 137 | geom_circle(aes(x0 = x0, y0 = y0, r = r))+ 138 | facet_wrap(~ id) 139 | --------------------------------------------------------------------------------