library(testthat) library(data.table) library(collapse) library(PiC) library(withr) # Funzione per generare un tronco d'albero verticale con rumore generate_trunk <- function(base_x, base_y, height, radius, points_per_meter = 200) { # Punti lungo l'altezza z_points <- seq(0, height, length.out = height * points_per_meter) # Per ogni altezza, genero punti in circonferenza trunk_points <- lapply(z_points, function(z) { angles <- seq(0, 2*pi, length.out = 120) x <- base_x + radius * cos(angles) + rnorm(length(angles), 0, 0.01) y <- base_y + radius * sin(angles) + rnorm(length(angles), 0, 0.01) data.frame(x = x, y = y, z = rep(z, length(angles))) }) do.call(rbind, trunk_points) } # Funzione per generare chioma dell'albero generate_crown <- function(trunk_x, trunk_y, trunk_height, crown_radius, points_per_volume = 1000) { n_points <- points_per_volume * crown_radius^3 # Genera punti in una sfera theta <- runif(n_points, 0, 2*pi) phi <- runif(n_points, 0, pi) r <- crown_radius * runif(n_points)^(1/3) x <- trunk_x + r * sin(phi) * cos(theta) y <- trunk_y + r * sin(phi) * sin(theta) z <- trunk_height + r * cos(phi) data.frame(x = x, y = y, z = z) } # Crea il test fixture defer({ files_to_remove <- list.files(pattern = "test_forest", full.names = TRUE) unlink(files_to_remove) }) # Genera dataset di test test_that("Wood_seg funziona correttamente con dati forestali", { # Dimensioni della scena x_range <- c(0, 20) y_range <- c(0, 20) # Genera solo alberi (tronchi e chiome) trees <- list() crowns <- list() # Genera 4 alberi come nel test precedente for(i in 1:4) { trunk_x <- runif(1, x_range[1], x_range[2]) trunk_y <- runif(1, y_range[1], y_range[2]) height <- runif(1, 5, 15) # altezze tra 5 e 15 metri radius <- runif(1, 0.2, 0.4) # raggi tra 20 e 40 cm trees[[i]] <- generate_trunk(trunk_x, trunk_y, height, radius) crowns[[i]] <- generate_crown(trunk_x, trunk_y, height*0.7, height/3) } # Combina i punti solo di tronchi e chiome forest_data <- rbind( do.call(rbind, trees), do.call(rbind, crowns) ) # Aggiungi rumore casuale forest_data$x <- forest_data$x + rnorm(nrow(forest_data), 0, 0.01) forest_data$y <- forest_data$y + rnorm(nrow(forest_data), 0, 0.01) forest_data$z <- forest_data$z + rnorm(nrow(forest_data), 0, 0.01) # crea la tabella un voxel per ogni punto (con doppioni) dim<-0.03 AAvox <- data.frame(as.integer(forest_data$x / dim) + 1, as.integer(forest_data$y / dim) + 1, as.integer(forest_data$z / dim) + 1) colnames(AAvox) <- c("u", "v", "w") # crea la nuvola di voxel, con valori univoci e quarta colonna col numero di punti per voxel AAvox1 <- data.frame(AAvox %>% fcount(u, v, w)) forest_data_vox<- data.frame(AAvox1$u, AAvox1$v, AAvox1$w) # Test della funzione expect_no_error( Wood_seg( forest_data_vox, filename = "test_wood", eps = 2, mpts = 6, N = 500, R = 30 ) ) # Verifica output wood_out <- fread("test_wood_WoodVox_eps2_mpts6.txt") # Test sui risultati expect_true(nrow(wood_out) > 0, "Nessun punto identificato come legno") expect_true(max(wood_out$z) > 5, "Altezza massima del legno troppo bassa") expect_true(all(colnames(wood_out) == c("x", "y", "z", "cls", "r", "pop_cls")), "Colonne output non corrette") })