How to represent 4 bit integers properly? - r

I need to convert a matrix to a hex file output. Each entry in the matrix needs to get translated to a 4 bit hex digit (8) and output in a single dimension array.
> matrix(c(0,0,0,5,0,0,5,5,0,0,5,0),nrow=3,ncol=4,byrow=T)
[,1] [,2] [,3] [,4]
[1,] 0 0 0 5
[2,] 0 0 5 5
[3,] 0 0 5 0
This is a 3 row, 4 column matrix with mostly 0s and some 5s. My desired output should be something similar to
#> as.raw(c(0,8,0,136,0,128))
> as.raw(solution)
[1] 00 08 00 88 00 80
I was trying to do some simple
> sidewaysraw<-as.raw(ifelse(mymat==5, 8,0))
but the 8 in the ifelse of course is a 16 bit integer, so it's always an 0x08. I don't see a slick way to translate 55s to 0x88s, 05s to 0x08s and 50s to 0x80s...
Is there a smooth way to get R to work with 4 bit integers?

It seems like you could do some matrix multiplication to help. First we can define a "translation matrix"
digits <- matrix(c(128,8,0,0,0,0,128,8), nrow=4, ncol=2)
Then you can get your numbers out with
(dd==5) %*% digits
# [,1] [,2]
# [1,] 0 8
# [2,] 0 136
# [3,] 0 128
and then extract them in the right order with a transposition
as.raw(t((dd==5) %*% digits))
# [1] 00 08 00 88 00 80
This should be efficient and doesn't bother with string manipulation.

Assuming I understood your question correctly, this solves your problem:
mat <- matrix(c(0,0,0,5,0,0,5,5,0,0,5,0),nrow=3,ncol=4,byrow=T)
mat_new <- matrix(t(mat),ncol=2,byrow=T) #reformat to 2 columns
vec <- apply(mat_new,1,function(row)
{
num <- paste0(row,collapse="") #collapse the rows
if(num == "00") return(as.raw(0)) #switch the resulting char
else if(num == "05") return(as.raw(8))
else if(num == "50") return(as.raw(128))
else if(num == "55") return(as.raw(136))
})
vec
[1] 00 08 00 88 00 80

Related

Loop over matrix using n consecutive rows in R

I have a matrix that consists of two columns and a number (n) of rows, while each row represents a point with the coordinates x and y (the two columns).
This is what it looks (LINK):
V1 V2
146 17
151 19
153 24
156 30
158 36
163 39
168 42
173 44
...
now, I would like to use a subset of three consecutive points starting from 1 to do some fitting, save the values from this fit in another list, an den go on to the next 3 points, and the next three, ... till the list is finished. Something like this:
Data_Fit_Kasa_1 <- CircleFitByKasa(Data[1:3,])
Data_Fit_Kasa_2 <- CircleFitByKasa(Data[3:6,])
....
Data_Fit_Kasa_n <- CircleFitByKasa(Data[i:i+2,])
I have tried to construct a loop, but I can't make it work. R either tells me that there's an "unexpected '}' in "}" " or that the "subscript is out of bonds". This is what I've tried:
minimal runnable code
install.packages("conicfit")
library(conicfit)
CFKasa <- NULL
Data.Fit <- NULL
for (i in 1:length(Data)) {
row <- Data[i:(i+2),]
CFKasa <- CircleFitByKasa(row)
Data.Fit[i] <- CFKasa[3]
}
RStudio Version 0.99.902 – © 2009-2016 RStudio, Inc.; Win10 Edu.
The third element of the fitted circle (CFKasa[3]) represents the radius, which is what I am really interested in. I am really stuck here, please help.
Many thanks in advance!
Best, David
Turn your data into a 3D array and use apply:
DF <- read.table(text = "V1 V2
146 17
151 19
153 24
156 30
158 36
163 39", header = TRUE)
a <- t(DF)
dim(a) <-c(nrow(a), 3, ncol(a) / 3)
a <- aperm(a, c(2, 1, 3))
# , , 1
#
# [,1] [,2]
# [1,] 146 17
# [2,] 151 19
# [3,] 153 24
#
# , , 2
#
# [,1] [,2]
# [1,] 156 30
# [2,] 158 36
# [3,] 163 39
center <- function(m) c(mean(m[,1]), mean(m[,2]))
t(apply(a, 3, center))
# [,1] [,2]
#[1,] 150 20
#[2,] 159 35
center(DF[1:3,])
#[1] 150 20

Implementing the MATLAB filter2 function in R

I am currently implementing the filter2 MATLAB function in R, which is a method for 2D convolution. I have made for the 2D convolution work, but how the 'valid' option in filter2 works is not quite clear to me.
The MATLAB function is described here:
http://se.mathworks.com/help/matlab/ref/filter2.html
My implementation:
filter2D <- function(img, window) {
# Algoritm for 2D Convolution
filter_center_index_y <- median(1:dim(window)[1])
filter_max_index_y <- dim(window)[1]
filter_center_index_x <- median(1:dim(window)[2])
filter_max_index_x <- dim(window)[2]
# For each position in the picture, 2D convolution is done by
# calculating a score for all overlapping values within the two matrices
x_min <- 1
x_max <- dim(img)[2]
y_min <- 1
y_max <- dim(img)[1]
df <- NULL
for (x_val in c(x_min:x_max)){
for (y_val in c(y_min:y_max)){
# Distanced from cell
img_dist_left <- x_val-1
img_dist_right <- x_max-x_val
img_dist_up <- y_val-1
img_dist_down <- y_max-y_val
# Overlapping filter cells
filter_x_start <- filter_center_index_x-img_dist_left
if (filter_x_start < 1) {
filter_x_start <- 1
}
filter_x_end <- filter_center_index_x+img_dist_right
if (filter_x_end > filter_max_index_x) {
filter_x_end <- filter_max_index_x
}
filter_y_start <- filter_center_index_y-img_dist_up
if (filter_y_start < 1) {
filter_y_start <- 1
}
filter_y_end <- filter_center_index_y+img_dist_down
if (filter_y_end > filter_max_index_y) {
filter_y_end <- filter_max_index_y
}
# Part of filter that overlaps
filter_overlap_matrix <- filter[filter_y_start:filter_y_end, filter_x_start:filter_x_end]
# Overlapped image cells
image_x_start <- x_val-filter_center_index_x+1
if (image_x_start < 1) {
image_x_start <- 1
}
image_x_end <- x_val+filter_max_index_x-filter_center_index_x
if (image_x_end > x_max) {
image_x_end <- x_max
}
image_y_start <- y_val-filter_center_index_y+1
if (image_y_start < 1) {
image_y_start <- 1
}
image_y_end <- y_val+filter_max_index_y-filter_center_index_y
if (image_y_end > y_max) {
image_y_end <- y_max
}
# Part of image that is overlapped
image_overlap_matrix <- img[image_y_start:image_y_end, image_x_start:image_x_end]
# Calculating the cell value
cell_value <- sum(filter_overlap_matrix*image_overlap_matrix)
df = rbind(df,data.frame(x_val,y_val, cell_value))
}
}
# Axis labels
x_axis <- c(x_min:x_max)
y_axis <- c(y_min:y_max)
# Populating matrix
filter_matrix <- matrix(df[,3], nrow = x_max, ncol = y_max, dimnames = list(x_axis, y_axis))
return(filter_matrix)
}
Running the method:
> image
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 2 3 4 5 6
[2,] 7 8 9 10 11 12
[3,] 13 14 15 16 17 18
[4,] 19 20 21 22 23 24
[5,] 25 26 27 28 29 30
[6,] 31 32 33 34 35 36
> filter
[,1] [,2] [,3]
[1,] 1 2 1
[2,] 0 0 0
[3,] -1 -2 -1
> filter2D(image, filter)
1 2 3 4 5 6
1 -22 -32 -36 -40 -44 -35
2 -36 -48 -48 -48 -48 -36
3 -36 -48 -48 -48 -48 -36
4 -36 -48 -48 -48 -48 -36
5 -36 -48 -48 -48 -48 -36
6 76 104 108 112 116 89
This is the same output that filter2(image, filter) produces in matlab, however, when the option 'valid' is added the following output is generated:
-48 -48 -48 -48
-48 -48 -48 -48
-48 -48 -48 -48
-48 -48 -48 -48
It is not entirely obvious how filter2 with the 'valid' option generates this. Is it just using the center values? Or is it doing something more sophisticated?
Before I start, your code is actually doing 2D correlation. 2D convolution requires that you perform a 180 degree rotation on the kernel before doing the weighted sum. Correlation and convolution are in fact the same operation if the kernel is symmetric (i.e. the transpose of the kernel is equal to itself). I just wanted to make that clear before I start. Also, the documentation for filter2 does state that correlation is being performed.
The 'valid' option in MATLAB simply means that it should return only the outputs where the kernel fully overlaps the 2D signal when performing filtering. Because you have a 3 x 3 kernel, this means that at location (2,2) in the 2D signal for example, the kernel does not go outside of the signal boundaries. Therefore, what is returned is the extent of the filtered 2D signal where the kernel was fully inside the original 2D signal. To give you an example, if you placed the kernel at location (1,1), some of the kernel would go out of bounds. Handling out of bounds conditions when filtering can be done in many ways which may affect results and the interpretation of those results when it comes down to it. Therefore the 'valid' option is desired as you are using true information that forms the final result. You aren't interpolating or performing any estimations for data that goes beyond the borders of the 2D signal.
Simply put, you return a reduced matrix which removes the border elements. The filter being odd shaped makes this easy. You simply remove the first and last floor(M/2) rows and the first and last floor(N/2) columns where M x N is the size of your kernel. Therefore, because your kernel is 3 x 3, this means that we need to remove 1 row from the top and 1 row from the bottom, as well as 1 column from the left and 1 column from the right. This results in the -48 within a 4 x 4 grid as you see from the output of MATLAB.
Therefore, if you want to use the 'valid' option in your code, simply make sure that you remove the border elements in your result. You can do this right at the end before your return the matrix:
# Place your code here...
# ...
# ...
# Now we're at the end of your code
# Populating matrix
filter_matrix <- matrix(df[,3], nrow = x_max, ncol = y_max, dimnames = list(x_axis, y_axis))
# New - Determine rows and columns of matrix as well as the filter kernel
nrow_window <- nrow(window)
ncol_window <- ncol(window)
nrows <- nrow(filter_matrix)
ncols <- ncol(filter_matrix)
# New - Figure out where to cut off
row_cutoff <- floor(nrow_window/2)
col_cutoff <- floor(ncol_window/2)
# New - Remove out borders
filter_matrix <- filter_matrix[((1+row_cutoff):(nrows-row_cutoff)), ((1+col_cutoff):(ncols-col_cutoff))]
# Finally return matrix
return(filter_matrix)
Example Run
Using your data:
> image <- t(matrix(c(1:36), nrow=6, ncol=6))
> image
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 2 3 4 5 6
[2,] 7 8 9 10 11 12
[3,] 13 14 15 16 17 18
[4,] 19 20 21 22 23 24
[5,] 25 26 27 28 29 30
[6,] 31 32 33 34 35 36
> filter <- matrix(c(1,0,-1,2,0,-2,1,0,-1), nrow=3, ncol=3)
> filter
[,1] [,2] [,3]
[1,] 1 2 1
[2,] 0 0 0
[3,] -1 -2 -1
I ran the function and now I get:
> filter2D(image,filter)
2 3 4 5
2 -48 -48 -48 -48
3 -48 -48 -48 -48
4 -48 -48 -48 -48
5 -48 -48 -48 -48
I think it may be important to leave the horizontal and vertical labels to be the way they are so you can explicitly see that not all of the signal is being returned, which is what the code is currently doing.... that's up to you though. I'll leave that to you to decide.

Output vector of loop function r

i´m trying to create an output vector of a loop, containing a result from each loop.
out=NULL
for (i in 1:5) {
out<-cbind(out,sample(1:100, 1)) #placeholderfunction
for (i in 1:5) {out[i]<- i+1}
}
The good side: My result contains the correct values. The bad side: it does as a matrix and i don´t know why.
> out
out
[1,] 2 71 14 46 96
[2,] 3 71 14 46 96
[3,] 4 71 14 46 96
[4,] 5 71 14 46 96
[5,] 6 71 14 46 96
What i want would be something like:
> out
out
[1,] 2 71 14 46 96
Probably it is just a small step from where i stand, but i just can´t figure it out, maybe someone could help?
(and yes i could just remove but i would like my code clean)
Thanks!
Ok,
by looking at the problem again on this scale i found it - a superfluous line:
> out=NULL
> for (i in 1:5) {
+ out<-cbind(out,sample(1:100, 1))
+ }
> out
[,1] [,2] [,3] [,4] [,5]
[1,] 63 98 78 43 19
What about this
out <- sample(100,5)
Update
I see why I got a -1, the OP wants to construct a vector with a for loop. As a word of caution, creating a vector in this manner is usually not a good idea. For example, my above code is both simpler and faster than the OP's code. That withstanding, if you want generate a vector of random numbers with a for loop use this approach
my.loop <- function(l){
out_1 <- numeric(l)
for (i in 1:l) {
out_1[i] <- sample(1:100, 1)
}
out_1
}
This will be much better than op approach below because we are preallocating memory.
op.loop <- function(l){
out_2 = NULL
for (i in 1:l) {
out_2 <- cbind(out_2, sample(1:100, 1))
}
out_2
}
For fun I timed the two approaches:

R - Apply function with different argument value for each row/column of a matrix

I am trying to apply a function to each row or column of a matrix, but I need to pass a different argument value for each row.
I thought I was familiar with lapply, mapply etc... But probably not enough.
As a simple example :
> a<-matrix(1:100,ncol=10);
> a
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 11 21 31 41 51 61 71 81 91
[2,] 2 12 22 32 42 52 62 72 82 92
[3,] 3 13 23 33 43 53 63 73 83 93
[4,] 4 14 24 34 44 54 64 74 84 94
[5,] 5 15 25 35 45 55 65 75 85 95
[6,] 6 16 26 36 46 56 66 76 86 96
[7,] 7 17 27 37 47 57 67 77 87 97
[8,] 8 18 28 38 48 58 68 78 88 98
[9,] 9 19 29 39 49 59 69 79 89 99
[10,] 10 20 30 40 50 60 70 80 90 100
Let's say I want to apply a function to each row, I would do :
apply(a, 1, myFunction);
However my function takes an argument, so :
apply(a, 1, myFunction, myArgument);
But if I want my argument to take a different value for each row, I cannot find the right way to do it.
If I define a 'myArgument' with multiple values, the whole vector will obviously be passed to each call of 'myFunction'.
I think that I would need a kind of hybrid between apply and the multivariate mapply. Does it make sense ?
One 'dirty' way to achieve my goal is to split the matrix by rows (or columns), use mapply on the resulting list and merge the result back to a matrix :
do.call(rbind, Map(myFunction, split(a,row(a)), as.list(myArgument)));
I had a look at sweep, aggregate, all the *apply variations but I wouldn't find the perfect match to my need. Did I miss it ?
Thank you for your help.
You can use sweep to do that.
a <- matrix(rnorm(100),10)
rmeans <- rowMeans(a)
a_new <- sweep(a,1,rmeans,`-`)
rowMeans(a_new)
I don't think there are any great answers, but you can somewhat simplify your solution by using mapply, which handles the "rbind" part for you, assuming your function always returns the same sizes vector (also, Map is really just mapply):
a <- matrix(1:80,ncol=8)
myFun <- function(x, y) (x - mean(x)) * y
myArg <- 1:nrow(a)
t(mapply(myFun, split(a, row(a)), myArg))
I know the topic is quiet old but I had the same issue and I solved it that way:
# Original matrix
a <- matrix(runif(n=100), ncol=5)
# Different value for each row
v <- runif(n=nrow(a))
# Result matrix -> Add a column with the row number
o <- cbind(1:nrow(a), a)
fun <- function(x, v) {
idx <- 2:length(x)
i <- x[1]
r <- x[idx] / v[i]
return(r)
}
o <- t(apply(o, 1, fun, v=v)
By adding a column with the row number to the left of the original matrix, the index of the needed value from the argument vector can be received from the first column of the data matrix.

Convert binary string to binary or decimal value

Is there any function to convert binary string into binary or decimal value?
If I have a binary string 000101, what should I do to convert it into 5?
You could use the packBits function (in the base package). Bear in mind that this function requires very specific input.
(yy <- intToBits(5))
# [1] 01 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
# [26] 00 00 00 00 00 00 00
# Note that there are 32 bits and the order is reversed from your example
class(yy)
[1] "raw"
packBits(yy, "integer")
# [1] 5
There is also the strtoi function (also in the base package):
strtoi("00000001001100110000010110110111", base = 2)
# [1] 20121015
strtoi("000101", base = 2)
# [1] 5
Here is what you can try:
binStr <- "00000001001100110000010110110111" # 20121015
(binNum <- 00000001001100110000010110110111) # 20121015
[1] 1.0011e+24
binVec <- c(1,0,1,0,0,0,1,1,0,0,0,0,0,0,1,0,0,0,0,0,0,1) # 2670721
shortBin <- 10011010010 # 1234
BinToDec <- function(x)
sum(2^(which(rev(unlist(strsplit(as.character(x), "")) == 1))-1))
BinToDec(binStr)
[1] 20121015
BinToDec(binNum)
[1] 576528
BinToDec(binVec)
[1] 2670721
BinToDec(shortBin)
[1] 1234
That is, you can input both strings (because of as.character()) and numeric binary values but there are some problems with large numbers like binNum. As I understand you also want to convert binary string to numeric binary values, but unfortunately there is no such data type at least in base R.
Edit: Now BinToDec also accepts binary vectors, which might be a solution for large numbers. Function digitsBase() from package sfsmisc returns such a vector:
(vec <- digitsBase(5, base= 2, 10))
Class 'basedInt'(base = 2) [1:1]
[,1]
[1,] 0
[2,] 0
[3,] 0
[4,] 0
[5,] 0
[6,] 0
[7,] 0
[8,] 1
[9,] 0
[10,] 1
BinToDec(vec)
[1] 5
Finally, another possibility is package compositions , for example:
(x <- unbinary("10101010"))
[1] 170
(y <- binary(x))
[1] "10101010"
base::strtoi(binary_string, base = 2)
This function calculates the decimal version with a flexible base. Base equals 2 is binary, etc. This should work up until a base of 10.
base2decimal = function(base_number, base = 2) {
split_base = strsplit(as.character(base_number), split = "")
return(sapply(split_base, function(x) sum(as.numeric(x) * base^(rev(seq_along(x) - 1)))))
}
> base2decimal(c("000101", "00000001001100110000010110110111"))
[1] 5 20121015
In the case that you have binary string, all of the prior answers are great. I often find myself in situations where I want to encode a combination of binary vectors. The logic of translating from a combination of 0's and 1's to an integer is always the same:
bincount <- function(B, base=2) { return(B %*% base^seq(0,ncol(B)-1)) }
Where B is a matrix, and each column is a binary vector.
Example:
isBig <- c(0, 1, 0, 1)
isRed <- c(0, 0, 1, 1)
B = cbind(isBig,isRed)
bincount(B)
# 0 1 2 3

Resources