How can I get a table to print under a picture using a loop in a .rmd with word_document? - r-markdown

I am trying to create a .rmd file that takes all of the pictures for a field day and the notes that was taken and create a report. I am able to get the pictures to plot but the no matter what I try the table with the notes does not want to print. Below is the loop I am utilizing:
for(i in 1:nrow(subset_Inventory_data)) {
singlept <- subset_Inventory_data[i,]
picture <- pictureLookup[singlept$GlobalID == pictureLookup$REL_GLOBAL,]
#PRINT PICTURE
plot(image_read(paste(baseURL,picture$UID,sep = "")) %>%
# image_resize("400x400") %>%
image_rotate(degrees = 90)
)
#creating table underneath picture
Categories <- c("Latitude", "Longitude", "Road Width", "Conditon", "Lock Present","Additional Notes")
sum_table <- data.frame(Category = character(),
Information = character(),
stringsAsFactors = FALSE)
sum_table <- rbind(sum_table,Categories,
stringsAsFactors = FALSE)
colnames(sum_table) <- Categories
sum_table$Latitude <- sprintf("%f",singlept$LAT)
sum_table$Longitude <-sprintf("%f",singlept$LONG)
sum_table$`Road Width` <- paste(singlept$Gate_Width,"feet")
sum_table$Conditon <- singlept$Condition
sum_table$`Lock Present` <- singlept$GlobalID
sum_table$`Additional Notes` <- singlept$General_Notes
#TRIED FLEXTABLE
ft <- flextable(sum_table)
ft <- fontsize(ft, size = 12)
ft <- autofit(ft)
print(ft)
#TRIED KABLE
print(kable(sum_table,"latex"))
}

Related

How can I print tops (print[:]) according user preference with slide bar?

How can i run a r shiny app, which print the top features based on user's choice?
I tried the following but I want the user to select, not putting it manually the top 3 for example
library(KEGGgraph)
library(xml2)
library(Rgraphviz)
ui <- fluidPage(
sidebarLayout(
sliderInput("range",
label = "Range of interest:",
min = 0, max = 10, value = c(0, 100))
),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plots", plotOutput(outputId="genePlot", width = 1300, height=900)),
tabPanel("Edges", verbatimTextOutput("out_tops")),
tabPanel("Compounds", tableOutput("out_compounds")))
)
)
)
server <- function(input, output) {
output$out_tops <- renderPrint({
mapkGall <- parseKGML2Graph(read_xml(sprintf("%s.xml", input$geneInput)), genesOnly=FALSE)
mapkGsub <- subGraphByNodeType(mapkGall, "gene")
graphs <- list(mapk=mapkGsub, wnt=mapkGall)
merged <- mergeGraphs(graphs)
merged
outs <- sapply(edges(merged), length) > 0
ins <- sapply(inEdges(merged), length) > 0
ios <- outs | ins
mapkGoutdegrees <- sapply(edges(mapkGall), length)
mapkGindegrees <- sapply(inEdges(mapkGall), length)
topouts <- sort(mapkGoutdegrees, decreasing=T)
topins <- sort(mapkGindegrees, decreasing=T)
if(require(org.Hs.eg.db)) {
top_nodes_out <- translateKEGGID2GeneID(names(topouts))
tmp <- c()
for (i in top_nodes_out) {
if (is.na(mget(sprintf("%s",i), org.Hs.egSYMBOL, ifnotfound = NA))) {
tmp <- append(tmp,sprintf("%s",i))
}
else {
tmp <- append(tmp,mget(sprintf("%s",i), org.Hs.egSYMBOL))
}
}
nodesNames_outs <- sapply(tmp, "[[",1)
} else {
nodesNames_outs <- names(topouts)
}
how can I let the user specify the printings by the slider bar?
names(nodesNames_outs) <- names(topouts)
print("top genes with out connections")
print(nodesNames_outs[1:3]) ### Here like something for the slider bar print[:,sliderbar$input]
I would like not to print manually the top 3 but the user to select how many he wants. the code should sort the top genes and print them accordingly when user uses the slidebar
Can you please suggest something?

shiny DT::renderDT() multiple tables

I can't get renderDT() to display multiple data tables that my script creates. The code below. Reading the input table works, the progress indicator progresses through each line, but the hg38 and hg19 tabs are empty in the display.
If I move the hg38 renderDT() inside of the my_data <- reactive( it will display the hg38 table, but I get the following error and nothing in the hg19 tab
```Warning: Error in $: object of type 'closure' is not subsettable```
```105: <Anonymous>```
If I move both renderDT() inside the my_data <- reactive( I get nothing in either tab. I'm clearly misunderstanding something, but I'm not sure what.
library(shiny)
library(DT)
library("dplyr")
library(GenomeInfoDb)
library(BSgenome)
library("MafDb.gnomAD.r2.1.hs37d5")
library("MafH5.gnomAD.v3.1.2.GRCh38")
library(BSgenome.Hsapiens.UCSC.hg19)
library(BSgenome.Hsapiens.UCSC.hg38)
mafdb_hg19 <- MafDb.gnomAD.r2.1.hs37d5
mafdb_hg38 <- MafH5.gnomAD.v3.1.2.GRCh38
hg19 <- BSgenome.Hsapiens.UCSC.hg19
hg38 <- BSgenome.Hsapiens.UCSC.hg38
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File", accept = ".csv"),
#checkboxInput("header", "Header", TRUE),
width = 2
),
mainPanel(
tabsetPanel(
tabPanel("Primers(input)", DT::dataTableOutput("primers")),
tabPanel("SNPs(hg38)", DT::dataTableOutput("hg38")),
tabPanel("SNPs(hg19)", DT::dataTableOutput("hg19"))
)
)
)
)
server <- function(input, output){
primer_file <- reactive(
{
file <- input$file1
ext <- tools::file_ext(file$datapath)
req(file)
validate(need(ext == "csv", "Please upload a csv file"))
primer_file <- as.data.frame(read.csv(file$datapath, header = TRUE))
return(primer_file)
})
output$primers <- DT::renderDT(primer_file())
my_data <- reactive(
{
primers_hg38 <- data.frame(primer_id=character(),
seq=character(),
chr=character(),
hg38_pos=integer(),
AF_allpopmax_hg38=integer(),
stringsAsFactors=FALSE)
primers_hg19 <- data.frame(primer_id=character(),
seq=character(),
chr=character(),
hg19_pos=integer(),
AF_afr=integer(),AF_amr=integer(), AF_asj=integer(), AF_eas=integer(), AF_fin=integer(), AF_nfe=integer(), AF_oth=integer(),
stringsAsFactors=FALSE)
progress <- shiny::Progress$new()
# Make sure it closes when we exit this reactive, even if there's an error
on.exit(progress$close())
progress$set(message = "Calculating", value = 0)
lastrow <- nrow(primer_file())
firstrow=1
for (no in (firstrow:lastrow))
{
row = primer_file()[no,]
temp_chr <- row$chr
temp_FP <- row$FP
temp_RP <- row$RP
progress$inc(1/lastrow, detail = paste("line ", no))
###################lets do hg38 first######################
subject_hg38 <- hg38[[temp_chr]]
products_hg38 <- matchProbePair(temp_FP,temp_RP,subject_hg38)
amp_start_hg38 = (start(products_hg38))
fp_end_hg38 = (start(products_hg38) + as.integer(nchar(row$FP)) - 1)
rp_start_hg38 = ( (start(products_hg38) + width(products_hg38)) - as.integer(nchar(row$RP)) )
amp_end_hg38 = (start(products_hg38) + width(products_hg38) - 1)
fp_range_hg38 <- GRanges(seqnames=temp_chr, IRanges(start=amp_start_hg38:fp_end_hg38, width=1))
fp_scores_hg38 <- gscores(mafdb_hg38,fp_range_hg38,pop="AF_allpopmax")
fp_scores_hg38 <- as.data.frame(fp_scores_hg38)
rp_range_hg38 <- GRanges(seqnames=temp_chr, IRanges(start=rp_start_hg38:amp_end_hg38, width=1))
rp_scores_hg38 <- gscores(mafdb_hg38,rp_range_hg38,pop="AF_allpopmax")
rp_scores_hg38 <- as.data.frame(rp_scores_hg38)
#primers_hg38 <- data.frame(primer_id=character(),
# seq=character(),
# chr=character(),
# hg38_pos=integer(),
# AF_allpopmax_hg38=integer(),
# stringsAsFactors=FALSE)
primers_hg38 <- bind_rows(primers_hg38,setNames(data.frame(primer_id <- paste0(row$ID,"_F"),
seq <- temp_FP,
chr <- fp_scores_hg38$seqnames,
hg38_pos <- fp_scores_hg38$start,
AF_allpopmax_hg38 <- fp_scores_hg38$AF_allpopmax, stringsAsFactors=FALSE),c("primer_id", "seq", "chr","hg38_pos","AF_allpopmax_hg38")))
#names(primers_hg38) <- c("primer_id","seq","chr","hg38_pos","AF_allpopmax_hg38")
primers_hg38 <- bind_rows(primers_hg38,setNames(data.frame(primer_id <- paste0(row$ID,"_R"),
seq <- temp_RP,
chr <- rp_scores_hg38$seqnames,
hg38_pos <- rp_scores_hg38$start,
AF_allpopmax_hg38 <- rp_scores_hg38$AF_allpopmax,stringsAsFactors=FALSE),c("primer_id", "seq", "chr","hg38_pos","AF_allpopmax_hg38")))
##########################now hg19######################################
#names(primers_hg38) <- c("primer_id","seq","chr","hg38_pos","AF_allpopmax_hg38")
subject_hg19 <- hg19[[temp_chr]]
products_hg19 <- matchProbePair(temp_FP,temp_RP,subject_hg19)
amp_start_hg19 = start(products_hg19)
fp_end_hg19 = ( start(products_hg19) + as.integer(nchar(row$FP)) - 1)
rp_start_hg19 = ( (start(products_hg19) + width(products_hg19)) - as.integer(nchar(row$RP)) )
amp_end_hg19 = (start(products_hg19) + width(products_hg19) - 1)
fp_range_hg19 <- GRanges(seqnames=temp_chr, IRanges(start=amp_start_hg19:fp_end_hg19, width=1))
fp_scores_hg19 <- gscores(mafdb_hg19,fp_range_hg19,pop=c("AF_afr","AF_amr","AF_asj","AF_eas","AF_fin","AF_nfe","AF_oth"))
fp_scores_hg19 <- as.data.frame(fp_scores_hg19)
rp_range_hg19 <- GRanges(seqnames=temp_chr, IRanges(start=rp_start_hg19:amp_end_hg19, width=1))
rp_scores_hg19 <- gscores(mafdb_hg19,rp_range_hg19,pop=c("AF_afr","AF_amr","AF_asj","AF_eas","AF_fin","AF_nfe","AF_oth"))
rp_scores_hg19 <- as.data.frame(rp_scores_hg19)
primers_hg19 <- bind_rows(primers_hg19,setNames(data.frame(primer_id <- paste0(row$ID,"_F"),
seq <- temp_FP,
chr <- fp_scores_hg19$seqnames,
hg19_pos <- fp_scores_hg19$start,
AF_afr <- fp_scores_hg19$AF_afr,
AF_amr <- fp_scores_hg19$AF_amr,
AF_asj <- fp_scores_hg19$AF_asj,
AF_eas <- fp_scores_hg19$AF_eas,
AF_fin <- fp_scores_hg19$AF_fin,
AF_nfe<- fp_scores_hg19$AF_nfe,
AF_oth<- fp_scores_hg19$AF_oth,
stringsAsFactors=FALSE),
c("primer_id", "seq", "chr","hg19_pos","AF_afr","AF_amr","AF_asj","AF_eas","AF_fin","AF_nfe","AF_oth")))
primers_hg19 <- bind_rows(primers_hg19,setNames(data.frame(primer_id <- paste0(row$ID,"_R"),
seq <- temp_RP,
chr <- rp_scores_hg19$seqnames,
hg19_pos <- rp_scores_hg19$start,
AF_afr <- rp_scores_hg19$AF_afr,
AF_amr <- rp_scores_hg19$AF_amr,
AF_asj <- rp_scores_hg19$AF_asj,
AF_eas <- rp_scores_hg19$AF_eas,
AF_fin <- rp_scores_hg19$AF_fin,
AF_nfe<- rp_scores_hg19$AF_nfe,
AF_oth<- rp_scores_hg19$AF_oth,
stringsAsFactors=FALSE),
c("primer_id", "seq", "chr","hg19_pos","AF_afr","AF_amr","AF_asj","AF_eas","AF_fin","AF_nfe","AF_oth")))
}
return(list(as.data.frame(primers_hg38), as.data.frame(primers_hg19)))
})
output$hg38 <- DT::renderDT(my_data()$primers_hg38)
#, options = list(paging = F, info = F, search = list(),
# dom = "Brtip", fixedColumns = T, fixedHeader = T,
# buttons = c("copy", "excel")),
# fillContainer = TRUE)
output$hg19 <- DT::renderDT(my_data()$primers_hg19, options = list(paging = F, info = F, search = list(),
dom = "Brtip", fixedColumns = T, fixedHeader = T,
buttons = c("copy", "excel")),
fillContainer = TRUE)
}
shinyApp(ui, server)
Please consider posting a MRE in the future. If you access the data as my_data()[[1]] it should work. However, if you define a named list, your method works. Take a look at an MRE below.
library(DT)
ui <- fluidPage(
DTOutput("t1"), DTOutput("t2")
)
server <- function(input, output) {
myd <- reactive(list(iris,mtcars))
myd2 <- reactive(list(ab=rock,cd=pressure))
output$t1 <- renderDT(head(myd()[[2]])) ### works
# output$t1 <- renderDT(myd()$mtcars) ### does not work
output$t2 <- renderDT(head(myd2()$ab)) ### works as a named list
}
shinyApp(ui = ui, server = server)

Functions dplyr with rlang::last_error() in purrr::map loop in r

I'm using a function to calculate the length of linestring per cell by ID and store in a list, convert each element of the list into a RasterLayer and turn that list into a RasterStack, average all layers and get a single raster.
#function
# build_length_raster <- function(one_df) {
intersect_list <- by(
one_df ,
one_df$sub_id,
function(subid_df) sf::st_intersection(grid2, subid_df) %>%
dplyr::mutate(length = as.numeric(sf::st_length(.))) %>%
sf::st_drop_geometry()
)
list_length_grid <- purrr::map(intersect_list, function(x)
x %>% dplyr::left_join(x=grid2, by="cell", copy=T) %>%
dplyr::mutate(length=length) %>%
dplyr::mutate_if(is.numeric,coalesce,0)
)
list_length_raster <- purrr::map(list_length_grid, function(x)
raster::rasterize(x, r, field="length", na.rm=F, background=0)
)
list_length_raster2 <- unlist(list_length_raster, recursive=F)
raster_stack <- raster::stack(list_length_raster2)
raster_mean <- raster::stackApply(
raster_stack,
indices = rep(1,nlayers(raster_stack)),
fun = "mean", na.rm = TRUE)
#}
The function presents a step where, in order for the resulting grid of st_intersection() to have the same number of cells as it had initially, I use left_join(by="cell" column).Then I use mutate() to replace the NA's with 0. When I run the function steps for one dataframe from the list, it works perfectly, but when I put it inside map() to do this in a list, I get this error, which seems to refer to the dplyr functions:
final_list <- purrr::map(mylist, build_length_raster)
> rlang::last_error()
<error/rlang_error>
Join columns must be present in data.
x Problem with `cell`.
Backtrace:
1. purrr::map(mylist, build_length_raster)
15. dplyr:::left_join.data.frame(., x = grid, by = "cell", copy = T)
16. dplyr:::join_mutate(...)
17. dplyr:::join_cols(...)
18. dplyr:::standardise_join_by(by, x_names = x_names, y_names = y_names)
19. dplyr:::check_join_vars(by$y, y_names)
Run `rlang::last_trace()` to see the full context.
Is there a way to solved this problem?
MYDATA example
library(tidyverse)
library(sf)
library(purrr)
library(raster)
#data example
id <- c("844", "844", "844", "844", "844","844", "844", "844", "844", "844",
"844", "844", "845", "845", "845", "845", "845","845", "845", "845",
"845","845", "845", "845")
sub_id <- c("2017_844_1", "2017_844_1", "2017_844_1", "2017_844_1", "2017_844_2",
"2017_844_2", "2017_844_2", "2017_844_2", "2017_844_3", "2017_844_3",
"2017_844_3", "2017_844_3", "2017_845_1", "2017_845_1", "2017_845_1",
"2017_845_1", "2017_845_2","2017_845_2", "2017_845_2", "2017_845_2",
"2017_845_3","2017_845_3", "2017_845_3", "2017_845_3")
lat <- c(-30.6456, -29.5648, -27.6667, -31.5587, -30.6934, -29.3147, -23.0538,
-26.5877, -26.6923, -23.40865, -23.1143, -23.28331, -31.6456, -24.5648,
-27.6867, -31.4587, -30.6784, -28.3447, -23.0466, -27.5877, -26.8524,
-23.8855, -24.1143, -23.5874)
long <- c(-50.4879, -49.8715, -51.8716, -50.4456, -50.9842, -51.9787, -41.2343,
-40.2859, -40.19599, -41.64302, -41.58042, -41.55057, -50.4576, -48.8715,
-51.4566, -51.4456, -50.4477, -50.9937, -41.4789, -41.3859, -40.2536,
-41.6502, -40.5442, -41.4057)
df <- tibble(id = as.factor(id), sub_id = as.factor(sub_id), lat, long)
#converting ​to sf
df.sf <- df %>%
​sf::st_as_sf(coords = c("long", "lat"), crs = 4326)
#creating grid
xy <- sf::st_coordinates(df.sf)
grid = sf::st_make_grid(sf::st_bbox(df.sf),
​cellsize = .1, square = FALSE) %>%
​sf::st_as_sf()
#creating raster
r <- raster::raster(grid, res=0.1)
#return grid because raster function changes number of cells
grid2 <- rasterToPolygons(r, na.rm=F) %>%
st_as_sf() %>% mutate(cell=1:ncell(r))
#creating linestring to each sub_id
df.line <- df.sf %>%
dplyr::group_by(sub_id, id) %>%
dplyr::summarize() %>%
sf::st_cast("LINESTRING")
#creating ID list
mylist<- split(df.line, df.line$id)
#separating one dataframe of list to test function
one_df <- df.line[df.line$id=="844",]
one_df$id <- droplevels(one_df$id)
one_df$sub_id <- droplevels(one_df$sub_id)
The specific error is caused because intersect_list has empty items in the list, which cannot be joined because they are empty, and hence have no columns to join by. If you modified the map function to only use non-empty items of intersect_list you would not get that error.
As you noted in the comments, removing the empty list entries with keep(intersect_list, ~ !is.null(.)) before mapping left_join onto the list items will fix the error.
However, I don't think this is the most elegant way to solve this problem. I might misunderstand what the goal is, but if it's to produce a raster from the total length of lines within each grid cell, I think a simpler approach without using purrr might work.
This is not the exact same as your product, but I'm keeping it simpler rn to illustrate an alternate approach. Here is a sum of the lengths in each cell as a stars object (similar to raster but plays better with the tidyverse and sf).
I'm starting off from your objects one_df and grid:
# Turn multiple lines into single MULTILINESTRING:
one_df %>%
st_union() ->
union_df
# Intersection of each grid cell with the MULTILINESTRING geometry:
grid %>%
st_intersection(union_df) ->
grid_lines
# Get lengths:
grid_lines %>%
mutate(length = st_length(x)) %>%
st_drop_geometry() ->
grid_lengths
# Join the calculated lengths back with the spatial grid,
# most of which will have NA for length
grid %>%
left_join(grid_lengths, by = "cell") ->
grid_with_lengths
# Rasterize the length field of the grid
grid_with_lengths %>%
dplyr::select(length) %>%
stars::st_rasterize() ->
length_stars
length_stars %>% mapview::mapview()

R Shiny dq_render_handsontable Error when adding columns and trying to Edit new columns' cells

I get an error while using shiny dq_render_handsontable which I guess it's a bug of the dq_shiny package. I would appreciate if anyone could know any work around.
I am trying to interactively update a table via an action button ("Generate" in the code below). The tables which I am trying to switch among, have different number of columns. All works up to the display of the new table, i.e., once I click on "Generate" I can see the new table with additional columns. BUT the problem is that once I try to edit the cells of the data frame with a more columns after editting the first one with less columns, the following error appear:
Warning: Error in [<-.data.frame: new columns would leave holes after existing columns
I guess that is certainly a bug of dq_render_handsontable that doesn't recognize the new columns added to handsontable. Anyone knows a workaround? Maybe refreshing the table before showing a new data frame with more columns?
I attach the peice of the code to reproduce the error:
library(shiny)
library(rhandsontable)
library(dqshiny)
library(rlang)
ui = fluidPage(
dq_handsontable_output("InputTable", 9)
,
# actionButton("render", "Render HoT"),
actionButton("simulationInput_2", "Generate"),
fluidRow(id="bigRow", class="hidden",
style="height:100vh;background:#ff8f00;")
)
server = function(input, output) {
hw <- c("Hello", "my", "funny", "world!")
data1 <- data.frame(A=hw, B=hw[c(2,3,4,1)], C=1:4, D=Sys.Date() - 0:3,
A2=hw, B2=hw[c(2,3,4,1)], C2=1:4, D2=Sys.Date() - 1:4,
stringsAsFactors = FALSE)
hw <- c("Hello", "my", "funny", "world!")
data2 <- data.frame(A=hw, B=hw[c(2,3,4,1)], C=1:4, D=Sys.Date() - 0:3,
# A2=NA, B2=NA, C2=NA, D2=NA,
stringsAsFactors = FALSE)
cont = 0
observeEvent(input$simulationInput_2, {
cont <<- cont+1
print(cont)
if(mod(cont,2)==0){
data <- data2
}else{
data <- data1
}
renderInputTable(data)
render_hot("InputTable")
})
renderInputTable <- function(data){
dq_render_handsontable(
"InputTable",
data, #"rand",
# filters = F, #c("S", "T", "R", "R"),
filters = rep(NA, ncol(data)),
table_param = list(rowHeaders = NULL, selectCallback = TRUE))
}
observeEvent(input$random_select, toggle("bigRow"))
observeEvent(input$render, render_hot("InputTable"))
}
shinyApp(ui, server)
I could overcome the problem by a trick which is renaming the dq_shiny table ID which is actually a bug of dq_render_handsontable:
library(shiny)
library(rhandsontable)
library(dqshiny)
library(rlang)
library(magrittr)
library(data.table)
ui = fluidPage(
tags$div(id="simulationInputTable_divOutside", style="padding:0px;margin:0px",
tags$div(id="simulationInputTable_divInside1", style="padding:0px;margin:0px",
dq_handsontable_output("InputTable1", 9)),
tags$div(id="simulationInputTable_divInside2", style="padding:0px;margin:0px",
dq_handsontable_output("InputTable2", 9)),
tags$div(id="simulationInputTable_divInside3", style="padding:0px;margin:0px",
dq_handsontable_output("InputTable3", 9))
)
,
# actionButton("render", "Render HoT"),
actionButton("simulationInput_2", "Generate"),
fluidRow(id="bigRow", class="hidden",
style="height:100vh;background:#ff8f00;")
)
server = function(input, output) {
columns <- c(1,2,3,4)
hw <- c("Hello", "my", "funny", "world!")
cont = 0
observeEvent(input$simulationInput_2, {
cont <<- cont+1
data1 <- data.frame(A=hw, B=hw[c(2,3,4,1)], C=1:4, D=Sys.Date() - 0:3,
A2=hw, B2=hw[c(2,3,4,1)], C2=1:4, D2=Sys.Date() - 1:4,
stringsAsFactors = FALSE)
name = paste0("InputTable",cont)
divName = paste0("simulationInputTable_divInside",cont-1)
hide(divName)
dq_render_handsontable(
name,
data1, #"rand",
# filters = F, #c("S", "T", "R", "R"),
filters = rep(NA, ncol(data1)),
table_param = list(rowHeaders = NULL, selectCallback = TRUE))
})
observeEvent(input$random_select, toggle("bigRow"))
observeEvent(input$render, render_hot("InputTable"))
}
shinyApp(ui, server)

Outputting the results from bife object to Latex in Rmarkdown?

I'm estimating a fixed-effects probit model using the bife package in R. I'm trying to extract the output into something I can use with either stargazer or texreg so I can output them into a paper using Rmarkdown to create a LaTeX object. I'm aware I can manually extract the coefficients and standard errors, etc., but I'm wondering if there isn't a more efficient way to coerce this object into something that'd work with either package.
Here's a reproducible example:
install.packages("bife")
library(bife)
data("iris")
iris$big <- ifelse(iris$Sepal.Length > median(iris$Sepal.Length),1,0)
output <- bife(big ~ Sepal.Width + Petal.Length | Species, data=iris, "logit")
I think I found an alternative solution for this one, even if it is probably too late
Basically, first, I went on the repository of the package "texreg" and found this function:
extract.bife <- function(model,
include.loglik = TRUE,
include.deviance = TRUE,
include.nobs = TRUE,
...) {
s <- summary(model)
coefficient.names <- rownames(s$cm)
co <- s$cm[, 1]
se <- s$cm[, 2]
pval <- s$cm[, 4]
gof <- numeric()
gof.names <- character()
gof.decimal <- logical()
if (include.loglik == TRUE) {
lik <- logLik(model)
gof <- c(gof, lik)
gof.names <- c(gof.names, "Log Likelihood")
gof.decimal <- c(gof.decimal, TRUE)
}
if (include.deviance == TRUE) {
gof <- c(gof, deviance(model))
gof.names <- c(gof.names, "Deviance")
gof.decimal <- c(gof.decimal, TRUE)
}
if (include.nobs == TRUE) {
n <- s$nobs["nobs"]
gof <- c(gof, n)
gof.names <- c(gof.names, "Num. obs.")
gof.decimal <- c(gof.decimal, FALSE)
}
tr <- createTexreg(
coef.names = coefficient.names,
coef = co,
se = se,
pvalues = pval,
gof.names = gof.names,
gof = gof,
gof.decimal = gof.decimal
)
return(tr)
}
So for your example, just apply it on your model and use the function texreg and you may have a Latex-"like" output
tr <- extract.bife(output)
texreg(tr)
I hope it will help!
Best