Nothing
# stv.wig(() - last revised 30 jan 2024
#' STV election count using WIG as for Scottish Council elections
#' calculated to 5 places of decimals as used for those elections
#'
#' @param votedata File with vote data
#' @param outdirec Needs to be set for permanent record of results
#' (press return to continue to next stage)
#' @param plot If =TRUE (default) produces plots of count and webpages in outdirec
#' @param webdisplay If =TRUE displays plots and statistics as web pages
#' @param interactive If =TRUE reports and pauses at each stage of the count
#' @param messages If=TRUE prints 1-line initial and final reports
#' @param timing Whether to report computing time at each stage
#' @param map Link to a map or other URL associated with election
#'
#' @return A list containing votes at each stage, + optional web pages; for details see manual pref_pkg_manual.pdf (section 3)
#' @export
#'
#' @examples hc12wig=stv.wig(hc12,plot=FALSE,messages=FALSE)
#' @examples nws17wig=stv.wig(nws17,plot=FALSE)
#' @examples p17wig=stv.wig(p17,plot=FALSE)
#' @examples cnc17wig=stv.wig(cnc17,plot=FALSE,timing=TRUE)
#'
stv.wig=function(votedata,outdirec=tempdir(),plot=TRUE,webdisplay=FALSE,interactive=FALSE,messages=TRUE,timing=FALSE,map=FALSE){
# don't try plotting if package jpeg is not available:
if(requireNamespace("jpeg")==FALSE){
plot=FALSE; warning("package jpeg not available, setting plot=FALSE")
}
sys="wig"
tim0=proc.time() # to track computing time taken (use timing=TRUE to print for each stage)
# read and unpack elecdata - only essential component is vote matrix ed$v
vd=votedata; vote=vd$v
nvd=names(vd)
if("s" %in% nvd){ns=vd$s}else{ns=as.numeric(readline("number of seats? "))}
nv0=dim(vote)[[1]]; nc0=dim(vote)[[2]]
if("e" %in% nvd){elecname=vd$e}else{elecname="election"}
if("c" %in% nvd){nc=vd$c}else{nc=nc0}
if("nv" %in% nvd){nv=vd$nv}else{nv=nv0}
if("m" %in% nvd){mult=vd$m}else{mult=rep(1,nv)}
totalvotes=sum(mult); na2=dimnames(vote)[[2]]
if(is.null(na2)){na2=let(nc)}else{if(na2[[1]]=="V1"){na2=let(nc)}}
if("n" %in% nvd){name=vd$n}else{if("n2" %in% nvd){name=vd$n2}else{name=na2}}
if("n2" %in% nvd){name2=vd$n2}else{name2=name}
if("f" %in% nvd){fname=vd$f}else{fname=rep("",nc)}
if("p" %in% nvd){party=vd$p}else{party=rep("",nc)}; np={party[[1]]==""}
if("col" %in% nvd){colour=vd$col}else{colour=grDevices::rainbow(nc)}
vd=list(e=elecname,s=ns,c=nc,nv=nv,m=mult,v=vote,f=fname,n=name,n2=name2,p=party,col=colour); votedata=vd
qa=ceiling((totalvotes+1)/(ns+1)) # quota (fixed)
qpc=100*qa/totalvotes
# inital output if interactive, briefer version if messages=TRUE
if(interactive==TRUE){
cat("\n"); cat("Election: ",elecname,"\n")
cat("System: WIG STV\n")
cat("To fill",ns,"seats; ",nc," candidates:\n")
cat(paste(name,collapse=", ")); cat("\n")
cat(totalvotes,"votes; quota",qa); cat("\n\n")
}else{
if(messages==TRUE){packageStartupMessage(paste("Election:",elecname,"(WIG STV) -",nc,"candidates,",totalvotes,"votes"))}
}
# quota (fixed) and quota (fixed) andhousekeeping variables
inn=rep(0,nc) # 0 indicates still in play (-1 elim, 1 elec, 2 elec & transf)
ic=1:nc
ne=0
it=numeric(); ite=numeric(); backlog=numeric(); ann=rep(0,nc); elec=numeric()
iter=0 # keeps track of number of iterations in count
st=character() # ? for stages
csum=numeric() # count summary (votes at each stage); note also vm, va
dnext="" # text carried over from one stage to next
txt=character() # text describing decisions at each stage
itt=list() # cand nos in order of elec/excl for each stage
trf=c("","t")
if(!dir.exists(outdirec)){dir.create(outdirec)}
# calculate first preferences
f=numeric()
ff=rep(0,nc)
for(iv in 1:nv){
b=vote[iv,]
if(max(b)>0){
f0=min(b[b!=0]); fp=ic[b==f0]
f[[iv]]=fp
ff[[fp]]=ff[[fp]]+mult[[iv]]
}}
stage=0
vm=matrix(0,nrow=nc,ncol=nc+1) # changed!
rem=rep(1,nv)
# transfer step - start of specifically wig stuff
while(ne<ns){ # start of main loop (`while no. elec < no. of seats')
iter=iter+1
done=length(it)
stage=stage+1
vm[,inn!=2]=0
# count votes
for(iv in 1:nv){
b=vote[iv,]
if(max(b)>0){
f0=min(b[b!=0]); fp=ic[b==f0]
vm[f[[iv]],fp]=vm[f[[iv]],fp]+mult[[iv]]*rem[[iv]]
}}
vm[,nc+1]=ff-apply(vm,1,sum)
v=apply(vm,2,sum)
vmp=vm # save values of vm for plotting at end of stage
csum=cbind(csum,v); st=c(st,paste("stage",stage,sep=""))
j=ic[inn[ic]==0 | inn[ic]==1]
je=j[v[j]>=qa] # any still in with >=quota deemed elected
if(length(je)>0){
je=je[order(-v[je])]
inn[je]=1
if(length(je)>1){backlog=je[2:length(je)]}else{backlog=numeric()} # the `queue'
}
# if only ns candidates left, declare all elected
act=ic[inn[ic]>=0]
if(length(act)==ns){
i2=ic[inn[ic]==1]; it=c(it,i2[order(-v[i2])])
i3=ic[inn[ic]==0]; it=c(it,i3[order(-v[i3])])
inn[act]=max(inn[act],1)
}else{
if(length(inn[inn>0])==ns){
i2=ic[inn[ic]==1]; it=c(it,i2[order(-v[i2])])
}else{
# decide whether surplus or elimination next
if(length(je)>0){
jm=je[[1]] # deal for now with largest of these
inn[[jm]]=2
tr=1-qa/v[[jm]]; it=c(it,jm)
vm[,jm]=vm[,jm]*(1-tr)
}else{ # otherwise exclude lowest
if(length(act)==ns+1){
io=order(-v[ic]); il=length(it[it>0])
if(il<ns){
jp=io[ns]; jm=io[ns+1]
margin=v[jp]-v[jm]
it=c(it,io[(il+1):ns]); inn[io[(il+1):ns]]=1; je=io[(il+1):ns]
}
# to add those `elected with <q' to elec
}else{
ix=ic[inn[ic]==0]; lx=length(ix); io=order(-v[ix])
jp=ix[io[lx-1]]
jm=ix[io[lx]]; margin=v[jp]-v[jm]
tr=1; it=c(it,-jm)
inn[jm]=-1
}
# can do extra output to identify close contests - qv R2019 version if wanted
}
# adjust vote file
for(i in 1:nv){
b=vote[i,]
if(max(b)>0){
bm=min(b[b!=0]); fp=ic[b==bm]
if(fp==jm){rem[[i]]=rem[[i]]*tr; rem[[i]]=.00001*floor(rem[[i]]*(10^5))}
vote[i,]=vote[i,]*{inn[1:nc]==0}
if(inn[[fp]]==1){vote[i,fp]=1}
}}
}}
ne=length(ic[inn[ic]>0])
ne2=length(it[it>0])
it_new=it[(done+1):length(it)]
ite=it_new[it_new>0]
xcl=it_new[it_new<0]
# additions to plotting text are for non-transferable
je=je[ann[je]==0]
elec=c(elec,je)
if(stage==1){
va=vm; itt=list(it)
}else{
va=array(c(va,vm),dim=c(nc,(nc+1),stage))
itt=append(itt,list(it))
}
# write output text
if(ne==ns){final=" - final result"}else{final=""}
dec2=""
if(stage==1){dec1=paste("first preferences -",final,sep="")}else{
dec1=paste("stage ",stage,final," - ",dnext,sep="")
}
if(length(ite)>0){
if(length(je)>0){
enames=name2[je]; x=plural(enames)
dec2=paste(x$out,x$has,"achieved the quota, so",x$is,"elected")
}
x=plural(name2[ite])
dnext=paste("after transfer of surplus",x$es," of ",x$out,sep="")
}
if(length(ite)==0){
if(ne==0){nomore="no-one"}else{nomore="no-one else"}
dec2=paste(nomore,"has achieved the quota, so exclude",name2[abs(xcl)])
dnext=paste("after transfer of votes of",name2[abs(xcl)])
}
# correction for when last elected don't reach quota
if(final != ""){
if(v[[ite[[1]]]]<qa){
dec2=paste(name2[[jm]],"is excluded, so")
enames=name2[ite]; x=plural(enames)
dec2=paste(dec2,x$out,x$is,"elected")
}}
dec=c(dec1,dec2)
txt=cbind(txt,dec)
tim=proc.time()-tim0; pt=tim[[1]]
# make permanent plots of stage (if plot=TRUE)
if(plot==TRUE){
wi=(nc+4.5); w=wi*120 # plot width in (approx) inches, and in pixels
for(i in 2:1){
transf=i-1
plotfile=paste(outdirec,paste("stage",trf[[i]],stage,".jpg",sep=""),sep="/")
h=600+200*transf
grDevices::jpeg(plotfile,width=w,height=h)
voteplot(ns,vmp,qpc,it,dec,name2,party,colour,transf,elecname,sys="wig")
grDevices::dev.off()
}}
if(timing==TRUE){message(paste(stage," process time ",round(pt,3)," secs"))}
# print decision (if interactive=TRUE)
if(interactive==TRUE){
cat(dec,sep="\n"); cat("\n")
# .. and plot current state of votes if plot=TRUE
if(plot==TRUE){plot_jpeg(plotfile,stage)}
if(final==""){readline("next? ")}
}
ann[je]=1
} # closes stages loop, i.e. end of this election count
csum[nc+1,]=totalvotes-apply(as.matrix(csum[1:nc,]),2,sum) # to change
# fudge to get "non-transferred" into line
cname=name
if(length(fname[fname!=""])>0){cname=paste0(cname,", ",fname)}
if(length(party[party!=""])>0){cname=paste0(cname," (",party,")")}
dimnames(csum)=list(name=c(cname,"non-transferable"),stage=st)
elec=it[it>0]; x=elec
txt=matrix(txt,nrow=2)
qtext=paste0("Total votes ",totalvotes,", quota = ",qa)
pp=paste(" (",party[x],")",sep=""); if(pp[[1]]==" ( )"|pp[[1]]==" ()"){pp=""}
elected=paste(fname[x]," ",name[x],pp,sep="",collapse=", ")
if(interactive==TRUE){cat("\nVotes at each stage and final keep values:\n")
print(round(csum,2))
cat("\n",qtext,"\n")
}else{
if(messages==TRUE){packageStartupMessage(paste("Those elected, in order of election:",elected))}
}
# save result details and elecdata in R data files
countdata=list(sys="wig",elec=elected,itt=itt,narrative=txt,count=csum,quotatext=qtext,va=va)
elecdata=c(votedata,countdata)
report=stv.report(elecdata)
elecdata=c(elecdata,list(report=report)) # add report narrative
elecfile=paste(strsplit(elecname," ")[[1]],collapse="_")
save(elecdata,file=paste0(outdirec,"/",elecfile,"_",sys,".rda"))
# if plot=TRUE make webpages to go with vote plots, ..
# .. and if interactive=TRUE and webdisplay=TRUE display them
if(plot==TRUE){
wp=webpages(elecdata,outdirec,map)
# if(interactive==TRUE){grDevices::dev.off()}
if(webdisplay==TRUE){utils::browseURL(paste(outdirec,"index.html",sep="/"),browser="open")}
}
elecdata
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.