Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Habitat Sampler
HabitatSampler
Commits
42fa9b17
Commit
42fa9b17
authored
Sep 24, 2021
by
Romulo Pereira Goncalves
Browse files
Merge changes
parents
3c0527b6
4c92bb0e
Pipeline
#28192
passed with stages
in 7 minutes and 42 seconds
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
R-package/DESCRIPTION
View file @
42fa9b17
Package: HaSa
Title: Autonomous Image Sampling and Probability Mapping
Version: 1.3.
0
Version: 1.3.
1
Authors@R:
person(given = "Carsten",
family = "Neumann",
...
...
R-package/R/inner_procedure.r
View file @
42fa9b17
...
...
@@ -65,7 +65,13 @@ sample_nb <- function(raster,
###
n_channel
<-
length
(
names
(
raster
))
###raster in MEMORY or NOT
if
(
in.memory
==
TRUE
&&
raster
::
fromDisk
(
raster
)
==
TRUE
)
{
rast
<-
raster
::
readAll
(
raster
)
}
else
{
rast
<-
raster
}
if
(
in.memory
==
TRUE
&&
raster
::
fromDisk
(
raster
)
==
TRUE
)
{
rast
<-
raster
::
readAll
(
raster
)
}
else
{
rast
<-
raster
}
rast
<-
raster
::
mask
(
rast
,
raster
::
calc
(
rast
,
fun
=
sum
))
###
l
<-
1
###6. opt=260
pbtn1
<-
matrix
(
1
,
nrow
=
1
,
ncol
=
1
)
...
...
@@ -107,7 +113,8 @@ sample_nb <- function(raster,
res
<-
parallel
::
mclapply
(
1
:
nb_mean
,
model_opt_r
,
raster
=
raster
,
raster
=
rast
,
col_names
=
names
(
raster
),
sample_type
=
sample_type
,
buffer
=
buffer
,
model
=
model
,
...
...
@@ -119,7 +126,6 @@ sample_nb <- function(raster,
mtry
=
mtry
,
mod.error
=
mod.error
,
pbtn1
=
pbtn1
,
rast
=
rast
,
max_samples_per_class
=
max_samples_per_class
,
mc.cores
=
cores
,
mc.preschedule
=
TRUE
,
...
...
@@ -133,7 +139,8 @@ sample_nb <- function(raster,
}
else
{
for
(
k
in
1
:
nb_mean
)
{
res
<-
model_opt_r
(
raster
=
raster
,
raster
=
rast
,
col_names
=
names
(
raster
),
sample_type
=
sample_type
,
buffer
=
buffer
,
model
=
model
,
...
...
@@ -146,7 +153,6 @@ sample_nb <- function(raster,
mtry
=
mtry
,
mod.error
=
mod.error
,
pbtn1
=
pbtn1
,
rast
=
rast
,
max_samples_per_class
=
max_samples_per_class
)
points_list
[[
k
]]
<-
res
$
points
...
...
R-package/R/model_opt.r
View file @
42fa9b17
...
...
@@ -4,6 +4,7 @@
#'
#' @param k Iteration value for the models.
#' @param raster satellite time series stack (rasterBrickObject) or just any type of image (*rasterObject)
#' @param col_names layer names
#' @param sample_type distribution of spatial locations c("random","regular")
#' @param buffer distance (in m) for new sample collection around initial samples (depends on pixel size)
#' @param model which machine learning classifier to use c("rf", "svm") for random forest or support vector machine implementation
...
...
@@ -15,7 +16,6 @@
#' @param mtry number of predictor used at random forest splitting nodes (mtry << n predictors)
#' @param mod.error threshold for model error until which iteration is being executed
#' @param pbtn1 matrix for points
#' @param rast raster
#' @param max_samples_per_class maximum number of samples per class
#'
#' @return a list with 4 elements:
...
...
@@ -26,6 +26,7 @@
#' @keywords internal
model_opt_r
<-
function
(
k
,
raster
,
col_names
,
sample_type
,
buffer
,
model
,
...
...
@@ -37,7 +38,6 @@ model_opt_r <- function(k,
mtry
,
mod.error
,
pbtn1
,
rast
,
max_samples_per_class
)
{
points
<-
NULL
models
<-
NULL
...
...
@@ -49,24 +49,21 @@ model_opt_r <- function(k,
if
(
sample_type
==
"random"
)
{
set.seed
(
seed2
[
k
])
pbt
<-
raster
::
sampleRandom
(
rast
er
,
size
=
sample_size
,
sp
=
T
)
raster
::
sampleRandom
(
rast
,
size
=
sample_size
,
sp
=
T
)
}
if
(
sample_type
==
"regular"
)
{
pbt
<-
raster
::
sampleRegular
(
rast
er
,
size
=
sample_size
,
sp
=
T
)
pbt
<-
raster
::
sampleRegular
(
rast
,
size
=
sample_size
,
sp
=
T
)
}
f
<-
which
(
is.na
(
pbt
@
data
[
1
]))
if
(
length
(
f
)
!=
0
)
{
pbt
<-
pbt
[
-
f
,]
}
set.seed
(
seed2
[
k
])
classes
<-
as.factor
(
sample
(
c
(
1
:
2
),
size
=
nrow
(
pbt
),
replace
=
T
))
if
(
length
(
levels
(
classes
))
<
2
)
{
break
}
data
<-
as.data.frame
(
cbind
(
classes
,
pbt
@
data
))
}
########################################################################
...
...
@@ -153,16 +150,15 @@ model_opt_r <- function(k,
rast
))
nam
<-
as.vector
(
fasterize
::
fasterize
(
sf
::
st_as_sf
(
poly
),
rast
[[
1
]],
field
=
"V1"
))[
-
attr
(
test1
,
"na.action"
)]
co
<-
raster
::
xyFromCell
(
rast
,
c
(
1
:
raster
::
ncell
(
rast
))[
-
attr
(
test1
,
"na.action"
)])
co
<-
raster
::
xyFromCell
(
rast
,
c
(
1
:
raster
::
ncell
(
rast
))[
-
attr
(
test1
,
"na.action"
)])
pbtn1
<-
as.data.frame
(
cbind
(
nam
,
co
))
sp
::
coordinates
(
pbtn1
)
<-
c
(
"x"
,
"y"
)
if
(
ncol
(
test1
)
==
1
)
{
test1
<-
t
(
test1
)
}
colnames
(
test1
)
<-
names
(
raster
)
colnames
(
test1
)
<-
col_
names
}
if
(
class
(
test1
)[
1
]
==
"numeric"
)
{
test1
<-
t
(
matrix
(
test1
))
...
...
@@ -189,7 +185,6 @@ model_opt_r <- function(k,
#####################################
###maximum sample size
if
(
sum
(
pbtn1
@
data
$
nam
==
1
)
>
max_samples_per_class
)
{
set.seed
(
seed
)
dr
<-
sample
(
which
(
pbtn1
@
data
$
nam
==
1
),
...
...
R-package/man/model_opt_r.Rd
View file @
42fa9b17
...
...
@@ -7,6 +7,7 @@
model_opt_r(
k,
raster,
col_names,
sample_type,
buffer,
model,
...
...
@@ -18,7 +19,6 @@ model_opt_r(
mtry,
mod.error,
pbtn1,
rast,
max_samples_per_class
)
}
...
...
@@ -27,6 +27,8 @@ model_opt_r(
\item{raster}{satellite time series stack (rasterBrickObject) or just any type of image (*rasterObject)}
\item{col_names}{layer names}
\item{sample_type}{distribution of spatial locations c("random","regular")}
\item{buffer}{distance (in m) for new sample collection around initial samples (depends on pixel size)}
...
...
@@ -49,8 +51,6 @@ model_opt_r(
\item{pbtn1}{matrix for points}
\item{rast}{raster}
\item{max_samples_per_class}{maximum number of samples per class}
}
\value{
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment