####################################################################
#######                                                      #######
#######       Recover the livebids from the Proxybids        #######     
#######                                                      #######
####################################################################


####################################################################
####      find the bid increment for a given auction price      ####
####################################################################

## function bid.incr(price)
bid.incr <- 
       function(price) 
           { bidint <- c(0,0.99,4.99,24.99,99.99,249.99,499.99,999.99,2499.99,4999.99)
               ## interval of prices
             inc <- c(0.05,0.25,0.5,1,2.5,5,10,25,50,100)
               ## increments of price for particular interval
             inc[findInterval(price,bidint)]
           }

############################################################
##########            make livebids              ###########
############################################################

## function recover.livebids(bids,bidder,openbid,winningbid)
## This function reconstructs the sequence of livebids by 
## inputing the raw bids,bidder IDs and opening bid

recover.livebids <- 
       function(bids,bidder,openbid,winningbid)
           { nbid <- length(bids)
             if (nbid==1) { live <- openbid
                            live
                           }
             else {
                   if (nbid==2) {live <- numeric(nbid)
                                 live[1] <- openbid
                                 live[nbid] <- winningbid
                                 live}

                   else { live <- numeric(nbid)
                          maxbid <- bids[1]
                          live[1] <- openbid
                          live[nbid] <- winningbid
                          currentprice <- bids[1]
                          maxbidder <- bidder[1]
                          for (i in 2:(nbid-1)) 
                                { newbid <- bids[i]
                                  newbidder <- bidder[i]
                                  if (newbid > maxbid) { if (!(identical(newbidder,maxbidder))) 
                                                             { incr <- bid.incr(maxbid)
                                                               if (newbid < maxbid+incr)  currentprice <- newbid
                                                               else currentprice <- maxbid+incr
                                                               maxbid <- newbid         
                                                               maxbidder <- newbidder
                                                              } 
                                                         else {maxbid <- newbid 
                                                               maxbidder <- maxbidder
                                                               }
                                                       }
                                  else {if (newbid < maxbid) { incr <- bid.incr(newbid)
                                                               if (newbid+incr>=maxbid) currentprice <- maxbid
                                                               else currentprice <- newbid+incr
                                                               maxbid <- maxbid
                                                               maxbidder <- maxbidder
                                                              }
                                         else { if (!(identical(newbidder,maxbidder))) 
                                                                            {currentprice <- maxbid
                                                                             maxbid <- maxbid
                                                                             maxbidder <- maxbidder
                                                                            }
                                                else {currentprice <- currentprice
                                                      maxbid <- maxbid
                                                      maxbidder <- maxbidder
                                                      }                                              
                                              }
                                        }
                                 live[i] <- currentprice
                               }
                         live
                        }
                  }
             }





############### Monotone Spline Smoothing #################



###########################################################
########### Start of Program                      #########
###########################################################
## Load packages                                      ##
 library(fda)
 library(splines)
 library(stats)

##set working directory
setwd("C:/Research/Data/Palm Pilot All Length")

##import data    
data<-read.csv("PalmBidHistoryAllLengthsA.csv",skip=0,header=T,sep=",")
#names(data)
# [1] "Auction.ID"        "Opening.Bid"       "Winning.Bid"      
# [4] "Start.Time...Date" "End.Time...Date"   "Length"           
# [7] "Bidder.ID"         "Bidder.Rating"     "Bid.Amount...."   
#[10] "Bid.Time...Date"   "Time"              "StartFromBegin"   
#[13] "EndFromBegin"      "BidFromBegin"

## create new data frame to be consistent with variable names and other data sets
newdata<-data.frame(auctid=data[[1]],
                         winningbid=data[[3]],startbid=data[[2]],length=data[[6]],
                         bidderid=data[[7]],bidderrating=data[[8]],bid=data[[9]],
                         startdate=data[[4]],
                         biddate=data[[10]],enddate=data[[5]],tbid=data[[11]],
			 startfrombegin=data[[12]],bidfrombegin=data[[14]],endfrombegin=data[[13]])
attach(newdata)
rm(data) 

BidTime <- split(tbid,auctid)
Bid  <- split(bid,auctid) 
#Bidder <- split(bidderid,auctid) 
Bidder <- split(substr(as.character(bidderid),1,15),auctid)  ## need to do it this way since some bidder names are too long!!!
numauct <- length(Bid)

## Vectors of Opening and Winning Bid for Each Auction
Otmp <- split(startbid,auctid)
Openbid <- numeric(numauct)
for (i in 1:numauct) {tmp <-  Otmp[[i]]
                        Openbid[i] <- tmp[1]
                        }
Wtmp <- split(winningbid,auctid)
Winbid <- numeric(numauct)
for (i in 1:numauct) {tmp <-  Wtmp[[i]]
                        Winbid[i] <- tmp[1]
                        }

knots <- c(0,1,3,5,6,6.5,7)
numk<-length(knots)
plotpoints <- seq(0,7,0.1)
numplot <- length(plotpoints)


###### reconstruct livebids for the rolexdata ######
livebids <- list(0); length(livebids) <- numauct
for (i in 1:numauct) livebids[[i]] <- recover.livebids(Bid[[i]],Bidder[[i]],Openbid[i],Winbid[i])

steptmp <- list(0); length(steptmp) <- numauct
newlive <- array(0,c(numauct,numk))
for (i in 1:numauct) {steptmp[[i]] <- stepfun(BidTime[[i]],c(Openbid[i],livebids[[i]]))
                      newlive[i,] <- steptmp[[i]](knots)
                     } 

########### set parameters ###########

norder <- 5
nbasis <- numk + 2
lambda <- 0.1
wbasis <- create.bspline.basis(rangeval=c(0,7),nbasis=nbasis, norder=5)
Wfd <- list(0); length(Wfd) <- numauct
for (i in 1:numauct) Wfd[[i]] <- data2fd(log(newlive[i,]),knots,wbasis)
mss <- list(0); length(mss) <- numauct
growfdPar <- fdPar(Wfd[[i]], 3, lambda)
#numauct<-9  ##uncomment to test code on nine auctions first (monotone.smooth computationally intensive)
for (i in 1:numauct) {mss[[i]] <-smooth.monotone(knots,log(newlive[i,]),rep(1,length(knots)),growfdPar,dbglev=0)
                      cat("iteration=",i)
                      }

beta <- array(0,c(numauct,2))
for (i in 1:numauct) beta[i,] <- mss[[i]]$beta
yhat <- yfdhat <- ysdhat <- array(0,c(numauct,numplot))
for (i in 1:numauct) 
        { yhat[i,]   <-beta[i,1]+beta[i,2]*eval.monfd(plotpoints,mss[[i]]$Wfdobj,Lfd=0)
          yfdhat[i,] <- beta[i,2]*eval.monfd(plotpoints,mss[[i]]$Wfdobj,Lfd=1)
          ysdhat[i,] <- beta[i,2]*eval.monfd(plotpoints,mss[[i]]$Wfdobj,Lfd=2)
        }