FC2ブログ

shiny 練習


library(shiny)

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

#side###################################################
sidebarPanel(

h3("selectfiles"),
actionButton("submit2","select files"),
actionButton("submit","select folder"),
htmlOutput("colname1"),
htmlOutput("colname4"),
h3("data split"),
actionButton("submit3","split"),


h3("data merge"),
actionButton("submit4","select merge file"),
htmlOutput("colname2"),
htmlOutput("colname5"),
htmlOutput("colname3"),
actionButton("submit5","merge")

),
#main###################################################
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("data",downloadButton("downloadData"," Data Download"), DT::dataTableOutput("table")),
tabPanel("merge data", DT::dataTableOutput("table2")),
tabPanel("merged data",downloadButton("downloadData3"," Data Download"), DT::dataTableOutput("table3"))
)
)
)
)
)

*****


library(shiny)
library(dplyr)
library(DT)

data<-NULL
data2<-NULL

shinyServer(
function(input, output,session) {

observeEvent(input$submit,{
data<<-NULL
file<-list.files(choose.dir(),full.names = T)
file<-gsub("\\\\","/",file)
for(filepath in file){
temp<-read.csv(filepath)
data<<-bind_rows(data,temp)
}
cols<-colnames(data)
output$colname1 <- renderUI({selectInput("col","colname",cols)})
output$colname4 <- renderUI({selectInput("col4","colname",cols)})
output$table = DT::renderDataTable(data)
output$downloadData = downloadHandler(filename = "output.csv",content = function(filename){write.csv(data,filename,row.names = F)})
})

observeEvent(input$submit2,{
data<<-NULL
file<-choose.files()
file<-gsub("\\\\","/",file)
for(filepath in file){
temp<-read.csv(filepath)
data<<-bind_rows(data,temp)
}
cols<-colnames(data)
output$colname1 <- renderUI({selectInput("col","colname",cols)})
output$colname4 <- renderUI({selectInput("col4","colname",c("NON",cols))})
output$table = DT::renderDataTable(data)
output$downloadData = downloadHandler(filename = "output.csv",content = function(file){write.csv(data,file,row.names = F)})
})

observeEvent(input$submit3,{
dir<-choose.dir()
dir<-gsub("\\\\","/",dir)
list<-unique(data[,input$col])
for(term in 1 : length(list)){
write.csv(data[data[,input$col] %in% list[term],],file = paste0(dir,"/",list[term],".csv",row.names=F))
}
})

observeEvent(input$submit4,{
data2<<-NULL
file<-choose.files()
file<-gsub("\\\\","/",file)
for(filepath in file){
temp<-read.csv(filepath)
data2<<-bind_rows(data2,temp)
}
cols<-colnames(data2)
output$colname2 <- renderUI({selectInput("col2","colname",cols)})
output$colname5 <- renderUI({selectInput("col5","colname",c("NON",cols))})
output$colname3 <- renderUI({checkboxGroupInput("col3","select col",cols,selected = cols)})
output$table2 = DT::renderDataTable(data2)

})

observeEvent(input$submit5,{

data3<-data2

if(input$col4 == "NON" || input$col5 == "NON"){
data3[,input$col]<-data2[,input$col2]
data3<-data3[,c(input$col,input$col3)]
data3<-left_join(data,data3,by = c(input$col))
}else{
data3[,input$col]<-data2[,input$col2]
data3[,input$col4]<-data2[,input$col5]
data3<-data3[,c(input$col,input$col4,input$col3)]
data3<-left_join(data,data3,by = c(input$col,input$col4))
}
output$table3 = DT::renderDataTable(data3)
output$downloadData3 = downloadHandler(filename = "output.csv",content = function(file){write.csv(data3,file,row.names = F)})
})

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

})
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

dplyr練習

library(dplyr)
library(readr)

change<-13
c_code<-103

b_day<-as.Date("2014-12-28")
n_day<-as.Date("2019-5-11")
week<-as.data.frame(seq(b_day,n_day,by="1 week"))
week$week<-1:nrow(week)
colnames(week)<-c("week","week_no")

s_day<-as.Date("2019-3-10")
e_day<-as.Date("2019-5-11")
getweek<-unlist(seq(s_day,e_day,by="1 week"))

reg<-"j"

indir<-"C:/xxx/xxx.csv"
data<-read_csv(indir)
colnames(data)<-c("D","k","code","ver")

data1<-ER(data,change,c_code,week,getweek,reg)


indir<-"C:/xxx/xxx.csv"
data<-read_csv(indir)
colnames(data)<-c("D","k","code","ver","a","aa","week")

mif<-MI(data,change,c_code,week,getweek,reg)


indir<-"C:/xxx/xxx.csv"
data<-read_csv(indir)
colnames(data)<-c("D","k","code","ver","a","aa","week","code2","cnt","fil")

data2<-BE(data,change,c_code,week,getweek,reg)



data1$week<-as.Date(data1$week)
data2$week<-as.Date(data1$week)
mif$week<-as.Date(mif$week)
data1 %>% dplyr::left_join(mif,by=c("week","flg")) %>% select(week,n.x,flg,reg.x,n.y) ->end
data2 %>% dplyr::left_join(mif,by=c("week","flg")) %>% select(week,n.x,n2,n3,flg,reg.x,n.y) ->end2




ER<-function(data,change,c_code,week,getweek,reg){


data<-data %>% dplyr::filter(code == c_code)
data_b<-data %>% dplyr::filter(ver < change)
data_a<-data %>% dplyr::filter(ver >= change)

data_b$week_no<-as.numeric(ceiling((as.Date(data_b$D)-b_day+0.00000001)/7))
data_b %>% dplyr::distinct(k,week_no,.keep_all = TRUE) %>%
select(k,week_no)-> data_b_b
data_b_b %>% group_by(week_no) %>% summarise(n=n()) ->data_b_end
week %>% dplyr::left_join(data_b_end) %>% select(week,n) ->week_data_b

week_data_b$flg<-0
week_data_b$reg<-reg

data_a$week_no<-as.numeric(ceiling((as.Date(data_b$D)-b_day+0.00000001)/7))
data_a %>% dplyr::distinct(k,week_no,.keep_all = TRUE) %>%
select(k,week_no)-> data_a_a
data_a_a %>% group_by(week_no) %>% summarise(n=n()) ->data_a_end
week %>% dplyr::left_join(data_a_end) %>% select(week,n) ->week_data_a

week_data_a$flg<-1
week_data_a$reg<-reg

data_end<-rbind(week_data_a,week_data_b)
data_end <-data_end[data_end$week %in% getweek,]

return(data_end)

}



BE<-function(data,change,c_code,week,getweek,reg){

data<-read_csv(indir)

data$week<-as.Date(data$week)
data %>% arrange(code2,k,D,cnt,fil)
data_b<-data %>% dplyr::filter(ver < change)
data_a<-data %>% dplyr::filter(ver >= change)

data_b %>% group_by(week) %>% summarise(n=n()) ->data_b_end

data_b$temp<-paste(data_b$k,data_b$code2,data_b$cnt,sep="-")
data_b[c(2:NROW(data_b)),"temp2"]<-data_b[c(1:NROW(data_b)-1),"temp"]
data_b[1,"temp2"]<-"temp"
data_b$temp3<-data_b$temp == data_b$temp2
data_b %>% dplyr::filter(temp3 == TRUE) %>% group_by(week) %>% summarise(n2=n()) %>% select(week,n2)->data_b_end2

data_b$temp4 <- ifelse(as.numeric(data_b$fil)>=10000,TRUE,FALSE)
data_b$temp5<-data_b$temp3*data_b$temp4
data_b %>% dplyr::group_by(week) %>% summarise(n3=sum(temp5)) %>% select(week,n3) ->data_b_end3

week %>% dplyr::left_join(data_b_end) %>% select(week,n) ->week_data_b
week_data_b %>% dplyr::left_join(data_b_end2) ->week_data_b
week_data_b %>% dplyr::left_join(data_b_end3) ->week_data_b
week_data_b$flg<-0
week_data_b$reg<-reg


data_a %>% group_by(week) %>% summarise(n=n()) ->data_a_end

data_a$temp<-paste(data_a$k,data_a$code2,data_a$cnt,sep="-")
data_a[c(2:NROW(data_a)),"temp2"]<-data_a[c(1:NROW(data_a)-1),"temp"]
data_a[1,"temp2"]<-"temp"
data_a$temp3<-data_a$temp == data_a$temp2
data_a %>% dplyr::filter(temp3 == TRUE) %>% group_by(week) %>% summarise(n2=n()) %>% select(week,n2)->data_a_end2

data_a$temp4 <- ifelse(as.numeric(data_a$fil)>=10000,TRUE,FALSE)
data_a$temp5<-data_a$temp3*data_a$temp4
data_a %>% dplyr::group_by(week) %>% summarise(n3=sum(temp5)) %>% select(week,n3) ->data_a_end3

week %>% dplyr::left_join(data_a_end) %>% select(week,n) ->week_data_a
week_data_a %>% dplyr::left_join(data_a_end2) ->week_data_a
week_data_a %>% dplyr::left_join(data_a_end3) ->week_data_a
week_data_a$flg<-1
week_data_a$reg<-reg


data_end<-rbind(week_data_b,week_data_a)
data_end <-data_end[data_end$week %in% getweek,]

return(data_end)

}


MI<-function(data,change,c_code,week,getweek,reg){

data<-read_csv(indir)

data_b<-data %>% dplyr::filter(ver < change)
data_a<-data %>% dplyr::filter(ver >= change)

#data_b$week<-as.numeric(ceiling((as.Date(data_b$D)-b_day)/7))
#data_b<-dplyr::left_join(data_b,week)
#data_b %>% dplyr::distinct(week,.keep_all = TRUE) %>%
# select(k,week)-> data_b_b
data_b %>% group_by(week) %>% summarise(n=n()) ->data_b_end
#week %>% dplyr::left_join(data_b_end) %>% select(day,n) ->week_data_b

data_b_end$flg<-0
data_b_end$reg<-reg

#data_a$week<-as.numeric(ceiling((as.Date(data_b$D)-b_day)/7))
#data_a<-dplyr::left_join(data_a,week)
#data_a %>% dplyr::distinct(k,week,.keep_all = TRUE) %>%
# select(k,week)-> data_a_a
data_a %>% group_by(week) %>% summarise(n=n()) ->data_a_end
#week %>% dplyr::left_join(data_a_end) %>% select(day,n) ->week_data_a

data_a_end$flg<-1
data_a_end$reg<-reg

data_end<-rbind(data_a_end,data_b_end)

return(data_end)
}


↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

textminning

library(RMeCab)

name<-"C:/Users/xxxx/Documents/R/1.csv"
temp<-"C:/Users/xxxx/Documents/R/"

col<-c("cause","measer")
NG<-c("数","代名詞","非自立","固有名詞")

data<-read.csv(name)
names(data)<-c(1,"cause","measer")
for(col.name in col){

for(i in 1:NROW(data)){
write.csv(data[i,col.name],paste0(temp,col.name,"/",i,".csv"),row.names = F)
}


data.path<-paste0(temp,col.name)
filename1<-list.files(data.path)
filename2<-list.files(data.path,full.names = T)

outword<-NULL
outword2<-NULL
for(i in 1:length(temp.name)){
temp.word<-RMeCabFreq(filename2[i])
word<-temp.word[temp.word$Info1=="名詞" & !temp.word$Info2 %in% NG,]

if(NROW(word)>2){
word$No<-filename1[i]
word$ans<-data[i,1]
word$contents<-data[i,2]
word2<-combn(word$Term,2)
word2<-data.frame(t(word2))
word2$No<-filename1[i]
word2$ans<-data[i,1]
word2$contents<-data[i,2]
outword<-rbind(outword,word)
outword2<-rbind(outword2,word2)
}
}

outfilename1<-paste(temp,col.name,"_1.csv")
outfilename2<-paste(temp,col.name,"_2.csv")

write.csv(outword,file=outfilename1,row.names = F)
write.csv(outword2,file=outfilename2,row.names = F)
}
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

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
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
プロフィール

abc

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

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

この人とブロともになる

QRコード
QR