Problem generating wavelet variance/covarance - wavelet

How do I solve the error?
Here's my script:
A=x
B=y
wf <- "la8"
J <- 8
N<- length(A)
A.modwt <- modwt(A, wf, J)
B.modwt <- modwt(B, wf, J)
A.modwt.bw <- brick.wall(A.modwt, wf)
B.modwt.bw <- brick.wall(B.modwt, wf)
WCOV = wave.covariance(A.modwt.bw, B.modwt.bw)
Error in x[c((n%/%2):n, 1:(n%/%2 - 1))] :
only 0's may be mixed with negative subscripts

Related

Error : length of 'dimnames' [2] not equal to array extent - but number of columns IS equal to number of columnnames

maybe you can help me with a small problem. I picked some data out of a bigger data file and combined those data in the end to a table. In the last line I want to put columnnames to that table. Before I put those columnnames to that table the length is = 115. But when I put the columnnames to that table the length is suddenly = 112 and the above mentioned error occurs. But I also counted the number of columnnames and there are 115. Maybe do you have clue what to do?
Thank you in advance and kind regards,
Julian
Code:
setwd("/home/julian/Schreibtisch/Test")
# Alle einzulesenden Daten
dirnames <- dir()
for(i in 1:length(dirnames)){
# Basis-Angaben
INSIST_basics_1 <- read.csv(dirnames[i])[ ,c('mouse.x', 'TN.Nr.')]
INSIST_basics_1 <- subset(INSIST_basics_1, mouse.x > 0)
INSIST_basics_1 <- INSIST_basics_1[,c('TN.Nr.')]
INSIST_basics_1 <- c(INSIST_basics_1)
INSIST_basics_1 <- rbind(INSIST_basics_1)
INSIST_basics_2 <- read.csv(dirnames[i])[ ,c('mouse.x', 'Termin')]
INSIST_basics_2 <- subset(INSIST_basics_2, mouse.x > 0)
INSIST_basics_2 <- INSIST_basics_2[,c('Termin')]
INSIST_basics_2 <- c(INSIST_basics_2)
INSIST_basics_2 <- rbind(INSIST_basics_2)
INSIST_basics_3 <- read.csv(dirnames[i])[ ,c('mouse.x', 'Zuweisung')]
INSIST_basics_3 <- subset(INSIST_basics_3, mouse.x > 0)
INSIST_basics_3 <- INSIST_basics_3[,c('Zuweisung')]
INSIST_basics_3 <- c(INSIST_basics_3)
INSIST_basics_3 <- rbind(INSIST_basics_3)
INSIST_basics <- c(INSIST_basics_1,INSIST_basics_2,INSIST_basics_3)
INSIST_basics <- rbind(INSIST_basics)
# VAS
INSIST_VAS <- read.csv(dirnames[i])[ ,c('Word', 'trials_4.thisIndex', 'trials_6.thisIndex', 'trials_10.thisIndex', 'trials_7.thisIndex', 'trials_8.thisIndex', 'slider.response')]
INSIST_VAS <- INSIST_VAS[-which(INSIST_VAS$Word == ""), ]
INSIST_VAS_1 <- subset(INSIST_VAS, trials_4.thisIndex >= 0)
INSIST_VAS_1 <- INSIST_VAS_1[order(INSIST_VAS_1$trials_4.thisIndex),]
INSIST_VAS_1 <- INSIST_VAS_1[,c('slider.response')]
INSIST_VAS_1 <- (INSIST_VAS_1 - 1) *100
INSIST_VAS_2 <- subset(INSIST_VAS, trials_6.thisIndex >= 0)
INSIST_VAS_2 <- INSIST_VAS_2[order(INSIST_VAS_2$trials_6.thisIndex),]
INSIST_VAS_2 <- INSIST_VAS_2[,c('slider.response')]
INSIST_VAS_2 <- (INSIST_VAS_2 - 1) *100
INSIST_VAS_3 <- subset(INSIST_VAS, trials_10.thisIndex >= 0)
INSIST_VAS_3 <- INSIST_VAS_3[order(INSIST_VAS_3$trials_10.thisIndex),]
INSIST_VAS_3 <- INSIST_VAS_3[,c('slider.response')]
INSIST_VAS_3 <- (INSIST_VAS_3 - 1) *100
INSIST_VAS_4 <- subset(INSIST_VAS, trials_7.thisIndex >= 0)
INSIST_VAS_4 <- INSIST_VAS_4[order(INSIST_VAS_4$trials_7.thisIndex),]
INSIST_VAS_4 <- INSIST_VAS_4[,c('slider.response')]
INSIST_VAS_4 <- (INSIST_VAS_4 - 1) *100
INSIST_VAS_5 <- subset(INSIST_VAS, trials_8.thisIndex >= 0)
INSIST_VAS_5 <- INSIST_VAS_5[order(INSIST_VAS_5$trials_8.thisIndex),]
INSIST_VAS_5 <- INSIST_VAS_5[,c('slider.response')]
INSIST_VAS_5 <- (INSIST_VAS_5 - 1) *100
INSIST_VAS_all <- c(INSIST_VAS_1,INSIST_VAS_2,INSIST_VAS_3,INSIST_VAS_4,INSIST_VAS_5)
INSIST_VAS_all <- rbind(INSIST_VAS_all)
# FB tDCS
INSIST_tDCS <- read.csv(dirnames[i])[ ,c('itemIndex','questions', 'ratings')]
INSIST_tDCS <- INSIST_tDCS[-which(INSIST_tDCS$questions == ""), ]
INSIST_tDCS <- INSIST_tDCS[,c('ratings')]
INSIST_tDCS <- c(INSIST_tDCS)
INSIST_tDCS <- rbind(INSIST_tDCS)
# FB Zustand
INSIST_Zustand <- read.csv(dirnames[i])[ ,c('questionText', 'trials_9.thisIndex', 'trials_13.thisIndex', 'trials_15.thisIndex', 'slider_13.response')]
INSIST_Zustand <- INSIST_Zustand[-which(INSIST_Zustand$questionText == ""), ]
INSIST_Zustand_1 <- subset(INSIST_Zustand, trials_9.thisIndex >= 0)
INSIST_Zustand_1 <- INSIST_Zustand_1[order(INSIST_Zustand_1$trials_9.thisIndex),]
INSIST_Zustand_1 <- INSIST_Zustand_1[,c('slider_13.response')]
INSIST_Zustand_1 <- (INSIST_Zustand_1 - 1) *100
INSIST_Zustand_2 <- subset(INSIST_Zustand, trials_13.thisIndex >= 0)
INSIST_Zustand_2 <- INSIST_Zustand_2[order(INSIST_Zustand_2$trials_13.thisIndex),]
INSIST_Zustand_2 <- INSIST_Zustand_2[,c('slider_13.response')]
INSIST_Zustand_2 <- (INSIST_Zustand_2 - 1) *100
INSIST_Zustand_3 <- subset(INSIST_Zustand, trials_15.thisIndex >= 0)
INSIST_Zustand_3 <- INSIST_Zustand_3[order(INSIST_Zustand_3$trials_15.thisIndex),]
INSIST_Zustand_3 <- INSIST_Zustand_3[,c('slider_13.response')]
INSIST_Zustand_3 <- (INSIST_Zustand_3 - 1) *100
INSIST_Zustand_all <- c(INSIST_Zustand_1,INSIST_Zustand_2,INSIST_Zustand_3)
INSIST_Zustand_all <- rbind(INSIST_Zustand_all)
# Szenarien
INSIST_Szenarien <- read.csv(dirnames[i])[ ,c('scenario', 'trials_11.thisIndex', 'rating_2.response')]
INSIST_Szenarien <- INSIST_Szenarien[-which(INSIST_Szenarien$scenario == ""), ]
INSIST_Szenarien <- INSIST_Szenarien[order(INSIST_Szenarien$trials_11.thisIndex),]
INSIST_Szenarien <- INSIST_Szenarien[,c('rating_2.response')]
INSIST_Szenarien <- c(INSIST_Szenarien)
INSIST_Szenarien <- rbind(INSIST_Szenarien)
# Alle Abschnitte zusammenfuehren
INSIST_tab <- c(INSIST_basics, INSIST_VAS_all, INSIST_tDCS, INSIST_Zustand_all, INSIST_Szenarien)
INSIST_tab <- rbind(INSIST_tab)
colnames(INSIST_tab) <- c( "TN_Nr", "Termin", "Zuweisung", "Hungrig_1", "Satt_1", "Durstig_1", "Aengstlich_1", "Froehlich_1", "Gestresst_1", "Schlaefrig_1", "Konzentriert_1", "Traurig_1", "Essen_generell_1", "Essen_suess_1", "Essen_herzhaft_1", "Hungrig_2", "Satt_2", "Durstig_2", "Aengstlich_2", "Froehlich_2", "Gestresst_2", "Schlaefrig_2", "Konzentriert_2", "Traurig_2", "Essen_generell_2", "Essen_suess_2", "Essen_herzhaft_2", "Hungrig_3", "Satt_3", "Durstig_3", "Aengstlich_3", "Froehlich_3", "Gestresst_3", "Schlaefrig_3", "Konzentriert_3", "Traurig_3", "Essen_generell_3", "Essen_suess_3", "Essen_herzhaft_3", "Hungrig_4", "Satt_4", "Durstig_4", "Aengstlich_4", "Froehlich_4", "Gestresst_4", "Schlaefrig_4", "Konzentriert_4", "Traurig_4", "Essen_generell_4", "Essen_suess_4", "Essen_herzhaft_4", "Hungrig_5", "Satt_5", "Durstig_5", "Aengstlich_5", "Froehlich_5", "Gestresst_5", "Schlaefrig_5", "Konzentriert_5", "Traurig_5", "Essen_generell_5", "Essen_suess_5", "Essen_herzhaft_5", "tDCS_Jucken_1", "tDCS_Schmerzen_1", "tDCS_Brennen_1", "tDCS_Waerme_1", "tDCS_Metall_1", "tDCS_Ermuedung_1", "tDCS_Kopf_1", "tDCS_Jucken_2", "tDCS_Schmerzen_2", "tDCS_Brennen_2", "tDCS_Waerme_2", "tDCS_Metall_2", "tDCS_Ermuedung_2", "tDCS_Kopf_2","tDCS_Jucken_3", "tDCS_Schmerzen_3", "tDCS_Brennen_3", "tDCS_Waerme_3", "tDCS_Metall_3", "tDCS_Ermuedung_3", "tDCS_Kopf_3", 'Zustand_Herr_1', 'Zustand_kontrollieren_1', 'Zustand_Versuchungen_1', 'Zustand_Stimmung_1', 'Zustand_Druck_1', 'Zustand_Kontrolle_1', 'Zustand_willensstark_1', 'Zustand_erschrocken_1', 'Zustand_ueberrascht_1', 'Zustand_Herr_2', 'Zustand_kontrollieren_2', 'Zustand_Versuchungen_2', 'Zustand_Stimmung_2', 'Zustand_Druck_2', 'Zustand_Kontrolle_2', 'Zustand_willensstark_2', 'Zustand_erschrocken_2', 'Zustand_ueberrascht_2','Zustand_Herr_3', 'Zustand_kontrollieren_3', 'Zustand_Versuchungen_3', 'Zustand_Stimmung_3', 'Zustand_Druck_3', 'Zustand_Kontrolle_3', 'Zustand_willensstark_3', 'Zustand_erschrocken_3', 'Zustand_ueberrascht_3','Kino', 'Pralinen', 'Zuhause', 'Weihnachtsessen' ) # Spaltennamen
}```

valuebox missing true/false statement

I am attempting to have two if else statements in a renderValuebox in shiny R. Here's the code:
observe({
a <- which(blkname==input$e0)
start <- input$dateRange[1]
end <- input$dateRange[2]
confInt <- input$CI
inc <- input$increment
output$Name <- renderText(paste0("Overview of ",input$e0," block"))
start1 <- as.character(format(input$dateRange[1], format="%B %d %Y"))
end1 <- as.character(format(input$dateRange[2], format="%B %d %Y"))
output$Head <- renderText(paste0("Distribution of dry matter across ", input$e0, " between ",start1, " and ", end1))
pts$DryMatter <- pts$DryMatter+(pts$Amend*inc)
pts$DryMatter <- round(pts$DryMatter, digits=2)
grap <- pts[which(pts$Date>start&pts$Date<end),]
grap <- grap[which(grap$paddock==a),]
grap$DryMatter<- round(grap$DryMatter, digits=2)
yup <- round(mean(grap$DryMatter), digits=2)
nump <- nrow(grap)
grapdevdm <- grap[which(grap$Amend==min(grap$Amend)),]
grapdev <- sd(grapdevdm$DryMatter)
grapsampnum <- nrow(grapdevdm)
grapdevmean <- mean(grapdevdm$DryMatter)
cv <- (grapdev/grapdevmean)*100
sampReq <-(1.7*1.7)*(cv*cv)/((100-confInt)^2)
~
output$treenum <- renderValueBox({
valueBox(
paste0(nrow(grap), "Trees sampled out of ", sampReq, "required."),
if(nrow(grap)>=sampReq){
icon = icon("thumbs-up", lib = "glyphicon")}else
{icon = icon("thumbs-down", lib = "glyphicon")},
if(nrow(grap)>=sampReq){ color = "green"} else {colour = "red"}
)
})
I am receiving Warning: Error in if: missing value where TRUE/FALSE needed
However both if else is completed, maybe I am missing something.
Cheers,

R deleting duplicates when duplicates slightly differ by 1 or 2 letters

I am collecting tweets with the twitteR package and get many duplicates. This code works fine:
tweets <- searchTwitter(keyword, n=500, lang="en", since=NULL, until=NULL, retryOnRateLimit=100)
mydata <- sapply(tweets, function(x) x$getText())
mydata <- unique(mydata, incomparables = F, nmax = NA)
The problem is that it actually doesn't delete any duplicates because it doesn't recognises them as such. The duplicate tweets typically contain shortened URLS that differ by 1 or 2 digits. So I tried to clean the tweets of URLS with this code:
tweets <- searchTwitter(keyword, n=500, lang="en", since=NULL, until=NULL,
retryOnRateLimit=100)
mydata <- sapply(tweets, function(x) x$getText())
mydata <- data.frame(tweetsText, stringsAsFactors = FALSE)
names(mydata) <- c('words')
removeURL <- function(x) gsub("http[[:alnum:]]*", "", x)
mydata$words <- removeURL(mydata$words)
removeURL <- function(x) gsub("https[[:alnum:]]*", "", x)
mydata$words <- removeURL(mydata$words)
mydata$words <- unique(mydata$words, incomparables = F, nmax = NA)
Now I get the error message:
Error in $<-.data.frame(*tmp*, "words", value = c("Tripping around #DisneySprings.....) : replacement has 295 rows, data has 300
Advice? Thanks!
Your error is easily reproducible:
mydata <- data.frame(list(w = c(0, 1, 0, 1)))
mydata$words <- c(0, 1, 1)
# Error in `$<-.data.frame`(`*tmp*`, "words", value = c(0, 1, 1)) :
# replacement has 3 rows, data has 4
This just means that you need to assign a vector of the same length as the length of the data frame.
To filter out duplicate values you need to change the last line of your code to:
res <- mydata[!duplicated(mydata$words), ]

WinBugs if else using step function

I want to construct a model like
Model3 <- function() {
# Likelihood of the model
for (i in 1:n) {
response2[i] ~ dbern(p[i])
logit(p[i]) <- m[i]
m[i] <- mfe[i]
mfe[i] <- beta[1] + f[i]
# the f functions or the if-else step like
f_branch[i, 2] <- alpha
f_branch[i, 1] <- 1+alpha*exp(-((1/phi)*X2[i,1])^2)
# the decision
if_branch[i] <- 1 + step(-(X2[i,1] - 2))
f[i] <- f_branch[i, if_branch[i]]
f[i] <- f_branch[i, if_branch[i]]
}
# Prediction step
for(ii in 1:ndist) {
if_branch2[ii] <- 1 + step(-(Dist[ii] - 2))
fhat[ii] <- f_branch2[ii, if_branch2[ii]]
fhat[ii] <- f_branch2[ii, if_branch2[ii]]
f_branch2[ii, 2] <- alpha
f_branch2[ii, 1] <- 1 + alpha*exp(-((1/phi)*Dist[ii])^2)
}
# Prior distribution of the fixed effects parameters
beta[1] ~ dnorm(0, 1.0E-6)}
# priors for the f function
alpha ~ dgamma(1, 1)
phi ~ dunif(0, 2)
}
And I am getting an error: Attempt to redefine node f[1]
In this case, the error message is pretty self-explanatory - you define f[1], and then define it again on the following line, since you have repeated the line:
f[i] <- f_branch[i, if_branch[i]]
Remove the second instance of that line, and that error should disappear.
You have also duplicated the line:
fhat[ii] <- f_branch2[ii, if_branch2[ii]]
so you'll need to remove the second instance of that as well.

trying to append a list, but something breaks

I'm trying to create an empty list which will have as many elements as there are num.of.walkers. I then try to append, to each created element, a new sub-list (length of new sub-list corresponds to a value in a.
When I fiddle around in R everything goes smooth:
list.of.dist[[1]] <- vector("list", a[1])
list.of.dist[[2]] <- vector("list", a[2])
list.of.dist[[3]] <- vector("list", a[3])
list.of.dist[[4]] <- vector("list", a[4])
I then try to write a function. Here is my feeble attempt that results in an error. Can someone chip in what am I doing wrong?
countNumberOfWalks <- function(walk.df) {
list.of.walkers <- sort(unique(walk.df$label))
num.of.walkers <- length(unique(walk.df$label))
#Pre-allocate objects for further manipulation
list.of.dist <- vector("list", num.of.walkers)
a <- c()
# Count the number of walks per walker.
for (i in list.of.walkers) {
a[i] <- nrow(walk.df[walk.df$label == i,])
}
a <- as.vector(a)
# Add a sublist (length = number of walks) for each walker.
for (i in i:num.of.walkers) {
list.of.dist[[i]] <- vector("list", a[i])
}
return(list.of.dist)
}
> num.of.walks.per.walker <- countNumberOfWalks(walk.df)
Error in vector("list", a[i]) : vector size cannot be NA
Assuming 'walk.df' is something like:
walk.df <- data.frame(label=sample(1:10,100,T),var2=1:100)
then:
countNumberOfWalks <- function(walk.df) {
list.of.walkers <- sort(unique(walk.df$label))
num.of.walkers <- length(unique(walk.df$label))
list.of.dist <- vector("list", num.of.walkers)
for (i in 1:num.of.walkers) {
list.of.dist[[i]] <- vector("list",
nrow(walk.df[walk.df$label == list.of.walkers[i],]))}
return(list.of.dist)
}
Will achieve what you're after.