.Rhistory

tr_roi@ymin <- tr_roi@ymax - 1200
tr_roi@ymax <- tr_roi@ymax + 1200
tr_roi@ymin <- max(c(tr_roi@ymin,orig.ext@ymin))
tr_roi@ymax <- min(c(tr_roi@ymax,orig.ext@ymax))
tr.image <- raster::crop(overview,tr_roi)
br_roi <- tr_roi
br_roi@ymin <- roi@ymin - 1200
br_roi@ymax <- roi@ymin + 1200
br_roi@ymin <- max(c(br_roi@ymin,orig.ext@ymin))
br_roi@ymax <- min(c(br_roi@ymax,orig.ext@ymax))
br.image <- raster::crop(overview,br_roi)
cmPerPixel <- pick_length_shiny(tr.image,br.image,roi)
}
cmPerPixelString <- glue::glue("cmPerPixel = {cmPerPixel}")
#export parameters for rerunning
#  no spectra string right now, fix later
#normParams <- glue::glue("{dirString},\n{cmPerPixelString},\n{spectraString},\n{roiString},\n{outputdirString},\n{corenameString}")
#assign to global just incase it fails
#also fails
# assign("normParams",normParams,envir = .GlobalEnv)
#crop the image
if(is.finite(cmPerPixel) & cmPerPixel > 0){
scaleY <- seq(from = cmPerPixel/2,to = (dim(filen)[1]*cmPerPixel)-cmPerPixel/2,by = cmPerPixel)
}else{
#calculate length interval of each pixel (necessary for indices calculations)
scaleY <- coreLength(stripe = roi, length = length)
}
#crop_1 <- raster::crop
#test how slow the crop function is for .5 cm interval (6 times) or jst 3 cm interval
#chunk into .5 cm bits, normalizate against the white dark lines, average into a single spectra.
length.out <- 1
chunk <- 0.5
sub <- raster::extent(filen@extent@xmin,filen@extent@xmax,filen@extent@ymin,length(which(scaleY <= length.out)))
full_spectra <- raster::crop(filen,sub)
new_vals <- raster::aggregate(full_spectra,fact=c(1,(((full_spectra@extent@ymax-full_spectra@extent@ymin)/((length.out/chunk)-1)))),FUN=mean)
#load in the white and dark refs
whiteRef <- raster::brick(paths$whiteref)
darkRef <- raster::brick(paths$darkref)
white.ref <- processReference(whiteRef,stripe = full_spectra,spectra = names(whiteRef))
dark.ref <- processReference(darkRef,stripe = full_spectra,spectra = names(whiteRef))
#now normalize
normalized <- whiteDarkNormalize(stripe = full_spectra, white.ref = white.ref, dark.ref = dark.ref)
if(!dir.exists(file.path(output.dir))){
dir.create(file.path(output.dir))
}
if(!dir.exists(file.path(output.dir,corename))){
dir.create(file.path(output.dir,corename))
}
#save normalized core image
normalizedImage <- normalizeCoreImage(paths$overview)
imager::save.image(normalizedImage,file = file.path(output.dir,"normalizedCoreImage.png"))
raster::writeRaster(normalized,file.path(output.dir,"normalized.tif"),overwrite = TRUE)
#save normalized data for future reference
save(normalized,file = file.path(output.dir,"normalized.RData"))
#save paths for images too?
return(list(allbands = allbands,
#spectra = spectra,
wavelengths = wavelengthsOut,
normalized = normalized,
scaleY = scaleY,
#  stripe = stripe,
cmPerPixel = cmPerPixel,
roi = roi,
corename = corename,
pngPath = paths$overview,
# normParams = normParams,
outputDir = output.dir))
}
dat <- full_spectra()
#folder name
# corename <- NA
if(is.na(corename)){
corename <-  basename(dirname(paths$overview))
}
corenameString <- glue::glue("corename = '{corename}'")
#load overview
overview <- raster::brick(paths$overview)
#ADDED
#    roi <- NA
#choose the ROI
if(!class(roi)=="Extent"){
roi <- pick_roi_shiny(overview)
}
roiString <- glue::glue("roi = raster::extent(matrix(c({roi@xmin},{roi@xmax},{roi@ymin},{roi@ymax}),nrow = 2,byrow = T))")
roi
roiString <- glue::glue("roi = raster::extent(matrix(c({roi@xmin},{roi@xmax},{roi@ymin},{roi@ymax}),nrow = 2,byrow = T))")
#record roi string
roi <- roi[[1]]
roiString <- glue::glue("roi = raster::extent(matrix(c({roi@xmin},{roi@xmax},{roi@ymin},{roi@ymax}),nrow = 2,byrow = T))")
source('~/Documents/GitHub/specimR/R/full_spectra.R')
dat <- full_spectra()
dat
source('~/Documents/GitHub/specimR/R/full_spectra.R')
new_vals
plot(new_vals)
dim(new_vals)
dim(full_spectra())
dim(full_spectra
#load in the white and dark refs
whiteRef <- raster::brick(paths$whiteref)
darkRef <- raster::brick(paths$darkref)
white.ref <- processReference(whiteRef,stripe = full_spectra,spectra = names(whiteRef))
dark.ref <- processReference(darkRef,stripe = full_spectra,spectra = names(whiteRef))
#now normalize
normalized <- whiteDarkNormalize(stripe = full_spectra, white.ref = white.ref, dark.ref = dark.ref)
if(!dir.exists(file.path(output.dir))){
dir.create(file.path(output.dir))
}
if(!dir.exists(file.path(output.dir,corename))){
dir.create(file.path(output.dir,corename))
}
#save normalized core image
normalizedImage <- normalizeCoreImage(paths$overview)
imager::save.image(normalizedImage,file = file.path(output.dir,"normalizedCoreImage.png"))
raster::writeRaster(normalized,file.path(output.dir,"normalized.tif"),overwrite = TRUE)
dim(full_spectra)
full_spectra <- raster::crop(filen,sub)
chunk <- 0.25
dim(full_spectra)
new_vals <- raster::aggregate(full_spectra,fact=c(1,(((full_spectra@extent@ymax-full_spectra@extent@ymin)/((length.out/chunk)-1)))),FUN=mean)
new_vals
plot(new_vals[[1]])
plot(new_vals[1])
plot(new_vals[1])
plot(new_vals[1,])
plot(new_vals[,])
source('~/Documents/GitHub/specimR/R/full_spectra.R')
darkRef
dim(new_vals)
dim(whiteRef)
devtools::document()
install.packages(c('raster','tcltk','rgdal','smoother','spatialEco','imager','magick','egg'))
install.packages("sf")
devtools::document()
install.packages(c('tcltk','imager'))
devtools::document()
install.packages(c('tcltk','imager'))
roxygen2::roxygenize()
install.packages("imager")
install.packages("tcltk")
library(tcltk)
library(specimR)
library(specimR)
library(specimR)
f <- fullSpectra(chunk.bot = NA, chunk.step = 1)
source("~/GitHub/specimR/fullSpectraWorkflow.R")
f
#get a list of all the prod.dirs
startDir <- "/Volumes/data/Lakes380/SurfaceSedimentScans/"
allRuns <- list.files(startDir)
indices <- c("RABD615", "RABD640655", "RABD660670", "RABD845", "R570R630", "R590R690","R950R970")
allRuns
gtr <- c()
for(r in allRuns){
tr <- list.files(file.path(startDir,r,"products"),full.names = TRUE)
wpds <- which(purrr::map_lgl(tr,dir.exists) & basename(tr) != "photos")
gtr <- c(gtr,tr[wpds])
}
gtr
startDir
source("~/Downloads/surfaceSedResults (1).R")
getNormWavelengthData()
normData
source("~/Downloads/surfaceSedResults.R")
length(gtr)
#process and export big.data
ggplot(big.data)+geom_point(aes(x = meanIndices,y = ,color = index))
View(big.data)
summary <- big.data %>%
group_by(index) %>%
summarize(across(everything(),mean))
cores <-  big.data %>%
group_by(index) %>%
summarize(corr = cor(mean95,meanIndices))
#prep to add to table
forTable <- big.data %>%
select(-c(2,3,5,6)) %>%
rename(median = `50%`) %>%
pivot_wider(names_from = index,values_from = -last_col())
readr::write_csv(big.data,"C:/Users/hyprspec/Desktop/SurfaceSedOutputMaster.csv")
readr::write_csv(big.data,"~/Downloads/SurfaceSedOutputMaster.csv")
readr::write_csv(forTable,"~/Downloads/SurfaceSedOutputBySample.csv")
library(googlesheets4)
newdat <- read_sheets("1VskYZ8rCEMzoKNgfnvnp9psoLhN-RaP6DKlYVG3AukM")
newdat <- read_sheet("1VskYZ8rCEMzoKNgfnvnp9psoLhN-RaP6DKlYVG3AukM")
library(ggplot2)
names(newdat)
library(geoChronR)
ggplot(newdata) + geom_point(aes(x = gaussianize(mean95_RABD845), y= gaussianize(ConcB)))
ggplot(newdat) + geom_point(aes(x = gaussianize(mean95_RABD845), y= gaussianize(ConcB)))
ggplot(newdat) + geom_point(aes(x = mean95_RABD845, y= gaussianize(ConcB)))
newdat845 <- filter(newdat, mean95_RABD845 >= 1)
ggplot(newdatHi845) + geom_point(aes(x = mean95_RABD845, y= gaussianize(ConcB)))
newdatHi845 <- filter(newdat, mean95_RABD845 >= 1)
ggplot(newdatHi845) + geom_point(aes(x = mean95_RABD845, y= gaussianize(ConcB)))
ggplot(newdatHi845) + geom_point(aes(x = gaussianize(mean95_RABD845), y= gaussianize(ConcB)))
ggplot(newdat) + geom_point(aes(x = gaussianize(mean95_RABD660670), y= gaussianize(CaSpec)))
startDir <- "/Volumes/data/Lakes380/SurfaceSedimentScans/"
newIndices <- 'specimR:::fullSpectraWholeROI('
outDirSearch <- "/Volumes/data/Lakes380/SurfaceSedimentScans/Reprocess/"
outDirBase <-  "/Volumes/data/Lakes380/SurfaceSedimentScans/FullSpectraSurface/"
torem <- c("clickDepths =",
"pixel =",
"cm = c",
"imageRoi =",
"overall.page.width =",
"individual.page.width =",
"plot.width =",
"page.width.multiplier =",
"page.length.multiplier =",
"core.width = ",
"wavelengths =",
"cmPerPixel")
newFileName <- "/Volumes/data/Lakes380/SurfaceSedimentScans/FullSpectraSurface/createFullSpectra.R"
start <- "#THIS FILE WAS CREATED PROGRAMMATICALLY BY createFullSpectraSurface.R\n\n" %>%
str_c("library(specimR)\n\n") %>%
str_c("library(tidyverse)\n\n") %>%
str_c("library(shiny)")
write(start,
file = newFileName,
append = FALSE)
write(start,
file = newFileName,
append = FALSE)
allRuns <- list.files(startDir)
allRuns
for(r in allRuns){
tr <- list.files(file.path(startDir,r,"products"),full.names = TRUE)
if(any(grepl(tr,pattern = "roi"))){
reproc <- readLines(file.path(startDir,r,"products","reprocess.R"))
ii <- which(grepl(reproc,pattern = "indices ="))
reproc[ii] <- newIndices
#output dir.
odi <- which(grepl(reproc,pattern = 'output.dir'))
odl <- reproc[odi]
odlNew <- str_replace(odl,outDirSearch,outDirBase)
newDir <- str_split(odlNew," = ")[[1]][2] %>% str_remove("',") %>% str_remove("'")
reproc[odi] <- odlNew
dir.create(dirname(newDir))
dir.create(newDir)
for(tri in torem){
wtri <- which(grepl(pattern = tri,reproc))
reproc <- reproc[-wtri]
}
#add new line
lastComma <- max(str_locate_all(reproc[length(reproc)],pattern = ",")[[1]])
substr(reproc[length(reproc)],lastComma,lastComma) <- ")"
write(reproc,
file = newFileName,
append = TRUE)
write("\n\n",
file = newFileName,
append = TRUE)
}
}
source("~/Downloads/createFullSpectraSurface.R")
R.version
sessionInfo()
library(tidyverse)
ff <- list.files("~/Download/drive-download-20210721T160335Z-001/",recursive = TRUE)
ff
ff <- list.files("~/Download/drive-download-20210721T160335Z-001/",recursive = TRUE,pattern = "depthTable.csv")
ff
path <- ff[22]
dat <- readr::read_csv(path)
ff <- list.files("~/Download/drive-download-20210721T160335Z-001/",
recursive = TRUE,
full.names = TRUE,
pattern = "depthTable.csv")
path <- ff[22]
dat <- readr::read_csv(path)
dat
dat <- readr::read_csv(path) %>%
dplyr::select(-pixel)
dat
dat <- readr::read_csv(path) %>%
dplyr::select(-pixel) %>%
tidyr::pivot_wider(names_from = position, values_from = cm)
dat
path
ff <- list.files("~/Download/DUNCA1 R Script HS Data/",
recursive = TRUE,
full.names = TRUE,
pattern = "depthTable.csv")
ff
path <- ff[5]
dat <- readr::read_csv(path) %>%
dplyr::select(-pixel) %>%
tidyr::pivot_wider(names_from = position, values_from = cm)
dat
#parse path to get core name
str_extract(path,"^/(?:\\.|[^/\\])*/")
#parse path to get core name
str_extract(path,"[^/(?:\\.|[^/\\])*/]")
#parse path to get core name
str_extract(path,"[^/(?:\\.|[^/\\])*/]")
#parse path to get core name
str_extract(path,"[^/(?:.|[^/])*/]")
path
#parse path to get core name
str_extract(path,"[^//(?:.|[^/])*//]")
#parse path to get core name
str_extract(path,"[^//*//]")
#parse path to get core name
str_extract(path,"[^//?*//]")
#parse path to get core name
str_extract(path,"[^//*?//]")
#parse path to get core name
str_extract(path,"[^////]")
#parse path to get core name
str_extract(path,"[^//]")
#parse path to get core name
str_extract(path,"[//]")
#parse path to get core name
str_extract(path,"[/*/]")
#parse path to get core name
str_extract(path,"^/")
#parse path to get core name
str_extract(path,"*^/")
#parse path to get core name
str_extract(path,"[*^/]")
#parse path to get core name
str_extract(path,"[^/*]")
#parse path to get core name
str_extract(path,"^[^\/]*\/[^\/]*")
#parse path to get core name
str_extract(path,"[^[^\/]*\/[^\/]*]")
#parse path to get core name
str_extract(path,"[^[^/]*\/[^/]*]")
#parse path to get core name
str_extract(path,"[^[^/]*/[^/]*]")
#parse path to get core name
str_extract(path,"[^[^/]*[^/]*]")
#parse path to get core name
str_extract(path,"^[^/]*[^/]*")
#parse path to get core name
str_extract(path,"^[^/]*[^/]*")
#parse path to get core name
str_extract(path,"[A-Z][A-Z}*")
#parse path to get core name
str_extract(path,"[A-Z][A-Z]*")
path
#parse path to get core name
str_extract(path,"^.*\/(.*)\/.*\/$")
#parse path to get core name
str_extract(path,"^.*\\/(.*)\\/.*\\/$")
#parse path to get core name
str_extract(path,"^.*/(.*)/.*/$")
#parse path to get core name
str_extract(path,"^.*/(.*)/.*/")
#parse path to get core name
str_extract(path,"^.*/(.*)/.*/$")
#parse path to get core name
str_extract(path,".*/(.*)/.*/$")
#parse path to get core name
str_extract(path,"*/(.*)/.*/$")
#parse path to get core name
str_extract(path,".*/.*/.*/$")
#parse path to get core name
str_extract(path,".*/.*/.*/")
#parse path to get core name
str_extract(path,"$.*/.*/.*/")
#parse path to get core name
str_extract(path,"^.+/\K[^/]+(?=/[^/]+/)")
#parse path to get core name
str_extract(path,"^.+/[^/]+(?=/[^/]+/)")
path <- "/Users/nicholas/Download/DUNCA1 R Script HS Data//DUNCA1_LC4U_1A/products/"
path
#parse path to get core name
str_extract(path,"^.+/[^/]+(?=/[^/]+/)")
path <- "/Users/nicholas/Download/DUNCA1 R Script HS Data/"
#parse path to get core name
str_extract(path,"^.+/[^/]+(?=/[^/]+/)")
#parse path to get core name
str_extract(path,"^.+/[^/]+(?=/[^/]+/)") %>%
dirname()
#parse path to get core name
str_extract(path,"^.+/[^/]+(?=/[^/]+/)") %>%
basename()
path <- ff[5]
path %>%
basename()
path %>%
dirname()
path %>%
dirname() %>%
dirname()
path %>%
dirname() %>%
dirname() %>%
basename()
dat <- readr::read_csv(path) %>%
dplyr::select(-pixel) %>%
tidyr::pivot_wider(names_from = position, values_from = cm)
#parse path to get core name
dat$corename <- path %>%
dirname() %>%
dirname() %>%
basename()
dat <- dplyr::select(corename,everything())
pullDepthData <- function(path){
dat <- readr::read_csv(path) %>%
dplyr::select(-pixel) %>%
tidyr::pivot_wider(names_from = position, values_from = cm)
#parse path to get core name
dat$corename <- path %>%
dirname() %>%
dirname() %>%
basename()
dat <- dplyr::select(corename,everything())
}
dat
dat <- dplyr::select(corename,everything())
#parse path to get core name
dat$corename <- path %>%
dirname() %>%
dirname() %>%
basename()
dat
dat <- dplyr::select(corename,everything())
dat <- dplyr::select(dat,corename,everything())
dat
source("~/.active-rstudio-document", echo=TRUE)
test
ff
ff <- str_detect(ff,"photos")
ff <- list.files("~/Download/DUNCA1 R Script HS Data/",
recursive = TRUE,
full.names = TRUE,
pattern = "depthTable.csv")
hp <- str_detect(ff,"photos")
hp
source("~/.active-rstudio-document", echo=TRUE)
test
#Analysis of temp data for NE N America during Early Holocene
library(lipdR) #to read and interact with LiPD data
library(geoChronR) #for plotting mostly
library(magrittr) #we'll be using the magrittr pipe ( %>% ) for simplicity
library(dplyr) #and dplyr for data.frame manipulation
library(ggplot2) #for plotting
library(compositeR) #remotes::install_github("nickmckay/compositeR")
library(foreach) #for parallel processing
library(doParallel)#for parallel processing
#First make a stack plot
D <- readLipd("https://lipdverse.org/Temp12k/1_0_2/Temp12k1_0_2.zip")
TS <- extractTs(D)
TS <- extractTs(D) %>% #extract to lipd-ts
as.lipdTsTibble()
View(TS)
TS <- extractTs(D) %>% #extract to lipd-ts
as.lipdTsTibble() %>% # and the then to lipd-ts-tibble for filtering
filter(between(geo_longitude,-90,-50)) %>%  #only NE NA longitudes
filter(between(geo_latitude,35,55)) %>%  #between 35 and 55 N
filter(interpretation1_variable == "T") %>% #only variables sensitive temperature
filter(paleoData_medianRes12k < 200) %>% #only time series at highres
filter(interpretation1_seasonalityGeneral == "summer+") %>% #only summer proxies
as.lipdTs() #back to TS for compositeR
L <- D$`117_723A.Godad.2011`
L$paleoData[[1]]$measurementTable[[1]]$age$values
ts <- extractTs(L) %>% ts2tibble()
View(ts)
library(magrittr)
library(ggplot2)
library(actR)
library(neotoma2)
library(tidyverse)
library(lipdR)
library(geoChronR)
remotes::install_github("neotomaDB/neotoma2")
library(magrittr)
library(ggplot2)
library(actR)
library(neotoma2)
library(tidyverse)
library(lipdR)
library(geoChronR)
L <- neotoma2::get_datasets(53327) %>% #Find the site of interest
neotoma2::get_downloads()  #download the data for this site
L_lip=lipdR::neotoma2lipd(L) #convert the site object into a LiPD object
mapLipd(L_lip,map.type = "stamen",extend.range = 5)#visualize the location
mapLipd(L_lip,map.type = "stamen",extend.range = 5)#visualize the location
my_counts<- neotoma2::samples(L)
counts=pivot_wider(my_counts, names_from = variablename, values_from = value, values_fill = NA, id_cols=age)
lat=L_lip[["geo"]][["latitude"]]
L_lip$chronData[[1]]$measurementTable[[1]]$age14C
L_lip$chronData[[1]]$measurementTable[[1]]$age
L_lip <- geoChronR::runBacon(L_lip,
lab.id.var = 'neotomaChronConrolId',
age.14c.var = 'age14C',#for rest: 'age14C'
age.14c.uncertainty.var = 'age14CUnc',#for rest: 'age14CUnc'
age.var = 'age', #for bambili: 'age'
age.uncertainty.var = 'ageUnc',#for bambili 'ageUnc'
depth.var = 'depth',
cc=3,
reservoir.age.14c.var = NULL,
reservoir.age.14c.uncertainty.var = NULL,
rejected.ages.var = NULL,
plot.pdf = FALSE,
accept.suggestions = TRUE)
L_lip <- geoChronR::runBacon(L_lip,
lab.id.var = 'neotomaChronConrolId',
age.14c.var = 'age14C',#for rest: 'age14C'
age.14c.uncertainty.var = 'age14CUnc',#for rest: 'age14CUnc'
age.var = NULL, #for bambili: 'age'
age.uncertainty.var = NULL,#for bambili 'ageUnc'
depth.var = 'depth',
cc=3,
reservoir.age.14c.var = NULL,
reservoir.age.14c.uncertainty.var = NULL,
rejected.ages.var = NULL,
plot.pdf = FALSE,
accept.suggestions = TRUE)