get_table_list <- function(lab_st_data,n_test_num,lab_name,test_num_info)
{
print("Start")
print("25")
plot_output_list <- lapply(1:n_test_num, function(i) {
print(i)
test_num_data <- lab_st_data %>%
filter(test_number %in% c(test_num_info$Run_test[i])) %>%
distinct(time_pull_B_M_E,parameter_name,parameter_cd,value_no,unit_desc,min_spec, max_spec, target_spec)
print(str(lab_st_data))
test_num_data110 <<- test_num_data
test_num_data <- test_num_data %>%
mutate(min_sd = min_spec - (0.05*min_spec),
max_sd = max_spec + (0.05*max_spec),
fin_spec= NA) %>%
mutate(fin_spec = ifelse(value_no <= max_spec & value_no >= min_spec,"#C4D79B",
ifelse(value_no < min_spec & value_no >= min_sd,"#FFFF00",
ifelse(value_no > max_spec & value_no <= max_sd,"#FFFF00",
ifelse(value_no > max_sd,"#FF0000",
ifelse(value_no < min_sd,"#FF0000","#F0F0F0")))))) %>%
select(-min_sd,-max_sd)
print("90")
test_num_data111 <<- test_num_data
test_num_data$fin_spec[is.na(test_num_data$fin_spec)] <- "#F0F0F0"
test_col_piv <- test_num_data %>%
select(-value_no,-min_spec, -max_spec, -target_spec) %>%
pivot_wider(names_from = c(time_pull_B_M_E),
values_from = c(fin_spec))
test_col_piv <- test_col_piv[,3:ncol(test_col_piv)]
colormatrix <- c(t(test_col_piv))
colormatrix[is.na(colormatrix)] <- "#F0F0F0"
test_num_piv <- test_num_data %>%
select(-fin_spec) %>%
pivot_wider(names_from = c(time_pull_B_M_E),
values_from = c(value_no))
print("60")
# test_num_piv <- merge(test_num_piv,spec_results[,c("Nutrient Testing","description","sort_no")],by.x = "parameter_cd",by.y = "parameter_cd")
# test_num_piv <- test_num_piv %>%
# arrange(sort_no) %>%
# select(-parameter_name,-parameter_cd,-sort_no)
# print("88")
# test_num_piv54 <<- test_num_piv
## Using left_join to merge based on 'parameter_cd'
test_num_piv <- test_num_piv %>%
inner_join(spec_results[, c("parameter_cd", "description", "sort_no")],
by = "parameter_cd") %>%
arrange(sort_no) %>%
select(-parameter_name,-parameter_cd, -sort_no)
test_num_piv54 <<- test_num_piv
ncol_sub <- ncol(test_num_piv)-1
test_num_piv <- cbind(description = test_num_piv$description,test_num_piv[,1:ncol_sub])
test_num_piv55 <<- test_num_piv
print("888")
test_num_piv <- test_num_piv %>%
rename("Parameter Name"=description,"Unit Desc"=unit_desc,"Min Spec"=min_spec,
"Max Spec"=max_spec,"Target Spec"=target_spec)
print("77")
box_title <- paste("Laboratory: ",lab_name," - Test Number: ",test_num_info$Run_test[i]," - Run Date: ",test_num_info$Run_date[i])
op <- as.data.frame(t(test_num_piv))
print("100")
op <- cbind(rownames(op),op)
colnames(op) <- op[1,]
op <- op[-1,]
col_dup <- make.unique(colnames(op))
colnames(op) <- col_dup
nrow_op <- nrow(op)
ncol_op <- ncol(op)
result_table <- uiOutput(op)
print(str(op))
print("137")
op12 <<- op
result_table <- renderUI({
op <- op %>%
flextable()
op <- op %>%
#theme_zebra() %>% # theme_booktabs() %>%
bg(bg = "#F0F0F0", part = "all") %>%
color(color = "#002288", part = "all") %>%
bg(i =5:nrow_op,j=2:ncol_op,bg=colormatrix) %>%
bold(j=1, bold = TRUE, part = "body") %>%
bold(bold = TRUE, part = "header") %>% #<= 0.05
font(fontname = 'Arial', part = "all") %>%
padding(padding = 0,part = "all") %>%
fontsize(size = 12, part = "header") %>%
fontsize(size = 11, part = "body") %>%
fontsize(j=1, size = 12, part = "body") %>%
align(align = "center", part = "all") %>%
border(border = fp_border(color = "#886600") , part = "all") %>%
border_outer(border = fp_border(color = "#000f3c", style = "solid", width = 2) , part = "all") %>%
autofit() %>%
height_all(height = 0.5, part = "all") %>% hrule(rule = "exact", part = "all") %>%
htmltools_value()
fluidRow(box(status = "primary",title = strong(box_title), collapsible = T,
height = NULL , width = 12, solidHeader = TRUE,
style = "overflow-y:scroll; overflow-x:scroll" ,#max-height: 400px;
op))
})
do.call(tagList, plot_output_list) # needed to display properly.
if(is.null(input$testname) || sum(input$testname == "")) {
test_name_info_spec <- unique(test_name_data_specs()$description)
} else{
test_name_info_spec <- input$testname
}
spec_results <- spec_results %>%
filter(description %in% c(test_name_info_spec)) %>%
select(-category_group,-sort_no,-`Nutrient Testing`,-formula_cd,-version,-created_by,-parameter_cd) %>%
rename("Unit Desc"=unit,"Min Spec"=min_spec,"Max Spec"=max_spec,"Target Spec"=target_spec,"Nutrient Testing" = description)
testname111 <<- input$testname
print(spec_results)
print(input$testname)
op <- as.data.frame(t(spec_results))
op <- cbind(rownames(op),op)
colnames(op) <- make.unique(colnames(op))
op11 <<- op
colnames(op) <- op[1,]
op <- op[-1,]
op <- op %>% flextable() %>% add_header_row(values=colnames(op), top=FALSE) %>% delete_rows(i=1,part="header")
op <- op %>%
#theme_zebra() %>% # theme_booktabs() %>%
bg(bg = "#f7f5f5", part = "all") %>%
bg(bg = "#D9D9D9", part = "header") %>%
color(color = "#000000", part = "all") %>%
bg(j=1,i=1,bg = "#FFFFCC", part = "body") %>%
bg(j=1,i=2,bg = "#DAEEF3", part = "body") %>%
bg(j=1,i=3,bg = "#DAEEF3", part = "body") %>%
bg(j=1,i=4,bg = "#B8CCE4", part = "body") %>%
bold(j=1, bold = TRUE, part = "body") %>%
bold(bold = TRUE, part = "header") %>% #<= 0.05
font(fontname = 'Arial', part = "all") %>%
padding(padding = 0,part = "all") %>%
fontsize(size = 12, part = "header") %>%
fontsize(size = 11, part = "body") %>%
fontsize(j=1, size = 12, part = "body") %>%
align(align = "center", part = "all") %>%
border(border = fp_border(color = "#000000") , part = "all") %>%
border_outer(border = fp_border(color = "#000000", style = "solid", width = 2) , part = "all") %>%
autofit() %>%
height_all(height = 0.5, part = "all") %>% hrule(rule = "exact", part = "all") %>%
htmltools_value()
return(op)
})
do.call(tagList, plot_output_list) # needed to display properly.
return(plot_output_list)
} this is my global code where op12 is giving me 7 obs and 65 variables in server I have similar table output which is op 11 gives 5 obs and 9 variables
output$spec_table <- renderUI({
if(is.null(spec_results)) return(NULL)
})
where is the error