R/example.R

Defines functions showExample writeExample appendExample

appendExample=function(argument,description,example,df=NULL) {
  p=file()

  ## replaces @test by p
  exampleval=gsub('@test','p',example)
  
  z=eval(parse(text=exampleval))
  if (!is.null(z)) {
    z=gsub('<','&lt;',z)
    z=gsub('>','&gt;',z)
    write(z,p)
  }
  write('\n',p)
  result=paste(readLines(p),collapse='')
  close(p)

  ## replaces @test by test.html
  example=gsub('@test','\'test.html\'',example)

  ## escapes linebreaks in HTML
  description=gsub('\n','<br/>',description)
  example=gsub('\n','<br/>',example)

  ## preserves HTML entities
  example=gsub('&','&amp;',example)
  description=gsub('\\$<','&lt;',description)
  description=gsub('\\$>','&gt;',description)

  ## removes comments
  example=gsub('## ','',example)

  if (!is.null(argument)) {
    argument=gsub('\n','<br/>',argument)
    z=data.frame(Argument=argument,Description=description,Example=example,Result=result)
  } else  z=data.frame(Description=description,Example=example,Result=result)
  
  if (is.null(df)) df=z
  else df=rbind(df,z)
  df
}

writeExample=function(df,p,cw,centerExample=TRUE) {
  if (centerExample) hwrite(df,p,row.bgcolor='#ffffaa',row.names=FALSE, col.width=cw,class='tab',col.style=c(Example='font-family:monospace',Result='text-align:center'),row.style='text-align:center')
  else hwrite(df,p,row.bgcolor='#ffffaa',row.names=FALSE, col.width=cw,class='tab',col.style=c(Example='font-family:monospace'),row.style='text-align:center')
 }

showExample=function() {
  tmpdir = tempdir()
  filename = file.path(tmpdir,'example-hwriter.html')
  
  ## copying data files
  imgdir=file.path(system.file(package='hwriter'),'images')
  images=file.path(imgdir,dir(imgdir))
  file.copy(images,tmpdir)
  
  ## opens webpage
  write(paste('Building the example webpage',filename,'...'),'')
  p=openPage(filename,link.css='hwriter.css')
  cw=c(Argument='100px',Description='400px',Example='350px',Result='300px')
  hwname=paste('hwriter_',getHwriterVersion(),'.tar.gz',sep='')
  hwriter=hwrite('hwriter',style='font-family:monospace')
    
  ## introduction
  text=hwrite('The hwriter package',heading=1,center=TRUE)
  text=c(text,hwriter,' is an easy-to-use package able to format and output R (from the R-project) objects in HTML format. It supports advanced formatting, tables, CSS styling, images, Javascript and provides a convenient mapping between R tables and HTML tables.<br/>')
  text=c(text,'This is ',hwriter,' version ',getHwriterVersion(),', written by Gregoire Pau. Download ',hwrite(hwname,style='font-family:monospace'),' ',hwrite('here',link=paste('http://www.embl.de/~gpau/hwriter/',hwname,sep='')),' or on ',hwrite('CRAN', link='http://cran.r-project.org/'),'.<br/><br/>')
  text=c(text,'This page (generated by ',hwriter,') shows examples of the package abilities and illustrates in detail the behavior of the optional arguments used by the function ',hwrite('hwrite()',style='font-family:monospace'),'. All the examples on this page are using the ',hwrite('current',link='hwriter.css'),' CSS stylesheet.')
  hwrite(paste(text,collapse=''),p,class='intro',div=TRUE)
  
  ## 1. Simple examples
  cw=c(Argument='100px',Description='300px',Example='350px',Result='300px')
  hwrite(hwrite('1. Simple examples',name='se'),p,heading=1)
  df=appendExample(NULL,'Writes a string.',"hwrite('Hello world !', @test)")
  df=appendExample(NULL,'Appends HTML elements in a page.\nWrites a string with an hyperlink.',
    "## p=openPage('test.html')
     hwrite('Hello', p, link='http://hello.com')
     hwrite(' world !', p)
     ## closePage(p)",df)
  df=appendExample(NULL,'Writes a vector.',"hwrite(1:5, @test)",df)
  df=appendExample(NULL,'Writes a matrix.',
    "hwrite(iris[1:2,1:2],  @test, row.bgcolor='#ffdc98')",df)
  df=appendExample(NULL,'Appends HTML elements in a page. Inserts an image.',
     "## p=openPage('test.html')
     hwrite('This is an iris flower:', p, br=TRUE)
     hwriteImage('iris1.jpg', p, br=TRUE)
     hwrite('',p, br=TRUE)
     hwrite(c('Plantae','Monocots','Iris'), p)
     ## closePage(p)",df)
  df=appendExample(NULL,'Outputs HTML code part.', "hwrite('Monocots', link='http://mc.org')",df)
  df=appendExample(NULL,'Combines HTML code parts.', "hwrite(c('Plantae', hwrite('Monocots', link='http://mc.org'), 'Iris'), @test)",df)
  df=appendExample(NULL,'Combines HTML code parts using nested calls.',
     "img=hwriteImage('iris3.jpg', center=TRUE)
      cap=hwrite(c('Plantae', hwrite('Monocots', link='http://mc.org'), 'Iris'))
      hwrite(c(img, cap), @test, dim=c(2,1), center=TRUE)",df)
  writeExample(df,p,cw)
  
  ## 2. advanced examples
  hwrite(hwrite('2. Advanced examples',name='ae'),p,heading=1)
  cw=c(Argument='100px',Description='400px',Example='200px',Result='300px') 
  df=appendExample(NULL,"CSS styling.",
     "## p=openPage('test.html')
      hwrite(paste('The fox jumps ',hwrite('over', link='http://over.com'), ' the ', hwrite('red', style='color:#cc3355'), ' wall.', collapse=''), p, br=TRUE)
      hwrite(paste('The function', hwrite( 'hwrite()', style='font-family:monospace'), 'is cool !'), p)
      ## closePage(p)")

  df=appendExample(NULL,"Banner of multisized images, with CSS tiled background and hyperlink.","
     hwriteImage('iris1.jpg', @test, width=c(50,75,100,125), link=c('http://www.ab1.com', 'http://www.ab2.com', 'http://www.ab3.com', 'http://www.ab4.com'), table.style='  background-image: url(motif.png);background-repeat: repeat')", df)

 df=appendExample(NULL,paste('Named anchors and customized CSS hyperlinks using classes in the ',hwrite('current',link="hwriter.css"),' CSS stylesheet and margins.',sep=''),"
      ## p=openPage('test.html', link.css='hwriter.css')
      hwrite('Please select an item:', p, br=TRUE)
      items=c('Gene', 'mRNA', 'Polypeptide', 'Protein')
      links=paste('http://en.wikipedia.org/wiki/', items, sep='')
      hwrite(hwrite(items, class='example', link=links, table=FALSE), p, border=0)
      sections=c('Simple examples', 'Advanced examples', 'Details')
      nanchors=c('#se', '#ae', '#de')
      hwrite(hwrite(sections, class='example2', link=nanchors, table=FALSE), p, dim=c(3,1), style='margin:0px ; padding:8px', table.style='margin-top:20px', border=0)
      ## closePage(p)",df)
  
  df=appendExample(NULL,'Pointing columns and rows. Changing background color, alignments, hyperlinks and CSS style.',"
     colors=c('#ffaaff','#ddaaff','#bbaaff','#99aaff','#55aaff')
     hwrite(iris[1:7,1:4], @test, center=TRUE, row.bgcolor=list('#aaffaa', '3'='#ffffaa', '5'=colors), col.style=list(Sepal.Length='font-style:italic',Petal.Length='text-align:center'), row.style=list('font-weight:bold'), col.link=list(Sepal.Width=iris$Sepal.Width[1:7]))",df)

  df=appendExample(NULL,'Color scale bar.',"
     scale=round(seq(0, 1, len=8), 2)
     colors=rgb(colorRamp(c('#ff0000', '#ffff00', '#ffffff'))(scale), max=255)
     band=hwrite(scale, @test, bgcolor=colors, style='color: black', col.width=rep(20, 8))
    ",df)
  
  df=appendExample(NULL,"Complex layout using borderless tables.",
     "img=hwriteImage('iris1.jpg', center=TRUE)
      cap=hwrite(c('Plantae', hwrite('Monocots', link='http://mc.org'), 'Iris'))
      iris=hwrite(c(img, cap), dim=c(2,1), center=TRUE, border=0)
      colors=rgb(colorRamp(c('#7f007f', '#aaaaaa'))(seq(0, 1, len=5)), max=255)
      band=hwrite(c('+', rep('&nbsp;',3), '0'), bgcolor=colors, dim=c(5,1), border=0, style='color: white')
      hwrite(c(iris,band), @test, border=0)",df)
 
  df=appendExample(NULL,"Combining matrix of images and hyperlinking.","
     himg=hwriteImage(c('iris1.jpg','iris2.jpg','iris3.jpg'), link=c('http://en.wikipedia.org/wiki/Iris_virginica', 'http://en.wikipedia.org/wiki/Iris_versicolor', 'http://en.wikipedia.org/wiki/Iris_virginica'), table=FALSE)
     mat=rbind(himg, c('Setosa','Versicolor','Virginica'))
     rownames(mat)=c('Image', 'Species')
     hwrite(mat, @test, br=TRUE, center=TRUE, row.bgcolor=list(Species=c('#ffaacc', '#ff88aa', '#ff6688')), col.bgcolor='#ffffaa', row.style=list(Species='text-align:center'))
     ",df)

  df=appendExample(NULL,'Fancy patchwork. Advanced text formatting.',"
     cells=matrix('', nr=6, nc=5)
     hotcolors=rgb(colorRamp(c('#ff0000', '#ffff00', '#ffffff'))(runif(length(cells))), max=255)
     bgcolor=array(hotcolors, dim=dim(cells))
     rownames(cells)=1:nrow(cells)
     patchwork=hwrite(cells, bgcolor=bgcolor, col.width=rep('16px', nrow(cells)))
     text='La volupt&eacute; de la chair est une chose de la vie des sens au meme titre que le regard pur, que la pure saveur d\\'un beau fruit sur notre langue...'
     text=paste(hwrite(text, br=TRUE), hwrite('Rainer Maria Rilke', style='font-style:italic'))
     hwrite(c(patchwork,text), @test, br=TRUE, center=TRUE, col.width=c(NA,'200px'), style='text-align:justify', border=0, cellspacing=10)
     ",df)
  
  df=appendExample(NULL,"Sections (divisions) and CSS styling.","
     ## p=openPage('test.html')
     codestyle='margin: 10px; padding: 10px; background-color: #aaffaa; border: solid 1px black; font-family: monospace ; text-align: left'
     hwrite('Please type the following commands:', p)
     hwrite(paste(hwrite(c('> library(rgl)', '> example(rgl)'), br=TRUE, table=FALSE), collapse=''), p, style=codestyle, div=TRUE)
     hwrite('to see nice examples of the package rgl.', p)
     ## closePage(p)",df)

  df=appendExample(NULL,paste('Styling sections using CSS classes defined in the ',hwrite('current',link="hwriter.css"),' CSS stylesheet.',sep=''),"
     ## p=openPage('test.html', link.css='hwriter.css')
     text=paste(hwrite('And the king said to her:', class='narrator'), hwrite('What is the matter with you ?', class='king', div=TRUE), hwrite('And she answered:', class='narrator'), hwrite('Give me your son that we may eat...', class='king', div=TRUE), sep='')
     hwrite(text, p, div=TRUE, class='textbox')
     ## closePage(p)",df)

  df=appendExample(NULL,"Use of Javascript through \'onmouseover\' and \'onmouseout\' attributes.","
     ## p=openPage('test.html')
     hwrite('Pass the mouse over:', p)
     hwrite(array('&nbsp;',dim=c(6,6)), p, onmouseover=\"this.bgColor='#ffaaaa'\", onmouseout=\"this.bgColor='white'\", bgcolor='white', col.width=rep(18,6), style='padding:0px; margin:0px')
     ## closePage(p)",df)

   df=appendExample(NULL,'Build HTML tags using \'hmakeTag\' to render additonal HTML objects.',"
     ## p=openPage('test.html')
     hwrite('This is an itemized bullet list:', p)
     li=paste(hmakeTag('li', c('Abstract', 'Methods', 'Results')), collapse='')
     hwrite(hmakeTag('ul', li, style='font-weight:bold; text-align:left'), p) 
     ## closePage(p)",df)
  
  writeExample(df,p,cw)
    
  ## 3. hwrite arguments
  cw=c(Argument='100px',Description='400px',Example='350px',Result='300px')
  hwrite(hwrite(paste('3. Detailed description of ',hwrite('hwrite()',style='font-family:monospace'),'arguments'),name='de'),p,heading=1)
  
  ## 3.1. general arguments 
  hwrite('3.1. General arguments',p,heading=2)
  df=appendExample('br','Inserts a carriage return (line break, newline) at the end of the HTML element.',
    "## p=openPage('test.html')
     hwrite('The fox ', p)
     hwrite('jumps', p, br=TRUE)
     hwrite('over the...', p, br=TRUE)
     ## closePage(p)")
  df=appendExample('table','Controls if the object should be written as an HTML table. Default is "TRUE" for vectors and matrices, and "FALSE" otherwise. If set to "FALSE", the object is written as a vector (or a matrix) of HTML elements.',
    "## p=openPage('test.html')
    hwrite(1:6, p, br=TRUE)
    hwrite(1:6, p, table=FALSE)
    ## closePage(p)",df)
   df=appendExample('name','Names the HTML element for further reference using hyperlinks.',
    "## p=openPage('test.html')
     hwrite(hwrite('Section 1.', name='s1'), p, heading=3)
     hwrite(c('Go to this ', hwrite('section', link='#s1'), ' or this ', hwrite('one', link='#s2'), '.'), p, table=FALSE)
     hwrite(hwrite('Section 2.', name='s2'), p, heading=3)
     hwrite('Another section...', p)
    ## closePage(p)",df)
  df=appendExample('link','Adds hyperlink(s) (anchor, hypertext) to the HTML element.',
    "hwrite('The fox', @test, link='http://www.fox.com')",df)
  df=appendExample('div','Places the HTML element into a div HTML section, using the $<div$> HTML tag. This is helpful for styling a section.',
    "## p=openPage('test.html', link.css='hwriter.css')
    hwrite('In Greek mythology, a cyclops is a member of...', p, div=TRUE, class='king')
    ## closePage(p)",df)
   df=appendExample('center','Centers the HTML element. This element may interfere with the current CSS style. Please consider the CSS style attribute \"text-align\" instead.',
    "## p=openPage('test.html')
     hwrite('The fox', p, center=TRUE)
     hwrite('jumps over the...', p, center=TRUE)
     ## closePage(p)",df)
   df=appendExample('...','Additional arguments are added to the HTML element as HTML attributes. For HTML tables, attributes are distributed on table cells using R recycling rules. For text elements, a $<span$> HTML tag (or $<div$> if \'div\' is \'TRUE\') is used to accommodate the attributes.',
    " hwrite(1:3, k=1:2)",df)
  writeExample(df,p,cw,centerExample=FALSE)
 
  ## 3.2. text elements
  hwrite('3.2. Text element specific arguments',p,heading=2)
  df=appendExample('heading',paste('Changes the heading level of the HTML element. Heading styles can be modified in the ',hwrite('current', link='hwriter.css'), ' CSS stylesheet.',sep=''),
    "## p=openPage('test.html')
    hwrite('Heading 1', p, heading=1)
    hwrite('Heading 2', p, heading=2)
    hwrite('Heading 3', p, heading=3)
    ## closePage(p)")
  
  df=appendExample('style\nclass',paste("Uses an CSS style (inline) or a CSS class (defined in the ",hwrite('current', link='hwriter.css')," stylesheet) to render the HTML element.
    CSS styles are versatile and allow to change the current typeface, color, margins, font, boldness, italic, padding, alignement... See the <a href='http://www.w3schools.com/css'>W3C reference</a> or this <a href='http://www.somacon.com/p334.php'>wizard</a> to generate new styles.
    By default, the style is changed on the fragment of a sentence, using the $<span$> HTML tag. Use the combination with the div argument to change the style of a whole section.",sep=''),
    "## p=openPage('test.html', link.css='hwriter.css')\n
     hwrite('The fox ', p, style='font-weight: bold')
     hwrite('jumps over ', p, style='font-family: monospace;color: #ff2233')
     hwrite('the wall.', p, style='text-align: right; font-style: italic')\n
     hwrite('hwriter', p, div=TRUE, style='margin:16px; font-size:150%; text-align:right')\n
     hwrite('Socrates was a Classical Greek philosopher.', p, class='king', div=TRUE)\n
     ## closePage(p)",df)
  
  writeExample(df,p,cw)
  
  ## 3.3 vector
  hwrite('3.3. Vector specific arguments',p,heading=2)
  df=appendExample('dim','Sets the dimension of the output HTML table.',
    "hwrite(1:6, @test, dim=c(2,3))")
  
  df=appendExample('byrow','Controls if the output HTML table should be filled by rows first. If set to "FALSE", the table is filled by columns first. Default is "FALSE".',
    "hwrite(1:6, @test, dim=c(2,3), byrow=TRUE)",df)
  
  df=appendExample('names','Controls if the names of a named vector should be shown. Default is "TRUE".',
    "## p=openPage('test.html')
     z=c(red=0.5, green=0.6, blue=0.7)
     hwrite(z, p, br=TRUE)
     hwrite(z, p, names=FALSE)
     ## closePage(p)",df)
  
  writeExample(df,p,cw)
  
  ## 3.4. table
  hwrite('3.4. Matrix/table and vector specific arguments',p,heading=2)
  df=appendExample('border',"Specifies the table border width. A value of 0 implies that no borders will be drawn. This argument may interfere with the \'border\' CSS style attribute.",
    "hwrite(iris[1:4,1:2], @test, border=0)")
  
  df=appendExample('row.names\ncol.names','Specifies if the row (resp. column) names should be displayed.',
    "## p=openPage('test.html')\n
     hwrite(iris[1:2,1:2], p, br=TRUE, row.names=FALSE)\n
     hwrite(iris[1:2,1:2], p, br=TRUE, row.names=FALSE, col.names=FALSE)\n
     ## closePage(p)",df)

  df=appendExample('cellspacing\ncellpadding',"Defines the padding and spacing space in pixels between cells. These arguments may interfere with the \'border\' and \'padding\' CSS style attributes.",
    "hwrite(iris[1:2,1:2], @test, center=TRUE, br=TRUE, row.bgcolor='#ffaaaa', cellspacing=10, table.class='raw')
    ",df)

  df=appendExample('width\ncol.width',"Defines global table width and column widths in HTML units (pixels or %).\n'width' specifies the table global width.\n'col.width' contains either a vector of widths (of size equals to the number of columns) which may contain NAs or a named vector of widths which point to some column names.",
    "## p=openPage('test.html')\n
     hwrite(iris[1:2,1:2], p, br=TRUE, width='150px', row.names=FALSE, col.names=FALSE)\n
     hwrite(iris[1:2,1:2], p, br=TRUE, col.width=c(Sepal.Length='150px'))\n
     ## closePage(p)",df)

  df=appendExample('style\nclass\nbgcolor\nlink\n...',"Distributes an attribute on table cells, using R recycling rules.
    'style' and 'class' distributes the HTML CSS styling attributes, 'bgcolor' distributes the background color HTML attribute but any valid HTML attribute can be used.
     Value of the attribute could be either a character vector or a matrix and may contain NAs to omit cells. Matrices may contain one extra row and/or column to target heading cells.",
    "## p=openPage('test.html')\n
     hwrite(iris[1:2,1:2], p, br=TRUE, style=matrix(c(NA, 'color:#ff0000', 'color:#0000ff; font-style:italic; text-align:right', NA),nr=2,nc=2))\n
     hwrite(iris[1:2,1:2], p, br=TRUE, bgcolor=matrix(c('#aaffaa', NA, '#ffffaa', '#ffffff','#aaaaff', NA),nr=3,nc=2))\n
     hwrite(1:4, p, br=TRUE, bgcolor=c('#66ffff', '#99ffee', '#ccffdd', '#ffffcc'), link=1:4)\n
     hwrite(array(1:20, dim=c(4,5)), p, br=TRUE, bgcolor=c('#ffffff', '#ffbbaa', '#ff9977', '#ffbbaa', '#ff5500'), link=matrix(1:4, nr=2, nc=2))\n
     ## closePage(p)",df)
    
  df=appendExample('row.style\ncol.style\nrow.bgcolor\ncol.bgcolor\nrow.link\ncol.link\nrow.*\ncol.*',"Distributes an attribute on table cells, according to row/columns. 
    The argument may contain a list of vectors of values or a vector of values. Named lists (or vectors) point the corresponding rows/columns, according to their names. Unnamed lists (or vectors) point the rows/columns in the numeric order and NAs can be used to omit rows/columns. If sizes don't match, values are recycled using R rules.",
    "## p=openPage('test.html')\n
     hwrite(iris[1:2,1:2], p, br=TRUE, row.bgcolor='#ffffaa')\n
     hwrite(iris[1:2,1:2], p, br=TRUE, row.style=list('font-weight:bold'),  col.style=list(Sepal.Length = 'text-align:left; color:#aa0000'))\n
     hwrite(iris[1:3,1:2], p, br=TRUE, col.bgcolor=list(Sepal.Width=c('#66ffff', '#99ffee', '#ccffdd', '#ffffcc')), row.link=list(NA, c('a', 'b'), NA))\n
     ## closePage(p)",df)
  
  df=appendExample('table.style\ntable.class\ntable.*',"Uses a global table attribute to render the HTML table.
    The attribute is added to the main $<table$> tag and should contain a single value. Some uses include setting of the CSS 'border' and 'margin' attributes that cannot be distributed on cells.",
    "## p=openPage('test.html')\n
    hwrite(iris[1:2,1:2], p, br=TRUE, table.style='font-family: monospace ; border-spacing: 5px; border-collapse: collapse; background-color: white')\n
    hwrite(iris[1:2,1:2], p, br=TRUE, table.frame='void')\n
    ## closePage(p)",df)
      
  writeExample(df,p,cw)
  
  closePage(p)

  ## open browser
  write(paste('Opening a web browser on', filename, '...'),'')
  if (interactive()) try(browseURL(paste("file://", filename, sep = "")))
  write("OK. A web page showing all the examples should have been opened.",'')
}

Try the hwriter package in your browser

Any scripts or data that you put into this service are public.

hwriter documentation built on April 8, 2022, 5:07 p.m.