Find maximum depth of nested parenthesis in a string R code - r

I have a problem to finish this R code. We are given a string having parenthesis like below
“( ((X)) (((Y))) )”
We need to find the maximum depth of balanced parenthesis, like 4 in above example. Since ‘Y’ is surrounded by 4 balanced parenthesis.
If parenthesis are unbalanced then return -1
My code looks like this:
current_max = 0
max = 0
def = function (S){
n=S
for (i in nchar(n))
if (is.element('(',n[i]))
{
current_max <- current_max + 1
}
if (current_max > max)
{
max <- current_max
}
else if (is.element(')',n[i]))
{
if (current_max > 0)
{
current_max <- current_max - 1
}
else
{
return -1
}
}
if (current_max != 0)
{
return -1
}
return (max)
}
but when i call function def("(A((B)))") answer should be 2. But every time it shows 0 even when the parenthesis is unbalanced. Im not sure if the code is correct or where is the mistake. Im trying to learn R so be patient with me. Thanks

If x <- "( ((X)) (((Y))) )", then remove all of the non-parentheses and split into characters...
y <- unlist(strsplit(gsub("[^\\(\\)]", "", x), ""))
y
[1] "(" "(" "(" ")" ")" "(" "(" "(" ")" ")" ")" ")"
and then the maximum nesting is the highest cumulative sum of +1 (for () and -1 (for ))...
z <- max(cumsum(ifelse(y=="(", 1, -1)))
z
[1] 4
If the parentheses are unbalanced then sum(ifelse(y=="(", 1, -1))) will not equal zero.

Here are three solutions. They are all vectorized, i.e. the input x can be a character vector, and they all handle the case of no parentheses properly.
1) strapply/proto strapply in the gsubfn packages matches the regular expression given as the second argument running the function fun in the proto object p which should also be passed to strapply. The pre function in p initializes the calculation for each component of the input x. The proto object can be used to retain memory of past matches (here lev is the nesting level) allowing counting to be done. We append an arbitrary character, here "X" to each string to ensure that there is always at least one match. If we knew there were no zero length character string inputs this could be omitted. The sapply uses Max which takes the maximum of the returned depths or returns -1 if no balance.
library(gsubfn) # also pulls in proto
# test input
x <- c("(A((B)))", "((A) ((())) (B))", "abc", "", "(A)((B)", "(A(B)))")
p <- proto(pre = function(.) .$lev <- 0,
fun = function(., x) .$lev <- .$lev + (x == "(") - (x == ")") )
Max <- function(x) if (tail(x, 1) == 0 && min(x) == 0) max(x) else -1
sapply(strapply(paste(x, "X"), ".", p), Max)
## [1] 3 4 0 0 -1 -1
2) Reduce This is a base solution. It makes use of Max from (1).
fun <- function(lev, char) lev + (char == "(") - (char == ")")
sapply(x, function(x) Max(Reduce(fun, init = 0, unlist(strsplit(x, "")), acc = TRUE)))
(A((B))) ((A) ((())) (B)) abc
3 4 0 0
(A)((B) (A(B)))
-1 -1
3) strapply/list Another possibility is to extract the parentheses and return with +1 or -1 for ( and ) using strapply with a replacement list. Then run cumsum and Max (from above) over that.
library(gsubfn)
fn$sapply(strapply(x, "[()]", list("(" = +1, ")" = -1), empty = 0), ~ Max(cumsum(x)))
## [1] 3 4 0 0 -1 -1

Related

Add 1 to the first even digit in a srting

I have a vector of numeric values in R
x <- c(4320, 5400, 6786)
For each of this values I want to get a new value, where I sum 1 to the first non 0 even digit (starting from the right). The resulting vector should be:
[1] 4330 5500 6787
I haven't made any progresses so far. For numbers with only four digits, as in the example, I guess this could be accomplished with stringr and ifelse statements, iterating through each digit. But I was looking for a more general solution.
EDIT
Additionally I also want to convert all the digits to the right of the focal number to 0. So I build on one of the solutions by #onyambu to get a slightly modified version.
x <- c(432095, 540100, 678507)
fun <- function(x){
y <- max(which(as.numeric(x) %%2 == 0 & x!='0'))
x[y]<- as.numeric(x[y]) + 1
x[(y+1):length(x)] <- 0 # line added to convert digits to the right to 0
as.numeric(paste0(x, collapse=''))
}
y = sapply(strsplit(as.character(x), ''), fun)
print(y)
[1] 433000 550000 679000
Using Recursion and only numerical operations:
fun <- function(x, ten_times = 0, rem=0 ){
if(floor(x/10) == x/10) # is divisible by 10? remove the zero
Recall(x/10, ten_times + 1, rem)
else if (x%%2 == 1) # is odd remove the odd and store it go to next digit
Recall(x%/%10, ten_times+1, rem + (x%%10)*10^ten_times)
else # add one to the even and also add back the remainder to the number
(x + 1) * 10^ten_times + rem
}
sapply(x, fun)
[1] 4330 5500 6787
Note that we could use vectorized ifelse with the same logic above to carry out the operation in a vectorized manner. Though you might want to increase the recursion depth. Probably stick with the non-vectorized version above and the use sapply
fun <- function(x, ten_times = 0, rem=0 ){
ifelse(floor(x/10) == x/10, Recall(x/10, ten_times + 1, rem),
ifelse(x%%2 == 1, Recall(x%/%10, ten_times+1, rem + (x%%10)*10^ten_times),
(x+1)*10^ten_times + rem))
}
fun(x)
[1] 4330 5500 6787
Note that this will throw an error if the number is purely made up of non-even numbers. eg fun(1111) will throw an error.
EDIT:
If you need all the values after the even number to be zero, change this into:
fun <- function(x, ten_times = 0){
if(floor(x/10) == x/10) Recall(x/10, ten_times + 1)
else if (x%%2 == 1)Recall(x%/%10, ten_times+1)
else (x + 1) * 10^ten_times
}
sapply(x, fun)
[1] 433000 550000 679000
Also seems like a ceiling problem:
y <- sapply(strsplit(as.character(x),''),
\(x)max(which(!as.numeric(x) %% 2 & x!='0'))) - nchar(x)
ceiling(x * 10^y)/10^y
[1] 433000 550000 679000
fun <- function(x){
y <- max(which(as.numeric(x) %%2 == 0 &x!='0'))
x[y]<- as.numeric(x[y]) + 1
as.numeric(paste0(x, collapse=''))
}
sapply(strsplit(as.character(x), ''), fun)
[1] 4330 5500 6787
Try this function
fn <- function(x) {
y <- x ; add <- 1
while(x != 0){
if(x %% 10 != 0 & x %% 2 == 0 ) {
y <- y + add
break
}
x <- floor(x/10)
add <- add * 10
}
y
}
fn <- Vectorize(fn)
fn(x)
#> [1] 4330 5500 6787
Another possible solution:
library(tidyverse)
str_split(x, "", simplify = T) %>%
type.convert(as.is = T) %>%
apply(1, \(x) {which.max(cumsum(x %% 2 == 0 & x != 0)) %>%
{x[.] <<- x[.] + 1}; x %>% str_c(collapse = "") %>% parse_integer})
#> [1] 4330 5500 6787
1) gsubfn Using gsubfn we can get a 2 line solution. gsubfn is like gsub except the second argument can be a function, possibly expressed in formula notation instead of a replacement string. The match to each capture group (portion in parenthesis) in the regular expression is passed as a separate argument to the function and the result is the output of the function.
In this case there are 3 capture groups which represent the prefix (p), the digit (d) and the suffix (s). The formula representation of the function is the body and the arguments are the free variables in the body in the order encountered.
library(gsubfn)
x1 <- c(4320, 5400, 6786)
f1 <- ~ paste0(p, as.numeric(d) + 1, s)
gsubfn("(.*)([2468])(.*)", f1, as.character(x1)) |> as.numeric()
## [1] 4330 5500 6787
To do that plus replace remaining characters after the transformed one to zero
x2 <- c(432095, 540100, 678507)
f2 <- ~ paste0(p, as.numeric(d) + 1, gsub(".", 0, s))
gsubfn("(.*)([2468])(.*)", f2, as.character(x2)) |> as.numeric()
## [1] 433000 550000 679000
2) Base R This base R solution extracts the prefix, digit and suffix using sub and then transforms the digit and pastes them back together.
pat <- "(.*)([2468])(.*)"
as.numeric(paste0(
sub(pat, "\\1", x1),
as.numeric(sub(pat, "\\2", x1)) + 1,
sub(pat, "\\3", x1)
))
## [1] 4330 5500 6787
or performing the same operation and zeroing out the suffix:
pat <- "(.*)([2468])(.*)"
as.numeric(paste0(
sub(pat, "\\1", x2),
as.numeric(sub(pat, "\\2", x2)) + 1,
gsub(".", 0, sub(pat, "\\3", x2))
))
## [1] 433000 550000 679000

simple function to count plus 1 and negative 1

I am trying to develop a really simple function in r, the idea is that;
Say I have the following sequence "UUDDDDUDU" where "U" = 1 and "D" = -1. I want to count the following: +1, +1, -1, -1, -1, -1, +1, -1, +1. Where I get the final number as -1.
funky <- function(n, s){
current_level = 0
U = 1
D = -1
for(i in 1:n){
if(s[i] == "U"){current_level +1}
if(s[i] == "D"){current_level -1}
}
}
funky(9, UUDDDDUDU)
Any pointers in the right direction would be great!
You could use stringr::str_count
s <- "UUDDDDUDU"
library(stringr)
str_count(s, 'U') - str_count(s, 'D')
# [1] -1
or more generally
library(purrr)
weights <- c(U = 1L, D = -1L)
sum(imap_int(weights, ~str_count(s, .y)*.x))
# [1] -1
Base R solution (using weights and s as defined above)
sum(weights[strsplit(s, '')[[1]]])
# [1] -1
These methods are in base R and should work with vectors
x = "UUDDDDUDU"
1
with(data.frame(t(sapply(strsplit(x, ""), table))), U - D)
#[1] -1
2
foo = function(p, s) {
sapply(gregexpr(p, s), function(x) sum(x > 0))
}
foo("U", x) + (-1 * foo("D", x))
#[1] -1
3
2 * nchar(gsub("D", "", x)) - nchar(x)
#[1] -1
Here is a method making use of reticulate
library(reticulate)
s <- "UUDDDDUDU"
repl_python()
>>> from collections import Counter
>>> sum([a* b for a, b in zip(Counter(list(r.s)).values(), [1, -1])])
#-1
Just for fun (and vectorised)...
s <- c("UUDDDDUDU", "UUDUU", "DDDDDUD")
sapply(parse(text=as.expression(gsub("(.)","\\11",chartr("UD","+-",s)))),eval)
[1] -1 3 -5
This translates as...
replace U with +, and D with - (chartr)
replace every character with that character followed by 1 (gsub)
and evaluate these character strings ("+1+1-1-1-1" etc) as expressions

printing matrices and vectors side by side

For tutorial purposes, I'd like to be able to print or display matrices and vectors side-by-side, often to illustrate the result of a matrix equation, like $A x = b$.
I could do this using SAS/IML, where the print statement takes an arbitrary collection of (space separated) expressions, evaluates them and prints the result, e.g.,
print A ' * ' x '=' (A * x) '=' b;
A X #TEM1001 B
1 1 -4 * 0.733 = 2 = 2
1 -2 1 -0.33 1 1
1 1 1 -0.4 0 0
Note that quoted strings are printed as is.
I've searched, but can find nothing like this in R. I imagine something like this could be done by a function showObj(object, ...) taking its list of arguments, formatting each to a block of characters, and joining them side-by-side.
Another use of this would be a compact way of displaying a 3D array as the side-by-side collection of its slices.
Does this ring a bell or does anyone have a suggestion for getting started?
I have created a very simple function that can print matrices and vectors with arbitrary character strings (typically operators) in between. It allows for matrices with different numbers of rows and treats vectors as column matrices. It is not very elaborate, so I fear there are many examples where it fails. But for an example as simple as the one in your question, it should be enough.
format() is used to convert the numbers to characters. This has the advantage that all the rows of the matrix have the same width and are thus nicely aligned when printed. If needed, you could add some of the arguments of format() also as arguments mat_op_print() to make the configurable. As an example, I have added the argument width that can be used to control the minimal width of the columns.
If the matrices and vectors are name in the function call, these names are printed as headers in the first line. Otherwise, only the numbers are printed.
So, this is the function:
mat_op_print <- function(..., width = 0) {
# get arguments
args <- list(...)
chars <- sapply(args, is.character)
# auxilliary function to create character of n spaces
spaces <- function(n) paste(rep(" ", n), collapse = "")
# convert vectors to row matrix
vecs <- sapply(args, is.vector)
args[vecs & !chars] <- lapply(args[vecs & !chars], function(v) matrix(v, ncol = 1))
# convert all non-characters to character with format
args[!chars] <- lapply(args[!chars], format, width = width)
# print names as the first line, if present
arg_names <- names(args)
if (!is.null(arg_names)) {
get_title <- function(x, name) {
if (is.matrix(x)) {
paste0(name, spaces(sum(nchar(x[1, ])) + ncol(x) - 1 - nchar(name)))
} else {
spaces(nchar(x))
}
}
cat(mapply(get_title, args, arg_names), "\n")
}
# auxiliary function to create the lines
get_line <- function(x, n) {
if (is.matrix(x)) {
if (nrow(x) < n) {
spaces(sum(nchar(x[1, ])) + ncol(x) - 1)
} else {
paste(x[n, ], collapse = " ")
}
} else if (n == 1) {
x
} else {
spaces(nchar(x))
}
}
# print as many lines as needed for the matrix with most rows
N <- max(sapply(args[!chars], nrow))
for (n in 1:N) {
cat(sapply(args, get_line, n), "\n")
}
}
And this is an example of how it works:
A = matrix(c(0.5, 1, 3, 0.75, 2.8, 4), nrow = 2)
x = c(0.5, 3.7, 2.3)
y = c(0.7, -1.2)
b = A %*% x - y
mat_op_print(A = A, " * ", x = x, " - ", y = y, " = ", b = b, width = 6)
## A x y b
## 0.50 3.00 2.80 * 0.5 - 0.7 = 17.090
## 1.00 0.75 4.00 3.7 -1.2 13.675
## 2.3
Also printing the slices of a 3-dimensional array side-by-side is possible:
A <- array(1:12, dim = c(2, 2, 3))
mat_op_print(A1 = A[, , 1], " | ", A2 = A[, , 2], " | ", A3 = A[, , 3])
## A1 A2 A3
## 1 3 | 5 7 | 9 11
## 2 4 6 8 10 12

How to transform solution of Ryacas into character string?

I want to get out the solution Ryacas gives me as a character string - but it doesn't work:
> require("Ryacas")
> x <- Sym("x")
> expr <- Solve(x + 1 == 0, x)
> expr
expression(list(x == -1))
> as.character(expr)
[1] "( Solve( ( ( x + 1 ) == 0 ) , x ) )"
Strangely enough when I print the variable I get the solution but when I try to read it out as a string I get the original equation.
My question
How can I transform the solution of Ryacas into a character string? (So that I can modify it further with standard R?)
If you want to get that expression into a string, you should use Eval() to get the results of evaluation
Eval(expr)
# [[1]]
# expression(x == -1)
if you want to extract the result as a character, in this case you can do
Eval(expr)[[1]][[1]]
# [1] "( x == -1 )"

how to return number of decimal places in R

I am working in R. I have a series of coordinates in decimal degrees, and I would like to sort these coordinates by how many decimal places these numbers have (i.e. I will want to discard coordinates that have too few decimal places).
Is there a function in R that can return the number of decimal places a number has, that I would be able to incorporate into function writing?
Example of input:
AniSom4 -17.23300000 -65.81700
AniSom5 -18.15000000 -63.86700
AniSom6 1.42444444 -75.86972
AniSom7 2.41700000 -76.81700
AniLac9 8.6000000 -71.15000
AniLac5 -0.4000000 -78.00000
I would ideally write a script that would discard AniLac9 and AniLac 5 because those coordinates were not recorded with enough precision. I would like to discard coordinates for which both the longitude and the latitude have fewer than 3 non-zero decimal values.
You could write a small function for the task with ease, e.g.:
decimalplaces <- function(x) {
if ((x %% 1) != 0) {
nchar(strsplit(sub('0+$', '', as.character(x)), ".", fixed=TRUE)[[1]][[2]])
} else {
return(0)
}
}
And run:
> decimalplaces(23.43234525)
[1] 8
> decimalplaces(334.3410000000000000)
[1] 3
> decimalplaces(2.000)
[1] 0
Update (Apr 3, 2018) to address #owen88's report on error due to rounding double precision floating point numbers -- replacing the x %% 1 check:
decimalplaces <- function(x) {
if (abs(x - round(x)) > .Machine$double.eps^0.5) {
nchar(strsplit(sub('0+$', '', as.character(x)), ".", fixed = TRUE)[[1]][[2]])
} else {
return(0)
}
}
Here is one way. It checks the first 20 places after the decimal point, but you can adjust the number 20 if you have something else in mind.
x <- pi
match(TRUE, round(x, 1:20) == x)
Here is another way.
nchar(strsplit(as.character(x), "\\.")[[1]][2])
Rollowing up on Roman's suggestion:
num.decimals <- function(x) {
stopifnot(class(x)=="numeric")
x <- sub("0+$","",x)
x <- sub("^.+[.]","",x)
nchar(x)
}
x <- "5.2300000"
num.decimals(x)
If your data isn't guaranteed to be of the proper form, you should do more checking to ensure other characters aren't sneaking in.
Not sure why this simple approach was not used above (load the pipe from tidyverse/magrittr).
count_decimals = function(x) {
#length zero input
if (length(x) == 0) return(numeric())
#count decimals
x_nchr = x %>% abs() %>% as.character() %>% nchar() %>% as.numeric()
x_int = floor(x) %>% abs() %>% nchar()
x_nchr = x_nchr - 1 - x_int
x_nchr[x_nchr < 0] = 0
x_nchr
}
> #tests
> c(1, 1.1, 1.12, 1.123, 1.1234, 1.1, 1.10, 1.100, 1.1000) %>% count_decimals()
[1] 0 1 2 3 4 1 1 1 1
> c(1.1, 12.1, 123.1, 1234.1, 1234.12, 1234.123, 1234.1234) %>% count_decimals()
[1] 1 1 1 1 2 3 4
> seq(0, 1000, by = 100) %>% count_decimals()
[1] 0 0 0 0 0 0 0 0 0 0 0
> c(100.1234, -100.1234) %>% count_decimals()
[1] 4 4
> c() %>% count_decimals()
numeric(0)
So R does not seem internally to distinguish between getting 1.000 and 1 initially. So if one has a vector input of various decimal numbers, one can see how many digits it initially had (at least) by taking the max value of the number of decimals.
Edited: fixed bugs
If someone here needs a vectorized version of the function provided by Gergely Daróczi above:
decimalplaces <- function(x) {
ifelse(abs(x - round(x)) > .Machine$double.eps^0.5,
nchar(sub('^\\d+\\.', '', sub('0+$', '', as.character(x)))),
0)
}
decimalplaces(c(234.1, 3.7500, 1.345, 3e-15))
#> 1 2 3 0
I have tested some solutions and I found this one robust to the bugs reported in the others.
countDecimalPlaces <- function(x) {
if ((x %% 1) != 0) {
strs <- strsplit(as.character(format(x, scientific = F)), "\\.")
n <- nchar(strs[[1]][2])
} else {
n <- 0
}
return(n)
}
# example to prove the function with some values
xs <- c(1000.0, 100.0, 10.0, 1.0, 0, 0.1, 0.01, 0.001, 0.0001)
sapply(xs, FUN = countDecimalPlaces)
In [R] there is no difference between 2.30000 and 2.3, both get rounded to 2.3 so the one is not more precise than the other if that is what you want to check. On the other hand if that is not what you meant: If you really want to do this you can use 1) multiply by 10, 2) use floor() function 3) divide by 10 4) check for equality with the original. (However be aware that comparing floats for equality is bad practice, make sure this is really what you want)
For the common application, here's modification of daroczig's code to handle vectors:
decimalplaces <- function(x) {
y = x[!is.na(x)]
if (length(y) == 0) {
return(0)
}
if (any((y %% 1) != 0)) {
info = strsplit(sub('0+$', '', as.character(y)), ".", fixed=TRUE)
info = info[sapply(info, FUN=length) == 2]
dec = nchar(unlist(info))[seq(2, length(info), 2)]
return(max(dec, na.rm=T))
} else {
return(0)
}
}
In general, there can be issues with how a floating point number is stored as binary. Try this:
> sprintf("%1.128f", 0.00000000001)
[1] "0.00000000000999999999999999939458150688409432405023835599422454833984375000000000000000000000000000000000000000000000000000000000"
How many decimals do we now have?
Interesting question. Here is another tweak on the above respondents' work, vectorized, and extended to handle the digits on the left of the decimal point. Tested against negative digits, which would give an incorrect result for the previous strsplit() approach.
If it's desired to only count the ones on the right, the trailingonly argument can be set to TRUE.
nd1 <- function(xx,places=15,trailingonly=F) {
xx<-abs(xx);
if(length(xx)>1) {
fn<-sys.function();
return(sapply(xx,fn,places=places,trailingonly=trailingonly))};
if(xx %in% 0:9) return(!trailingonly+0);
mtch0<-round(xx,nds <- 0:places);
out <- nds[match(TRUE,mtch0==xx)];
if(trailingonly) return(out);
mtch1 <- floor(xx*10^-nds);
out + nds[match(TRUE,mtch1==0)]
}
Here is the strsplit() version.
nd2 <- function(xx,trailingonly=F,...) if(length(xx)>1) {
fn<-sys.function();
return(sapply(xx,fn,trailingonly=trailingonly))
} else {
sum(c(nchar(strsplit(as.character(abs(xx)),'\\.')[[1]][ifelse(trailingonly, 2, T)]),0),na.rm=T);
}
The string version cuts off at 15 digits (actually, not sure why the other one's places argument is off by one... the reason it's exceeded through is that it counts digits in both directions so it could go up to twice the size if the number is sufficiently large). There is probably some formatting option to as.character() that can give nd2() an equivalent option to the places argument of nd1().
nd1(c(1.1,-8.5,-5,145,5,10.15,pi,44532456.345243627,0));
# 2 2 1 3 1 4 16 17 1
nd2(c(1.1,-8.5,-5,145,5,10.15,pi,44532456.345243627,0));
# 2 2 1 3 1 4 15 15 1
nd1() is faster.
rowSums(replicate(10,system.time(replicate(100,nd1(c(1.1,-8.5,-5,145,5,10.15,pi,44532456.345243627,0))))));
rowSums(replicate(10,system.time(replicate(100,nd2(c(1.1,-8.5,-5,145,5,10.15,pi,44532456.345243627,0))))));
Don't mean to hijack the thread, just posting it here as it might help someone to deal with the task I tried to accomplish with the proposed code.
Unfortunately, even the updated #daroczig's solution didn't work for me to check if a number has less than 8 decimal digits.
#daroczig's code:
decimalplaces <- function(x) {
if (abs(x - round(x)) > .Machine$double.eps^0.5) {
nchar(strsplit(sub('0+$', '', as.character(x)), ".", fixed = TRUE)[[1]][[2]])
} else {
return(0)
}
}
In my case produced the following results
NUMBER / NUMBER OF DECIMAL DIGITS AS PRODUCED BY THE CODE ABOVE
[1] "0.0000437 7"
[1] "0.000195 6"
[1] "0.00025 20"
[1] "0.000193 6"
[1] "0.000115 6"
[1] "0.00012501 8"
[1] "0.00012701 20"
etc.
So far was able to accomplish the required tests with the following clumsy code:
if (abs(x*10^8 - floor(as.numeric(as.character(x*10^8)))) > .Machine$double.eps*10^8)
{
print("The number has more than 8 decimal digits")
}
PS: I might be missing something in regard to not taking the root of the .Machine$double.eps so please take caution
Another contribution, keeping fully as numeric representations without converting to character:
countdecimals <- function(x)
{
n <- 0
while (!isTRUE(all.equal(floor(x),x)) & n <= 1e6) { x <- x*10; n <- n+1 }
return (n)
}
Vector solution based on daroczig's function (can also deal with dirty columns containing strings and numerics):
decimalplaces_vec <- function(x) {
vector <- c()
for (i in 1:length(x)){
if(!is.na(as.numeric(x[i]))){
if ((as.numeric(x[i]) %% 1) != 0) {
vector <- c(vector, nchar(strsplit(sub('0+$', '', as.character(x[i])), ".", fixed=TRUE)[[1]][[2]]))
}else{
vector <- c(vector, 0)
}
}else{
vector <- c(vector, NA)
}
}
return(max(vector))
}
as.character uses scientific notation for numbers that are between -1e-4 and 1e-4 but not zero:
> as.character(0.0001)
[1] "1e-04"
You can use format(scientific=F) instead:
> format(0.0001,scientific=F)
[1] "0.0001"
Then do this:
nchar(sub("^-?\\d*\\.?","",format(x,scientific=F)))
Or in vectorized form:
> nplaces=function(x)sapply(x,function(y)nchar(sub("^-?\\d*\\.?","",format(y,scientific=F))))
> nplaces(c(0,-1,1.1,0.123,1e-8,-1e-8))
[1] 0 0 1 3 8 8

Resources