Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

maprich returns the same output as mapocc! #11

Open
jgsaulsbury opened this issue Apr 14, 2019 · 2 comments
Open

maprich returns the same output as mapocc! #11

jgsaulsbury opened this issue Apr 14, 2019 · 2 comments

Comments

@jgsaulsbury
Copy link

This can be seen from the example on the front of the github - if you compare the output of maprich and mapocc for testudinata, side-by-side, you can see they are exactly the same. I imagine it should not be too hard to change it so that maprich counts only unique occurrences?

@jgsaulsbury
Copy link
Author

jgsaulsbury commented Apr 14, 2019

I implemented a goofy fix by modifying .rank_filter. There are undoubtedly better ways of doing this (this one is implemented just for maps of species richness):

.rank_filter <- function(r, data, res, rank) {
  if (rank=="species") {
    #save all fossil occurrences where the rank is species
    rank.df <- base::subset(data, !is.na(data$species))
  }
  if (rank=="genus") {
    #save all fossil occurrences where there is a known genus
    rank.df <- base::subset(data, !is.na(data$genus))
  }
  if (rank=="family") {
    #save all fossil occurrences where there is a known family
    rank.df <- base::subset(data, !is.na(data$family))
  }
  if (rank=="order") {
    #save all fossil occurrences where there is a known order
    rank.df <- base::subset(data, data$order!="NA")
  }
  if (rank=="class") {
    #save all fossil occurrences where there is a known class
    rank.df <- base::subset(data, data$class!="NA")
  }
  if (rank=="phylum") {
    #save all fossil occurrences where there is a known phylum
    rank.df <- base::subset(data, data$order!="NA")
  }
  rank.df <- stats::setNames(split(rank.df, seq(nrow(rank.df))), rank.df$species)
  rankraster <- base::lapply(rank.df, function(y) {
    #split off paleolat and paleolng
    latlng <- base::split(y, base::paste(y$paleolng, y$paleolat))
    latlngmatrix <- base::as.matrix(base::do.call(base::rbind,base::lapply(latlng,function(x)c(x$paleolng[1],
                                                                                               x$paleolat[1],1))))

    latlngmatrix <- base::rbind(latlngmatrix[1,], latlngmatrix)
    latlngras <- raster::rasterize(latlngmatrix[,1:2], r, latlngmatrix[,3])
  })
  splist <- list()
  for(i in 1:base::length(base::unique(base::names(rankraster)))){
    print(paste("generating raster for species",i))
    suppressWarnings(rs <- raster::subset(rankraster,names(rankraster)==base::unique(base::names(rankraster))[i])
    rs <- raster::calc(raster::stack(rs), function(x) base::sum(x,na.rm=TRUE))
    #creates a presence/absence matrix for this species
    rs[rs>0] <- 1
    splist <- c(splist, rs)
  }
  rankraster <- raster::calc(raster::stack(splist), function(x) base::sum(x,na.rm=TRUE))
  raster::values(rankraster)[raster::values(rankraster)==0]<-NA
  return(rankraster)
}

@SaraVarela
Copy link
Member

Hi! Thank you very much for the feedback and for your help! this library is not finished and it might have some more issues. A student will finish it in the next months, so I will let him decide what to do with this issue :-) abrazos, Sara

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

2 participants