Issues Running the updated version of grts() within the package spsurvey - r

With the updated version of spsurvey I am having a difficult time trying to generate random points for my design using the grts() function. With the code below I can produce points if n_over = some number and it draws that number across all strata. However I would like a different number of oversamples per stratum based on acres. The first bit of code works and draws the right amount of base points then produces 10 over sample points per stratum
However when I try to do something similar for n_over (Over.test) I receive this error message
" Input Error Message
n_base + n_over : For each stratum, the sum of the base sites and 'Over' replacement sites must be no larger than the number of rows in 'sframe' representing that stratum."
Even though there are 115+ rows per strata in the test.inShape<-st_read("UFO_2022_Ints_Pts_Strata.shp")
There is unfortunately very little information out on the updated spsurvey package.
"ALLOT_NAME" is a column within the shape file that contains the name for each stratum (Adobe, Big Pasture, ect...)
New to Stackoverflow so I apologize if I have not presented this appropriately
### Working code ####
test.prj=c("UFO_2022_Ints_Pts_Strata")
test.inShape<-st_read("UFO_2022_Ints_Pts_Strata.shp")
plots.df<-read.csv("GUSG_Strata.csv")
strata.list<-as.vector(plots.df)
x<-c('Adobe' = 2, 'Big Pasture' = 2, 'Black Ridge' = 45, 'Blue Cimarron' = 2, Buck = 2, 'Crawford Reservoir' = 2, 'Dave Wood Road' = 2, 'Dry Cedar' = 2, 'East Gould Reservoir' = 2, 'Gould Reservoir' = 20, 'Green Mountain - Middle' = 35, 'Grizzly Gulch' = 2, 'Iron Canyon' = 15, 'Little Baldy' = 2, 'Lower Horsefly' = 35, 'Onion Valley' = 2, 'Poison Spring' = 15, 'Rawhide - Coffee Pot' = 2, 'Rim Rock' = 2, 'Shinn Park' = 2, 'Tappan Creek' = 2, 'Green Mountain - Jensen Ware' = 15, 'Green Mountain - West' = 35, 'Green Mountain - East' = 30)
#test.sample<-grts(design=test.design, DesignID="RGFO_2022_RangeLPI", in.shape=test.inShape, id = "RGFO_2022_RangeLPI", prjfilename=test.prj, out.shape="RGFO_2022_RangeLPI_GRTS")
test.sample<-grts(test.inShape, n_base=x, stratum_var="ALLOT_NAME", n_over=10, DesignID="UFO_2022_GUSG" )
test.output<-sp_rbind(test.sample)
st_write(test.output, "UFO_2022_GUSG_SampleDesign_V1_TESTErase.shp")
# will not work when I use n_over = Over.list trying to specify oversample points for each strata
Over.list <- c('Adobe' = 3,
'Big Pasture' = 3,
'Black Ridge' = 10,
'Blue Cimarron' = 3,
'Buck' = 3,
'Crawford Reservoir' = 3,
'Dave Wood Road' = 3,
'Dry Cedar' = 3,
'East Gould Reservoir' = 3,
'Gould Reservoir' = 3,
'Green Mountain - Middle' = 10,
'Grizzly Gulch' = 3,
'Iron Canyon' = 10,
'Little Baldy' = 3,
'Lower Horsefly' = 10,
'Onion Valley' = 3,
'Poison Spring' = 10,
'Rawhide - CoffeePot' = 3,
'Rim Rock' = 3,
'Shinn Park' = 3,
'Tappan Creek' = 3,
'Green Mountain - Jensen Ware' = 10,
'Green Mountain - West' = 10,
'Green Mountain - East' = 10)
### Below is the layout of the grts function
# grts
# sframe,
# n_base,
# stratum_var = NULL,
# seltype = NULL,
# caty_var = NULL,
# caty_n = NULL,
# aux_var = NULL,
# legacy_var = NULL,
# legacy_sites = NULL,
# legacy_stratum_var = NULL,
# legacy_caty_var = NULL,
# legacy_aux_var = NULL,
# mindis = NULL,
# maxtry = 10,
# n_over = NULL,
# n_near = NULL,
# wgt_units = NULL,
# pt_density = NULL,
# DesignID = "Site",
# SiteBegin = 1,
# sep = "-",
# projcrs_check = TRUE
# )

Sorry for the late response here! I think the error you are receiving is the result of a bug in one of our error checks. This bug will be fixed in version 5.4.0 of spsurvey, which should be on CRAN within the next couple weeks. I am hopeful your code will work once the new version is installed. Additionally, spsurvey has a new website viewable here that contains a lot of information about the package.
As for "presenting appropriately" on Stack Overflow, usually you want to provide a reproducible example (more on that here and here). Given the nature of this bug, I think that providing a reproducible example would have been challenging. Thus, I appreciate that you provided all of your code.
EDIT: spsurvey version 5.4.0 was pushed to CRAN on November 22, 2022.

Related

Is there a way to visualize a partially directed graph using R forceNetwork() function?

I am currently working with the R forceNetwork function of the networkD3 package and I have properly validated the correctness of the Nodes and Links data frames for my graph.
My Nodes data frame (node_df) is like this:
node_id node_type node_size
0 T054717 irrelevant 10
1 T095006 irrelevant 10
2 T088658 irrelevant 10
3 T069179 irrelevant 10
4 T009515 irrelevant 10
5 T152167 irrelevant 10
6 T100447 irrelevant 10
7 T150659 irrelevant 10
...
and My Links dataframe (links_df) is like this:
tid1 tid2 edge_dir
0 37 36 10
1 37 0 10
2 37 1 10
3 37 3 10
...
147 34 35 5
148 7 47 5
149 34 47 5
150 35 47 5
151 36 48 5
152 1 48 5
I set the forceNetwork function like this:
network <- forceNetwork (Links = links_df,
Nodes = node_df,
Source = "tid1",
Target = "tid2",
Value = "edge_dir",
NodeID = "node_id",
Nodesize = "node_size",
Group = "node_type",
colourScale = JS("d3.scaleOrdinal(d3.schemeCategory20);"),
fontSize = 10,
linkDistance = 100,
radiusCalculation = JS(" Math.sqrt(d.nodesize)+6"),
charge = -30,
linkColour = ifelse(links_df$edge_dir == 10, "black","red"),
opacity = 1,
zoom = TRUE,
arrows = ifelse(links_df$edge_dir == 10, TRUE, FALSE),
opacityNoHover = TRUE,
clickAction = NULL)
I am struggling with the arrows parameter of the function. In fact I would like to specify if there should be a directed edge (arrows = TRUE) or an undirected edge (arrows = FALSE) for each link, by checking the Value parameter.
In my case Value refers to a column of the Links data frame named edge_dir, which specifies if the edge should be directed (edge_dir = 10) or not (edge_dir = 5).
After looking at this stackoverflow link, specify-colors-for-each-link-in-a-force-directed-network-networkd3
I've tried to set the parameter like this:
arrows = ifelse(links_df$edge_dir == 10, TRUE, FALSE) but the output graph has arrows where there just should be undirected lines.
Using the same structure in the linkColour parameter: linkColour = ifelse(links_df$edge_dir == 10, "black","red") it works fine, directed edges are black and the ones that should be undirected, but they aren't, are red, as shown in this graph output image
Is it possible to display a graph which has directed and undirected edges by modifying the arrows parameter?
Thank you!
This is an imperfect solution, but it's easier than making substantial modifications to the underlying JavaScript yourself. You can use htmlwidgets::onRender() to inject some JavaScript to run just after the plot is generated. Here's an example of how you could turn off the arrows for only those links that have a value equal to 5...
library(tibble)
library(networkD3)
library(htmlwidgets)
node_df <- tibble::tribble(
~node_id, ~node_type, ~node_size, ~directed,
"T054717", "irrelevant", 10, TRUE,
"T095006", "irrelevant", 10, FALSE,
"T088658", "irrelevant", 10, TRUE,
"T069179", "irrelevant", 10, FALSE,
"T009515", "irrelevant", 10, TRUE,
"T152167", "irrelevant", 10, FALSE,
"T100447", "irrelevant", 10, TRUE,
"T150659", "irrelevant", 10, FALSE
)
links_df <- tibble::tribble(
~tid1, ~tid2, ~edge_dir,
0, 1, 10,
0, 2, 10,
0, 3, 10,
1, 3, 10,
2, 4, 5,
2, 5, 5,
3, 6, 5,
4, 5, 5,
5, 6, 5,
5, 6, 5
)
network <- forceNetwork (Links = links_df,
Nodes = node_df,
Source = "tid1",
Target = "tid2",
Value = "edge_dir",
NodeID = "node_id",
Nodesize = "node_size",
Group = "node_type",
colourScale = JS("d3.scaleOrdinal(d3.schemeCategory20);"),
fontSize = 10,
linkDistance = 100,
radiusCalculation = JS(" Math.sqrt(d.nodesize)+6"),
charge = -30,
linkColour = ifelse(links_df$edge_dir == 10, "black","red"),
opacity = 1,
zoom = TRUE,
arrows = ifelse(links_df$edge_dir == 10, TRUE, FALSE),
opacityNoHover = TRUE,
clickAction = NULL)
htmlwidgets::onRender(network, '
function(el) {
d3.select("svg")
.selectAll(".link")
.filter(function(d) { return d.value == 5; })
.style("marker-end", null);
}')

R plotly scatter3d: How to make nearest marker appear the biggest?

Currently my code looks like this:
library(plotly)
count = data.frame(
row.names = c("Cell1", "Cell2", "Cell3", "Cell4", "Cell5", "Cell6"),
Gene1 = c(10, 11, 8, 3, 2, 1),
Gene2 = c(6, 4, 5, 3, 2.8, 1),
Gene3 = c(12, 9, 10, 2.5, 1.3, 2),
Gene4 = c(5, 7, 6, 2, 4, 7),
stringsAsFactors = FALSE
)
threeD = plotly::plot_ly(
data = count,
x = ~Gene1,
y = ~Gene2,
z = ~Gene3,
type = "scatter3d",
mode = "markers",
marker = list(size = 20),
color = row.names(count)
)
threeD
This code generates following output:
I would like to make the marker scale with the distance. So the markers nearest to "me" is bigger (Cell1 & Cell 2) and the markers far away appear smaller (Cell5 & Cell6). This would achieve a more realistic 3D feeling.
It's possible to make a kind of "bubble" plot by assigning a list of size to the markers so that they grow according to their respective value along the z-axis. The simplest way is to reuse the same data and apply some scaling function (product, log, etc.) as needed for example :
marker = list(size = c(12, 9, 10, 2.5, 1.3, 2)*5)
The problem is that if you change your point of view, the markers won't update magically for the intended 3D feeling.
You can also use color scaling by adding the colorscale property to the marker object, for example :
colorscale = c('#FFE1A1', '#683531')

R circlize chordDiagram how to improve image qualiity

I am attempting to make a chord diagram of a fairly large 18*65 table (not every cell has a value).
I have generated the image I want but the quallity of it is nothing like what is shown on the github seen below:
I figure maybe the number of cells needing to be plotted may cause problems but otherwise I am not sure why i get such a difference:
circos.par(gap.after = c(rep(2, ncol(chord_data)-1), 10, rep(2, 8-1), 5, rep(2, 10-1), 5, rep(2, 5-1), 5, rep(2, 3-1), 5, rep(2, 1), 5, rep(2, 12-1), 5, rep(2, 10-1), 5, rep(2, 6-1), 5, rep(2, 7-1), rep(2, 3-1), 10))
png(file = "antismash_by_type.png", width = 800, height = 800)
chordDiagram(chord_data,
grid.col = grid.col,
order = order,
annotationTrack = "grid",
preAllocateTracks = 1)
circos.track(track.index = 1, panel.fun = function(x, y) {
circos.text(CELL_META$xcenter, CELL_META$ylim[1], CELL_META$sector.index,
facing = "clockwise", niceFacing = TRUE, adj = c(0, 0.5))
}, bg.border = NA)
dev.off()
Secondly my chords do not appear to be scaling to the value of the cell which ranges from 0-100 and from what I read this is meant to occure by default but does not appear to be.

Parts Missing From Plot, That then Reappear and Overwrite The Entire Plot When Saved? (R, Heatmap.2)

I'm using heatmap.2 to create a plot, however, the initial plot that is saved to my source folder is missing a key and title.
When I then run the dev.off() command, the Key and the Title are then used to overwrite the original graph?
For instance, I will produce a plot like this:
Which is far from perfect. But then when I run the dev.off() to close the device (otherwise a host of other errors ensue):
What you are looking at above is a very distorted Key and my 'XYZ' title.
Why on earth is it creating two files, firstly the one with my matrix, and then overwriting this with a second file containing my flipping key and my title? I cannot follow the logic.
I've updated my OS, my version of R, RStudio, all my packages and unistalled RStudio. Nothing seems to help.
If you'd like to try and replicate my error here is the example matrix:
structure(c(1, 4, 5, 3, 3, 4, 6, 1, 7, 5, 5, 4, 4, 8, 1, 3, 9,
2, 2, 9, 3, 1, 3, 4, 4, 5, 5, 5, 1, 4, 4, 3, 3, 3, 9, 1), .Dim = c(6L,
6L))
And this is the script I'm using to plot my example data. You'll need to provide a SourceDir and make sure you assign the matrix to the name "Matrix".
if (!require("gplots")) {
install.packages("gplots", dependencies = TRUE)
library(gplots)
}
if (!require("RColorBrewer")) {
install.packages("RColorBrewer", dependencies = TRUE)
library(RColorBrewer)
}
my_palette <- colorRampPalette(c("snow", "yellow", "darkorange", "red"))(n = 399)
transition
col_breaks = c(seq(0,1,length=100), #white 'snow'
seq(2,4,length=100), # for yellow
seq(5,7,length=100), # for orange 'darkorange'
seq(8,9,length=100)) # for red
png(paste(SourceDir, "Heatmap_Test.png"),
width = 5*1000,
height = 5*1000,
res = 300,
pointsize =15)
heatmap.2(Matrix,
main = paste("XYZ"),
notecol="black",
key = "true" ,
colsep = c(3, 6, 9),
rowsep = c(3, 6, 9),
labCol = NULL,
labRow = NULL,
sepcolor="white",
sepwidth=c(0.08,0.08),
density.info="none",
trace="none",
margins=c(1,1),
col=my_palette,
breaks=col_breaks,
dendrogram="none",
RowSideColors = c(rep("blue", 3), rep("orange", 3)),
ColSideColors = c(rep("blue", 3), rep("orange", 3)),
srtCol = 0 ,
asp = 1 ,
adjCol = c(NA, 0) ,
adjRow = c(0, NA) ,
#keysize = 2 ,
Colv = FALSE ,
Rowv = FALSE ,
key.xlab = paste("Correlation") ,
cexRow = (1.8) ,
cexCol = (1.8) ,
notecex = (1.5) ,
lmat = rbind(c(0,0,0,0), c(0,0,2,0),c(0,1,3,0),c(0,0,0,0)) ,
#par(ColSideColors = c(2,2)),
lhei = c(1, 1, 3, 1) ,
lwid = c(1, 1, 3, 1))
dev.off()
I'd really appreciate any insight into this problem.
I believe this resulted from the fact that I had more than just elements 1 to four, as the coloured rows I had added counted as additional elements that had to be arranged in the display matrix.
As such:
mat = rbind(c(0,0,0,0), c(0,0,2,0),c(0,1,3,0),c(0,0,0,0)) ,
lhei = c(1, 1, 3, 1) ,
lwid = c(1, 1, 3, 1))
No longer cut the butter. After much ado, I finally managed to get the following layout to work (on my actual data, not my example data).
lmat = rbind(c(0,4,5,0), c(0,0,2,0),c(0,1,3,0),c(0,0,6,0)) ,
lhei = c(0.4, 0.16, 3, 0.4) , # Alter dimensions of display array cell heighs
lwid = c(0.4, 0.16, 3, 0.4),
Notice the inclusion of elements 5 and 6.
So my final command looks like this (note that there will be many other changes but the real progress happened once I added in 5 and 6):
png(paste(SourceDir, "XYZ.png"),
width = 5*1500,
height = 5*1500,
res = 300, # 300 pixels per inch
pointsize =30)
heatmap.2(CombinedMtx,
main = paste("XYZ"), # heat map title
notecol="black",
key = "true" ,# change font color of cell labels to black
colsep = c(6, 12, 18),
labCol = c(" "," "," ", "XX"," "," "," "," "," ", "YY"," "," "," "," "," ", "ZZ"," "," "," "," "," ", "QQ"),
rowsep = c(6, 12, 18),
labRow = c(" "," "," ", "XX"," "," "," "," "," ", "YY"," "," "," "," "," ", "ZZ"," "," "," "," "," ", "QQ"),
sepcolor="white",
sepwidth=c(0.08,0.08),
density.info="none",
trace="none",
margins=c(1,1),
col=my_palette,
breaks=col_breaks,
dendrogram="none",
RowSideColors = c(rep("#deebf7", 6), rep("#1c9099", 6), rep("#addd8e", 6), rep("#fee391", 6)),
ColSideColors = c(rep("#deebf7", 6), rep("#1c9099", 6), rep("#addd8e", 6), rep("#fee391", 6)),
srtCol = 0 ,
asp = 1 ,
adjCol = c(1.5, -61.5) ,
adjRow = c(0, -1.38),
offsetRow = (-59.5),
keysize = 2 ,
Colv = FALSE ,
Rowv = FALSE ,
key.xlab = NA ,
key.ylab = NULL ,
key.title = NA ,
cexRow = (1.6) ,
cexCol = (1.6) ,
notecex = (1.5) ,
cex.main = (20),
lmat = rbind(c(0,4,5,0), c(0,0,2,0),c(0,1,3,0),c(0,0,6,0)) ,
#par(ColSideColors = c(2,2)),
lhei = c(0.4, 0.16, 3, 0.4) , # Alter dimensions of display array cell heighs
lwid = c(0.4, 0.16, 3, 0.4),
symkey = any(0.5 < 0, na.rm=FALSE) || col_breaks,
key.par=list(mar=c(3.5,0, 1.8,0) ) #tweak specific key paramters
)
dev.off()
Also, if you don't start each time by creating the PNG and enf each time by using dev.off() it won't work. I believe this might also have been contribution to my confusion, and potentially after drawing the heatmap, some elements were being drawn once the dev.off() command was run, causing the heatmap to be overwritten.
This (with my matrix) creates this image.
What I have done is a really gammy way of labelling my blocks but until I can work out how to get ComplexHeatmap working properly I'll be stuck using hacks like this with Heatmap.2.

Plotting with Vennerable package in R

Here is a very basic example:
library(vennerable)
srl.venn <- Venn(SetNames=c("Cognitive condition","Operations","Individual differences"),
Weight=c(0,30, 21, 15, 1, 8, 3, 6))
plot(srl.venn)
All I'm trying to do is to remove borders around circles, and format colors and fonts. However, still haven't done much.
Could you please share any useful examples?
Check out VennThemes for changing parameters within the plot. For example:
library(Vennerable)
srl.venn <- Venn(SetNames=c("Cognitive condition","Operations","Individual differences"),
Weight=c(0,30, 21, 15, 1, 8, 3, 6))
srl.venn.c <- compute.Venn(srl.venn, doWeights=T)
gp <- VennThemes(srl.venn.c, colourAlgorithm = "binary")
plot(srl.venn.c, gpList = gp, show = list(FaceText = "signature", SetLabels = FALSE,
Faces = FALSE, DarkMatter = FALSE))
More detail can be found in the man pages or by calling vignette("Venn")

Resources