How to make a table of icons and text in Rmarkdown - html-table

In several web pages for courses I have a Resources page that lists some recommended
books, using icons of the cover and text that contains links to related materials.
I can do this, as shown below, but the code in my .Rmd file is unnecessarily complex, making it
a chore to add new books.
How can I simplify this code in the chunks? I use several functions defined below
```{r do-books, echo=FALSE}
width <- "160px"
tab(class="cellpadding", width="800px",
tr(
tabfig("fox", "images/books/car-3e.jpg",
"https://us.sagepub.com/en-us/nam/an-r-companion-to-applied-regression/book246125", width=width),
tabtxt("Fox & Weisberg,", a("An R Companion to Applied Regression",
href="https://us.sagepub.com/en-us/nam/an-r-companion-to-applied-regression/book246125"),
". A comprehensive introduction to linear models, regression diagnostics, etc.", br()
# "Course notes at", aself("http://ccom.unh.edu/vislab/VisCourse/index.html")
)
),
tr(
tabfig("Wickham", "images/books/ggplot-book-2ndEd.jpg",
"https://www.springer.com/gp/book/9780387981413", width=width),
tabtxt("Hadley Wickham,", a("ggplot2: Elegant Graphics for Data Analysis",
href="https://www.springer.com/gp/book/9780387981413"),
". The printed version of the ggplot2 book. The 3rd edition is online at",
a("https://ggplot2-book.org/", href= "https://ggplot2-book.org/")
)
)
)
```
The functions tabfig and tabtext are defined in a sourced file:
library(htmltools)
# table tags
tab <- function (...)
tags$table(...)
td <- function (...)
tags$td(...)
tr <- function (...)
tags$tr(...)
# an <a> tag with href as the text to be displayed
aself <- function (href, ...)
a(href, href=href, ...)
# thumnail figure with href in a table column / row
tabfig <- function(name, img, href, ...) {
td(
a(class = "thumbnail", title = name, href = href,
img(src = img, ...)
)
)
}
tabtxt <- function(text, ...) {
td(text, ...)
}

Related

R markdown: simplify creating tables of figures and text

For R markdown Rmd web pages I want to generate tables containing in the first column thumbnail images (that link to a larger image or a web site) and
descriptive text in the 2nd column. One example is the following image:
I know I can create this manually in raw HTML, but that is very fiddly and time-consuming. There must be some easier way.
On a different page, I tried a markdown / pandoc table, but that didn't work, and I reverted to manual coding of HTML
icon | title
--------------------------------------------------+--------------------------
<img src="images/books/R-Graphics.jpg" height=50> |Paul Murrell, *R Graphics*, 2nd Ed.
<img src="images/books/R-graphics-cookbook.jpg" height=50> | Winston Chang, R Graphics Cookbook
<img src="images/books/lattice.png" height=50> | Deepayan Sarkar, *lattice*
<img src="images/books/ggplot2.jpg" height=50> | Hadley Wickham, *ggplot2*
Perhaps the htmltools package would be useful here, but I can't quite see how to use it in my Rmd files for this application.
Probably forgot escaping quotes? This works fine for me:
---
title: "The Mighty Doge"
output: html_document
---
```{r}
library(knitr)
create_thumbnail <- function(file) {
paste0("<img src=\"", file, "\" style=\"width: 50px;\"/>")
}
df <- data.frame(Image = rep("unnamed.png", 5),
Description = rep("Doge", 5))
df$Image <- create_thumbnail(df$Image)
kable(df)
```
Here is an approach that uses htmltools and seems much more flexible, in that I can control the details somewhat more easily.
I'm not familiar with bootstrap <div> constructs, so I used HTML table constructs. I had to define functions for tr(), td() etc.
```{r html-setup, echo=FALSE}
library(htmltools)
# table tags
tab <- function (...)
tags$table(...)
td <- function (...)
tags$td(...)
tr <- function (...)
tags$tr(...)
# an <a> tag with href as the text to be displayed
aself <- function (href, ...)
a(href, href=href, ...)
```
Then functions to construct my table entries the way I wanted:
```{r table-functions, echo=FALSE}
# thumnail figure with href in a table column
tabfig <- function(name, img, href, width) {
td(
a(class = "thumbnail", title = name, href = href,
img(src = img, width=width)
)
)
}
tabtxt <- function(text, ...) {
td(text, ...)
}
```
Finally, use them to input the entries:
## Blogs
```{r do-blogs, echo=FALSE}
width="160px"
tab(
tr(
tabfig("FlowingData", "images/blogs/flowingdata.png", "http://flowingdata.com/", width=width),
tabtxt("Nathan Yau,", aself("flowingdata.com/"),
"A large number of blog posts illustrating data visualization methods with tutorials on how do do these with R and other software.")
),
tr(
tabfig("Junk Charts", "images/blogs/junkcharts.png", "http://junkcharts.typepad.com/", width=width),
tabtxt("Kaiser Fung,", aself("http://junkcharts.typepad.com/"),
"Fung discusses a variety of data displays and how they can be improved.")
),
tr(
tabfig("Data Stories", "images/blogs/datastories.png", "http://datastori.es/", width=width),
tabtxt("A podcast on data visualization with Enrico Bertini and Moritz Stefaner,",
aself("http://datastori.es/"),
"Interviews with over 100 graphic designers & developers.")
)
)
```
I still need to tweak the padding, but this gives me more or less what I was after:

How to add/remove input fields dynamically by a button in shiny

I've been trying to find a solution how to add and remove input fields with a button in shiny. I don't have a source code since I haven't made that much progress, but this jQuery example (http://www.mkyong.com/jquery/how-to-add-remove-textbox-dynamically-with-jquery/) gives a good idea on what I'm trying to accomplish. Is this possible in shiny or should I use shinyjs to do this? Thank you in advance!
EDIT: I read the jQuery example a bit more, and added a code snippet doing what I think you were looking for.
I don't know jQuery, so I couldn't make much out of the example link. I took a guess on what you wanted, but I think the key idea is the use of renderUI and uiOutput even if my suggestion here misses the point.
To toggle a ui element:
If you specifically don't want to use shinyjs, you could do something like this:
library(shiny)
ui <- shinyUI(fluidPage(
actionButton("btn", "Toggle Textbox"),
textOutput("btn_val"),
uiOutput("textbox_ui")
))
server <- shinyServer(function(input, output, session) {
output$btn_val <- renderPrint(print(input$btn))
textboxToggle <- reactive({
if (input$btn %% 2 == 1) {
textInput("textin", "Write something:", value = "Hello World!")
}
})
output$textbox_ui <- renderUI({ textboxToggle() })
})
shinyApp(ui, server)
To add and remove elements:
After reading a bit of the jQuery example, I think this is similar to what you were looking for:
library(shiny)
ui <- shinyUI(fluidPage(
sidebarPanel(
actionButton("add_btn", "Add Textbox"),
actionButton("rm_btn", "Remove Textbox"),
textOutput("counter")
),
mainPanel(uiOutput("textbox_ui"))
))
server <- shinyServer(function(input, output, session) {
# Track the number of input boxes to render
counter <- reactiveValues(n = 0)
observeEvent(input$add_btn, {counter$n <- counter$n + 1})
observeEvent(input$rm_btn, {
if (counter$n > 0) counter$n <- counter$n - 1
})
output$counter <- renderPrint(print(counter$n))
textboxes <- reactive({
n <- counter$n
if (n > 0) {
lapply(seq_len(n), function(i) {
textInput(inputId = paste0("textin", i),
label = paste0("Textbox", i), value = "Hello World!")
})
}
})
output$textbox_ui <- renderUI({ textboxes() })
})
shinyApp(ui, server)
The problem with this approach is that each time you press the add or remove button, all of the input boxes get re-rendered. This means that any input you might have had on them disappears.
I think you could get around that by also saving the current input values of the input boxes into a reactiveValues object, and setting the values from the object as the starting values of the re-rendered input boxes by using the value option in textInput. I'll leave the implementation of that for now, though.
Thank you #Mikko Marttila for your answer. I was able to use it for my purpose. Also, referring to the issue of all input boxes getting re-rendered here I found a solution worked from this answer. You can save all user inputs using reactiveValuesToList(), then call the reactive list accordingly to set every value to the corresponding user's input in the lapply() statement.
library(shiny)
ui <- shinyUI(fluidPage(
sidebarPanel(
actionButton("add_btn", "Add Textbox"),
actionButton("rm_btn", "Remove Textbox"),
textOutput("counter")
),
mainPanel(uiOutput("textbox_ui"))
))
server <- shinyServer(function(input, output, session) {
# Track the number of input boxes to render
counter <- reactiveValues(n = 0)
# Track all user inputs
AllInputs <- reactive({
x <- reactiveValuesToList(input)
})
observeEvent(input$add_btn, {counter$n <- counter$n + 1})
observeEvent(input$rm_btn, {
if (counter$n > 0) counter$n <- counter$n - 1
})
output$counter <- renderPrint(print(counter$n))
textboxes <- reactive({
n <- counter$n
if (n > 0) {
isolate({
lapply(seq_len(n), function(i) {
textInput(inputId = paste0("textin", i),
label = paste0("Textbox", i),
value = AllInputs()[[paste0("textin", i)]])
})
})
}
})
output$textbox_ui <- renderUI({ textboxes() })
})
shinyApp(ui, server)
EDIT: I wrapped the lapply() statement in isolate() because it gets annoying when boxes are being re-rendered as you're trying to type in the field
Instead of re-rendering the entire list of inputs, try the following
I keep track of all the ids that are created, I remove the last one created, and I reuse the ids of the deleted ones.
I start with an initial box (there is no real need for that, but I guess in a real work scenario you would expect at least 1 textBox to appear and increase thereafter). It is straightforward to start without the initial box.
Also, I keep track of the values of the textInput boxes that are currently active, in a reactive List. You would definitely need this
Lastly, I think for the two reactiveValues I have [inserted and counter], one of them is possibly redundant, but hey...
Hope it helps!
library(shiny)
ui <- fluidPage(
actionButton("insertBtn", "Insert"),
actionButton("deleteBtn", "Delete"),
h4("My boxes"),
# Initial box here to start with. Not needed but it is nice to have one :)
div(id = "box-1", textInput(inputId = "box-1", label = "box-1")),
div(id = "placeholder"),
h4('Box contents'),
verbatimTextOutput("my_inputs")
)
server <- function(input, output, session) {
## keep track of elements inserted and a counter of the elements
rv <- reactiveValues(
inserted = c("box-1"),
counter = 1
)
observeEvent(input$insertBtn, {
rv$counter <- rv$counter+1
serial <- rv$counter
id <- paste0('box-', serial)
rv$inserted <- c(rv$inserted, id)
insertUI(
selector = '#placeholder',
## wrap element in a div with id for ease of removal
ui = div(id = id,
textInput(inputId = id, label = paste0("box-", serial))
)
)
})
observeEvent(input$deleteBtn, {
req(rv$counter>0)
# removes the last one
id_to_remove <- rv$inserted[length(rv$inserted)]
removeUI(
## pass it in as JQuery selector
selector = paste0('#', id_to_remove)
)
rv$inserted <- rv$inserted[-length(rv$inserted)]
rv$counter <- rv$counter - 1
})
my_inputs <- reactive({
req(rv$inserted) # need to have some inputs
l <- reactiveValuesToList(input)
# regex of the union of all inputs. Note the starting input box-1
ids_regex <- paste(c("box-1", rv$inserted), collapse = "|")
l[grepl(ids_regex, names(l))]
})
output$my_inputs <- renderPrint({
my_inputs()
})
}
shinyApp(ui, server)
Many thanks to
this post
and this
and these SO posts one, two

How do I set the text attributes on an empty line in a PyGtk TextView?

The first section of code is the original code posted. The second code is modification of Bob's answer who led me in the right direction.
I need the user, when they reach a specific line (where this is a new line, which of course is empty) in the gtk.TextBuffer to be typing in a bold font.
If possible, what change is necessary in the code below that would make the font bold from where the user begins to type?
import gtk, pango
class BoldTestWindow(gtk.Window):
def __init__(self):
gtk.Window.__init__(self)
self.connect( "destroy", lambda *w: gtk.main_quit() )
self.set_default_size(280, 80)
# Create a text view and get it's buffer.
self.tv = gtk.TextView()
buffer = self.tv.get_buffer()
# Create the Tags and add them to the Tag Table.
tags = [["weight", pango.WEIGHT_BOLD], ]
for tag in tags:
newTag = gtk.TextTag(name=tag[0])
newTag.set_property(tag[0], tag[1])
textTable = buffer.get_tag_table()
textTable.add(newTag)
# Grab an Iter to insert text.
startIter = buffer.get_start_iter()
# Insert some text in which to apply the bold attribute.
buffer.insert(startIter, "A Bold Statement.")
# startIter must be asked for again, because text was inserted.
startIter = buffer.get_start_iter()
endIter = buffer.get_end_iter()
# Apply the tags to entire range of TextBuffer
tags = ["weight",]
for tag in tags:
buffer.apply_tag_by_name(tag, startIter, endIter)
# Let's see what happens.
self.add(self.tv)
self.tv.grab_focus()
self.set_position(gtk.WIN_POS_CENTER)
self.show_all()
if __name__ == "__main__":
bww = BoldTestWindow()
gtk.main()
Bob's answer was the expose event, accept the expose event floods with thousands of calls to change the attributes, where only one call is neccessary per character added.
In order to stop a flooding of events, I experimented with key events.
I tried using key-press-event, but the character was not modified until the next event round, which left no style changes for the last character pressed.
I tried key-release-event and this worked, but there was a small delay in adding the attributes. The character would be no attribute for a split second, then the bold attribute would be added.
Finally, I tried a mix of key-press-event with expose-event, but that bottle necked some, then Juhaz from irc #pygtk recommended changed event which seems to work well. I believe the anser is close, I will use the following section to post it when done. I still have to work out line justification properties, they are still buggy.
import gtk, pango
# TaggedCursorTextView attempts to only add one feature to gtk.TextView: make the cursor dynamically settable
# to a list of tags. This forces the current text being typed to the set of tags set.
class TaggedCursorTextView(gtk.TextView):
def __init__(self):
gtk.TextView.__init__(self)
# Create buffer variable that point to it's internal TextBuffer.
self.buffer = self.get_buffer()
# Listen for the changed event. (User types, deletes or pastes text, etc.)
self.connect("key-press-event", self.on_key_press_event)
# What ever tags are place in here determines the text attributes (font type, bold, etc.)
# That is being typed by the user at any given moment.
# Default should be kept empty, no styles.
self.cursorTags = []
self.handlerID = None
def addTags(self, tagList):
# Create the Tags and add them to the Tag Table. Ignores duplicate tag names.
for tag in tagList:
newTag = gtk.TextTag(name=tag[0])
textTable = self.buffer.get_tag_table()
tagNameFound = textTable.lookup(tag[0])
if not tagNameFound:
newTag.set_property(tag[1], tag[2])
textTable.add(newTag)
def removeTags(self, tagNameList):
pass
def setCursorTags(self, tagList):
self.cursorTags = tagList
def on_key_press_event(self, widget, event):
self.handlerID = self.buffer.connect("changed", self.on_changed_event)
def on_changed_event(self, widget):
"""This method updates the last character type to the cursor style."""
self.buffer.disconnect(self.handlerID)
# Get the iter that falls before and after the last char typed.
endIter = self.buffer.get_end_iter()
offset = endIter.get_offset() - 1
startIter = self.buffer.get_iter_at_offset(offset)
# Apply the tags to the newly typed char
for tag in self.cursorTags:
self.buffer.apply_tag_by_name(tag, startIter, endIter)
class TaggedCurserTextViewTestWindow(gtk.Window):
def __init__(self):
gtk.Window.__init__(self)
self.connect( "destroy", lambda *w: gtk.main_quit() )
self.set_default_size(280, 80)
# Create a TaggedCursorTextView.
tctv = TaggedCursorTextView()
# Add some cursors tags that will be used at some point later in the app.
# Each tag element list is: [tag name, tag property, tag value]
tagList = [["Italic", "style", pango.STYLE_ITALIC], ["Bold", "weight", pango.WEIGHT_BOLD], ["Center", "justification", gtk.JUSTIFY_CENTER]]
tctv.addTags(tagList)
# Use the names of the tags in a list to set the cursor tags.
tctv.setCursorTags(["Italic", "Bold", "Center"]) # Comment out this line for no style.
# Let's see what happens.
self.add(tctv)
tctv.grab_focus()
self.set_position(gtk.WIN_POS_CENTER)
self.show_all()
if __name__ == "__main__":
TaggedCurserTextViewTestWindow()
gtk.main()
Here's a rather crude modification of your code. I've just created an expose-event handler for your textview and whenever expose-event is invoked (i.e. when your textview requests to redraw), it redraws everything with bold font.
I'm not sure, if this is what you wanted; please explain in more detail your purpose, if it's not (I'm in IRC).
import gtk, pango
class BoldTestWindow(gtk.Window):
def __init__(self):
gtk.Window.__init__(self)
self.connect( "destroy", lambda *w: gtk.main_quit() )
self.set_default_size(280, 80)
# Create a text view and get it's buffer.
self.tv = gtk.TextView()
buffer = self.tv.get_buffer()
# Create the Tags and add them to the Tag Table.
tags = [["weight", pango.WEIGHT_BOLD], ]
for tag in tags:
newTag = gtk.TextTag(name=tag[0])
newTag.set_property(tag[0], tag[1])
textTable = buffer.get_tag_table()
textTable.add(newTag)
# Grab an Iter to insert text.
startIter = buffer.get_start_iter()
# Insert some text in which to apply the bold attribute.
buffer.insert(startIter, "A Bold Statement.")
# startIter must be asked for again, because text was inserted.
startIter = buffer.get_start_iter()
endIter = buffer.get_end_iter()
# Apply the tags to entire range of TextBuffer
tags = ["weight",]
for tag in tags:
buffer.apply_tag_by_name(tag, startIter, endIter)
# Let's see what happens.
self.add(self.tv)
self.tv.grab_focus()
self.set_position(gtk.WIN_POS_CENTER)
self.show_all()
def on_expose_event(self, widget, event, data=None):
buffer = self.tv.get_buffer()
startIter = buffer.get_start_iter()
endIter = buffer.get_end_iter()
# Apply the tags to entire range of TextBuffer
tags = ["weight",]
for tag in tags:
buffer.apply_tag_by_name(tag, startIter, endIter)
if __name__ == "__main__":
bww = BoldTestWindow()
bww.tv.connect("expose-event", bww.on_expose_event)
gtk.main()

How to extract Highlighted Parts from PDF files

Is there any way to extract highlighted text from a PDF file programmatically? Any language is welcome. I have found several libraries with Python, Java, and also PHP but none of them do the job.
To extract highlighted parts, you can use PyMuPDF. Here is an example which works with this pdf file:
Direct download
# Based on https://stackoverflow.com/a/62859169/562769
from typing import List, Tuple
import fitz # install with 'pip install pymupdf'
def _parse_highlight(annot: fitz.Annot, wordlist: List[Tuple[float, float, float, float, str, int, int, int]]) -> str:
points = annot.vertices
quad_count = int(len(points) / 4)
sentences = []
for i in range(quad_count):
# where the highlighted part is
r = fitz.Quad(points[i * 4 : i * 4 + 4]).rect
words = [w for w in wordlist if fitz.Rect(w[:4]).intersects(r)]
sentences.append(" ".join(w[4] for w in words))
sentence = " ".join(sentences)
return sentence
def handle_page(page):
wordlist = page.get_text("words") # list of words on page
wordlist.sort(key=lambda w: (w[3], w[0])) # ascending y, then x
highlights = []
annot = page.first_annot
while annot:
if annot.type[0] == 8:
highlights.append(_parse_highlight(annot, wordlist))
annot = annot.next
return highlights
def main(filepath: str) -> List:
doc = fitz.open(filepath)
highlights = []
for page in doc:
highlights += handle_page(page)
return highlights
if __name__ == "__main__":
print(main("PDF-export-example-with-notes.pdf"))
Ok, after looking I found a solution for exporting highlighted text from a pdf to a text file. Is not very hard:
First, you highlight your text with the tool you like to use (in my case, I highlight while I'm reading on an iPad using Goodreader app).
Transfer your pdf to a computer and open it using Skim (a pdf reader, free and easy to find on the web)
On FILE, choose CONVERT NOTES and convert all the notes of your document to SKIM NOTES.
That's all: simply go to EXPORT an choose EXPORT SKIM NOTES. It will export you a list of your highlighted text. Once opened this list can be exported again to a txt format file.
Not much work to do, and the result is fantastic.

Content templates rendering in TYPO3

I've got a strange problem connected with content rendering.
I use following code to grab the content:
lib.otherContent = CONTENT
lib.otherContent {
table = tt_content
select {
pidInList = this
orderBy = sorting
where = colPos=0
languageField = sys_language_uid
}
renderObj = COA
renderObj {
10 = TEXT
10.field = header
10.wrap = <h2>|</h2>
20 = TEXT
20.field = bodytext
20.wrap = <div class="article">|</div>
}
}
and everything works fine, except that I'd like to use also predefined column-content templates other than simple text (Text with image, Images only, Bullet list etc.).
The question is: with what I have to replace renderObj = COA and the rest between the brackets to let the TYPO3 display it properly?
Thanks,
I.
The available cObjects are more or less listed in TSRef, chapter 8.
TypoScript for rendering Text w/image can be found in typo3/sysext/css_styled_content/static/v4.3/setup.txt at line 724, and in the neighborhood you'll find e.g. bullets (below) and image (above), which is referenced in textpic line 731. Variants of this is what you'll write in your renderObj.
You will find more details in the file typo3/sysext/cms/tslib/class.tslib_content.php, where e.g. text w/image is found at or around line 897 and is called IMGTEXT (do a case-sensitive search). See also around line 403 in typo3/sysext/css_styled_content/pi1/class.cssstyledcontent_pi1.php, where the newer css-based rendering takes place.