Question

这是我的代码我有3个不同的问题，我搜索了evrywhere并尝试了很多东西，但它总是给我一个错误。首先，我如何添加一个函数来保存我的rglwidgetoutput到任何文件？还有mby保存日志。 Secound：如果我打开程序，它总是打开一个小小的焦点＆＃34;窗口，我可以以某种方式删除它吗？最后但并非最不重要的是，我有一个Log，我想重命名data_planes，以便日志文件看起来更好：）

#######################################################################################
#                                 Install librarys                                    #
#######################################################################################
#install.packages("shiny")
#install.packages("rgl")
#install.packages("shinythemes")
#install.packages("devtools")

library(shiny)
library(rgl)
library(shinythemes)
library(devtools)
#install_github("rgl", "trestletech", "js-class")
#install_github("rgl", "trestletech", "js-class")

#######################################################################################
#                                   User Interface                                    #
#######################################################################################

ui <- fluidPage(theme = shinytheme("slate"),

  headerPanel("Block Theory"),

  sidebarPanel(

     numericInput(inputId = "dd", label = "Dip direction:", value = "", width = "80%", min = 0, max = 360),

     numericInput(inputId = "fa", label = "Fracture angle:", value = "", width = "80%", min = 0, max = 90),

     numericInput(inputId = "position_x", label = "Position:", value = "", width = "40%"),

     numericInput(inputId = "position_y", label = "", value = "", width = "40%"),

     numericInput(inputId = "position_z", label = "", value = "", width = "40%"),

     #selectInput("form", "Form:",
     #            c("Circle", "Square", "Ellipsoid")),

     actionButton(inputId = "add", label = "Add a plane"),

     actionButton(inputId = "plotbutton", label = "Update")

  ),

  mainPanel(  
    tabsetPanel(

      tabPanel("Plot", rglwidgetOutput(outputId = "plot")), # Output

      tabPanel("Log", verbatimTextOutput(outputId = "log_planes")), # Log File

      # OPTIONS : 

      tabPanel("Preferences", 

               checkboxInput("axes_lim", "axes min / max"),
               conditionalPanel(
                 condition = "input.axes_lim == true",
                 splitLayout(
                 numericInput(inputId = "min_x", label = "x min:", value = "0", width = "90%"),
                 numericInput(inputId = "max_x", label = "x max:", value = "1000", width = "90%")),
                 splitLayout(
                 numericInput(inputId = "min_y", label = "y min:", value = "0", width = "90%"),
                 numericInput(inputId = "max_y", label = "y max:", value = "1000", width = "90%")),
                 splitLayout(
                 numericInput(inputId = "min_z", label = "z min:", value = "0", width = "90%"),
                 numericInput(inputId = "max_z", label = "z max:", value = "1000", width = "90%"))),

               checkboxInput("axes", "Change axes ratio"),
               conditionalPanel(
                 condition = "input.axes == true",

                 sliderInput("x_axis", "x axis:",min = 0, max = 1, value = 1, step = 0.1),

                 sliderInput("y_axis", "y axis:",min = 0, max = 1, value = 1, step = 0.1),     

                 sliderInput("z_axis", "z axis:",min = 0, max = 1, value = 1, step = 0.1)),

               checkboxInput("theme", "Change shiny theme"),
               conditionalPanel(
                condition = "input.theme == true",
                  shinythemes::themeSelector()  )
              ))

  ) # /Main panel
) # /ui


#######################################################################################
#                                       SERVER                                        #
#######################################################################################


server <- function(input, output) {

  data_planes <- data.frame()
  makeReactiveBinding("data_planes")  



  observe({
    input$add
    isolate({
      data_planes <<- rbind(data_planes, data.frame(input$dd, input$fa , input$position_x , input$position_y , input$position_z))
      data_planes <<- na.omit(data_planes)

    })
  })  


  output$plot <- renderRglwidget({

    input$plotbutton

isolate({

  ####################################################     
  #    Open 3d plot:
  x<-sample(input$min_x:input$max_x, 100)
  y<-sample(input$min_y:input$max_y, 100)
  z<-sample(input$min_z:input$max_z, 100)
  plot3d(x, y, z, type = "n",xlim = c(min(x), max(x)), ylim = c(min(y), max(y)), zlim = c(min(z), max(z),expand = 1.03))
  aspect3d(input$x_axis , input$y_axis , input$z_axis)
  ####################################################      

    i=1;
    while (i <= nrow(data_planes)) {

      phi <- data_planes[i,1] * pi / 180
      theta <- data_planes[i,2] * pi / 180
      Px <- data_planes[i,3]
      Py <- data_planes[i,4]
      Pz <- data_planes[i,5]
      n <- c(sin(theta)*sin(phi), sin(theta) * cos(phi), cos(theta))
      # n <- c(-sin(theta)*sin(phi), sin(theta) * cos(phi), -cos(theta))

      P_n <- cos(phi)*sin(theta)*Px+(sin(phi)*sin(theta))*Py+cos(phi)*Pz   # d = -P * n

      # planes3d() plots equation:   a*x + b*y +  c*z + d = 0         

      a <- -sin(theta)*sin(phi)
      b <- sin(theta) * cos(phi)
      c <- -cos(theta)
      d <- P_n          


      cols<-rgb(runif(5),runif(5),runif(5))  #random color genarator

      i <- i + 1

      planes3d(a, b, c , d , col = cols, alpha = 0.6) 

    }

    rglwidget() # opens the plot inside of main panel

  })
  })


  output$log_planes <- renderPrint(data_planes)


}
#######################################################################################
shinyApp(ui = ui, server = server

）

Answer 1

将rgl输出保存到PDF并不容易。您可以使用以下代码将其保存到html页面：

htmlwidgets::saveWidget(rglwidget(), file = "rgl.html")

如果找不到Pandoc，则会失败;你可以用

htmlwidgets::saveWidget(rglwidget(), file = "rgl.html", selfcontained = FALSE)

没有Pandoc，但会创建HTML文件和支持文件的子目录。

您看到的小窗口可能是rgl输出窗口。如果你不想看到它，请运行

options(rgl.useNULL = TRUE)

在加载rgl包之前。这对于Shiny应用程序来说是一个好主意，因为它们可能在某个服务器上运行，你不想尝试在那里打开一个rgl窗口。

对不起，我真的不明白你的第三个问题。

闪亮保存为pdf或情节

1 个答案: