I am using the seqLogo package to draw some sequence Logos. I need to make the logos wider, the default drawing makes the logos into square graphs. Is there a way to do this?
You can view the code from seqLogo:
> library(seqLogo)
> seqLogo
function (pwm, ic.scale = TRUE, xaxis = TRUE, yaxis = TRUE, xfontsize = 15, yfontsize = 15)
{
if (class(pwm) == "pwm") {
pwm <- pwm#pwm
}
...
}
<environment: namespace:seqLogo>
>
There are parameters in there that control rendering, which you could adjust by editing the function code. See this SO answer to learn about the fix() function.
Related
I want my function to print nice-looking tables, whether it's called from base R or from an RStudio Notebook (.Rmd file). The function should figure out where it's being called from, and adjust the table accordingly. I want the function to be easy to use, and don't want the user to have to specify anything about where the function is being called from.
I can achieve some of this with huxtable, but the user still has to modify the code a little. (I think this would work similarly with kable.)
Here is the function definition:
library(huxtable)
func = function() {
table = hux(head(iris))
# Color of table border: white on screen / base R, black in HTML
color = if(isTRUE(all.equal(getOption('huxtable.print') , huxtable::print_screen))) "white" else "black"
table = set_all_borders(table, brdr(color = color))
print(table)
}
In base R, I can just call the function:
# Base R
func()
But in an RStudio Notebook, I need to make a couple of changes when calling the function, namely:
{r, results="asis"}
options("huxtable.print" = huxtable::print_html)
The call looks like this:
```{r, results="asis"}
# RStudio
options("huxtable.print" = huxtable::print_html)
func()
```
Is there a better solution where the user can call the function the same way in base R and RStudio?
Maybe something like this?
library(huxtable)
func = function(table) {
html_output = isTRUE(all.equal(getOption('huxtable.print') ,
huxtable::print_html) ||
guess_knitr_output_format() == "html"
color = if(html_output) "black" else "white"
table = set_all_borders(table, brdr(color = color))
print(table)
}
Thanks to #dash2 for giving me the idea. Here is the function that does what I want:
library(huxtable)
func = function() {
table = hux(head(iris))
if (guess_knitr_output_format() == "") { # base R
table = set_all_borders(table, brdr(color = "white"))
print(table, colnames = FALSE)
} else { # knitr / RStudio
table = set_all_borders(table, brdr(color = "black"))
huxtable:::knit_print.huxtable(table, colnames = FALSE)
}
}
func()
I'm trying to draw car trips on a plane. I'm using Plotters library.
Here is some code example of trips' drawing procedure:
pub fn save_trips_as_a_pic<'a>(trips: &CarTrips, resolution: (u32, u32))
{
// Some initializing stuff
/// <...>
let root_area =
BitMapBackend::new("result.png", (resolution.0, resolution.1)).into_drawing_area();
root_area.fill(&WHITE).unwrap();
let root_area =
root_area.margin(10,10,10,10).titled("TITLE",
("sans-serif", 20).into_font()).unwrap();
let drawing_areas =
root_area.split_evenly((cells.1 as usize, cells.0 as usize));
for (index, trip) in trips.get_trips().iter().enumerate(){
let mut chart =
ChartBuilder::on(drawing_areas.get(index).unwrap())
.margin(5)
.set_all_label_area_size(50)
.build_ranged(50.0f32..54.0f32, 50.0f32..54.0f32).unwrap();
chart.configure_mesh().x_labels(20).y_labels(10)
.disable_mesh()
.x_label_formatter(&|v| format!("{:.1}", v))
.y_label_formatter(&|v| format!("{:.1}", v))
.draw().unwrap();
let coors = trip.get_points();
{
let draw_result =
chart.draw_series(series_from_coors(&coors, &BLACK)).unwrap();
draw_result.label(format!("TRIP {}",index + 1)).legend(
move |(x, y)|
PathElement::new(vec![(x, y), (x + 20, y)], &random_color));
}
{
// Here I put red dots to see exact nodes
chart.draw_series(points_series_from_trip(&coors, &RED));
}
chart.configure_series_labels().border_style(&BLACK).draw().unwrap();
}
}
What I got now on Rust Plotters:
So, after drawing it in the 'result.png' image file, I struggle to understand these "lines", because I don't see the map itself. I suppose, there is some way in this library to put a map "map.png" in the background of the plot. If I would use Python, this problem will be solved like this:
# here we got a map image;
img: Image.Image = Image.open("map-image.jpg")
img.putalpha(64)
imgplot = plt.imshow(img)
# let's pretend that we got our map size in pixels and coordinates
# just in right relation to each other.
scale = 1000
x_shift = 48.0
y_shift = 50.0
coor_a = Coordinate(49.1, 50.4)
coor_b = Coordinate(48.9, 51.0)
x_axis = [coor_a.x, coor_b.x]
x_axis = [(element-x_shift) * scale for element in x_axis]
y_axis = [coor_a.y, coor_b.y]
y_axis = [(element-y_shift) * scale for element in y_axis]
plt.plot(x_axis, y_axis, marker='o')
plt.show()
Desired result on Python
Well, that's easy on Python, but I got no idea, how to do similar thing on Rust.
I'm using the bupaR process mining suite and processmapR to plot my log as a process map but when I try to set a custom position (which force the graph to use a neato layout) the edge become almost staight and the edge value hard to read:
Default graph with no custom position:
With custom position:
I tried to use
positions <- data.frame(act = c("node1","node2","node 3","node 4","node 5","Start", "End"),
y = c(5,4,3,2,1,6,0),
x = c(1,2,3,4,5,0,6),
stringsAsFactors = F)
graph = process_map(log, fixed_node_pos = positions, render = F)
map = add_global_graph_attrs(graph,
attr = "splines",
value = "true",
attr_type = "graph")
render_graph(map)
But I could not find any attribute to change the way edge are displayed, like adding more curve to them
How can I fix this problem ?
Thanks
Try the following:
map = add_global_graph_attrs(graph,
attr = "splines",
value = "curved",
attr_type = "graph")
How can I sort/order R6 objects based on an own function value or a compare function value?
I have made up a little example with rectangles that I would like to sort by their area:
library('R6')
Rectangle <- R6Class(
"Rectangle",
public = list(
initialize = function(width, height) {
private$width = width
private$height = height
},
get_area = function(){
private$width*private$height
}
),
private = list(
width = NULL,
height = NULL
)
)
array_of_rects = c( Rectangle$new(7,3), Rectangle$new(5,2), Rectangle$new(3,4))
I would like to sort array_of_rects by their area given by the get_area() function.
I tried different things like:
`>.Rectangle` <- function(e1, e2) { e1[[1]]$get_area() > e2[[1]]$get_area() }
`==.Rectangle` <- function(e1, e2) { e1[[1]]$get_area() == e2[[1]]$get_area() }
sort(array_of_rects)
but without luck (I get an 'x' must be atomic error message).
I tried without the [[1]] (like this e1$get_area()) but this didn't work either.
Searched around but haven't found anything leading me to a solution.
Any suggestions? Thanks in advance!
Well, inspired by https://stackoverflow.com/a/23647092/1935801
I found the following nice and elegant solution
area = function(rect){ rect$get_area() }
sorted_rects = array_of_rects[ order( sapply(array_of_rects, FUN = area) ) ]
At the end of the day works with R6 like with any other class/object.
Consider either function which (for rstudio) will open something in the viewer if y = TRUE and in your browser if y = FALSE. You can force the whatever to open in your browser via options(viewer = NULL) (and then you need to reset to before), but I can't get this to work inside functions using the normal on.exit approach. Tested on windows and osx.
f <- function(x, y = TRUE) {
if (y) {
oo <- getOption('viewer')
on.exit(options(viewer = oo))
options(viewer = NULL)
} else options(viewer = NULL)
print(getOption('viewer'))
DT::datatable(x)
}
g <- function(x, y = TRUE) {
if (y) {
oo <- getOption('viewer')
on.exit(options(viewer = oo))
options(viewer = NULL)
} else options(viewer = NULL)
print(getOption('viewer'))
htmlTable::htmlTable(x)
}
## in rstudio, returns the viewer function
getOption('viewer')
# function (url, height = NULL)
# ...
## opens in viewer despite `options(viewer = NULL)`
g(mtcars)
# NULL
## again returns the function, ie, reset my options to before g call successfully
getOption('viewer')
# function (url, height = NULL)
# ...
## opens in browser but leaves `options(viewer = NULL)` after exiting
g(mtcars, FALSE)
# NULL
getOption('viewer')
# NULL
It seems like the viewer isn't respecting my options within the function environment with either just some html (g) or a widget (f). I thought both would use viewer = NULL inside the function and return my options the way they were upon exiting so that I can control where I want to view the result.
Or is there a better way of doing this for both html and widgets? I have tried the options argument in DT::datatable to no avail, but this wouldn't help for the htmlTable::htmlTable case.
The only other approach I can think of is to write all the code to a temp file and use if (rstudio) rstudio::viewer(tempfile) else browseURL(tempfile) which I think is a lot of work for something seemingly so straight-forward.
Although this isn't a fix, I think it illustrates what's going on. Try adding a Sys.sleep() call in the on.exit() handler:
f <- function(x) {
viewer <- getOption("viewer")
on.exit({
print("Restoring viewer...")
Sys.sleep(3)
options(viewer = viewer)
}, add = TRUE)
options(viewer = NULL)
DT::datatable(x)
}
## opens in viewer despite `options(viewer = NULL)`
f(mtcars)
You'll notice that RStudio doesn't 'decide' what to do with the result of DT::datatable() call until after the on.exit() handler has finished execution. This means that, by the time RStudio wants to figure out to do with the result, the viewer has already been restored! Odds are, RStudio waits until R is no longer 'busy' to decide how to display the resulting content, and by then is too late for temporary changes to the viewer option.
Note that this doesn't explain the htmlTable behaviour. My best guess is that there is some kind of race condition going on; the lost viewer option seems to go away with strategically placed Sys.sleep() calls...
Unfortunately, working around this means avoiding the use of on.exit() call -- unless we can figure out to handle this in RStudio, of course.
Here's one way you could get this functionality by writing the code to a temporary file and using browseURL or whatever you like.
The gist of both f and g are the same, so you could have one function to handle any type of html code or widget I suppose. And probably widgets need to be selfcontained = TRUE.
f <- function(x, y = TRUE) {
x <- if ((inherits(x, 'iplot'))) x else DT::datatable(x)
if (!y) {
htmlFile <- tempfile(fileext = '.html')
htmlwidgets::saveWidget(x, htmlFile, selfcontained = TRUE)
utils::browseURL(htmlFile)
} else x
}
g <- function(x, y = TRUE) {
x <- htmlTable::htmlTable(x)
if (!y) {
htmlFile <- tempfile(fileext = '.html')
writeLines(x, con = htmlFile)
utils::browseURL(htmlFile)
} else x
}
## opens in viewer
g(mtcars)
## opens in browser
g(mtcars, FALSE)
## same for widgets
f(mtcars)
f(mtcars, FALSE)
f(qtlcharts::iplot(1:5, 1:5), FALSE)
## and my options haven't changed
getOption('viewer')
# function (url, height = NULL)
# ...
Side note that this is actually the proper way to have htmlTable::htmlTable use a different viewer, but g should work for any html.
library('htmlTable')
print(htmlTable(mtcars), useViewer = utils::browseURL)