OK, I got it figured out. I was not keying into a length greater than 1, so:
# I added this object and placed it into the iftelse statement:
lid <- sum(match(id, st[i], nomatch = 0))
out$var.g[i]<-ifelse(lid ==1, meta$var.g[id==st[i]],
aggs(g=g[id==st[i]],
n.1= n.1[id==st[i]],
n.2 = n.2[id==st[i]], cor)[2])
#full function:
agg_g <- function(meta,var.g, id, g, n.1, n.2, cor = .50) {
meta$var.g <- var.g
st <- unique(id)
out <- data.frame(id=rep(NA,length(st)))
for(i in unique(id)) {
out$id[i] <- st[i]
out$g[i] <- aggs(g=g[id==st[i]], n.1= n.1[id==st[i]],
n.2 = n.2[id==st[i]], cor)[1]
#out$var.g[i] <- aggs(g=g[id==st[i]], n.1= n.1[id==st[i]],
# n.2 = n.2[id==st[i]], cor)[2]
#out$var.g[i] <- aggs(g=g[id==st[i]],
# n.1= n.1[id==st[i]],
# n.2 = n.2[id==st[i]], cor)[2]
lid <- sum(match(id, st[i], nomatch = 0))
out$var.g[i]<-ifelse(lid ==1, meta$var.g[id==st[i]],
aggs(g=g[id==st[i]],
n.1= n.1[id==st[i]],
n.2 = n.2[id==st[i]], cor)[2])
out$n.1[i] <- round(mean(n.1[id==st[i]]),0)
out$n.2[i] <- round(mean(n.2[id==st[i]]),0)
}
return(out)
}
AC
On Thu, Mar 4, 2010 at 9:35 AM, AC Del Re <delre@wisc.edu> wrote:
> Hi All,
>
> I am using a specialized aggregation function to reduce a dataset with
> multiple rows per id down to 1 row per id. My function work perfect when
> there are >1 id but alters the 'var.g' in undesirable ways when
this
> condition is not met, Therefore, I have been trying ifthen() statements to
> keep the original value when length of unique id == 1 but I cannot get it
to
> work. e.g.:
>
> #function to aggregate effect sizes:
> aggs <- function(g, n.1, n.2, cor = .50) {
> n.1 <- mean(n.1)
> n.2 <- mean(n.2)
> N_ES <- length(g)
> corr.mat <- matrix (rep(cor, N_ES^2), nrow=N_ES)
> diag(corr.mat) <- 1
> g1g2 <- cbind(g) %*% g
> PSI <- (8*corr.mat + g1g2*corr.mat^2)/(2*(n.1+n.2))
> PSI.inv <- solve(PSI)
> a <- rowSums(PSI.inv)/sum(PSI.inv)
> var.g <- 1/sum(PSI.inv)
> g <- sum(g*a)
> out<-cbind(g,var.g, n.1, n.2)
> return(out)
> }
>
>
> # automating this procedure for all rows of df. This format works perfect
> when there is > 1 id per row only:
>
> agg_g <- function(id, g, n.1, n.2, cor = .50) {
> st <- unique(id)
> out <- data.frame(id=rep(NA,length(st)))
> for(i in 1:length(st)) {
> out$id[i] <- st[i]
> out$g[i] <- aggs(g=g[id==st[i]], n.1= n.1[id==st[i]],
> n.2 = n.2[id==st[i]], cor)[1]
> out$var.g[i] <- aggs(g=g[id==st[i]], n.1= n.1[id==st[i]],
> n.2 = n.2[id==st[i]], cor)[2]
> out$n.1[i] <- round(mean(n.1[id==st[i]]),0)
> out$n.2[i] <- round(mean(n.2[id==st[i]]),0)
> }
> return(out)
> }
>
>
> # The attempted solution using ifthen() and minor changes to function but
> it's not working properly:
> agg_g <- function(df,var.g, id, g, n.1, n.2, cor = .50) {
> df$var.g <- var.g
> st <- unique(id)
> out <- data.frame(id=rep(NA,length(st)))
> for(i in 1:length(st)) {
> out$id[i] <- st[i]
> out$g[i] <- aggs(g=g[id==st[i]], n.1= n.1[id==st[i]],
> n.2 = n.2[id==st[i]], cor)[1]
> out$var.g[i]<-ifelse(length(st[i])==1, df$var.g[id==st[i]],
> aggs(g=g[id==st[i]],
> n.1= n.1[id==st[i]],
> n.2 = n.2[id==st[i]], cor)[2])
> out$n.1[i] <- round(mean(n.1[id==st[i]]),0)
> out$n.2[i] <- round(mean(n.2[id==st[i]]),0)
> }
> return(out)
> }
>
> # sample data:
> id<-c(1, rep(1:19))
> n.1<-c(10,20,13,22,28,12,12,36,19,12,36,75,33,121,37,14,40,16,14,20)
> n.2 <- c(11,22,10,20,25,12,12,36,19,11,34,75,33,120,37,14,40,16,10,21)
> g <-
c(.68,.56,.23,.64,.49,-.04,1.49,1.33,.58,1.18,-.11,1.27,.26,.40,.49,
> .51,.40,.34,.42,1.16)
> var.g <-
> c(.08,.06,.03,.04,.09,.04,.009,.033,.0058,.018,.011,.027,.026,.0040,
> .049,.0051,.040,.034,.0042,.016)
> df<-data.frame(id, n.1,n.2, g, var.g)
>
> Any help is much appreciated,
>
> AC
>
[[alternative HTML version deleted]]
