How to convert Geometry ElevationGrid of VRML to Aframe - aframe

everyone. I have an issue in converting VRML to A-frame.
VRML has the "Geometry ElevationGrid" function to set the DEM value of the texture.
Instance code is as follows.
geometry ElevationGrid {
xDimension 9
zDimension 9
xSpacing 1.0
zSpacing 1.0
solid FALSE
height [
0.0, 0.0, 0.5, 1.0, 0.5, 0.0, 0.0, 0.0, 0.0,
0.0, 0.0, 0.0, 0.0, 2.5, 0.5, 0.0, 0.0, 0.0,
0.0, 0.0, 0.5, 0.5, 3.0, 1.0, 0.5, 0.0, 1.0,
0.0, 0.0, 0.5, 2.0, 4.5, 2.5, 1.0, 1.5, 0.5,
1.0, 2.5, 3.0, 4.5, 5.5, 3.5, 3.0, 1.0, 0.0,
0.5, 2.0, 2.0, 2.5, 3.5, 4.0, 2.0, 0.5, 0.0,
0.0, 0.0, 0.5, 1.5, 1.0, 2.0, 3.0, 1.5, 0.0,
0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2.0, 1.5, 0.5,
0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0,
]
}
I tried to convert this above VRML ElevationGrid code to Aframe.
But I can't find how to do it. Please help me if anyone knows.


This can be done, but it is a complex topic. Aframe does not have the equivalent of an elevation grid. But aframe is simply a framework for working with THREEjs, and THREE does have way to generate a mesh from scratch, and displace its height. Explaining it is far beyond the scope of this response, but take a look at this tutorial on THREEjs fundamentals. It walks through the entire process.
https://threejsfundamentals.org/threejs/lessons/threejs-custom-geometry.html


Eric Eisenman (aka Sir FizX, on the AFrame slack) has written a terrain component and made it public. It uses a vertex shader, and is a very beautiful (and fast) implementation of generated terrain. Here it is on glitch.
https://glitch.com/~aframe-terrain

Related

is there a simple way to draw a graph in christmas tree farm in r

Is there a mathematical function or a way in which we can get a graph that will be in the form of a Christmas tree, like this?
thanks for your help

Here's one of many options:
tree <- data.frame(x = c(-5, 5, 2, 4, 1.5, 3, 0, -3, -1.5, -4, -2, -5,
-0.75, 0.75, 0.75, -0.75),
y = c(1, 1, 3, 3, 5, 5, 7, 5, 5, 3, 3, 1, 0, 0, 1, 1),
part = rep(c("branches", "trunk"), times = c(12, 4)))
baubles <- data.frame(x = c(-1.9, -2.4, 0.5, -0.3, -0.2, -1.3, 0.5,
1.2, -2.2, -1, 1.7, -1.4, -1.4, 0.4, 2.1, 0.4,
-0.8, -3.3, 0.5, -2.2, -0.1, -1.5, 2, 3.9, 1.3,
-1.7, 3.7, 2.8, 1, -0.1, 3.8, -2.9, -1.9, -1.7,
-2.6, -2.3, 0.9, 1, -0.4, 1.5, 1.8, -0.5, -1.4,
-0.4, -0.5, -0.9, -1.7, 0.7, 1.6, 1.2, -0.4, 1,
0.8, 2.3, -2.5, -2, -2.9, -1.4, -1.1, 0.2),
y = c(3, 3.3, 1.2, 4.4, 5.1, 5.2, 1.1, 6, 1.5, 2.4, 1.2,
5.4, 2.2, 3.4, 3.4, 3.8, 3.1, 1.2, 4.3,
1.6, 2.4, 5.4, 4.5, 1.1, 1.3, 5, 1.5, 1.9, 1.7,
5.4, 1.3, 1.1, 2.2, 4, 1.8, 2, 4.6, 1.1, 5.9, 4.4,
2, 1.5, 2, 1.2, 5.3, 3.6, 3.5, 4.5, 5.8, 3, 2.7,
5.3, 3.1, 1.7, 1.6, 2.8, 3.6, 2.2, 2.8, 1.7),
color = sample(c("white", "yellow", "red"), 60, TRUE))
library(ggplot2)
ggplot(tree, aes(x, y)) +
geom_polygon(aes(fill = part)) +
geom_point(data = baubles, aes(color = color), size = 4) +
scale_fill_manual(values = c("green4", "brown4"), name = "Parts of tree") +
scale_color_identity(guide = guide_legend(), labels = c("red bauble",
"white bauble", "yellow bauble"), name = "Decorations") +
theme_minimal(base_size = 20)
Created on 2022-11-20 with reprex v2.0.2

first selected option in selectizeInput overwriting plot output so that only one variable plots instead of multiple in radar plot

I'm trying to create a radar plot that I can select multiple inputs on (cultivars) and plot 3 together. However, it seems my code causes the first selected option to overwrite any additional selections. I think, perhaps, a loop is needed but I'm unsure of how to fix it.
For example, based on each selected input I define the dataset that will be plotted as "new" but don't know how to approach this to make it so that there can be multiple selections.
library(shiny)
library(fmsb)
aroma<-data.frame(
aroma = c(15.0, 0.0, 1.2, 1.8, 2.0, 2.6, 2.8, 1.1, 1.2, 2.6, 1.0, 2.7, 1.7, 2.5, 2.0, 1.5, 1.6, 2.4),
leaf_size = c(15.0, 0.0, 4.6, 6.1, 4.5, 5.6, 6.5, 8.1, 6.6, 6.6, 2.6, 2.5, 2.4,5.5, 6.1, 7.5, 8.0, 7.3),
red_stems_and_leaves = c(15.0, 0.0, 0.0, 6.0, 5.8, 7.3, 0.0, 0.0, 0.0,0.0, 0.0, 0.0, 0.0 ,0.0, 1.1, 0.0, 3.6, 12.8),
leaf_homogeneity = c(15.0, 0.0, 13.3, 10.8, 0.0, 11.0, 11.0, 9.9, 12.0, 11.7, 13.1, 11.4, 12.0, 12.5, 10.1, 13.4, 12.0, 13.0),
leaf_yellowing = c(15.0, 0.0, 0.0, 0.7, 0.8, 0.5, 0.5, 1.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0),
color_intensity = c(15.0, 0.0, 5.1, 8.7, 7.4, 8.9, 7.1, 3.9, 8.8, 5.5, 7.0, 6.5, 5.6, 7.6, 6.7, 6.6, 7.2, 14.0),
hardness = c(15.0, 0.0, 1.8, 4.4, 3.5, 2.6, 3.0, 2.9, 3.3, 2.8, 2.2, 3.0, 2.3, 2.6, 2.0, 3.9, 3.3, 2.2),
crispness = c(15.0, 0.0, 2.9, 5.0, 4.0, 7.9, 3.5, 4.0, 3.9, 4.0, 4.6, 5.9, 4.8, 4.8, 4.5, 5.0, 5.0, 2.5),
fibrousness = c(15.0, 0.0, 3.1, 2.6, 3.1, 3.0, 2.1, 2.8, 3.5, 3.0, 2.0, 3.3, 3.0, 2.7, 1.5, 3.6, 3.0, 2.9),
moisture_release = c(15.0, 0.0, 3.5, 3.1, 3.1, 2.5, 2.0, 3.0, 2.5, 2.5, 2.1, 2.9, 3.9, 4.0, 3.8, 2.3, 2.0, 2.0),
row.names = c("max", "min", "Sorrel", "Cabbage, Red", "Kohlrabi, Purple", "Mustard, Garnet Giant", "Arugula",
"Pac Choi, Tokyo Bekana", "Kale, Toscano", "Mustard, Green Wave", "Tatsoi", "Mizuna, Central Red","Mustard, Wasabina",
"Broccoli", "Kale, Red Russian", "Radish, Daikon", "Radish, Hong Vit", "Radish, Red Rambo"))
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Rename"),
# Sidebar
sidebarLayout(
sidebarPanel(
selectizeInput("cultivar",
"Select Cultivars:",
choices = c("Sorrel", "Cabbage, Red", "Kohlrabi, Purple", "Mustard, Garnet Giant", "Arugula",
"Pac Choi, Tokyo Bekana", "Kale, Toscano", "Mustard, Green Wave", "Tatsoi", "Mizuna, Central Red","Mustard, Wasabina",
"Broccoli", "Kale, Red Russian", "Radish, Daikon", "Radish, Hong Vit", "Radish, Red Rambo"),
selected = "Sorrel",
multiple = TRUE)
),
# Show a plot
mainPanel(
plotOutput("plot")
)
)
)
# Define server logic
server <- function(input, output) {
output$plot <- renderPlot({
if (input$cultivar == "Sorrel") {
new <- aroma[c(1:2, 3), ]
}
if (input$cultivar == "Cabbage, Red") {
new <- aroma[c(1:2, 4), ]
}
if (input$cultivar == "Kohlrabi, Purple") {
new <- aroma[c(1:2, 5), ]
}
if (input$cultivar == "Mustard, Garnet Giant") {
new <- aroma[c(1:2, 6), ]
}
if (input$cultivar == "Arugula") {
new <- aroma[c(1:2, 7), ]
}
if (input$cultivar == "Pac Choi, Tokyo Bekana") {
new <- aroma[c(1:2, 8), ]
}
if (input$cultivar == "Kale, Toscano") {
new <- aroma[c(1:2, 9), ]
}
if (input$cultivar == "Mustard, Green Wave") {
new <- aroma[c(1:2, 10), ]
}
if (input$cultivar == "Tatsoi") {
new <- aroma[c(1:2, 11), ]
}
if (input$cultivar == "Mizuna, Central Red") {
new <- aroma[c(1:2, 12), ]
}
if (input$cultivar == "Mustard, Wasabina") {
new <- aroma[c(1:2, 13), ]
}
if (input$cultivar == "Broccoli") {
new <- aroma[c(1:2, 14), ]
}
if (input$cultivar == "Kale, Red Russian") {
new <- aroma[c(1:2, 15), ]
}
if (input$cultivar == "Radish, Daikon") {
new <- aroma[c(1:2, 16), ]
}
if (input$cultivar == "Radish, Hong Vit") {
new <- aroma[c(1:2, 17), ]
}
if (input$cultivar == "Radish, Red Rambo") {
new <- aroma[c(1:2, 18), ]
}
radarchart(new,
seg = 20,
title = input$variable1,
# pcol = colors_line,
# pfcol = colors_fill,
plwd = 1
)
})
}
# Run the application
shinyApp(ui = ui, server = server)

Please try the following code. You don't need to use all the if statements; instead, check which elements in row.names match the choices.
library(shiny)
library(fmsb)
aroma<-data.frame(
aroma = c(15.0, 0.0, 1.2, 1.8, 2.0, 2.6, 2.8, 1.1, 1.2, 2.6, 1.0, 2.7, 1.7, 2.5, 2.0, 1.5, 1.6, 2.4),
leaf_size = c(15.0, 0.0, 4.6, 6.1, 4.5, 5.6, 6.5, 8.1, 6.6, 6.6, 2.6, 2.5, 2.4,5.5, 6.1, 7.5, 8.0, 7.3),
red_stems_and_leaves = c(15.0, 0.0, 0.0, 6.0, 5.8, 7.3, 0.0, 0.0, 0.0,0.0, 0.0, 0.0, 0.0 ,0.0, 1.1, 0.0, 3.6, 12.8),
leaf_homogeneity = c(15.0, 0.0, 13.3, 10.8, 0.0, 11.0, 11.0, 9.9, 12.0, 11.7, 13.1, 11.4, 12.0, 12.5, 10.1, 13.4, 12.0, 13.0),
leaf_yellowing = c(15.0, 0.0, 0.0, 0.7, 0.8, 0.5, 0.5, 1.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0),
color_intensity = c(15.0, 0.0, 5.1, 8.7, 7.4, 8.9, 7.1, 3.9, 8.8, 5.5, 7.0, 6.5, 5.6, 7.6, 6.7, 6.6, 7.2, 14.0),
hardness = c(15.0, 0.0, 1.8, 4.4, 3.5, 2.6, 3.0, 2.9, 3.3, 2.8, 2.2, 3.0, 2.3, 2.6, 2.0, 3.9, 3.3, 2.2),
crispness = c(15.0, 0.0, 2.9, 5.0, 4.0, 7.9, 3.5, 4.0, 3.9, 4.0, 4.6, 5.9, 4.8, 4.8, 4.5, 5.0, 5.0, 2.5),
fibrousness = c(15.0, 0.0, 3.1, 2.6, 3.1, 3.0, 2.1, 2.8, 3.5, 3.0, 2.0, 3.3, 3.0, 2.7, 1.5, 3.6, 3.0, 2.9),
moisture_release = c(15.0, 0.0, 3.5, 3.1, 3.1, 2.5, 2.0, 3.0, 2.5, 2.5, 2.1, 2.9, 3.9, 4.0, 3.8, 2.3, 2.0, 2.0),
row.names = c("max", "min", "Sorrel", "Cabbage, Red", "Kohlrabi, Purple", "Mustard, Garnet Giant", "Arugula",
"Pac Choi, Tokyo Bekana", "Kale, Toscano", "Mustard, Green Wave", "Tatsoi", "Mizuna, Central Red","Mustard, Wasabina",
"Broccoli", "Kale, Red Russian", "Radish, Daikon", "Radish, Hong Vit", "Radish, Red Rambo"))
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Rename"),
# Sidebar
sidebarLayout(
sidebarPanel(
selectizeInput("cultivar",
"Select Cultivars:",
choices = row.names(aroma)[-(1:2)],
selected = "Sorrel",
multiple = TRUE)
),
# Show a plot
mainPanel(
plotOutput("plot")
)
)
)
# Define server logic
server <- function(input, output) {
selectedVar <- reactive({
input$cultivar
})
newDf <- reactive({
# check which elements in row.names match the choices
g1 <- apply(sapply(X = selectedVar(), FUN = grepl, row.names(aroma)), MARGIN = 1, FUN = any)
addedDf <- aroma[c(1:2, which(g1)), ] # this is the "new" with (multiple) selections
return(addedDf)
})
output$plot <- renderPlot({
radarchart(newDf(),
seg = 20,
title = input$variable1,
# pcol = colors_line,
# pfcol = colors_fill,
plwd = 1
)
})
}
# Run the application
shinyApp(ui = ui, server = server)

simprof, Error in if (denom != 0) { : missing value where TRUE/FALSE needed

I would like to test the pairwise similarity between 22 study sites (rows) using the simprof function in the 'clustsig' package in R.
It is based on Clarke, Somerfield, and Gorley (2008), who developed SIMPROF, a “similarity profile,” which represents the matrix of pairwise similarity values between any set of objects. The data represent percent cover of benthic organisms on a coral reef with each row summing to 100.
Using a matrix with more than 20 rows, I get the following error,
"Error in if (denom != 0) { : missing value where TRUE/FALSE needed"
I do not get this error with 20 rows or less.
Any guidance or possible explanation for this error would be appreciated.
install.packages("clustsig")
require(clustsig)
mdat2 <- matrix(
c(2.0, 3.0, 32.3, 0.0, 2.3, 43.7, 0.3, 0.3, 2.0, 0.0, 13.7, 0.3, #1
16.9, 0.0, 4.5, 0.0, 12.4, 36.9, 0.0, 0.7, 0.7, 5.9, 21.0, 1.0, #2
28.3, 0.0, 7.3, 0.0, 21.7, 12.9, 0.0, 0.0, 0.7, 4.2, 21.7, 3.1, #3
4.1, 2.0, 31.8, 0.0, 6.1, 31.1, 3.0, 0.7, 5.7, 0.3, 15.2, 0.0, #4
13.1, 0.7, 46.3, 0.3, 0.0, 1.7, 0.3, 0.0, 0.3, 0.3, 36.9, 0.0, #5
1.3, 23.7, 55.5, 9.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 9.4, 0.3, #6
4.1, 0.7, 27.9, 0.7, 3.1, 32.1, 14.5, 0.0, 4.8, 0.0, 11.0, 1.0, #7
1.0, 4.7, 68.9, 0.0, 1.0, 11.8, 3.4, 0.3, 2.4, 0.0, 6.1, 0.3, #8
8.2, 0.0, 49.1, 0.0, 0.7, 5.5, 0.0, 0.3, 0.3, 0.0, 32.3, 3.4, #9
17.8, 2.4, 48.8, 0.0, 0.3, 2.0, 3.0, 0.0, 11.1, 0.0, 13.8, 0.7, #10
17.3, 0.4, 30.0, 5.1, 0.0, 18.1, 0.0, 1.1, 5.8, 0.0, 21.7, 0.7, #11
8.1, 1.0, 62.3, 0.0, 3.0, 4.0, 0.0, 0.0, 0.7, 0.0, 19.2, 1.7, #12
12.8, 0.0, 65.9, 0.3, 0.0, 1.0, 0.0, 0.0, 0.7, 0.0, 17.9, 1.4, #13
16.3, 4.2, 46.7, 0.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 31.5, 0.7, #14
24.9, 0.0, 15.4, 0.0, 0.3, 2.0, 0.3, 0.7 ,2.7, 0.0, 50.9, 2.7, #15
19.8, 0.0, 35.1, 0.0, 0.0, 2.1, 1.4, 0.7, 1.4, 0.0, 39.2, 0.3, #16
14.2, 0.0, 48.1, 0.0, 0.3, 11.2, 0.0, 0.0, 1.0, 0.0, 24.1, 1.0, #17
25.0, 0.7, 27.4, 0.3, 0.7, 28.0, 0.0, 1.0, 6.1, 0.0, 10.1, 0.7, #18
7.4, 0.3, 41.1, 0.0, 0.0, 27.4, 0.3, 0.3, 10.7, 0.0, 11.7, 0.7, #19
8.7, 5.4, 63.4, 2.0, 0.0, 1.0, 0.0, 0.0, 1.3, 0.0, 17.8, 0.3, #20
15.9, 0.0, 34.2, 0.0, 2.7, 6.4, 0.3, 1.7, 2.7, 0.0, 34.2, 1.7, #21
5.1, 1.7, 60.3, 1.0, 1.0, 3.0, 0.0, 0.0, 2.0, 0.0, 25.9, 0.0 #22
),
nrow = 22, ncol = 12, byrow = TRUE,
dimnames = list(c("row1", "row2", "row3", "row4", "row5",
"row6", "row7", "row8", "row9", "row10",
"row11", "row12", "row13", "row14", "row15",
"row16", "row17", "row18", "row19",
"row20", "row21", "row22"
),
c("c.1", "c.2", "c.3", "c.4", "c.5", "c.6",
"c.7", "c.8", "c.9", "c.10", "c.11", "c.12")
)
)
mdat2.simprof <- simprof(mdat2,
num.expected = 1000, num.simulated = 999,
method.distance = "actual-braycurtis",
method.transform = "identity", alpha = 0.05,
sample.orientation = "row", const = 1,
silent = FALSE, increment = 100,
undef.zero = TRUE, warn.braycurtis = TRUE)

Triangle Mesh, unable to add object to scene in JavaFX

I'm working on importing a 3D model (obj file) and using JavaFX triangle mesh to add it to the scene.
first, I read the obj file, parse it and save its content to (float array "Vertices", and integer array for "Faces". My mesh points :[0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 1.0, 0.0, 0.0, 1.0, 1.0, 1.0, 0.0, 0.0, 1.0, 0.0, 1.0, 1.0, 1.0, 0.0, 1.0, 1.0, 1.0], and mesh faces : [1, 0, 7, 0, 5, 0, 1, 0, 3, 0, 7, 0, 1, 0, 4, 0, 3, 0,........]
and then I add it to my scene
MeshView cubeMesh = new MeshView(mesh);
cubeMesh.setDrawMode(DrawMode.FILL);
cubeMesh.setTranslateX(20);
cubeMesh.setTranslateY(10);
cubeMesh.setTranslateZ(20);
displayPane.getChildren().add(cubeMesh);
Unfortunately, nothing is added to the scene. Would anybody be able to suggest a solution, tutorial or a book?

Here is an initial tutorial directly from Oracle: https://docs.oracle.com/javase/8/javafx/graphics-tutorial/javafx-3d-graphics.htm

Unwanted lines between groups in ggplot

I have climate logger data for several years and want to plot the daily temperature cycle for each day in one month. I am using ggplot and and grouping the data by day
When I plot data from a single year, everything is fine. When I plot data from multiple years, I get lines from 23:00 back to 00:00. If I use facet_wrap, it works, but I have multiple sites and want to facet by site not year.
clim2 <- structure(list(date = structure(c(1404172980, 1404176580, 1404180180,
1404183780, 1404187380, 1404190980, 1404194580, 1404198180, 1404201780,
1404205380, 1404208980, 1404212580, 1404216180, 1404219780, 1404223380,
1404226980, 1404230580, 1404234180, 1404237780, 1404241380, 1404244980,
1404248580, 1404252180, 1404255780, 1404259380, 1404262980, 1404266580,
1404270180, 1404273780, 1404277380, 1404280980, 1404284580, 1404288180,
1404291780, 1404295380, 1404298980, 1404302580, 1404306180, 1404309780,
1404313380, 1404316980, 1404320580, 1404324180, 1404327780, 1404331380,
1404334980, 1404338580, 1404342180, 1435708980, 1435712580, 1435716180,
1435719780, 1435723380, 1435726980, 1435730580, 1435734180, 1435737780,
1435741380, 1435744980, 1435748580, 1435752180, 1435755780, 1435759380,
1435762980, 1435766580, 1435770180, 1435773780, 1435777380, 1435780980,
1435784580, 1435788180, 1435791780, 1435795380, 1435798980, 1435802580,
1435806180, 1435809780, 1435813380, 1435816980, 1435820580, 1435824180,
1435827780, 1435831380, 1435834980, 1435838580, 1435842180, 1435845780,
1435849380, 1435852980, 1435856580, 1435860180, 1435863780, 1435867380,
1435870980, 1435874580, 1435878180), class = c("POSIXct", "POSIXt"
), tzone = "NMT"), value = c(-0.1, 0, 0, 0, 0, 0, 0, 0, 0.2,
0.3, 0.7, 2.2, 2.6, 2.6, 3.3, 3, 1.9, 1.7, 1.1, 2.1, 0.7, 0.3,
-0.3, -0.4, -0.3, -1, -0.9, -1, -1, -1.1, -1.2, -0.5, -0.6, -1.2,
1.1, 3, 3.4, 4.5, 1.9, 1.9, 3.8, 3.4, 1.3, -0.1, 0.2, -0.6, -0.8,
-0.9, -0.4, -0.3, -0.3, -0.3, -0.2, -0.3, -0.6, -0.8, -0.7, -1.1,
1.2, 2.9, 1.9, 1.4, 1.7, 1.9, 1.6, 1.5, 0.9, 1.1, -0.5, -1.4,
-1.2, -1.1, -1.6, -1.3, -1.4, -1.4, -1.5, -1.3, -1.3, -1.6, -1.9,
-1.8, 0.9, 1.4, 0.9, 0.7, 0.4, -0.5, 0.1, 0.2, 0.1, -0.1, -0.6,
-0.9, -0.9, -0.7)), .Names = c("date", "value"), row.names = c(NA,
-96L), class = "data.frame")
library(ggplot2)
library(lubridate)
g <-ggplot(clim2, aes(x = hour(date) + minute(date)/60, y = value, colour = factor(year(date)), group = factor(day(date)))) +
geom_path() +
xlab("Time")
print(g)

If you want to remove these lines, you have to make sure that group contains unique value for one path (roughly speaking, some sort of non-overlapping id), e.g.
clim2$year <- year(clim2$date)
clim2$day_id <- paste0(day(clim2$date), "_", clim2$year)
ggplot(clim2, aes(x = hour(date) + minute(date)/60,
y = value, colour = factor(year), group = day_id)) +
geom_path() +
xlab("Time")

Resources