Skip to main content
  • Home
  • Development
  • Documentation
  • Donate
  • Operational login
  • Browse the archive

swh logo
SoftwareHeritage
Software
Heritage
Archive
Features
  • Search

  • Downloads

  • Save code now

  • Add forge now

  • Help

https://doi.org/10.5281/zenodo.14318846
17 December 2024, 12:45:03 UTC
  • Code
  • Branches (0)
  • Releases (1)
  • Visits
    • Branches
    • Releases
      • 1
      • 1
    • c8b2287
    • /
    • combining-hmm-and-ssf-code
    • /
    • Cross validating codes
    • /
    • 04 - lineups.Rmd
    Raw File Download

    To reference or cite the objects present in the Software Heritage archive, permalinks based on SoftWare Hash IDentifiers (SWHIDs) must be used.
    Select below a type of object currently browsed in order to display its associated SWHID and permalink.

    • content
    • directory
    • snapshot
    • release
    origin badgecontent badge
    swh:1:cnt:489e473321b98d88eadf0d7231884b926f611ca6
    origin badgedirectory badge
    swh:1:dir:f52c58daf971b90f0ea8392f9f530b88abe7d5d1
    origin badgesnapshot badge
    swh:1:snp:05a2af42b588522ca08f036c1f785d8457dcf25e
    origin badgerelease badge
    swh:1:rel:aa35d9e39d94cbf3f73362c2c2b5cd04c355e955

    This interface enables to generate software citations, provided that the root directory of browsed objects contains a citation.cff or codemeta.json file.
    Select below a type of object currently browsed in order to generate citations for them.

    • content
    • directory
    • snapshot
    • release
    Generate software citation in BibTex format (requires biblatex-software package)
    Generating citation ...
    Generate software citation in BibTex format (requires biblatex-software package)
    Generating citation ...
    Generate software citation in BibTex format (requires biblatex-software package)
    Generating citation ...
    Generate software citation in BibTex format (requires biblatex-software package)
    Generating citation ...
    04 - lineups.Rmd
    ---
    title: "Lineup"
    author: "Rachel Mawer"
    date: "2023-12-14"
    output: 
      html_document:
        toc: true
        toc_float: true
        theme: cerulean
    ---
    
    ```{r setup, include=FALSE}
    knitr::opts_chunk$set(echo = F,message=F)
    
    #main packages #delete/add as needed
    library(dplyr)
    library(ggplot2)
    library(knitr)
    library(ggpubr)
    library(plotly)
    library(pracma) #for standard error
    library(reactable)
    library(amt)
    ```
    
    ## Code for all
    
    Code to create line ups for all fish of a data type (e.g. all with HMMs). The code will
    
    * randomly assign fish a new ID
    * plot all specified parameters with real data randomly located
    * save a DF containing real and fake ID, and location of real data in plots
    * save a blinded DF for analysis
    
    For each observer, this file is knitted and the folder name at the end of the document changed to save outputs to a specific folder per observer.
    
    ```{r get data stuff}
    fish_files <- list.files("agents + real data - pooled",full.names = T)
    
    #create fake IDs to assign
    fake_ids <- sample(1:length(fish_files),length(fish_files)) %>% as.numeric()
    
    p <- cbind(fish_files,fake_ids) %>% as.data.frame() 
    
    p$fake_ids <- as.numeric(p$fake_ids)
    
    p <- p %>% arrange(fake_ids)
    ```
    
    ```{r make plots}
    
    for(i in 1:length(fish_files)){
      dat_all <- read.csv(p$fish_files[i])
      
      #assign a fake ID, 1:31
      fake_fish_id <- p$fake_ids[i]
      
      #repeat below bit for every plot
      agents_id <- data.frame(agent=unique(dat_all$agent),plot_id=sample(1:20,20))
      #this assigns a random number 1 - 20 to dictate the plot position
      
      dat <- merge(dat_all,agents_id) #do unique for each plot LMAO !!
      
      dat_id1 <- agents_id %>% filter(agent=="real")
      dat_id1$plot_type <- "tracks"
      
      dat_id <- dat_id1
      
      dat2 <- dat %>% filter(x!=0 &y!=0)
      #tracks
      print(ggplot(dat2,aes(x=x,y=y,col=as.factor(approach)))+
        geom_path()+
        facet_wrap(~plot_id)+
        theme(axis.text.x = element_blank(),axis.text.y = element_blank(),
              axis.ticks = element_blank())+
        labs(title=paste0("Plot for fish id ",fake_fish_id," -  Tracks")))
      
      #repeat below bit for every plot
      agents_id <- data.frame(agent=unique(dat$agent),plot_id=sample(1:20,20))
      #this assigns a random number 1 - 20 to dictate the plot position
      
      
      dat <- merge(dat_all,agents_id) #do unique for each plot LMAO !!
      
      dat_id1 <- agents_id %>% filter(agent=="real")
      dat_id1$plot_type <- "heatmap"
      
      dat_id <- rbind(dat_id,dat_id1)
      dat2 <- dat %>% filter(x!=0 &y!=0)
    
      
      #heatmp
      print(ggplot(dat2,aes(x=x,y=y))+
        geom_bin2d()+
        #stat_bin_2d(aes(fill=log(..density..)))+
        facet_wrap(~plot_id)+
        scale_fill_continuous(type = "viridis",trans="log")+
        theme(axis.text.x = element_blank(),axis.text.y = element_blank(),
              axis.ticks = element_blank())+
        labs(title=paste0("Plot for fish id ",fake_fish_id," -  Heatmaps")))
      
      
      
      
      #repeat below bit for every plot...
      agents_id <- data.frame(agent=unique(dat$agent),plot_id=sample(1:20,20))
      #this assigns a random number 1 - 20 to dictate the plot position
      
      
      dat <- merge(dat_all,agents_id) #do unique for each plot LMAO !!
      
      dat_id1 <- agents_id %>% filter(agent=="real")
      dat_id1$plot_type <- "flow velocity"
      
      dat_id <- rbind(dat_id,dat_id1)
      #wv
      print(ggplot(dat,aes(x=water_velocity))+
        geom_histogram()+
        facet_wrap(~plot_id)+
        labs(title=paste0("Plot for fish id ",fake_fish_id," -  Flow velocity")))
      
      
      #repeat below bit for every plot...
      agents_id <- data.frame(agent=unique(dat$agent),plot_id=sample(1:20,20))
      #this assigns a random number 1 - 20 to dictate the plot position
      
      
      dat <- merge(dat_all,agents_id) #do unique for each plot LMAO !!
      
      dat_id1 <- agents_id %>% filter(agent=="real")
      dat_id1$plot_type <- "svg"
      
      dat_id <- rbind(dat_id,dat_id1)
      
      #svg
      print(ggplot(dat,aes(x=svg))+
        geom_histogram()+
        facet_wrap(~plot_id)+
        labs(title=paste0("Plot for fish id ",fake_fish_id," -  SVG")))
      
      
      #repeat below bit for every plot...
      agents_id <- data.frame(agent=unique(dat$agent),plot_id=sample(1:20,20))
      #this assigns a random number 1 - 20 to dictate the plot position
      
      
      dat <- merge(dat_all,agents_id) #do unique for each plot LMAO !!
      
      dat_id1 <- agents_id %>% filter(agent=="real")
      dat_id1$plot_type <- "depth"
      
      dat_id <- rbind(dat_id,dat_id1) #here add in fish id somehow and fake fish id
      
      #depth
      print(ggplot(dat,aes(x=depth))+
        geom_histogram()+
        facet_wrap(~plot_id)+
        labs(title=paste0("Plot for fish id ",fake_fish_id," -  Depth")))
      
      #repeat below bit for every plot...
      agents_id <- data.frame(agent=unique(dat$agent),plot_id=sample(1:20,20))
      #this assigns a random number 1 - 20 to dictate the plot position
      
      
      dat <- merge(dat_all,agents_id) #do unique for each plot LMAO !!
      
      dat_id1 <- agents_id %>% filter(agent=="real")
      dat_id1$plot_type <- "diffsvgang"
      
      dat_id <- rbind(dat_id,dat_id1)
      
      #diffsvgang
      print(ggplot(dat,aes(x=diff_svg_abs_ang_end))+
        geom_histogram()+
        facet_wrap(~plot_id)+
        labs(title=paste0("Plot for fish id ",fake_fish_id," -  Diff SVG - Fish angle")))
      
      #repeat below bit for every plot...
      agents_id <- data.frame(agent=unique(dat$agent),plot_id=sample(1:20,20))
      #this assigns a random number 1 - 20 to dictate the plot position
      
      
      dat <- merge(dat_all,agents_id) #do unique for each plot LMAO !!
      
      dat_id1 <- agents_id %>% filter(agent=="real")
      dat_id1$plot_type <- "diffvang"
      
      dat_id <- rbind(dat_id,dat_id1)
      
      #diffvelang
      print(ggplot(dat,aes(x=diff_vel_abs_ang_end))+
        geom_histogram()+
        facet_wrap(~plot_id)+
        labs(title=paste0("Plot for fish id ",fake_fish_id," -  Diff Vel - Fish angle")))
      
      #DO FOR STEP LENGTH AND TURNING ANGLE
     
      l <- dat_all %>% make_track(.x=x,.y=y,all_cols=T) %>% steps(keep_cols="start")
      
      #repeat below bit for every plot...
      agents_id <- data.frame(agent=unique(l$agent),plot_id=sample(1:20,20))
      #this assigns a random number 1 - 20 to dictate the plot position
      
      
      l2 <- merge(l,agents_id) #do unique for each plot LMAO !!
      
      dat_id1 <- agents_id %>% filter(agent=="real")
      dat_id1$plot_type <- "Step length"
      
      dat_id <- rbind(dat_id,dat_id1)
      
      l2 <- l2 %>% filter(x1_!=0 & x2_!=0 &y1_!=0 &y2_!=0)
      
      print(ggplot(l2,aes(x=sl_))+
        geom_histogram()+
        facet_wrap(~plot_id)+
        labs(title=paste0("Plot for fish id ",fake_fish_id," -  Step lengths")))
      #add code to limit x axis, e.g. max 500 m?
      
      #turning angle
      
      #repeat below bit for every plot...
      agents_id <- data.frame(agent=unique(l$agent),plot_id=sample(1:20,20))
      #this assigns a random number 1 - 20 to dictate the plot position
      
      
      l2 <- merge(l,agents_id) #do unique for each plot LMAO !!
      
      dat_id1 <- agents_id %>% filter(agent=="real")
      dat_id1$plot_type <- "Turning angle"
      
      dat_id <- rbind(dat_id,dat_id1)
      
      print(ggplot(l2,aes(x=ta_))+
        geom_histogram()+
        facet_wrap(~plot_id)+
        labs(title=paste0("Plot for fish id ",fake_fish_id," - Turning angle")))
      
      
      #save df with all data
      
      dat_id$fish_id <- unique(dat$fish_id)
      dat_id$fake_fish_id <- fake_fish_id
      
      
      dat_id_blind <- dat_id %>% dplyr::select(fake_fish_id,plot_type)
      dat_id_blind$plot_id_guess <- NA
      
    if(i==1){
      dat_id_all <- dat_id
      dat_id_blind_all <- dat_id_blind
    } else{
      dat_id_all <- bind_rows(dat_id_all,dat_id)
      dat_id_blind_all <- bind_rows(dat_id_blind_all,dat_id_blind)
    }
    
    }  
    
    write.csv(dat_id_all,"line up pooled/all_dat.csv",row.names = F)
    write.csv(dat_id_blind_all,"line up pooled/blinded.csv",row.names = F)
    
    ```
    
    
    

    back to top

    Software Heritage — Copyright (C) 2015–2025, The Software Heritage developers. License: GNU AGPLv3+.
    The source code of Software Heritage itself is available on our development forge.
    The source code files archived by Software Heritage are available under their own copyright and licenses.
    Terms of use: Archive access, API— Content policy— Contact— JavaScript license information— Web API