FC2ブログ

スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

Rでウェブアプリ

#実行ファイル(vbs)_RunShinyApp.vbs
Set RdoObject = CreateObject("Wscript.Shell")
RdoObject.Run "C:\Users\papas\Documents\R\App\R-Portable\App\R-Portable\bin\R.exe/ CMD BATCH --encoding=UTF-8 runShinyApp.R", False

#Shiny発動R_runShinyApp.R

library(openxlsx)

.libPaths("./R-Portable/App/R-Portable/library")
# the path to portable firefox
browser.path = file.path("C:/Program Files/internet explorer/iexplore.exe")
options(browser = browser.path)
shiny::runApp("./Shiny/",port=7779,launch.browser=TRUE)

#ui.R

library(shiny)

shinyUI(
fluidPage(
titlePanel("Hazard_cul"),
# Sidebar with a slider input for number of bins
sidebarLayout(

#side###################################################
sidebarPanel(
#fileinput
fluidRow(
h2("1.Select setting file of calculation"),
column(10,
fileInput("file","xlsx File select",accept = c("text/csv","text/comma-separated-values,text/plain",".csv"))
)),
#number
h2("2.Let's calculate Average"),
actionButton("submit","RUN"),
h4("result --- Calculation Data TAB"),
br(),

h2("3.Let's culculate Graph"),
h3(" Setting graph calculation"),

htmlOutput("colname1"),
h4("3-2.Set trim of maximum value of hazard calculation"),
fluidRow(
column(5,numericInput("num.haztrim","sheet",0)),
column(5,numericInput("num.haztrim_lf","life",0))
),
h4("3-3.Set trim of maximum value of wpp calculation"),
fluidRow(
column(5,numericInput("num.wpptrim"," sheet",0)),
column(5,numericInput("num.wpptrim_lf","life",0))
),
h4("3-4.Set the number of data to divide"),
fluidRow(
column(5,numericInput("num.divdata","sheet",0)),
column(5,numericInput("num.divdata_lf","life",0))
),
actionButton("submit2","RUN"),
h4(" result --- Graph TAB")
#download
#h2("Data DownLoad")
# downloadButton("downloadData","download")
#****

),
#main###################################################
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Setting Parameters",tableOutput("table")),
tabPanel("Calculation Data",downloadButton("downloadData","Calculate Data Download"), tableOutput("table2")),
tabPanel("Hazard Graph",downloadButton("downloadData2","Graph Data Download"), plotOutput("haz_dist")),
tabPanel("Weibull Graph",downloadButton("downloadData3","Graph Data Download"), plotOutput("wpp_dist")),
tabPanel("Hazard Graph life",downloadButton("downloadData4","Graph Data Download"), plotOutput("haz_dist_lf")),
tabPanel("Weibull Graph life",downloadButton("downloadData5","Graph Data Download"), plotOutput("wpp_dist_lf"))
)
)
)
)
)

#server.R

library(shiny)
library(openxlsx)
#library(ggplot2)
source("hazard0.R")
source("hazard1.R")
source("hazard2.R")
source("wpp.R")
source("hazard3.R")
source("wpp2.R")
shinyServer(
function(input, output,session) {
observeEvent(input$file,{
csv_file = reactive(read.xlsx(input$file$datapath,startRow = 2))
output$table = renderTable(csv_file())
x<-csv_file()
runname = paste(x[,1],x[,2],x[,3],x[,4],x[,5],sep="-")
output$colname1 = renderUI({selectInput("ui.bin","3-1.select No of graph cul ",runname)})
})

observeEvent(input$submit,{
csv_file = reactive(read.xlsx(input$file$datapath,startRow = 2))
setting <- csv_file()

sumdata<- gethazard(setting,input$ui.bin,input$num.haztrim,input$num.wpptrim,input$num.divdata)
sumdata2<- gethazard_lf(setting,input$ui.bin,input$num.haztrim_lf,input$num.wpptrim_lf,input$num.divdata_lf)
sumdata3<-cbind(sumdata,sumdata2)
output$table2 = renderTable(sumdata3)
output$downloadData = downloadHandler(filename = "hazard_output.csv",content = function(file){write.csv(sumdata,file,row.names = F)})

})

observeEvent(input$submit2,{
csv_file = reactive(read.xlsx(input$file$datapath,startRow = 2))
setting <- csv_file()
haz_dist<- gethazard_dist(setting,input$ui.bin,input$num.haztrim,input$num.wpptrim,input$num.divdata)
wpp_dist<- getwpp_dist(setting,input$ui.bin,input$num.haztrim,input$num.wpptrim,input$num.divdata)
haz_dist_lf<- gethazard_dist_lf(setting,input$ui.bin,input$num.haztrim_lf,input$num.wpptrim_lf,input$num.divdata_lf)
wpp_dist_lf<- getwpp_dist_lf(setting,input$ui.bin,input$num.haztrim_lf,input$num.wpptrim_lf,input$num.divdata_lf)

x<-haz_dist[,"cnt"]
y<-haz_dist[,"Ft"]
xx<-wpp_dist[,"w_cnt"]
yy<-wpp_dist[,"w_Ft"]
x_lf<-haz_dist_lf[,"cnt"]
y_lf<-haz_dist_lf[,"Ft"]
xx_lf<-wpp_dist_lf[,"w_cnt"]
yy_lf<-wpp_dist_lf[,"w_Ft"]
titlename<-paste("Ft-cnt",input$ui.bin)
titlename2<-paste("Ft-cnt_Weibull-Approximate",input$ui.bin)
filename<-paste("hazard_",input$ui.bin,".xlsx",sep="")
filename2<-paste("wpp_",input$ui.bin,".xlsx",sep="")

output$haz_dist<-renderPlot(plot(x,y,xlim = c(0,max(x)),ylim = c(0,1),main=titlename,xlab="cnt",ylab="Ft"))
output$wpp_dist<-renderPlot({
plot(0,0,type="n",xlim = c(0,max(x,xx)),ylim=c(0,1),main=titlename2,xlab="cnt",ylab = "Ft")
points(xx,yy,col = "black",pch = 16)
points(x,y,col = "red",pch = 20)
})

output$haz_dist_lf<-renderPlot(plot(x_lf,y_lf,xlim = c(0,max(x_lf)),ylim = c(0,1),main=titlename,xlab="cnt",ylab="Ft"))
output$wpp_dist_lf<-renderPlot({
plot(0,0,type="n",xlim = c(0,max(x_lf,xx_lf)),ylim=c(0,1),main=titlename2,xlab="cnt",ylab = "Ft")
points(xx_lf,yy_lf,col = "black",pch = 16)
points(x_lf,y_lf,col = "red",pch = 20)
})
# output$wpp_dist<-renderPlot({
# ggplot()+
# geom_point(data=wpp_dist,aes(x=w_cnt,y=w_Ft,size = 1.5))+
# geom_point(data=haz_dist,aes(x=cnt,y=Ft,colour = "red"))+
# labs(title = titlename2,x="cnt",y="Ft")
# })
output$downloadData2 = downloadHandler(filename = filename,content = function(file){write.xlsx(haz_dist,file,row.names = F)})
output$downloadData3 = downloadHandler(filename = filename2,content = function(file){write.xlsx(wpp_dist,file,row.names = F)})
output$downloadData4 = downloadHandler(filename = filename,content = function(file){write.xlsx(haz_dist_lf,file,row.names = F)})
output$downloadData5 = downloadHandler(filename = filename2,content = function(file){write.xlsx(wpp_dist_lf,file,row.names = F)})

})
session$onSessionEnded(function(){
stopApp()
q("no")
})
})

#hazard0.R
gethazard<-function(setting,colname1,haz_trim,wpp_trim,div_data){

summary_data<-1
summary_data<-as.data.frame(summary_data)

#library(openxlsx)
#setting<-read.xlsx(paste(getwd(),"/条件シート.xlsx",sep=""),startRow = 2)
for(i in 1:NROW(setting)){

#test


#normal_set

seihin<-setting[i,2]
model<-setting[i,3]
simuke<-setting[i,4]
parts<-setting[i,5]
#file
filepath<-setting[i,6]
if(is.na(filepath)){filepath<-paste(getwd(),"/data",sep="")
}else{filepath<-gsub("\\\\","/",filepath)}

filename<-setting[i,7]
if(is.na(filename)){file<-list.files(filepath)
}else{file<-list.files(filepath,pattern = filename) }
f_type<-setting[i,8]
head<-as.logical(setting[i,9])
data2<-NULL
if(f_type == "csv"){
for(j in 1:length(file)){
data<-read.csv(paste(filepath,"/",file[j],sep=""),header = head)
data2<-rbind(data2,data)
}
}
if(f_type == "xlsx"){
for(j in 1:length(file)){
data<-read.xlsx(paste(filepath,"/",file[j],sep=""),header = head)
data2<-rbind(data2,data)
}
}
dataname<-names(data2)
cntcol<-setting[i,10]
excol<-setting[i,12]
ariname<-setting[i,13]
exname<-setting[i,14]
josu<-setting[i,15]
exjosu<-setting[i,16]
arijosu<-setting[i,17]
filcol<-unlist(strsplit(setting[i,18],","))
filname<-unlist(strsplit(setting[i,19],","))
cultype<-setting[i,20]
official<-setting[i,21]
haz_trim2<-setting[i,22]
wpp_trim2<-setting[i,23]
div_data2<-setting[i,24]

if(haz_trim == 0){
if(is.na(haz_trim2)){
haz_trim<-10000000
}else{
haz_trim<-haz_trim2
}
}
if(wpp_trim == 0){
if(is.na(wpp_trim2)){
wpp_trim<-10000000
}else{
wpp_trim<-haz_trim2
}
}

data2[,cntcol]<-as.numeric(data2[,cntcol])

if(!is.na(filcol) && !is.na(filname)){
for(k in 1:length(filcol)){
data2<-data2[data2[,as.numeric(filcol[k])] %in% filname,]
}}

data_death<-data2[data2[,as.numeric(excol)] %in% exname,cntcol]


if (length(data_death) == 0){
d_ave<-0
h_average<-0
}else{
d_ave<-mean(data_death)

if(is.na(josu) || is.na(exjosu) || is.na(arijosu)){
data2[,"exari"]<-data2[,excol]
exna_jo<-exname
arina_jo<-ariname
exari<-c(exna_jo,arina_jo)
data2<-data2[data2[,"exari"] %in% exari ,]
}else{
data2[,"exari"]<-paste(data2[,excol],data2[,josu],sep="")
exna_jo<-paste(exname,exjosu,sep="")
arina_jo<-paste(ariname,arijosu,sep="")
exari<-c(exna_jo,arina_jo)
data2<-data2[data2[,"exari"] %in% exari ,]
}

data2[,"1_0"]<- ifelse(data2[,excol] == exname,1,0)
data2<-data2[data2[,cntcol] < as.numeric(haz_trim),]
data2<-data2[,c(dataname[cntcol],"1_0")]
names(data2)<-c("cnt","1_0")
if(cultype != "normal"){
data2[nrow(data2),"1_0"] <- 1
}
data2<-data2[order(data2[,"cnt"]),]
data2[,"backnum"]<-c(nrow(data2):1)
data2[,"ht"]<-1/data2[,"backnum"]
data2[,"temp1"]<-data2[,"ht"]*data2[,"1_0"]
data2[,"Ht"]<-cumsum(data2[,"temp1"])
data2[,"Ft"]<-1-exp(-1*data2[,"Ht"])
data2<-data2[data2[,"1_0"] == 1,]

data2[1,"cnt-1"]<-0
data2[c(2:nrow(data2)),"cnt-1"]<-data2[c(1:nrow(data2)-1),"cnt"]
data2[1,"Ft-1"]<-0
data2[c(2:nrow(data2)),"Ft-1"]<-data2[c(1:nrow(data2)-1),"Ft"]
data2[,"temp"]<-(2-data2[,"Ft"]-data2[,"Ft-1"])*(data2[,"cnt"]-data2[,"cnt-1"])/2
h_average<-sum(data2[,"temp"])
data2<-data2[,c("cnt","Ft")]
}

###wpp###

if (NROW(data2) < 6){
w_average<-0

}else{

data3<-data2[data2[,"cnt"] < wpp_trim,]

data3<-data3[data3[,"cnt"]>0,]
data3<-data3[data3[,"Ft"]>0,]

data3[c(1:(NROW(data3)-1)),"cnt-1"]<-data3[c(2:NROW(data3)),"cnt"]
data3[NROW(data3),"cnt-1"]<-0
data3[1,"cnt+1"]<-0
data3[c(2:(NROW(data3))),"cnt+1"]<-data3[c(1:(NROW(data3)-1)),"cnt"]
data3[,"tf-1"]<-data3[,"cnt"] == data3[,"cnt-1"]
data3[,"tf+1"]<-data3[,"cnt"] == data3[,"cnt+1"]
data3[,"tf"]<-data3[,"tf-1"]+data3[,"tf+1"]
data3<-data3[data3[,"tf"]<2,c("cnt","Ft")]

if(is.na(official)){
official<-0
}
offi_data <- NROW(data3[data3[,"cnt"] > official,])
if(offi_data<25){
cut_data<-5
}else{
cut_data<-round(offi_data/5)
}
if(div_data != 0){
cut_data <- div_data
}else if(!is.na(div_data2)){
cut_data <-div_data2
}
division<-round(NROW(data3)/cut_data)
wpp<-NULL
Ft_max<-0


for(m in 1:division){
if( m==1 ){
wpp_cnt<-log(data3[c(m:cut_data),"cnt"])
wpp_ft<-log(log(1/(1-data3[c(m:cut_data),"Ft"])))
w_cnt<-seq(data3[m,"cnt"],data3[cut_data,"cnt"],length = 100)
}else if(m == division){
wpp_cnt<-log(data3[c((cut_data*(m-1)):(NROW(data3))),"cnt"])
wpp_ft<-log(log(1/(1-data3[c((cut_data*(m-1)):(NROW(data3))),"Ft"])))
w_cnt<-seq(data3[(cut_data*(m-1)),"cnt"],data3[(NROW(data3)),"cnt"],length = 100)
}
else{
wpp_cnt<-log(data3[c((cut_data*(m-1)):(cut_data*m)),"cnt"])
wpp_ft<-log(log(1/(1-data3[c((cut_data*(m-1)):(cut_data*m)),"Ft"])))
w_cnt<-seq(data3[(cut_data*(m-1)),"cnt"],data3[(cut_data*m),"cnt"],length = 100)
}
AB<-lm(wpp_ft~wpp_cnt)
ganma<-coef(AB)[2]
fai<-exp(-coef(AB)[1]/ganma)

w_Ft<-1-exp(-(w_cnt/fai)^ganma)
w_ft<-(ganma/fai)*(w_cnt/fai)^(ganma-1)*exp(-(w_cnt/fai)^ganma)
data_wpp<-data.frame(w_cnt,w_Ft,w_ft)
data_wpp<-data_wpp[data_wpp[,"w_Ft"]>Ft_max,]

wpp<-rbind(wpp,data_wpp)
Ft_max<-max(w_Ft)
}
if(Ft_max<0.9999){
max_Ft<-log(1-0.9999)
max_cnt<--9.21034037197629^(1/ganma)*(-fai)
w_cnt_max<-w_cnt[100]
w_cnt<-seq(w_cnt_max,max_cnt,length = 100)
w_Ft<-1-exp(-(w_cnt/fai)^ganma)
w_ft<-(ganma/fai)*(w_cnt/fai)^(ganma-1)*exp(-(w_cnt/fai)^ganma)
data_wpp<-data.frame(w_cnt,w_Ft,w_ft)
data_wpp<-data_wpp[data_wpp[,"w_Ft"]>Ft_max,]

wpp<-rbind(wpp,data_wpp)

}

wpp[1,"w_cnt-1"]<-0
wpp[c(2:nrow(wpp)),"w_cnt-1"]<-wpp[c(1:nrow(wpp)-1),"w_cnt"]
wpp[1,"w_Ft-1"]<-0
wpp[c(2:nrow(wpp)),"w_Ft-1"]<-wpp[c(1:nrow(wpp)-1),"w_Ft"]
wpp[,"temp"]<-(2-wpp[,"w_Ft"]-wpp[,"w_Ft-1"])*(wpp[,"w_cnt"]-wpp[,"w_cnt-1"])/2
w_average<-sum(wpp[,"temp"])


###wpp###

summary_data[i,"No"]<-i
today<-Sys.Date()
summary_data[i,"作成日"]<-format(today,"%Y/%m/%d")
summary_data[i,"製品"]<-seihin
summary_data[i,"モデル"]<-model
summary_data[i,"仕向け"]<-simuke
summary_data[i,"部品名称"]<-parts
summary_data[i,"フィルター条件"]<-paste(filname,collapse = "/")
summary_data[i,"死亡平均"]<-d_ave
summary_data[i,"ハザード平均"]<-h_average
summary_data[i,"hzard_average_by_wpp"]<-w_average
summary_data[i,"トリム_hazard"]<-haz_trim
summary_data[i,"trim_wpp"]<-wpp_trim
summary_data[i,"cutting"]<-cut_data


}
}

summary_data<-summary_data[,-1]

return(summary_data)
}

#hazard1.R
gethazard_lf<-function(setting,colname1,haz_trim,wpp_trim,div_data){

summary_data<-1
summary_data<-as.data.frame(summary_data)

#library(openxlsx)
#setting<-read.xlsx(paste(getwd(),"/条件シート.xlsx",sep=""),startRow = 2)
for(i in 1:NROW(setting)){

#test


#normal_set

seihin<-setting[i,2]
model<-setting[i,3]
simuke<-setting[i,4]
parts<-setting[i,5]
#file
filepath<-setting[i,6]
if(is.na(filepath)){filepath<-paste(getwd(),"/data",sep="")
}else{filepath<-gsub("\\\\","/",filepath)}

filename<-setting[i,7]
if(is.na(filename)){file<-list.files(filepath)
}else{file<-list.files(filepath,pattern = filename) }
f_type<-setting[i,8]
head<-as.logical(setting[i,9])
data2<-NULL
if(f_type == "csv"){
for(j in 1:length(file)){
data<-read.csv(paste(filepath,"/",file[j],sep=""),header = head)
data2<-rbind(data2,data)
}
}
if(f_type == "xlsx"){
for(j in 1:length(file)){
data<-read.xlsx(paste(filepath,"/",file[j],sep=""),header = head)
data2<-rbind(data2,data)
}
}
dataname<-names(data2)
cntcol<-setting[i,11]
if(is.na(cntcol)){

summary_data[i,"死亡平均_life"]<-"non"
summary_data[i,"ハザード平均_life"]<-"non"
summary_data[i,"hzard_average_by_wpp_life"]<-"non"
summary_data[i,"トリム_hazard_life"]<-"non"
summary_data[i,"trim_wpp_life"]<-"non"
summary_data[i,"cutting_life"]<-"non"
}else{
excol<-setting[i,12]
ariname<-setting[i,13]
exname<-setting[i,14]
josu<-setting[i,15]
exjosu<-setting[i,16]
arijosu<-setting[i,17]
filcol<-unlist(strsplit(setting[i,18],","))
filname<-unlist(strsplit(setting[i,19],","))
cultype<-setting[i,20]
official<-80
haz_trim2<-setting[i,25]
wpp_trim2<-setting[i,26]
div_data2<-setting[i,27]

if(haz_trim == 0){
if(is.na(haz_trim2)){
haz_trim<-5000
}else{
haz_trim<-haz_trim2
}
}
if(wpp_trim == 0){
if(is.na(wpp_trim2)){
wpp_trim<-5000
}else{
wpp_trim<-haz_trim2
}
}

data2[,cntcol]<-as.numeric(data2[,cntcol])

if(!is.na(filcol) && !is.na(filname)){
for(k in 1:length(filcol)){
data2<-data2[data2[,as.numeric(filcol[k])] %in% filname,]
}}

data_death<-data2[data2[,as.numeric(excol)] %in% exname,cntcol]


if (length(data_death) == 0){
d_ave<-0
h_average<-0
}else{
d_ave<-mean(data_death)

if(is.na(josu) || is.na(exjosu) || is.na(arijosu)){
data2[,"exari"]<-data2[,excol]
exna_jo<-exname
arina_jo<-ariname
exari<-c(exna_jo,arina_jo)
data2<-data2[data2[,"exari"] %in% exari ,]
}else{
data2[,"exari"]<-paste(data2[,excol],data2[,josu],sep="")
exna_jo<-paste(exname,exjosu,sep="")
arina_jo<-paste(ariname,arijosu,sep="")
exari<-c(exna_jo,arina_jo)
data2<-data2[data2[,"exari"] %in% exari ,]
}

data2[,"1_0"]<- ifelse(data2[,excol] == exname,1,0)
data2<-data2[data2[,cntcol] < as.numeric(haz_trim),]
data2<-data2[,c(dataname[cntcol],"1_0")]
names(data2)<-c("cnt","1_0")
if(cultype != "normal"){
data2[nrow(data2),"1_0"] <- 1
}
data2<-data2[order(data2[,"cnt"]),]
data2[,"backnum"]<-c(nrow(data2):1)
data2[,"ht"]<-1/data2[,"backnum"]
data2[,"temp1"]<-data2[,"ht"]*data2[,"1_0"]
data2[,"Ht"]<-cumsum(data2[,"temp1"])
data2[,"Ft"]<-1-exp(-1*data2[,"Ht"])
data2<-data2[data2[,"1_0"] == 1,]

data2[1,"cnt-1"]<-0
data2[c(2:nrow(data2)),"cnt-1"]<-data2[c(1:nrow(data2)-1),"cnt"]
data2[1,"Ft-1"]<-0
data2[c(2:nrow(data2)),"Ft-1"]<-data2[c(1:nrow(data2)-1),"Ft"]
data2[,"temp"]<-(2-data2[,"Ft"]-data2[,"Ft-1"])*(data2[,"cnt"]-data2[,"cnt-1"])/2
h_average<-sum(data2[,"temp"])
data2<-data2[,c("cnt","Ft")]
}

###wpp###

if (NROW(data2) < 6){
w_average<-0

}else{

data3<-data2[data2[,"cnt"] < wpp_trim,]

data3<-data3[data3[,"cnt"]>0,]
data3<-data3[data3[,"Ft"]>0,]

data3[c(1:(NROW(data3)-1)),"cnt-1"]<-data3[c(2:NROW(data3)),"cnt"]
data3[NROW(data3),"cnt-1"]<-0
data3[1,"cnt+1"]<-0
data3[c(2:(NROW(data3))),"cnt+1"]<-data3[c(1:(NROW(data3)-1)),"cnt"]
data3[,"tf-1"]<-data3[,"cnt"] == data3[,"cnt-1"]
data3[,"tf+1"]<-data3[,"cnt"] == data3[,"cnt+1"]
data3[,"tf"]<-data3[,"tf-1"]+data3[,"tf+1"]
data3<-data3[data3[,"tf"]<2,c("cnt","Ft")]

if(is.na(official)){
official<-0
}
offi_data <- NROW(data3[data3[,"cnt"] > official,])
if(offi_data<25){
cut_data<-5
}else{
cut_data<-round(offi_data/5)
}
if(div_data != 0){
cut_data <- div_data
}else if(!is.na(div_data2)){
cut_data <-div_data2
}
division<-round(NROW(data3)/cut_data)
wpp<-NULL
Ft_max<-0


for(m in 1:division){
if( m==1 ){
wpp_cnt<-log(data3[c(m:cut_data),"cnt"])
wpp_ft<-log(log(1/(1-data3[c(m:cut_data),"Ft"])))
w_cnt<-seq(data3[m,"cnt"],data3[cut_data,"cnt"],length = 100)
}else if(m == division){
wpp_cnt<-log(data3[c((cut_data*(m-1)):(NROW(data3))),"cnt"])
wpp_ft<-log(log(1/(1-data3[c((cut_data*(m-1)):(NROW(data3))),"Ft"])))
w_cnt<-seq(data3[(cut_data*(m-1)),"cnt"],data3[(NROW(data3)),"cnt"],length = 100)
}
else{
wpp_cnt<-log(data3[c((cut_data*(m-1)):(cut_data*m)),"cnt"])
wpp_ft<-log(log(1/(1-data3[c((cut_data*(m-1)):(cut_data*m)),"Ft"])))
w_cnt<-seq(data3[(cut_data*(m-1)),"cnt"],data3[(cut_data*m),"cnt"],length = 100)
}
AB<-lm(wpp_ft~wpp_cnt)
ganma<-coef(AB)[2]
fai<-exp(-coef(AB)[1]/ganma)

w_Ft<-1-exp(-(w_cnt/fai)^ganma)
w_ft<-(ganma/fai)*(w_cnt/fai)^(ganma-1)*exp(-(w_cnt/fai)^ganma)
data_wpp<-data.frame(w_cnt,w_Ft,w_ft)
data_wpp<-data_wpp[data_wpp[,"w_Ft"]>Ft_max,]

wpp<-rbind(wpp,data_wpp)
Ft_max<-max(w_Ft)
}
if(Ft_max<0.9999){
max_Ft<-log(1-0.9999)
max_cnt<--9.21034037197629^(1/ganma)*(-fai)
w_cnt_max<-w_cnt[100]
w_cnt<-seq(w_cnt_max,max_cnt,length = 100)
w_Ft<-1-exp(-(w_cnt/fai)^ganma)
w_ft<-(ganma/fai)*(w_cnt/fai)^(ganma-1)*exp(-(w_cnt/fai)^ganma)
data_wpp<-data.frame(w_cnt,w_Ft,w_ft)
data_wpp<-data_wpp[data_wpp[,"w_Ft"]>Ft_max,]

wpp<-rbind(wpp,data_wpp)

}

wpp[1,"w_cnt-1"]<-0
wpp[c(2:nrow(wpp)),"w_cnt-1"]<-wpp[c(1:nrow(wpp)-1),"w_cnt"]
wpp[1,"w_Ft-1"]<-0
wpp[c(2:nrow(wpp)),"w_Ft-1"]<-wpp[c(1:nrow(wpp)-1),"w_Ft"]
wpp[,"temp"]<-(2-wpp[,"w_Ft"]-wpp[,"w_Ft-1"])*(wpp[,"w_cnt"]-wpp[,"w_cnt-1"])/2
w_average<-sum(wpp[,"temp"])


###wpp###

summary_data[i,"死亡平均_life"]<-d_ave
summary_data[i,"ハザード平均_life"]<-h_average
summary_data[i,"hzard_average_by_wpp_life"]<-w_average
summary_data[i,"トリム_hazard_life"]<-haz_trim
summary_data[i,"trim_wpp_life"]<-wpp_trim
summary_data[i,"cutting_life"]<-cut_data

}
}
}
summary_data<-summary_data[,-1]

return(summary_data)
}

#hazard2.R
gethazard_dist<-function(setting,colname1,haz_trim,wpp_trim,div_data){

# library(openxlsx)
# setting<-read.xlsx(paste(getwd(),"/条件シート.xlsx",sep=""),startRow = 2)
# colname1 = "2-xxx-yyy-zzz-A"

colname2<-paste(setting[,1],setting[,2],setting[,3],setting[,4],setting[,5],sep="-")
i<-grep(colname1 , colname2)

#haz

seihin<-setting[i,2]
model<-setting[i,3]
simuke<-setting[i,4]
parts<-setting[i,5]
#file
filepath<-setting[i,6]
if(is.na(filepath)){filepath<-paste(getwd(),"/data",sep="")
}else{filepath<-gsub("\\\\","/",filepath)}

filename<-setting[i,7]
if(is.na(filename)){file<-list.files(filepath)
}else{file<-list.files(filepath,pattern = filename) }
f_type<-setting[i,8]
head<-as.logical(setting[i,9])
data2<-NULL
if(f_type == "csv"){
for(j in 1:length(file)){
data<-read.csv(paste(filepath,"/",file[j],sep=""),header = head)
data2<-rbind(data2,data)
}
}
if(f_type == "xlsx"){
for(j in 1:length(file)){
data<-read.xlsx(paste(filepath,"/",file[j],sep=""),header = head)
data2<-rbind(data2,data)
}
}


dataname<-names(data2)
cntcol<-setting[i,10]
excol<-setting[i,12]
ariname<-setting[i,13]
exname<-setting[i,14]
josu<-setting[i,15]
exjosu<-setting[i,16]
arijosu<-setting[i,17]
filcol<-unlist(strsplit(setting[i,18],","))
filname<-unlist(strsplit(setting[i,19],","))
cultype<-setting[i,20]
official<-setting[i,21]
haz_trim2<-setting[i,22]
wpp_trim2<-setting[i,23]
div_data2<-setting[i,24]

if(haz_trim == 0){
if(is.na(haz_trim2)){
haz_trim<-10000000
}else{
haz_trim<-haz_trim2
}
}
if(wpp_trim == 0){
if(is.na(wpp_trim2)){
wpp_trim<-10000000
}else{
wpp_trim<-haz_trim2
}
}


data2[,cntcol]<-as.numeric(data2[,cntcol])

if(!is.na(filcol) && !is.na(filname)){
for(k in 1:length(filcol)){
data2<-data2[data2[,as.numeric(filcol[k])] %in% filname,]
}}

data_death<-data2[data2[,as.numeric(excol)] %in% exname,cntcol]

if (length(data_death) == 0){
data2[,"cnt"]<-0
data2[,"Ft"]<-0
data2<-data2[,c("cnt","Ft")]

return(data2)

}else if(is.na(cntcol) || is.na(excol) || is.na(exname) || is.na(ariname)){
data2[,"cnt"]<-0
data2[,"Ft"]<-0
data2<-data2[,c("cnt","Ft")]

return(data2)
}else{

d_ave<-mean(as.numeric(data_death))

if(is.na(josu) || is.na(exjosu) || is.na(arijosu)){
data2[,"exari"]<-data2[,excol]
exna_jo<-exname
arina_jo<-ariname
exari<-c(exna_jo,arina_jo)
data2<-data2[data2[,"exari"] %in% exari ,]
}else{
data2[,"exari"]<-paste(data2[,excol],data2[,josu],sep="")
exna_jo<-paste(exname,exjosu,sep="")
arina_jo<-paste(ariname,arijosu,sep="")
exari<-c(exna_jo,arina_jo)
data2<-data2[data2[,"exari"] %in% exari ,]
}

data2[,"1_0"]<- ifelse(data2[,excol] == exname,1,0)
data2<-data2[data2[,cntcol] < as.numeric(haz_trim),]
data2<-data2[,c(dataname[cntcol],"1_0")]
names(data2)<-c("cnt","1_0")
if(cultype != "normal"){
data2[nrow(data2),"1_0"] <- 1
}
data2<-data2[order(data2[,"cnt"]),]
data2[,"backnum"]<-c(nrow(data2):1)
data2[,"ht"]<-1/data2[,"backnum"]
data2[,"temp1"]<-data2[,"ht"]*data2[,"1_0"]
data2[,"Ht"]<-cumsum(data2[,"temp1"])
data2[,"Ft"]<-1-exp(-1*data2[,"Ht"])
data2<-data2[data2[,"1_0"] == 1,]
data2<-data2[,c("cnt","Ft")]

return(data2)
}
}

#hazard3.R
gethazard_dist_lf<-function(setting,colname1,haz_trim,wpp_trim,div_data){

# library(openxlsx)
# setting<-read.xlsx(paste(getwd(),"/条件シート.xlsx",sep=""),startRow = 2)
# colname1 = "2-xxx-yyy-zzz-A"

colname2<-paste(setting[,1],setting[,2],setting[,3],setting[,4],setting[,5],sep="-")
i<-grep(colname1 , colname2)

#haz

seihin<-setting[i,2]
model<-setting[i,3]
simuke<-setting[i,4]
parts<-setting[i,5]
#file
filepath<-setting[i,6]
if(is.na(filepath)){filepath<-paste(getwd(),"/data",sep="")
}else{filepath<-gsub("\\\\","/",filepath)}

filename<-setting[i,7]
if(is.na(filename)){file<-list.files(filepath)
}else{file<-list.files(filepath,pattern = filename) }
f_type<-setting[i,8]
head<-as.logical(setting[i,9])
data2<-NULL
if(f_type == "csv"){
for(j in 1:length(file)){
data<-read.csv(paste(filepath,"/",file[j],sep=""),header = head)
data2<-rbind(data2,data)
}
}
if(f_type == "xlsx"){
for(j in 1:length(file)){
data<-read.xlsx(paste(filepath,"/",file[j],sep=""),header = head)
data2<-rbind(data2,data)
}
}


dataname<-names(data2)
cntcol<-setting[i,11]
excol<-setting[i,12]
ariname<-setting[i,13]
exname<-setting[i,14]
josu<-setting[i,15]
exjosu<-setting[i,16]
arijosu<-setting[i,17]
filcol<-unlist(strsplit(setting[i,18],","))
filname<-unlist(strsplit(setting[i,19],","))
cultype<-setting[i,20]
official<-setting[i,21]
haz_trim2<-setting[i,25]
wpp_trim2<-setting[i,26]
div_data2<-setting[i,27]

if(haz_trim == 0){
if(is.na(haz_trim2)){
haz_trim<-5000
}else{
haz_trim<-haz_trim2
}
}
if(wpp_trim == 0){
if(is.na(wpp_trim2)){
wpp_trim<-5000
}else{
wpp_trim<-haz_trim2
}
}


data2[,cntcol]<-as.numeric(data2[,cntcol])

if(!is.na(filcol) && !is.na(filname)){
for(k in 1:length(filcol)){
data2<-data2[data2[,as.numeric(filcol[k])] %in% filname,]
}}

data_death<-data2[data2[,as.numeric(excol)] %in% exname,cntcol]

if (length(data_death) == 0){
data2[,"cnt"]<-0
data2[,"Ft"]<-0
data2<-data2[,c("cnt","Ft")]

return(data2)

}else if(is.na(cntcol) || is.na(excol) || is.na(exname) || is.na(ariname)){
data2[,"cnt"]<-0
data2[,"Ft"]<-0
data2<-data2[,c("cnt","Ft")]

return(data2)
}else{

d_ave<-mean(as.numeric(data_death))

if(is.na(josu) || is.na(exjosu) || is.na(arijosu)){
data2[,"exari"]<-data2[,excol]
exna_jo<-exname
arina_jo<-ariname
exari<-c(exna_jo,arina_jo)
data2<-data2[data2[,"exari"] %in% exari ,]
}else{
data2[,"exari"]<-paste(data2[,excol],data2[,josu],sep="")
exna_jo<-paste(exname,exjosu,sep="")
arina_jo<-paste(ariname,arijosu,sep="")
exari<-c(exna_jo,arina_jo)
data2<-data2[data2[,"exari"] %in% exari ,]
}

data2[,"1_0"]<- ifelse(data2[,excol] == exname,1,0)
data2<-data2[data2[,cntcol] < as.numeric(haz_trim),]
data2<-data2[,c(dataname[cntcol],"1_0")]
names(data2)<-c("cnt","1_0")
if(cultype != "normal"){
data2[nrow(data2),"1_0"] <- 1
}
data2<-data2[order(data2[,"cnt"]),]
data2[,"backnum"]<-c(nrow(data2):1)
data2[,"ht"]<-1/data2[,"backnum"]
data2[,"temp1"]<-data2[,"ht"]*data2[,"1_0"]
data2[,"Ht"]<-cumsum(data2[,"temp1"])
data2[,"Ft"]<-1-exp(-1*data2[,"Ht"])
data2<-data2[data2[,"1_0"] == 1,]
data2<-data2[,c("cnt","Ft")]

return(data2)
}
}

#wpp.R
getwpp_dist<-function(setting,colname1,haz_trim,wpp_trim,div_data){

# library(openxlsx)
# setting<-read.xlsx(paste(getwd(),"/条件シート.xlsx",sep=""),startRow = 2)
# colname1 = "2-xxx-yyy-zzz-A"

colname2<-paste(setting[,1],setting[,2],setting[,3],setting[,4],setting[,5],sep="-")
i<-grep(colname1 , colname2)

#haz

seihin<-setting[i,2]
model<-setting[i,3]
simuke<-setting[i,4]
parts<-setting[i,5]
#file
filepath<-setting[i,6]
if(is.na(filepath)){filepath<-paste(getwd(),"/data",sep="")
}else{filepath<-gsub("\\\\","/",filepath)}

filename<-setting[i,7]
if(is.na(filename)){file<-list.files(filepath)
}else{file<-list.files(filepath,pattern = filename) }
f_type<-setting[i,8]
head<-as.logical(setting[i,9])
data2<-NULL
if(f_type == "csv"){
for(j in 1:length(file)){
data<-read.csv(paste(filepath,"/",file[j],sep=""),header = head)
data2<-rbind(data2,data)
}
}
if(f_type == "xlsx"){
for(j in 1:length(file)){
data<-read.xlsx(paste(filepath,"/",file[j],sep=""),header = head)
data2<-rbind(data2,data)
}
}
dataname<-names(data2)
cntcol<-setting[i,10]
excol<-setting[i,12]
ariname<-setting[i,13]
exname<-setting[i,14]
josu<-setting[i,15]
exjosu<-setting[i,16]
arijosu<-setting[i,17]
filcol<-unlist(strsplit(setting[i,18],","))
filname<-unlist(strsplit(setting[i,19],","))
cultype<-setting[i,20]
official<-setting[i,21]
haz_trim2<-setting[i,22]
wpp_trim2<-setting[i,23]
div_data2<-setting[i,24]

if(haz_trim == 0){
if(is.na(haz_trim2)){
haz_trim<-10000000
}else{
haz_trim<-haz_trim2
}
}
if(wpp_trim == 0){
if(is.na(wpp_trim2)){
wpp_trim<-10000000
}else{
wpp_trim<-haz_trim2
}
}


data2[,cntcol]<-as.numeric(data2[,cntcol])

if(!is.na(filcol) && !is.na(filname)){
for(k in 1:length(filcol)){
data2<-data2[data2[,as.numeric(filcol[k])] %in% filname,]
}}

data_death<-data2[data2[,as.numeric(excol)] %in% exname,cntcol]

if (length(data_death) == 0){
data2[,"w_cnt"]<-0
data2[,"w_Ft"]<-0
data2[,"w_ft"]<-0
data2[,"w_Rt"]<-0
wpp<-data2[1,c("w_cnt","w_Ft","w_ft","w_Rt")]

return(wpp)
}else if(is.na(cntcol) || is.na(excol) || is.na(exname) || is.na(ariname)){
data2[,"w_cnt"]<-0
data2[,"w_Ft"]<-0
data2[,"w_ft"]<-0
data2[,"w_Rt"]<-0
wpp<-data2[1,c("w_cnt","w_Ft","w_ft","w_Rt")]

return(wpp)
}else{

d_ave<-mean(as.numeric(data_death))

if(is.na(josu) || is.na(exjosu) || is.na(arijosu)){
data2[,"exari"]<-data2[,excol]
exna_jo<-exname
arina_jo<-ariname
exari<-c(exna_jo,arina_jo)
data2<-data2[data2[,"exari"] %in% exari ,]
}else{
data2[,"exari"]<-paste(data2[,excol],data2[,josu],sep="")
exna_jo<-paste(exname,exjosu,sep="")
arina_jo<-paste(ariname,arijosu,sep="")
exari<-c(exna_jo,arina_jo)
data2<-data2[data2[,"exari"] %in% exari ,]
}

data2[,"1_0"]<- ifelse(data2[,excol] == exname,1,0)
data2<-data2[data2[,cntcol] < as.numeric(haz_trim),]
data2<-data2[,c(dataname[cntcol],"1_0")]
names(data2)<-c("cnt","1_0")
if(cultype != "normal"){
data2[nrow(data2),"1_0"] <- 1
}
data2<-data2[order(data2[,"cnt"]),]
data2[,"backnum"]<-c(nrow(data2):1)
data2[,"ht"]<-1/data2[,"backnum"]
data2[,"temp1"]<-data2[,"ht"]*data2[,"1_0"]
data2[,"Ht"]<-cumsum(data2[,"temp1"])
data2[,"Ft"]<-1-exp(-1*data2[,"Ht"])
data2<-data2[data2[,"1_0"] == 1,]
data2<-data2[,c("cnt","Ft")]

#wpp

if (NROW(data2) < 6){
data2[,"w_cnt"]<-0
data2[,"w_Ft"]<-0
data2[,"w_ft"]<-0
data2[,"w_Rt"]<-0
wpp<-data2[1,c("w_cnt","w_Ft","w_ft","w_Rt")]

return(wpp)
}else{

data3<-data2[data2[,"cnt"] < wpp_trim,]
data3<-data3[data3[,"cnt"]>0,]
data3<-data3[data3[,"Ft"]>0,]

data3[c(1:(NROW(data3)-1)),"cnt-1"]<-data3[c(2:NROW(data3)),"cnt"]
data3[NROW(data3),"cnt-1"]<-0
data3[1,"cnt+1"]<-0
data3[c(2:(NROW(data3))),"cnt+1"]<-data3[c(1:(NROW(data3)-1)),"cnt"]
data3[,"tf-1"]<-data3[,"cnt"] == data3[,"cnt-1"]
data3[,"tf+1"]<-data3[,"cnt"] == data3[,"cnt+1"]
data3[,"tf"]<-data3[,"tf-1"]+data3[,"tf+1"]
data3<-data3[data3[,"tf"]<2,c("cnt","Ft")]

if(is.na(official)){
official<-0
}
offi_data <- NROW(data3[data3[,"cnt"] > official,])
if(offi_data<25){
cut_data<-5
}else{
cut_data<-round(offi_data/5)
}
if(div_data != 0){
cut_data <- div_data
}else if(!is.na(div_data2)){
cut_data <-div_data2
}
division<-round(NROW(data3)/cut_data)
wpp<-NULL
Ft_max<-0



for(m in 1:division){
if( m==1 ){
wpp_cnt<-log(data3[c(m:cut_data),"cnt"])
wpp_ft<-log(log(1/(1-data3[c(m:cut_data),"Ft"])))
w_cnt<-seq(data3[m,"cnt"],data3[cut_data,"cnt"],length = 100)
}else if(m == division){
wpp_cnt<-log(data3[c((cut_data*(m-1)):(NROW(data3))),"cnt"])
wpp_ft<-log(log(1/(1-data3[c((cut_data*(m-1)):(NROW(data3))),"Ft"])))
w_cnt<-seq(data3[(cut_data*(m-1)),"cnt"],data3[(NROW(data3)),"cnt"],length = 100)
}
else{
wpp_cnt<-log(data3[c((cut_data*(m-1)):(cut_data*m)),"cnt"])
wpp_ft<-log(log(1/(1-data3[c((cut_data*(m-1)):(cut_data*m)),"Ft"])))
w_cnt<-seq(data3[(cut_data*(m-1)),"cnt"],data3[(cut_data*m),"cnt"],length = 100)
}
AB<-lm(wpp_ft~wpp_cnt)
ganma<-coef(AB)[2]
fai<-exp(-coef(AB)[1]/ganma)

w_Ft<-1-exp(-(w_cnt/fai)^ganma)
w_ft<-(ganma/fai)*(w_cnt/fai)^(ganma-1)*exp(-(w_cnt/fai)^ganma)
data_wpp<-data.frame(w_cnt,w_Ft,w_ft)
data_wpp<-data_wpp[data_wpp[,"w_Ft"]>Ft_max,]

wpp<-rbind(wpp,data_wpp)
Ft_max<-max(w_Ft)
}
if(Ft_max<0.9999){
max_Ft<-log(1-0.9999)
max_cnt<--9.21034037197629^(1/ganma)*(-fai)
w_cnt_max<-w_cnt[100]
w_cnt<-seq(w_cnt_max,max_cnt,length = 100)
w_Ft<-1-exp(-(w_cnt/fai)^ganma)
w_ft<-(ganma/fai)*(w_cnt/fai)^(ganma-1)*exp(-(w_cnt/fai)^ganma)
data_wpp<-data.frame(w_cnt,w_Ft,w_ft)
data_wpp<-data_wpp[data_wpp[,"w_Ft"]>Ft_max,]

wpp<-rbind(wpp,data_wpp)

}
wpp[,"w_Rt"]<-1-wpp[,"w_Ft"]
#plot(wpp[,"w_cnt"],wpp[,"w_ft"])


return(wpp)
}}
}

#wpp2.R
getwpp_dist_lf<-function(setting,colname1,haz_trim,wpp_trim,div_data){

library(openxlsx)
setting<-read.xlsx(paste(getwd(),"/条件シート.xlsx",sep=""),startRow = 2)
colname1 = "2-xxx-yyy-zzz-A"

colname2<-paste(setting[,1],setting[,2],setting[,3],setting[,4],setting[,5],sep="-")
i<-grep(colname1 , colname2)

#haz

seihin<-setting[i,2]
model<-setting[i,3]
simuke<-setting[i,4]
parts<-setting[i,5]
#file
filepath<-setting[i,6]
if(is.na(filepath)){filepath<-paste(getwd(),"/data",sep="")
}else{filepath<-gsub("\\\\","/",filepath)}

filename<-setting[i,7]
if(is.na(filename)){file<-list.files(filepath)
}else{file<-list.files(filepath,pattern = filename) }
f_type<-setting[i,8]
head<-as.logical(setting[i,9])
data2<-NULL
if(f_type == "csv"){
for(j in 1:length(file)){
data<-read.csv(paste(filepath,"/",file[j],sep=""),header = head)
data2<-rbind(data2,data)
}
}
if(f_type == "xlsx"){
for(j in 1:length(file)){
data<-read.xlsx(paste(filepath,"/",file[j],sep=""),header = head)
data2<-rbind(data2,data)
}
}
dataname<-names(data2)
cntcol<-setting[i,11]
excol<-setting[i,12]
ariname<-setting[i,13]
exname<-setting[i,14]
josu<-setting[i,15]
exjosu<-setting[i,16]
arijosu<-setting[i,17]
filcol<-unlist(strsplit(setting[i,18],","))
filname<-unlist(strsplit(setting[i,19],","))
cultype<-setting[i,20]
official<-80
haz_trim2<-setting[i,25]
wpp_trim2<-setting[i,26]
div_data2<-setting[i,27]

if(haz_trim == 0){
if(is.na(haz_trim2)){
haz_trim<-5000
}else{
haz_trim<-haz_trim2
}
}
if(wpp_trim == 0){
if(is.na(wpp_trim2)){
wpp_trim<-5000
}else{
wpp_trim<-haz_trim2
}
}


data2[,cntcol]<-as.numeric(data2[,cntcol])

if(!is.na(filcol) && !is.na(filname)){
for(k in 1:length(filcol)){
data2<-data2[data2[,as.numeric(filcol[k])] %in% filname,]
}}

data_death<-data2[data2[,as.numeric(excol)] %in% exname,cntcol]

if (length(data_death) == 0){
data2[,"w_cnt"]<-0
data2[,"w_Ft"]<-0
data2[,"w_ft"]<-0
data2[,"w_Rt"]<-0
wpp<-data2[1,c("w_cnt","w_Ft","w_ft","w_Rt")]

return(wpp)
}else if(is.na(cntcol) || is.na(excol) || is.na(exname) || is.na(ariname)){
data2[,"w_cnt"]<-0
data2[,"w_Ft"]<-0
data2[,"w_ft"]<-0
data2[,"w_Rt"]<-0
wpp<-data2[1,c("w_cnt","w_Ft","w_ft","w_Rt")]

return(wpp)
}else{

d_ave<-mean(as.numeric(data_death))

if(is.na(josu) || is.na(exjosu) || is.na(arijosu)){
data2[,"exari"]<-data2[,excol]
exna_jo<-exname
arina_jo<-ariname
exari<-c(exna_jo,arina_jo)
data2<-data2[data2[,"exari"] %in% exari ,]
}else{
data2[,"exari"]<-paste(data2[,excol],data2[,josu],sep="")
exna_jo<-paste(exname,exjosu,sep="")
arina_jo<-paste(ariname,arijosu,sep="")
exari<-c(exna_jo,arina_jo)
data2<-data2[data2[,"exari"] %in% exari ,]
}

data2[,"1_0"]<- ifelse(data2[,excol] == exname,1,0)
data2<-data2[data2[,cntcol] < as.numeric(haz_trim),]
data2<-data2[,c(dataname[cntcol],"1_0")]
names(data2)<-c("cnt","1_0")
if(cultype != "normal"){
data2[nrow(data2),"1_0"] <- 1
}
data2<-data2[order(data2[,"cnt"]),]
data2[,"backnum"]<-c(nrow(data2):1)
data2[,"ht"]<-1/data2[,"backnum"]
data2[,"temp1"]<-data2[,"ht"]*data2[,"1_0"]
data2[,"Ht"]<-cumsum(data2[,"temp1"])
data2[,"Ft"]<-1-exp(-1*data2[,"Ht"])
data2<-data2[data2[,"1_0"] == 1,]
data2<-data2[,c("cnt","Ft")]

#wpp

if (NROW(data2) < 6){
data2[,"w_cnt"]<-0
data2[,"w_Ft"]<-0
data2[,"w_ft"]<-0
data2[,"w_Rt"]<-0
wpp<-data2[1,c("w_cnt","w_Ft","w_ft","w_Rt")]

return(wpp)
}else{

data3<-data2[data2[,"cnt"] < wpp_trim,]
data3<-data3[data3[,"cnt"]>0,]
data3<-data3[data3[,"Ft"]>0,]

data3[c(1:(NROW(data3)-1)),"cnt-1"]<-data3[c(2:NROW(data3)),"cnt"]
data3[NROW(data3),"cnt-1"]<-0
data3[1,"cnt+1"]<-0
data3[c(2:(NROW(data3))),"cnt+1"]<-data3[c(1:(NROW(data3)-1)),"cnt"]
data3[,"tf-1"]<-data3[,"cnt"] == data3[,"cnt-1"]
data3[,"tf+1"]<-data3[,"cnt"] == data3[,"cnt+1"]
data3[,"tf"]<-data3[,"tf-1"]+data3[,"tf+1"]
data3<-data3[data3[,"tf"]<2,c("cnt","Ft")]

if(is.na(official)){
official<-0
}
offi_data <- NROW(data3[data3[,"cnt"] > official,])
if(offi_data<25){
cut_data<-5
}else{
cut_data<-round(offi_data/5)
}
if(div_data != 0){
cut_data <- div_data
}else if(!is.na(div_data2)){
cut_data <-div_data2
}
division<-round(NROW(data3)/cut_data)
wpp<-NULL
Ft_max<-0



for(m in 1:division){
if( m==1 ){
wpp_cnt<-log(data3[c(m:cut_data),"cnt"])
wpp_ft<-log(log(1/(1-data3[c(m:cut_data),"Ft"])))
w_cnt<-seq(data3[m,"cnt"],data3[cut_data,"cnt"],length = 100)
}else if(m == division){
wpp_cnt<-log(data3[c((cut_data*(m-1)):(NROW(data3))),"cnt"])
wpp_ft<-log(log(1/(1-data3[c((cut_data*(m-1)):(NROW(data3))),"Ft"])))
w_cnt<-seq(data3[(cut_data*(m-1)),"cnt"],data3[(NROW(data3)),"cnt"],length = 100)
}
else{
wpp_cnt<-log(data3[c((cut_data*(m-1)):(cut_data*m)),"cnt"])
wpp_ft<-log(log(1/(1-data3[c((cut_data*(m-1)):(cut_data*m)),"Ft"])))
w_cnt<-seq(data3[(cut_data*(m-1)),"cnt"],data3[(cut_data*m),"cnt"],length = 100)
}
AB<-lm(wpp_ft~wpp_cnt)
ganma<-coef(AB)[2]
fai<-exp(-coef(AB)[1]/ganma)

w_Ft<-1-exp(-(w_cnt/fai)^ganma)
w_ft<-(ganma/fai)*(w_cnt/fai)^(ganma-1)*exp(-(w_cnt/fai)^ganma)
data_wpp<-data.frame(w_cnt,w_Ft,w_ft)
data_wpp<-data_wpp[data_wpp[,"w_Ft"]>Ft_max,]

wpp<-rbind(wpp,data_wpp)
Ft_max<-max(w_Ft)
}
if(Ft_max<0.9999){
max_Ft<-log(1-0.9999)
max_cnt<--9.21034037197629^(1/ganma)*(-fai)
w_cnt_max<-w_cnt[100]
w_cnt<-seq(w_cnt_max,max_cnt,length = 100)
w_Ft<-1-exp(-(w_cnt/fai)^ganma)
w_ft<-(ganma/fai)*(w_cnt/fai)^(ganma-1)*exp(-(w_cnt/fai)^ganma)
data_wpp<-data.frame(w_cnt,w_Ft,w_ft)
data_wpp<-data_wpp[data_wpp[,"w_Ft"]>Ft_max,]

wpp<-rbind(wpp,data_wpp)


}
wpp[,"w_Rt"]<-1-wpp[,"w_Ft"]
#plot(wpp[,"w_cnt"],wpp[,"w_ft"])


return(wpp)
}}
}
スポンサーサイト
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

リスト作成とFLGつけ

Sub fopen()

Dim filename As String
Dim data As String
Dim n As Long

data = "data"

filename = Application.GetOpenFilename

If filename <> "False" Then
ans = MsgBox(filename & "を読み込みます", vbOKCancel, "読み込み確認")
If ans = vbOK Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = data
Workbooks.Open filename
Name = ActiveWorkbook.Name
Range("A1").CurrentRegion.Select
Selection.Copy
ThisWorkbook.Sheets(data).Range("A1").PasteSpecial
Workbooks(Name).Close
Else
MsgBox "終了します"
End
End If

Else
MsgBox "終了します"
End
End If

'入力規則のリスト作成
Sheets(data).Select
n = Sheets(data).Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(2, 3), Cells(n, 3)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("設定").Range("B1"), Unique:=True

Sheets("設定").Select
n = Sheets("設定").Cells(Rows.Count, 2).End(xlUp).Row
With Range("A1:A10").Cells.Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=設定!$B$1:$B$" & n

End With




End Sub


flgつけ
Sub kib()

Dim bubann As Long
bubann = Sheets("設定").Cells(Rows.Count, 1).End(xlUp).Row - 1
Dim buban() As String
ReDim buban(bubann)

For i = 0 To bubann - 1
buban(i) = Cells(i + 2, 1)
Next

Dim i As Long
Dim k As Long
Dim katan As Long
katan = Cells(Rows.Count, 4).End(xlUp).Row - 1

Dim n As Long
Dim kata() As String
Dim katanum() As Long
ReDim kata(katan)
ReDim katanum(katan)

Sheets("設定").Select
katan = Cells(Rows.Count, 4).End(xlUp).Row - 1
For i = 0 To katan - 1
kata(i) = Cells(i + 2, 3)
katanum(i) = Cells(i + 2, 4)
Next

Sheets("data").Select
n = Sheets("data").Cells(Rows.Count, 1).End(xlUp).Row
m = Sheets("data").Cells(1, Columns.Count).End(xlToLeft).Column

Cells(2, m + 1).Resize(n - 1).Formula = "=Left(A2, 3)"
Cells(2, m + 2).Resize(n - 1).Formula = "=value(Right(A2, 3))"

For i = 0 To katan - 1
For k = 0 To n - 1
If Cells(2 + k, 5) = kata(i) And Cells(2 + k, 6) >= katanum(i) Then
Cells(2 + k, 7) = "対象"
End If
Next k
Next i


For i = 0 To bubann - 1
For k = 0 To n - 1
If Cells(2 + k, 3) = buban(i) Then
Cells(2 + k, 7) = "対象"
End If
Next k
Next i


End Sub
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

マージ

a<-read.csv("A.csv",header=T)
b<-read.csv("B.csv",header=T)
a[,2]<-as.Date(a[,2])
b[,2]<-as.Date(b[,2])

akey<-a[,c(1,2)]
akey[,1:2]<-paste(a[,1],a[,2],sep="")
bkey<-b[,c(1,2)]
bkey[,1]<-paste(b[,1],b[,2],sep="")


j<-0
k<-1
bkey<-merge(bkey,akey,by.x="No",by.y="No",all.x=T)
for (i in 1:10){
k<-k*i
j<-j+k
akey[,1]<-paste(a[,1],a[,2]+j,sep="")
bkey<-merge(bkey,akey,by.x="No",by.y="No",all.x=T)
bkey[,3]<-ifelse(is.na(bkey[,3]),bkey[,i+2],bkey[,3])
k<-k/abs(k)*(-1)
}
b[,"key"]<-bkey[,3]
a[,"key"]<-akey[,2]
a_out<-merge(a,b,by.x="key",by.y="key",all.x=T)
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

テスト

Sub stap()

Dim cv As Integer
Dim m As Integer
Dim m_mrow As Integer
Dim koukan As Integer


cv = Range("B4")
m = Range("B6")
koukan = Range("B8")
m_mrow = Cells(Rows.Count, 14).End(xlUp).Row

Range("L:L").Clear
Range("P:P").Clear
Range("R:AB").Clear
Range("AC5").CurrentRegion.Clear
Range("G5").CurrentRegion.Clear

Range("L5").Resize(cv).Formula = "=K5/$B$5"
Range("P5").Resize(m).Formula = "=O5+P4"
Range("M5") = 0
Range("M6").Resize(m - 1).Formula = "=R7C2+R[-1]C"

For i = 0 To cv - 1
Cells(1, 19 + i) = Cells(5 + i, 10)
Cells(2, 19 + i) = Cells(5 + i, 12)
Cells(3, 19 + i) = "=Roundup(R3C2/R[-2]C,0)"

Next

For J = 0 To koukan - 1
For k = 0 To cv - 1
Sheets("Sheet1").Cells(5, 19 + k).Resize(m).Formula = _
"=IF(RC13/R3C>=" & J + 1 & ",1+R[-1]C,0)"
Sheets("Sheet1").Cells(5, 19 + k + J * cv + cv).Resize(m).Formula = _
"=IFERROR(VLOOKUP(RC[-" & cv + J * cv & "],R5C13:R" & m_mrow & "C15,3,FALSE),0)*R2C[-" & cv + J * cv & "]"

Next
Range(Cells(5, 29 + J * cv), Cells(m_mrow, 29 + J * cv + cv - 1)).Copy
Range(Cells(5, 29 + J * cv), Cells(m_mrow, 29 + J * cv + cv - 1)).PasteSpecial Paste:=xlPasteValues
Next

Range("R5").Resize(m).Formula = "=sum(RC[" & cv + 1 & "]:RC[" & cv + cv * koukan & "])"
Range("G5").Resize(m).Formula = "=R5/P5"
Range("H5").Resize(m).Formula = "=Q5/P5"


End Sub ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

その他

★チェックボックスで0/1 を入力

Private Sub check_Click()
If Sheets("平均値").Range("H2") = 1 Then

Sheets("平均値").Range("H2") = 0

Else
Sheets("平均値").Range("H2") = 1
End If

End Sub

★文字ラベルにセルを参照させる方法

Private Sub Tx_wid_Change()
Sheets("平均値").Cells(14, 2) = Me.Tx_wid.Text
End Sub

Private Sub UserForm_Initialize()


Me.Controls("Label1").Caption = "お勧めは5000分割の " & Sheets("平均値").Cells(14, 2) & " です"
Me.Tx_wid.Text = Sheets("平均値").Cells(14, 2)

End Sub ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
プロフィール

abc

Author:abc
このブログの内容に真実はありません。

最新記事
最新コメント
月別アーカイブ
カテゴリ
検索フォーム
RSSリンクの表示
リンク
ブロとも申請フォーム

この人とブロともになる

QRコード
QR
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。