[R] (no subject)

Michael Bedward michael.bedward at gmail.com
Thu Oct 14 11:32:46 CEST 2010


Hello Julia,

I'm afraid your code had multiple problems: variables declared but not
used, incorrect or unnecessary use of the "c" function, out-of-bounds
subscripts and overwriting of result objects.

Rather than point them all out in detail I've modified your code so
that it works (see below). Please study this code and compare it to
your original code. This will help you to understand how to do things
more simply and reliably in R. Don't be discouraged - it takes
practice :)

Note, I didn't know whether you really wanted to retain the resultx
and resultb matrices. I've left them in there just in case.

Michael


bidding.simulation <- function(nsim=10, N=200, I=5) {
  set.seed(180185)

  tau <- seq(0.48, 0.52, 0.001)
  tau.mid <- which(tau == 0.5)

  Ntau <- length(tau)

  mresultx <- matrix(-99, nrow=I*N, ncol=nsim)
  mresultb <- matrix(-99, nrow=I*N, ncol=nsim)

  h <- seq(0.001, 0.020, 0.001)

  Mb0 <- matrix(0, nrow=nsim, ncol=Ntau)
  Mb1 <- matrix(0, nrow=nsim, ncol=Ntau)
  colnames(Mb1) <- colnames(Mb0) <- paste("tau", tau, sep=".")

  Mhb0 <- matrix(0, nrow=nsim, ncol=tau.mid - 1)
  Mhb1 <- matrix(0, nrow=nsim, ncol=tau.mid - 1)
  colnames(Mhb1) <- colnames(Mhb0) <- paste("width", tau[(tau.mid -
1):1] - tau[(tau.mid + 1):Ntau], sep=".")

  for (i in 1:nsim){
    mu <- runif(I*N)
    mx <- rep(runif(N), I)
    b0 <- rep(1, I*N)

    #function for private cost
    cost <- b0+b0*mx+mu

    #bidding strategy
    bid <- mx+((I+1)/I)+((I-1)/I)*mu
    mresultb[,i] <- bid
    mresultx[,i] <- mx

    qf <- rq(formula = bid ~ mx, tau = tau)
    coefs <- coef(qf)

    Mb0[i, ] <- coefs[1, ]
    Mb1[i, ] <- coefs[2, ]
    Mhb0[i, ] <- coefs[1, (tau.mid - 1):1] - coefs[1, (tau.mid+1):Ntau]
    Mhb1[i, ] <- coefs[2, (tau.mid - 1):1] - coefs[2, (tau.mid+1):Ntau]
  }

  # return results as a list
  list(Mb0=Mb0, Mb1=Mb1, Mhb0=Mhb0, Mhb1=Mhb1, mresultx=mresultx,
mresultb=mresultb)
}




On 14 October 2010 05:37, Julia Lira <julia.lira at hotmail.co.uk> wrote:
>
> Dear all,
>
>
>
> I have just sent an email with my problem, but I think no one can see the red part, beacuse it is black. So, i am writing again the codes:
>
>
>
> rm(list=ls()) #remove almost everything in the memory
>
> set.seed(180185)
> nsim <- 10
> mresultx <- matrix(-99, nrow=1000, ncol=nsim)
> mresultb <- matrix(-99, nrow=1000, ncol=nsim)
> N <- 200
> I <- 5
> taus <- c(0.480:0.520)
> h <- c(1:20/1000)
> alpha1 <- c(1:82)
> aeven1 <- alpha[2 * 1:41]
> aodd1 <- alpha[-2 * 1:41]
> alpha2 <- c(1:40)
> aeven2 <- alpha2[2 * 1:20]
> #Create an object to hold results.
> M <- matrix(0, ncol=82, nrow=nsim)
> Mhb0 <- matrix(0, ncol=20, nrow=nsim)
> Mhb1 <- matrix(0, ncol=20, nrow=nsim)
> Mchb0 <- matrix(0, ncol=20, nrow=nsim)
> Mchb1 <- matrix(0, ncol=20, nrow=nsim)
> for (i in 1:nsim){
> # make a matrix with 5 cols of N random uniform values
> u <- replicate( 5, runif(N, 0, 1) )
> # fit matrix u in another matrix of 1 column
> mu <- matrix(u, nrow=1000, ncol=1)
> # make auction-specific covariate
> x <- runif(N, 0, 1)
> mx <- matrix(rep(x,5), nrow=1000, ncol=1)
> b0 <- matrix(rep(c(1),1000), nrow=1000, ncol=1)
> #function for private cost
> cost <- b0+b0*mx+mu
> #bidding strategy
> bid <- mx+((I+1)/I)+((I-1)/I)*mu
> mresultb[,i] <- bid
> mresultx[,i] <- mx
> qf <- rq(formula = mresultb[,i] ~ mresultx[,i], tau= 480:520/1000)
> # Storing result and does not overwrite prior values
> M[i, ] <- coef(qf)
> QI <- (1-0.5)/(I-1)
> M50b0 <- M[,41]
> M50b1 <- M[,42]
> Mb0 <- matrix(M[,aodd1], nrow=nsim, ncol=20)
> Mb1 <- matrix(M[,aeven1], nrow=nsim, ncol=20)
>  for (t in aeven2){
>  Mhb0[,t] <- M[,(41+t)]-M[,(41-t)]
>  Mhb1[,t] <- M[,(42+t)]-M[,(42-t)]
>  }
> }
>
>
>
> The problem is in the part:
>
> for (t in aeven2){
>  Mhb0[,t] <- M[,(41+t)]-M[,(41-t)]
>  Mhb1[,t] <- M[,(42+t)]-M[,(42-t)]
>  }
>
>
> Since I want the software to subtract from column (41+t) of matrix called M the column (41-t), in such a way that the matrix Mhb0 will show me the result for each t organized by columns.
>
>
>
> Does anybody know what exactly I am doing wrong?
>
>
>
> Thanks in advance!
>
>
>
> Julia
>
>        [[alternative HTML version deleted]]
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>



More information about the R-help mailing list