最大値を取り出す

• 複数の直線が２次元座標にあるとする
• そのｙ値の最大値のグラフを描く
• 実行

N<-10
As<-sample(1:N)
Bs<-1:N
bs<-basket(As,Bs)
bs
plotBasket(bs)

• 関数
  • 手続は
    • 直線の傾き・ｙ切片を与える
    • 直線をユニークにする
    • 始点を定める(今回は、x=0の最大値からスタート)
    • 始点から、傾きが最大の直線を採用する
    • 採択された直線と、その直線より傾きが正側に大な直線との交点を求め、そのうち、ｘが最小の点で、交線に乗り換える
    • 以後、繰り返し

basket<-function(As,Bs,x=0){
 ABs<-unique(cbind(As,Bs))
 Xs<-Ys<-Sl<-c()
 first<-find1st(ABs[,1],ABs[,2],x)
 Xs<-c(Xs,rep(x,length(first)))
 Ys<-c(Ys,ABs[first,1]*x+ABs[first,2])
 Sl<-c(Sl,ABs[first,1])
 newABs<-ABs
 loop<-TRUE
 while(loop){
  currentX<-Xs[length(Xs)]
  currentY<-Ys[length(Ys)]
  currentSlope<-Sl[length(Sl)]
  newABs<-matrix(newABs[which(newABs[,1]>currentSlope),],ncol=2)
  if(length(newABs)>0){
   intersectX<-(currentY-currentSlope*currentX-newABs[,2])/(newABs[,1]-currentSlope)
   nextID<-which(intersectX==min(intersectX))
   intersectY<-newABs[nextID,1]*intersectX[nextID]+newABs[nextID,2]
   Xs<-c(Xs,intersectX[nextID])
   Ys<-c(Ys,intersectY)
   Sl<-c(Sl,newABs[nextID,1])
  }else{
   loop<-FALSE
  }
 }
 return(list(uniqueABs=ABs,Xs=Xs,Ys=Ys,Sl=Sl))
}

plotBasket<-function(bs){
 redfactor<-0.2
 xlim<-c(0,max(bs$Xs)*(1+redfactor))
 ylim<-c(min(bs$Ys),max(bs$Ys)*(1+redfactor))
 plot(bs$Xs,bs$Ys,type="b",col="red",xlim=xlim,ylim=ylim)
 for(i in 1:length(bs$uniqueABs[,1])){
  abline(bs$uniqueABs[i,2],bs$uniqueABs[i,1])
 }
 addpointX<-max(bs$Xs)*(1+redfactor)
 addpointY<-bs$Sl[length(bs$Sl)]*(addpointX-bs$Xs[length(bs$Xs)])+bs$Ys[length(bs$Ys)]
 par(new=TRUE)
 plot(bs$Xs,bs$Ys,type="p",pch=15,col="red",xlim=xlim,ylim=ylim)
 par(new=TRUE)
 plot(c(bs$Xs,addpointX),c(bs$Ys,addpointY),type="l",col="red",xlim=xlim,ylim=ylim)

}
find1st<-function(As,Bs,x=0){
 tmp<-which(As*x+Bs==max(As*x+Bs))
 tmp[which(As[tmp]==max(As[tmp]))]
}