Lines outlined each triangle

[WONGY20]

Was trying to reproduce this outcome

with the code below

library(anglr)

img <- raster::brick("https://upload.wikimedia.org/wikipedia/commons/thumb/e/ec/Mona_Lisa%2C_by_Leonardo_da_Vinci%2C_from_C2RMF_retouched.jpg/800px-Mona_Lisa%2C_by_Leonardo_da_Vinci%2C_from_C2RMF_retouched.jpg")

mesh <- as.mesh3d(img, image_texture = img) #, max_triangles = 10000
mesh_plot(mesh, asp = 1)

But the outcome has white lines outlining each triangle,

is there anyway to remove those lines?

Any help will be appreciated, thanks in advance!

[mdsumner]

oh gee, that is exactly as you mentioned it - sorry I was terse before, please share output of

sessionInfo()

and I'll have a look

[WONGY20]

Here is my session info, many thanks.

[mdsumner]

hmm, can you try this pls :)

test_plot <- function (x, col = NULL, add = FALSE, zlim = NULL, ..., coords = NULL, 
    crs = NULL) 
{
    if (!is.null(coords)) {
        warning("argument 'coords' is only used for 'mesh_plot(Raster)', ignoring")
    }
    if (!is.null(x$material$texture)) {
        x <- anglr:::texture_mesh3d(x)
    }
    if (!is.null(crs)) {
        xy <- try(reproj::reproj(t(x$vb[1:2, ]), crs)[, 1:2], 
            silent = TRUE)
        if (!inherits(xy, "try-error")) 
            x$vb[1:2, ] <- t(xy)
    }
    if (!is.null(x$ib)) {
        id <- x$ib
    }
    if (!is.null(x$it)) {
        id <- x$it
    }
    xx <- x$vb[1L, id]
    yy <- x$vb[2L, id]
    ID <- rep(seq_len(ncol(id)), each = nrow(id))
    if (is.null(col)) {
        if (is.null(x$material$color)) {
            cols <- viridis::viridis(100)[scales::rescale(x$vb[3L, 
                id[1L, ]], c(1, 100))]
        }
        else {
            cols <- x$material$color
        }
    }
    else {
        cols <- col
    }
    xx <- list(x = xx, y = yy, id = ID, col = cols)
    if (!add) {
        graphics::plot.new()
        graphics::plot.window(xlim = range(xx$x, finite = TRUE), 
            ylim = range(xx$y, finite = TRUE), ...)
    }
    vps <- gridBase::baseViewports()
    grid::pushViewport(vps$inner, vps$figure, vps$plot)
    grid::grid.polygon(xx$x, xx$y, xx$id, gp = grid::gpar(col = "transparent",  fill = xx$col), default.units = "native")
    grid::popViewport(3)
    invisible(NULL)
}


test_plot(mesh)

Trying to set 'col = "transparent"' in grid.polygon() rather than NA, which perhaps is the Mac vs. Windows difference

[WONGY20]

hmm, the lines are still there unfortunately

library(anglr)

img <- raster::brick("https://upload.wikimedia.org/wikipedia/commons/thumb/e/ec/Mona_Lisa%2C_by_Leonardo_da_Vinci%2C_from_C2RMF_retouched.jpg/800px-Mona_Lisa%2C_by_Leonardo_da_Vinci%2C_from_C2RMF_retouched.jpg")

mesh <- as.mesh3d(img, image_texture = img, max_triangles = 1024) #, max_triangles = 10000
#mesh_plot(mesh, asp = 1)

test_plot <- function (x, col = NULL, add = FALSE, zlim = NULL, ..., coords = NULL, 
    crs = NULL) 
{
    if (!is.null(coords)) {
        warning("argument 'coords' is only used for 'mesh_plot(Raster)', ignoring")
    }
    if (!is.null(x$material$texture)) {
        x <- anglr:::texture_mesh3d(x)
    }
    if (!is.null(crs)) {
        xy <- try(reproj::reproj(t(x$vb[1:2, ]), crs)[, 1:2], 
            silent = TRUE)
        if (!inherits(xy, "try-error")) 
            x$vb[1:2, ] <- t(xy)
    }
    if (!is.null(x$ib)) {
        id <- x$ib
    }
    if (!is.null(x$it)) {
        id <- x$it
    }
    xx <- x$vb[1L, id]
    yy <- x$vb[2L, id]
    ID <- rep(seq_len(ncol(id)), each = nrow(id))
    if (is.null(col)) {
        if (is.null(x$material$color)) {
            cols <- viridis::viridis(100)[scales::rescale(x$vb[3L, 
                id[1L, ]], c(1, 100))]
        }
        else {
            cols <- x$material$color
        }
    }
    else {
        cols <- col
    }
    xx <- list(x = xx, y = yy, id = ID, col = cols)
    if (!add) {
        graphics::plot.new()
        graphics::plot.window(xlim = range(xx$x, finite = TRUE), 
            ylim = range(xx$y, finite = TRUE), ...)
    }
    vps <- gridBase::baseViewports()
    grid::pushViewport(vps$inner, vps$figure, vps$plot)
    grid::grid.polygon(xx$x, xx$y, xx$id, gp = grid::gpar(col = "transparent",  fill = xx$col), default.units = "native")
    grid::popViewport(3)
    invisible(NULL)
}

test_plot(mesh)

[mdsumner]

oh dang, then I'm afraid I have no good solution - could try setting them to the fill colour but it which might be enough?

test_plot <- function (x, col = NULL, add = FALSE, zlim = NULL, ..., coords = NULL, 
    crs = NULL) 
{
    if (!is.null(coords)) {
        warning("argument 'coords' is only used for 'mesh_plot(Raster)', ignoring")
    }
    if (!is.null(x$material$texture)) {
        x <- anglr:::texture_mesh3d(x)
    }
    if (!is.null(crs)) {
        xy <- try(reproj::reproj(t(x$vb[1:2, ]), crs)[, 1:2], 
            silent = TRUE)
        if (!inherits(xy, "try-error")) 
            x$vb[1:2, ] <- t(xy)
    }
    if (!is.null(x$ib)) {
        id <- x$ib
    }
    if (!is.null(x$it)) {
        id <- x$it
    }
    xx <- x$vb[1L, id]
    yy <- x$vb[2L, id]
    ID <- rep(seq_len(ncol(id)), each = nrow(id))
    if (is.null(col)) {
        if (is.null(x$material$color)) {
            cols <- viridis::viridis(100)[scales::rescale(x$vb[3L, 
                id[1L, ]], c(1, 100))]
        }
        else {
            cols <- x$material$color
        }
    }
    else {
        cols <- col
    }
    xx <- list(x = xx, y = yy, id = ID, col = cols)
    if (!add) {
        graphics::plot.new()
        graphics::plot.window(xlim = range(xx$x, finite = TRUE), 
            ylim = range(xx$y, finite = TRUE), ...)
    }
    vps <- gridBase::baseViewports()
    grid::pushViewport(vps$inner, vps$figure, vps$plot)
    grid::grid.polygon(xx$x, xx$y, xx$id, gp = grid::gpar(col = xx$col,  fill = xx$col), default.units = "native")
    grid::popViewport(3)
    invisible(NULL)
}

[WONGY20]

Yes, this is working fine now!
Thank you so much for your help!

[mdsumner]

Thank you, I think I'll set this as default in anglr