#*********************************************
#*********************************************
#' ***DECRIPTION MISSING***
#'
#' @return
#'
#' @examples
#' \dontrun{}
#'
#' @importFrom gdata read.xls
#' @importFrom TSD chars NAs ones zeros
#'
#' @export
#' @rdname writePointsRound
#'
writePointsRound<-function(round=1,volume=1,pow=c(3,3,3,3,1,1),w=c(32,32,31,28,10,6),subst=TRUE,write=c("StatsPlayersRound","PointsRound","TableRound","form")){
# In "StatsPlayersRound" the values are updated by the latest WR and collected points. In "PointsRound" and "TableRound" and "form" the values at the start of the round is used, unless volume=="all".
charvector=c("","*","**","***","****","*****","******","*******","********","*********","**********","***********","************","*************","**************","***************","****************","*****************","******************","*******************","********************","*********************","**********************","***********************","************************","*************************")
nrounds=min(13,round)
nparticipants=100
pos=c("Keeper","Left defender","Rigth defender","Left wing","Center","Right wing","Substitute 1","Substitute 2")
maxprice=50
reorder=function(x){
order=seq_along(x)
arezeros=which(x[1:6]==0)
subst=which(x[7:8]>0)
if(length(arezeros)>0 && length(subst)>0){
if(length(arezeros)<length(subst)){
out=order[arezeros[seq_along(arezeros)]]
order[arezeros[seq_along(arezeros)]]=subst[seq_along(arezeros)]+6
order[subst[seq_along(arezeros)]+6]=out
}
else{
out=order[arezeros[seq_along(subst)]]
order[arezeros[seq_along(subst)]]=subst+6
order[subst+6]=out
}
}
order
}
# Get all players:
allplayers=getallplayers()
nplayers=nrow(allplayers)
allplayers[,1]=substr(allplayers[,1],1,20)
allplayerstables=vector("list",nrow(allplayers))
# Read deadlines:
t=as.matrix(read.xls("/Users/arnejohannesholmin/Documents/Diverse/Bordhockey/FantasyNBA/Deadlines/Deadlines2012.xls")[,2:3])
dir="/Users/arnejohannesholmin/Documents/Diverse/Bordhockey/FantasyNBA/Tournaments"
teamdir=list.files("/Users/arnejohannesholmin/Documents/Diverse/Bordhockey/FantasyNBA/FantasyNBA testsesong vår 2012/",full.names=TRUE)
teamdirnames=basename(teamdir)
valid=substr(teamdirnames,1,5)=="Runde"
teamdir=teamdir[valid]
teamdirnames=teamdirnames[valid]
r=as.numeric(substr(teamdirnames,7,8))
teamnames=NULL
oldteamnames=NULL
teams=NAs(8,nrounds,nparticipants)
points=NAs(8,nrounds,nparticipants)
values=NAs(8,nrounds,nparticipants)
ntransfers=NAs(nrounds,nparticipants)
bank=NAs(nrounds,nparticipants)
oldprice=NULL
diffprice=NULL
# 'oldteams' is useful when extracting which players are sold and bought, and how many times:
oldteams=NULL
dreamteamRounds=zeros(nplayers,nrounds)
dreamteamTotal=zeros(nplayers,nrounds)
pTotalforDreamteamTotal=NULL
gameweekjoined=NULL
for(j in seq_len(nrounds)){
# Get player points:
p=get.points_fantasyNBA(dir,pow=pow,w=w,t=t[j,],n=if(j==nrounds) volume else "all")
# Get player prices:
if(substr(t[j,1],4,8)=="0101"){
t[j,1]=paste(as.numeric(substr(t[j,1],1,4))-1,"1231",sep="")
}
if(substr(t[j,1],7,8)=="01" && substr(t[j,1],5,6)%in%c("01","02","04","06","08","09","11")){
t[j,1]=paste(as.numeric(substr(t[j,1],1,6))-1,"31",sep="")
}
else if(substr(t[j,1],7,8)=="01" && substr(t[j,1],5,6)%in%c("05","07","10","12")){
t[j,1]=paste(as.numeric(substr(t[j,1],1,6))-1,"30",sep="")
}
else if(substr(t[j,1],7,8)=="01" && substr(t[j,1],5,6)=="03"){
t[j,1]=paste(as.numeric(substr(t[j,1],1,6))-1,"28",sep="")
}
else{
t[j,1]=t[j,1]-1
}
price=getprice_testseason(t[j,1])
price[,1]=substr(price[,1],1,20)
p$total$Player=substr(p$total$Player,1,20)
p$total=cbind(p$total,Dreamteam=0)
pTotalforDreamteamTotal=cbind(pTotalforDreamteamTotal,p$total$total-price[,ncol(price)]/1000000)
if(!(j==nrounds && volume==0) && length(p$dates)>0){
p$total$Dreamteam[order(p$total$total-price[,ncol(price)]/1000000,decreasing=TRUE)[1:6]]=1
p$total$Dreamteam[p$total$total==0]=0
dreamteamRounds[,j]=p$total$Dreamteam
dreamteamTotal[order(rowSums(pTotalforDreamteamTotal),decreasing=TRUE)[1:6],j]=1
dreamteamTotal[rowSums(pTotalforDreamteamTotal)==0]=0
}
dreamteamRounds[is.na(dreamteamRounds)]=0
# Read the teams:
thisplayers=readTeams(teamdir[r==j])
thisteamnames=colnames(thisplayers)
newteamnames=setdiff(thisteamnames,teamnames)
# Add the new team names to 'teamnames':
teamnames=c(teamnames,setdiff(thisteamnames,teamnames))
gameweekjoined=c(gameweekjoined,rep(j,length(newteamnames)))
teamseq=seq_along(teamnames)
# Add the new teams to 'teams':
if(j>1){
teams[,j,]=teams[,j-1,]
}
teams[,j,match(thisteamnames,teamnames)]=thisplayers
points[,j,teamseq]=p$total$total[match(teams[,j,teamseq],p$total$Player)]
points[is.na(points)]=0
thisprice=price[match(teams[,j,teamseq],price[,1]),ncol(price)]
thisprice[is.na(thisprice)]=2
values[,j,teamseq]=thisprice
if(j==nrounds && volume=="all"){
lastprice=getprice_testseason(t[j,2])
lastprice[,1]=substr(lastprice[,1],1,20)
thisprice=lastprice[match(teams[,j,teamseq],lastprice[,1]),ncol(lastprice)]
thisprice[is.na(thisprice)]=2
currentvalues=array(thisprice,dim=c(8,length(teamseq)))
}
else{
currentvalues=values[,j,teamseq]
}
# Get the price changes:
if(j==1){
diffprice=data.frame(zeros(nrow(price)))
}
else{
diffprice=price[ncol(price)]-oldprice[ncol(oldprice)]
}
colnames(diffprice)="Change"
bought=NULL
sold=NULL
selected=round(table(teams[,j,])/length(teamnames)*100,digits=1)
for(pl in seq_along(oldteamnames)){
bought=c(bought,setdiff(teams[,j,pl],oldteams[,pl]))
sold=c(sold,setdiff(oldteams[,pl],teams[,j,pl]))
}
if(j==1){
bought=table(teams[,j,])
}
else{
bought=table(bought)
}
sold=table(sold)
for(pl in seq_along(allplayerstables)){
WR_pl=price$PointsWR0[price[,1]==allplayers[pl]]
sold_pl=sold[allplayers[pl]]
bought_pl=bought[allplayers[pl]]
selected_pl=selected[allplayers[pl]]
points3_pl=p$total[p$total[,1]==allplayers[pl],2:4]
total_pl=0
price_pl=price[price[,1]==allplayers[pl],ncol(price)]
pricechange_pl=diffprice[price[,1]==allplayers[pl],1]
thisdreamteamRound=dreamteamRounds[price[,1]==allplayers[pl],j]
thisdreamteamTotal=dreamteamTotal[price[,1]==allplayers[pl],j]
thisline=unlist(c(WR=WR_pl, Sold=sold_pl, Bought=bought_pl, Selected=selected_pl, Touraments=points3_pl[1], Local=points3_pl[2], Points=points3_pl[3], Total=total_pl, Price=price_pl, Change=pricechange_pl, DreamteamRound=thisdreamteamRound, DreamteamTotal=thisdreamteamTotal))
thisline[is.na(thisline)]=0
allplayerstables[[pl]]=rbind(allplayerstables[[pl]],thisline)
}
# Calculate the bank and reset the values to the current values:
if(length(newteamnames)>0){
bank[j,match(newteamnames,teamnames)]=maxprice-colSums(values[,j,match(newteamnames,teamnames),drop=FALSE],na.rm=TRUE)
ntransfers[j,match(newteamnames,teamnames)]=0
}
if(j>1){
values_oldteam=array(unlist(price[match(oldteams,price[,1]),ncol(price),drop=FALSE]),dim=dim(oldteams))
values_oldteam[is.na(values_oldteam)]=2
bank[j,match(oldteamnames,teamnames)]=bank[j-1,match(oldteamnames,teamnames)]-colSums(values[,j,match(oldteamnames,teamnames)],na.rm=TRUE)+colSums(values_oldteam,na.rm=TRUE)
for(p in match(oldteamnames,teamnames)){
ntransfers[j,p]=length(setdiff(teams[,j,p],teams[,j-1,p]))
}
}
oldprice=price
oldteams=teams[,j,teamseq]
oldteamnames=teamnames
}
lastprice=getprice_testseason(t[j,2])
# Define colnames to the tables for each player:
for(pl in seq_along(allplayerstables)){
allplayerstables[[pl]]=as.data.frame(allplayerstables[[pl]])
colnames(allplayerstables[[pl]])=c("WR","Sold","Bought","Selected","Tournaments","Local","Points","Total","Price","Change","DreamteamRound","DreamteamTotal")
row.names(allplayerstables[[pl]])=paste("Round",seq_len(nrounds),sep="")
allplayerstables[[pl]]$DreamteamRound=charvector[dreamteamRounds[pl,]+1]
allplayerstables[[pl]]$DreamteamTotal=charvector[dreamteamTotal[pl,]+1]
# Add up the points to get the cummulated points:
allplayerstables[[pl]]$Total=cumsum(allplayerstables[[pl]]$Points)
# Move the price change to the week they resulted from:
allplayerstables[[pl]]$Change[-nrounds]=allplayerstables[[pl]]$Change[-1]
allplayerstables[[pl]]$Change[nrounds] = lastprice[substr(allplayers[pl,1],1,20)==substr(lastprice[,1],1,20),ncol(lastprice)] - allplayerstables[[pl]]$Price[nrounds]
}
names(allplayerstables)=allplayers[,1]
if("StatsPlayersRound" %in% write){
file=paste("/Users/arnejohannesholmin/Documents/Diverse/Bordhockey/FantasyNBA/Handouts new/StatsPlayersRound_",j,"_",volume,".xls",sep="")
ordertotalpoints=order(sapply(allplayerstables,function(x) x[nrow(x),8]),decreasing=TRUE)
for(p in seq_along(ordertotalpoints)){
write.table(array(c(paste(p,names(allplayerstables[ordertotalpoints[p]]),sep=": "),character(9)),dim=c(1,9)),file,append=p>1,sep="\t",row.names=FALSE,col.names=FALSE)
suppressWarnings(write.table(allplayerstables[[ordertotalpoints[p]]],file,append=TRUE,sep="\t",row.names=FALSE,dec=","))
if(p<length(allplayerstables)){
suppressWarnings(write.table(chars(2,10),file,append=TRUE,sep="\t",row.names=FALSE,col.names=FALSE))
}
}
}
# Determine which teams are participating and define minus points due to transfers:
validteams=which(!is.na(teams[1,nrounds,]))
ntransfers[is.na(ntransfers)]=0
freetransfers=ones(nrounds+1,nparticipants)
freetransfers[1,]=0
for(j in seq_len(nrounds+1)){
if(j>2){
# If the team has not played a full round,
get2= (ntransfers[j-1,]==0 | (freetransfers[j-1,]==2 & ntransfers[j-1,]<2)) & c(j>gameweekjoined+1,logical(nparticipants-length(gameweekjoined)))
freetransfers[j,get2]=2
}
}
minuspoints=8*(ntransfers-freetransfers[seq_len(nrounds),])
minuspoints[minuspoints<0]=0
#minuspoints=minuspoints[,validteams,drop=FALSE]
allrounds=vector("list",nrounds)
for(j in seq_len(nrounds)){
thisPosition=c(pos,paste("Round",j),"Total","Transfers","TransfersTotal","Subtracted","SubtractedTotal","Value","Bank")
validteams=which(!is.na(teams[1,j,]))
allrounds[[j]]=vector("list",length(validteams))
names(allrounds[[j]])=teamnames[validteams]
file=paste("/Users/arnejohannesholmin/Documents/Diverse/Bordhockey/FantasyNBA/Handouts new/PointsRound_",j,"_",volume,".xls",sep="")
for(p in order(teamnames[validteams])){
if(subst || j<nrounds){
neworder=reorder(points[1:8,j,p])
teams[1:8,j,p]=teams[neworder,j,p]
points[1:8,j,p]=points[neworder,j,p]
values[1:8,j,p]=values[neworder,j,p]
}
thisp=validteams[p]
thisteam=c(teams[,j,thisp],character(8))
thispoints=c(p1t8=points[,j,thisp], p9=sum(points[1:6,j,thisp],na.rm=TRUE), p10=sum(points[1:6,seq_len(j),thisp],na.rm=TRUE)-sum(minuspoints[seq_len(j),thisp],na.rm=TRUE), p11=ntransfers[j,thisp], p12=sum(ntransfers[seq_len(j),thisp],na.rm=TRUE), p13=minuspoints[j,thisp], p14=sum(minuspoints[seq_len(j),thisp],na.rm=TRUE), p15=sum(values[,j,thisp],na.rm=TRUE), p16=bank[j,thisp])
thisprice=c(gsub(".",",",c(price[match(teams[,j,thisp],allplayers),ncol(price)]),fixed=TRUE),character(8))
thisprice[is.na(thisprice)]=2
thisdreamteamRound=c(charvector[dreamteamRounds[match(teams[,j,thisp],allplayers),j]+1],character(8))
thisdreamteamTotal=c(charvector[dreamteamTotal[match(teams[,j,thisp],allplayers),j]+1],character(8))
thisdreamteamRound[is.na(thisdreamteamRound)]=""
thisdreamteamTotal[is.na(thisdreamteamTotal)]=""
allrounds[[j]][[p]]=data.frame(Position=thisPosition,Player=thisteam,Price=thisprice,Points=thispoints,DreamteamRound=thisdreamteamRound,DreamteamTotal=thisdreamteamTotal)
if(j==nrounds && "PointsRound" %in% write){
write.table(array(c(names(allrounds[[j]][p]),character(5)),dim=c(1,5)),file,append=p>1,sep="\t",row.names=FALSE,col.names=FALSE)
suppressWarnings(write.table(allrounds[[j]][[p]],file,append=TRUE,sep="\t",row.names=FALSE,dec=","))
if(subst){
for(s in which(neworder[1:6]!=1:6)){
suppressWarnings(write.table(array(c(paste("Substituted: ",teams[neworder[s],j,p]," out, ",teams[s,j,p]," in",sep=""),"",""),dim=c(1,3)),file,append=TRUE,sep="\t",row.names=FALSE,col.names=FALSE))
}
}
if(p<length(allrounds[[j]])){
suppressWarnings(write.table(chars(2,6),file,append=TRUE,sep="\t",row.names=FALSE,col.names=FALSE))
}
}
}
}
Team=teamnames
RoundBrutto = t(apply(points[1:6,,validteams,drop=FALSE],2:3,sum,na.rm=TRUE))
RoundNetto = t(apply(points[1:6,,validteams,drop=FALSE],2:3,sum,na.rm=TRUE))-t(minuspoints[,validteams,drop=FALSE])
RoundTransfers = ntransfers[,validteams,drop=FALSE]
RoundSubtracted = minuspoints[,validteams,drop=FALSE]
TotalBrutto=apply(points[1:6,seq_len(nrounds),validteams,drop=FALSE],3,sum,na.rm=TRUE)
TotalSubtracted = colSums(minuspoints[,validteams,drop=FALSE],na.rm=TRUE)
TotalNetto=apply(points[1:6,seq_len(nrounds),validteams,drop=FALSE],3,sum,na.rm=TRUE)-TotalSubtracted
TotalTransfers=colSums(ntransfers[,validteams,drop=FALSE],na.rm=TRUE)
CurrentValue=colSums(currentvalues)
#Value=t(apply(values[,nrounds,validteams,drop=FALSE],2:3,sum,na.rm=TRUE))
Bank=bank[nrounds,validteams]
TotalValue=CurrentValue+Bank
if(length(RoundBrutto)>0){
teamtable=data.frame(Team=Team, array(rbind(RoundBrutto,RoundNetto,t(RoundTransfers),t(RoundSubtracted)),dim=c(nrow(RoundBrutto),4*ncol(RoundBrutto))), TB=TotalBrutto, TN=TotalNetto, TT=TotalTransfers, TS=TotalSubtracted, FT=freetransfers[nrounds,validteams], CV=CurrentValue, B=Bank, TV=TotalValue)
colnames(teamtable)=c("Team",outer(c("RB","RN","RT","RS"),seq_len(nrounds),paste,sep=""),"TB","TN","TT","TS","FT","CV","B","TV")
teamtable=teamtable[order(teamtable$TN,decreasing=TRUE),]
teamtable=cbind(Rank=floor(nrow(teamtable)+1-rank(teamtable$TN,ties.method="max")),teamtable)
if("TableRound" %in% write){
file=paste("/Users/arnejohannesholmin/Documents/Diverse/Bordhockey/FantasyNBA/Handouts new/TableRound_",j,"_",volume,".xls",sep="")
write.table(teamtable,file,sep="\t",row.names=FALSE,col.names=TRUE,dec=",")
}
write.table(rbind("",cbind("",c("RB: RoundBrutto","RN: RoundNetto","RT: RoundTransfers","RS: RoundSubtracted","TB: TotalBrutto","TN: TotalNetto","TT: TotalTransfers","TS: TotalSubtracted","FT: FreeTransfers","CV=CurrentValue","B: Bank","TV: TotalValue"))),file,sep="\t",row.names=FALSE,col.names=FALSE,append=TRUE)
}
##### Finally write the gameweek form: #####
# Excelark med informasjon om spelarane og høve til å velja lag:
# Rank Player Club Nation Sold Bought Selected PriceChange PointsWR Best Score2011 Scorev2012 ScoreRound PriceT *Lag*
if("form" %in% write){
formdir=paste("/Users/arnejohannesholmin/Documents/Diverse/Bordhockey/FantasyNBA/Handouts new/Forms round",nrounds,sep="")
dir.create(formdir)
setwd(formdir)
}
WRvsS=c(1,2) # c(1,2)
WRvsS=WRvsS/sum(WRvsS)
# Minimum price:
minprice=2
minpriceWR = minprice*WRvsS[1]
minpriceS = minprice*WRvsS[2]
# Parameters of the prices:
ScaleWR=0.001
ScaleS=0.025
# Correct for half season:
ScaleS=ScaleS*2
# Read prices:
thisPriceWR=getpriceWR(date=t[nrounds,2],par=c(ScaleWR,minpriceWR))
validteams=which(!is.na(teams[1,nrounds-1,]))
for(p in seq_along(validteams)){
Player=allplayers[,1]
Club=allplayers[,2]
Nation=allplayers[,3]
transferweek=nrow(allplayerstables[[1]]) - as.numeric(j>1)
Sold=sapply(allplayerstables,function(x) x[transferweek,2])
Bought=sapply(allplayerstables,function(x) x[transferweek,3])
Selected=sapply(allplayerstables,function(x) x[transferweek,4])
Change=round(diffprice[match(allplayers[,1],price[,1]),1],digits=1)
PointsWR=thisPriceWR$PointsWR
Best=thisPriceWR$Best
Score2011=2*price$Points2011[match(allplayers[,1],price[,1])]
Scorev2012=sapply(allplayerstables,function(x) sum(x[seq_len(nrow(x)),8]))
ScoreRound=sapply(allplayerstables,function(x) x[nrow(x),8])
Price=price[match(allplayers[,1],price[,1]),ncol(price)]
Position=c("Keeper","Left defender","Rigth defender","Left wing","Center","Right wing","Substitute 1","Substitute 2",character(length(Price)-8))
Team=c(teams[,j,validteams[p]],"Total","Old Team Value","In the bank","Rest","","Free transfers",character(length(Price)-14))
thisbank=max(bank[nrounds,validteams[p]],0)
Value=c(character(9),sum(values[,nrounds,validteams[p]]),thisbank,"","",freetransfers[nrounds,validteams[p]],character(length(Price)-14))
gameweekform=data.frame(Player=Player, Club=Club, Nation=Nation, Sold=Sold, Bought=Bought, Selected=Selected, Change=Change,PointsWR=PointsWR, Best=Best, Score2011=Score2011, Scorev2012=Scorev2012, ScoreRound=ScoreRound, Price=Price)
gameweekform=cbind(Rank=floor(nrow(gameweekform)+1-rank(gameweekform$Price)),gameweekform)
gameweekform=gameweekform[order(gameweekform$Price,decreasing=TRUE),]
gameweekform=cbind(gameweekform, data.frame(Position=Position, Team=Team, Value=gsub(".",",",Value,fixed=TRUE)))
if("form" %in% write){
thisteamname=teamnames[p]
thisteamname=strsplit(thisteamname," - ")[[1]]
write.table(x=gameweekform,paste(thisteamname[1],"@",thisteamname[2],"@FantasyNBA runde ",nrounds,".xls",sep=""),row.names = FALSE,dec = ",",sep="\t")
}
}
# Return various information:
if(length(RoundBrutto)>0){
list(allrounds=allrounds,teamtable=teamtable,allplayerstables=allplayerstables, gameweekform=gameweekform)
}
else{
list(allrounds=allrounds,allplayerstables=allplayerstables, gameweekform=gameweekform)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.