R: gWidgets: gText: add a search/find function - r

I'd like to ask if there is a way of adding a search/find function in gtext gwidget.
x <- c(1, 2)
y <- c(3, 4)
z <- c(5, 6)
df <- data.frame(x, y, z)
df.co <- capture.output(df) # get df as text
str.split <- strsplit(df.co, "\\s+") # split every line in its components
w1 <- gwindow()
gt1 <- gtext(container=w1)
insert(gt1, df.co)

Related

R Getting numeric matrix from predict()

I have the following code:
fit_lm=lm(z~x+y)
mix <- 2
max <- 12
miy <- 2
may <- 12
griddf <- expand.grid(x = seq(mix,max, length.out = 10),
y = seq( miy,may,length.out = 10))
Prediction_data <- data.frame(griddf)
colnames(Prediction_data) <- c("x", "y")
coordinates(Prediction_data ) <- ~ x + y
terrain_lm <- predict(fit_lm, Prediction_data)
I want that terrain_lm is a numeric matrix, in such a way, that I can use
fig <- plot_ly()
fig <- fig %>% add_surface(terrain_lm)
but I get a 1d array with 100 elements.
The result of predict is a vector. You need to add it to the x and y values and then use xtabs to transform into a suitable matrix for a surface plot.
library(plotly)
#test data
x <- runif(20, 4, 10)
y <- runif(20, 3, 6)
z <- 3*x+y +runif(20, 0, 2)
fit_lm <- lm(z~x+y)
mix <- 2
max <- 12
miy <- 2
may <- 12
griddf <- expand.grid(x = seq(mix,max, length.out = 10),
y = seq( miy,may,length.out = 10))
terrain_lm <- data.frame(griddf)
terrain_lm$z <- predict(fit_lm, terrain_lm)
fig <- plot_ly(z = ~xtabs(z ~ x + y, data = terrain_lm))
fig <- fig %>% add_surface()

nested for loop to lapply for list of matrices - non identical output

I made a calculation for a nested loop, then I tried to transform it to lapply but it doesn't show the same result, do you know why is it? This is my code:
#list
l <- list()
l[[1]] <- matrix(c(4, 3, 20, 10), ncol=2)
l[[2]] <- matrix(c(3, 3, 40, 12), ncol=2)
l[[3]] <- matrix(c(2, 3, 60, 10), ncol=2)
#loop
##index
s <- 1:length(l)
#for loop
zzz <- list()
for (i in s){
zzz[[i]] <- apply(X = l[[i]], MARGIN = 1,
FUN = function(x) spDistsN1(l[[i]], x, longlat = T))
zzz
}
#lapply loop
yyy <- lapply(s, function(x){
apply(X = l[[i]], MARGIN = 1,
FUN = function(x) spDistsN1(l[[i]], x, longlat = T))
})
And they output aren't identical, why?
identical(zzz,yyy)
[1] FALSE
We can change the code to
library(sp)
yyy <- lapply(s, function(i) apply(l[[i]], 1, FUN= function(x)
spDistsN1(l[[i]], x, longlat = TRUE)))
identical(zzz, yyy)
#[1] TRUE
In the OP's code, the anonymous function call used in both function is x, so within the spDistsN1, the x was coming from the whole matrix instead of the row

How to associate variable values from a df to another

I have a dataframe with three values, x and y are coordinates and z is the value of the indipendent variable:
x.range <- c(1,10)
y.range <- c(20,50)
grid <- expand.grid(x = seq(x.range[1], x.range[2], by=0.5),
y = seq(y.range[1], y.range[2], by=0.5))
grid$z <- runif(nrow(grid),10, 70)
Now i have another dataframe like this with only x and y values:
x1 <- c(3.7,5.4,9.2)
y1 <- c(41.1,30.3,22.9)
df <- data.frame(x=x1,y=y1)
Now i want to associate to the points of dataframe df the z value of the nearest point of dataframe grid (with the shortest distance). Thanks.
This isn't the prettiest, but works
apply(df, 1,
function(x){
pythag <- sqrt((x[1] - grid$x)^2 +
(x[2] - grid$y)^2)
grid[which.min(pythag), "z"]
})
Simply returning the value for the nearest point using Pythagoras.
Edit
Recoding to adhere to coding standards:
pythag <- function(x, y, g){
which.min(((x - g$x)^2 + (y - g$y)^2)^0.5)
}
idx <- mapply(FUN = pythag,
x = df[["x"]],
y = df[["y"]],
MoreArgs = list(g = grid))
grid[idx,]

How to do calculations on elements from a sublist in R

my code is as follows:
x <- data.frame(matrix(rnorm(20), nrow=10))
colnames(x) <- c("z", "m")
n_boot<-4
bs <- list()
for (i in 1:n_boot) {
bs[[i]] <- x[sample(nrow(x), 10, replace = TRUE), ]
}
bt<-matrix(unlist(bs), ncol = 2*n_boot, byrow = FALSE)
colnames(bt) <- rep(c("z","m"),times=n_boot)
M_to_boot <- bt[,seq(2,8,by=2)]
funct<-function(M_boot_max) {
od<-(1/((10*((10^((16-M_boot_max-25)/5))^3)/3)*((max(M_boot_max)-min(M_boot_max))/50)))
}
V_boot<-apply(M_to_boot,2,funct)
rows.combined <- nrow(M_to_boot)
cols.combined <- ncol(M_to_boot) + ncol(V_boot)
matrix.combined <- matrix(NA, nrow=rows.combined, ncol=cols.combined)
matrix.combined[, seq(1, cols.combined, 2)] <- M_to_boot
matrix.combined[, seq(2, cols.combined, 2)] <- V_boot
colnames(matrix.combined) <- rep(c("M_boot","V_boot"),times=n_boot)
df<-as.data.frame(matrix.combined)
start0 <- seq(1, by = 2, length = ncol(df) / 2)
start <- lapply(start0, function(i, df) df[i:(i+1)], df = df)
tests<-lapply(start, function(xy) split(xy, cut(xy$M_boot,breaks=5)))
Now I want to prepare some calculations on values V_boot from a sublists. To be specific I want to for each subsample calculate the sum of V_boot. So, for example I want for a bin M_boot "[[4]]$(0.811,1.25]" to have a value of sum(V_boot) for that bin. But I cannot figure out how to get to that each V_boot values.
Please help me.

boxplot for only the outliers

Greeting
I would only like to plot the outliers for boxplot
this is my solution but it does not seem to be very efficient or elegant.
Any packages or better code for doing that.
As you can see I am calling boxplot twice to do this
So if my dataset is very big than it will be bad
Thanks
set.seed(1501)
y <- c(4, 0, 7, -5, rnorm(16))
x1 <- c("a", "a", "b", "b", sample(letters[1:5], 16, T))
lab_y <- sample(letters, 20)
datxx <- as.matrix(cbind(y,x1,lab_y))
boxplot_outlier<- function(dat){
bx <- boxplot(as.numeric(dat[,"y"]) ~ dat[,"x1"])
out_label <- c()
for ( i in seq(bx$out)){
out_label[i] <- dat[which(dat[,"y"]==bx$out[i]),"lab_y"]
}
out_label
out_g <- c()
for ( i in seq(bx$out)){
out_g[i] <- dat[which(dat[,"y"]==bx$out[i]),"x1"]
}
out_g
out_y <- c()
for ( i in seq(bx$out)){
out_y[i] <- dat[which(dat[,"y"]==bx$out[i]),"y"]
}
out_y
out_all<-cbind(out_y,out_g,out_label)
out_all <- as.matrix(out_all)
out_g <- as.matrix(out_g)
colnames(out_g)[1]<-"x1"
out_g_x <- out_g[which(!duplicated(out_g[,"x1"]))]
out_g_x <- as.matrix(out_g_x)
colnames(out_g_x)[1]<-"x1"
datsub <- merge(dat,out_g_x,by=c("x1"))
datsub <- as.matrix(datsub)
bx2 <- boxplot(as.numeric(datsub[,"y"]) ~ datsub[,"x1"],data=datsub)
mynum <- cbind(as.numeric(c(1:nrow(out_g_x))),out_g_x)
mynumxx <- merge(x=out_g,y=mynum,by=c("x1"))
colnames(mynumxx)[2]<-"v1"
text(as.numeric(mynumxx[,"v1"])+0.2,as.numeric(out_all[,"out_y"]),out_all[,"out_label"])
}
boxplot_outlier(datxx)
You could use ggplot2 to plot and set the box and lines to a fully transparent colour. Note that you have to put your data into a data.frame for this, which is better anyway, since y is converted to character in a matrix with the other variables.
dat <- data.frame(y,x1,lab_y)
ggplot(as.data.frame(dat), aes(x=x1,y=y)) + geom_boxplot(fill="#00000000",colour="#00000000")

Resources