R/htm2txt.R

Defines functions browse gettxt htm2txt

Documented in browse gettxt htm2txt

####################################
# R htm2txt package Ver 2.2.2      #
#                 by Sangchul Park #
####################################

#' Convert a html document to plain texts by stripping off all html tags
#'
#' @param htm A character vector, containing a html document, to be converted into plain texts (other objects are coerced into character vectors).
#' @param list A character that replaces "li" tags (referring to a numbering or bullet for lists). The default is a line change followed by a bullet character and a space.
#' @param pagebreak A character that replaces "hr" tags (referring to a thematic change in the content or a page break).
#' @return A character vector containing plain texts converted from the html document.
#' @examples
#' text = htm2txt("<html><body>html texts</body></html>")
#' text = htm2txt(c("Hello<p>World", "Goodbye<br>Friends"))
#' text = htm2txt("<p>Menu:</p><ul></li>Coffee</li><li>Tea</li></ul>", list = "\n- ")
#' text = htm2txt("Page 1<hr>Page 2", pagebreak = "\n\n[NEW PAGE]\n\n")
#' @export
htm2txt <- function(htm, list = "\n&#8226; ", pagebreak = "\n\n----------\n\n") {
  
  # function gsubfun: work like gsubfn::gsubfn, but does not damage unicodes
  gsubfun <- function(x, pattern, FUN) {
    match = lapply(regmatches(x, gregexpr(pattern, x, useBytes = TRUE)), function(y) if (length(y) == 0) return(y) else return(sapply(y, FUN)))
    nonmatch = regmatches(x, gregexpr(pattern, x, useBytes = TRUE), invert = TRUE)
    return(sapply(seq_along(match), function(i) if (length(.subset2(match, i)) == 0) return(x[i]) else return(paste(append(.subset2(nonmatch, i)[1], sapply(seq_along(.subset2(match, i)), function(j) paste(.subset2(match, i)[j], .subset2(nonmatch, i)[j + 1], sep = ''))), collapse = ''))))
  }
  
  # htm2txt main codes
  htm = as.vector(unlist(htm))
  htm = gsub('<style[^>]*>(.*?)</style[^>]*>|<script[^>]*>(.*?)</script[^>]*>|<title[^>]*>(.*?)</title[^>]*>|<!--(.*?)-->', '', htm)
  htm = gsub('</?p>|</?p [^>]*>|(</?(div|h1|h2|h3|h4|h5|h6|form|ul|ol|dir|dl|table|section|textarea|article|aside|details|blockquote)[^>]*>)+', '\n\n', htm, ignore.case = TRUE)
  htm = gsub('(</?(br|tr|dt|dd|button|label|option|summary|legend)[^>]*>)+', '\n', htm, ignore.case = TRUE)
  htm = gsub('<td[^>]*>', ' ', htm, ignore.case = TRUE)
  htm = gsub('</?q>|</?q [^>]*>', '"', htm, ignore.case = TRUE)
  htm = gsub('<hr[^>]*>', pagebreak, htm, ignore.case = TRUE)
  htm = gsub('<li>[[:blank:](\n)(\t)]*|<li [^>]*>[[:blank:](\n)(\t)]*', list, htm, ignore.case = TRUE)
  htm = gsub('<[/A-z!]+[^<>]*<[^<>]*<[^<>]*>[^<>]*>[^<>]*>', '', htm)
  htm = gsub('<[/A-z!]+[^<>]*<[^<>]*>[^<>]*>', '', htm)
  htm = gsub('<[/A-z!]+[^<>]*>', '', htm)
  entities = c('&Aacute;','&Aacute','&aacute;','&aacute','&Abreve;','&abreve;','&ac;','&acd;','&acE;','&Acirc;','&Acirc','&acirc;','&acirc','&acute;','&acute','&Acy;','&acy;','&AElig;','&AElig','&aelig;','&aelig','&af;','&Afr;','&afr;','&Agrave;','&Agrave','&agrave;','&agrave','&alefsym;','&aleph;','&Alpha;','&alpha;','&Amacr;','&amacr;','&amalg;','&AMP;','&AMP','&amp;','&amp','&And;','&and;','&andand;','&andd;','&andslope;','&andv;','&ang;','&ange;','&angle;','&angmsd;','&angmsdaa;','&angmsdab;','&angmsdac;','&angmsdad;','&angmsdae;','&angmsdaf;','&angmsdag;','&angmsdah;','&angrt;','&angrtvb;','&angrtvbd;','&angsph;','&angst;','&angzarr;','&Aogon;','&aogon;','&Aopf;','&aopf;','&ap;','&apacir;','&apE;','&ape;','&apid;','&apos;','&ApplyFunction;','&approx;','&approxeq;','&Aring;','&Aring','&aring;','&aring','&Ascr;','&ascr;','&Assign;','&ast;','&asymp;','&asympeq;','&Atilde;','&Atilde','&atilde;','&atilde','&Auml;','&Auml','&auml;','&auml','&awconint;','&awint;','&backcong;','&backepsilon;','&backprime;','&backsim;','&backsimeq;','&Backslash;','&Barv;','&barvee;','&Barwed;','&barwed;','&barwedge;','&bbrk;','&bbrktbrk;','&bcong;','&Bcy;','&bcy;','&bdquo;','&becaus;','&Because;','&because;','&bemptyv;','&bepsi;','&bernou;','&Bernoullis;','&Beta;','&beta;','&beth;','&between;','&Bfr;','&bfr;','&bigcap;','&bigcirc;','&bigcup;','&bigodot;','&bigoplus;','&bigotimes;','&bigsqcup;','&bigstar;','&bigtriangledown;','&bigtriangleup;','&biguplus;','&bigvee;','&bigwedge;','&bkarow;','&blacklozenge;','&blacksquare;','&blacktriangle;','&blacktriangledown;','&blacktriangleleft;','&blacktriangleright;','&blank;','&blk12;','&blk14;','&blk34;','&block;','&bne;','&bnequiv;','&bNot;','&bnot;','&Bopf;','&bopf;','&bot;','&bottom;','&bowtie;','&boxbox;','&boxDL;','&boxDl;','&boxdL;','&boxdl;','&boxDR;','&boxDr;','&boxdR;','&boxdr;','&boxH;','&boxh;','&boxHD;','&boxHd;','&boxhD;','&boxhd;','&boxHU;','&boxHu;','&boxhU;','&boxhu;','&boxminus;','&boxplus;','&boxtimes;','&boxUL;','&boxUl;','&boxuL;','&boxul;','&boxUR;','&boxUr;','&boxuR;','&boxur;','&boxV;','&boxv;','&boxVH;','&boxVh;','&boxvH;','&boxvh;','&boxVL;','&boxVl;','&boxvL;','&boxvl;','&boxVR;','&boxVr;','&boxvR;','&boxvr;','&bprime;','&Breve;','&breve;','&brvbar;','&brvbar','&Bscr;','&bscr;','&bsemi;','&bsim;','&bsime;','&bsol;','&bsolb;','&bsolhsub;','&bull;','&bullet;','&bump;','&bumpE;','&bumpe;','&Bumpeq;','&bumpeq;','&Cacute;','&cacute;','&Cap;','&cap;','&capand;','&capbrcup;','&capcap;','&capcup;','&capdot;','&CapitalDifferentialD;','&caps;','&caret;','&caron;','&Cayleys;','&ccaps;','&Ccaron;','&ccaron;','&Ccedil;','&Ccedil','&ccedil;','&ccedil','&Ccirc;','&ccirc;','&Cconint;','&ccups;','&ccupssm;','&Cdot;','&cdot;','&cedil;','&cedil','&Cedilla;','&cemptyv;','&cent;','&cent','&CenterDot;','&centerdot;','&Cfr;','&cfr;','&CHcy;','&chcy;','&check;','&checkmark;','&Chi;','&chi;','&cir;','&circ;','&circeq;','&circlearrowleft;','&circlearrowright;','&circledast;','&circledcirc;','&circleddash;','&CircleDot;','&circledR;','&circledS;','&CircleMinus;','&CirclePlus;','&CircleTimes;','&cirE;','&cire;','&cirfnint;','&cirmid;','&cirscir;','&ClockwiseContourIntegral;','&CloseCurlyDoubleQuote;','&CloseCurlyQuote;','&clubs;','&clubsuit;','&Colon;','&colon;','&Colone;','&colone;','&coloneq;','&comma;','&commat;','&comp;')
  entities = append(entities, c('&compfn;','&complement;','&complexes;','&cong;','&congdot;','&Congruent;','&Conint;','&conint;','&ContourIntegral;','&Copf;','&copf;','&coprod;','&Coproduct;','&COPY;','&COPY','&copy;','&copy','&copysr;','&CounterClockwiseContourIntegral;','&crarr;','&Cross;','&cross;','&Cscr;','&cscr;','&csub;','&csube;','&csup;','&csupe;','&ctdot;','&cudarrl;','&cudarrr;','&cuepr;','&cuesc;','&cularr;','&cularrp;','&Cup;','&cup;','&cupbrcap;','&CupCap;','&cupcap;','&cupcup;','&cupdot;','&cupor;','&cups;','&curarr;','&curarrm;','&curlyeqprec;','&curlyeqsucc;','&curlyvee;','&curlywedge;','&curren;','&curren','&curvearrowleft;','&curvearrowright;','&cuvee;','&cuwed;','&cwconint;','&cwint;','&cylcty;','&Dagger;','&dagger;','&daleth;','&Darr;','&dArr;','&darr;','&dash;','&Dashv;','&dashv;','&dbkarow;','&dblac;','&Dcaron;','&dcaron;','&Dcy;','&dcy;','&DD;','&dd;','&ddagger;','&ddarr;','&DDotrahd;','&ddotseq;','&deg;','&deg','&Del;','&Delta;','&delta;','&demptyv;','&dfisht;','&Dfr;','&dfr;','&dHar;','&dharl;','&dharr;','&DiacriticalAcute;','&DiacriticalDot;','&DiacriticalDoubleAcute;','&DiacriticalGrave;','&DiacriticalTilde;','&diam;','&Diamond;','&diamond;','&diamondsuit;','&diams;','&die;','&DifferentialD;','&digamma;','&disin;','&div;','&divide;','&divide','&divideontimes;','&divonx;','&DJcy;','&djcy;','&dlcorn;','&dlcrop;','&dollar;','&Dopf;','&dopf;','&Dot;','&dot;','&DotDot;','&doteq;','&doteqdot;','&DotEqual;','&dotminus;','&dotplus;','&dotsquare;','&doublebarwedge;','&DoubleContourIntegral;','&DoubleDot;','&DoubleDownArrow;','&DoubleLeftArrow;','&DoubleLeftRightArrow;','&DoubleLeftTee;','&DoubleLongLeftArrow;','&DoubleLongLeftRightArrow;','&DoubleLongRightArrow;','&DoubleRightArrow;','&DoubleRightTee;','&DoubleUpArrow;','&DoubleUpDownArrow;','&DoubleVerticalBar;','&DownArrow;','&Downarrow;','&downarrow;','&DownArrowBar;','&DownArrowUpArrow;','&DownBreve;','&downdownarrows;','&downharpoonleft;','&downharpoonright;','&DownLeftRightVector;','&DownLeftTeeVector;','&DownLeftVector;','&DownLeftVectorBar;','&DownRightTeeVector;','&DownRightVector;','&DownRightVectorBar;','&DownTee;','&DownTeeArrow;','&drbkarow;','&drcorn;','&drcrop;','&Dscr;','&dscr;','&DScy;','&dscy;','&dsol;','&Dstrok;','&dstrok;','&dtdot;','&dtri;','&dtrif;','&duarr;','&duhar;','&dwangle;','&DZcy;','&dzcy;','&dzigrarr;','&Eacute;','&Eacute','&eacute;','&eacute','&easter;','&Ecaron;','&ecaron;','&ecir;','&Ecirc;','&Ecirc','&ecirc;','&ecirc','&ecolon;','&Ecy;','&ecy;','&eDDot;','&Edot;','&eDot;','&edot;','&ee;','&efDot;','&Efr;','&efr;','&eg;','&Egrave;','&Egrave','&egrave;','&egrave','&egs;','&egsdot;','&el;','&Element;','&elinters;','&ell;','&els;','&elsdot;','&Emacr;','&emacr;','&empty;','&emptyset;','&EmptySmallSquare;','&emptyv;','&EmptyVerySmallSquare;','&emsp;','&emsp13;','&emsp14;','&ENG;','&eng;','&ensp;','&Eogon;','&eogon;','&Eopf;','&eopf;','&epar;','&eparsl;','&eplus;','&epsi;','&Epsilon;','&epsilon;','&epsiv;','&eqcirc;','&eqcolon;','&eqsim;','&eqslantgtr;','&eqslantless;','&Equal;','&equals;','&EqualTilde;','&equest;','&Equilibrium;','&equiv;','&equivDD;','&eqvparsl;','&erarr;','&erDot;','&Escr;','&escr;','&esdot;','&Esim;','&esim;','&Eta;','&eta;','&ETH;','&ETH','&eth;','&eth','&Euml;','&Euml','&euml;','&euml','&euro;','&excl;','&exist;','&Exists;','&expectation;','&ExponentialE;','&exponentiale;','&fallingdotseq;','&Fcy;','&fcy;','&female;','&ffilig;','&fflig;','&ffllig;','&Ffr;','&ffr;','&filig;','&FilledSmallSquare;','&FilledVerySmallSquare;','&fjlig;','&flat;','&fllig;','&fltns;','&fnof;','&Fopf;','&fopf;','&ForAll;','&forall;','&fork;','&forkv;','&Fouriertrf;'))
  entities = append(entities, c('&fpartint;','&frac12;','&frac12','&frac13;','&frac14;','&frac14','&frac15;','&frac16;','&frac18;','&frac23;','&frac25;','&frac34;','&frac34','&frac35;','&frac38;','&frac45;','&frac56;','&frac58;','&frac78;','&frasl;','&frown;','&Fscr;','&fscr;','&gacute;','&Gamma;','&gamma;','&Gammad;','&gammad;','&gap;','&Gbreve;','&gbreve;','&Gcedil;','&Gcirc;','&gcirc;','&Gcy;','&gcy;','&Gdot;','&gdot;','&gE;','&ge;','&gEl;','&gel;','&geq;','&geqq;','&geqslant;','&ges;','&gescc;','&gesdot;','&gesdoto;','&gesdotol;','&gesl;','&gesles;','&Gfr;','&gfr;','&Gg;','&gg;','&ggg;','&gimel;','&GJcy;','&gjcy;','&gl;','&gla;','&glE;','&glj;','&gnap;','&gnapprox;','&gnE;','&gne;','&gneq;','&gneqq;','&gnsim;','&Gopf;','&gopf;','&grave;','&GreaterEqual;','&GreaterEqualLess;','&GreaterFullEqual;','&GreaterGreater;','&GreaterLess;','&GreaterSlantEqual;','&GreaterTilde;','&Gscr;','&gscr;','&gsim;','&gsime;','&gsiml;','&GT;','&GT','&Gt;','&gt;','&gt','&gtcc;','&gtcir;','&gtdot;','&gtlPar;','&gtquest;','&gtrapprox;','&gtrarr;','&gtrdot;','&gtreqless;','&gtreqqless;','&gtrless;','&gtrsim;','&gvertneqq;','&gvnE;','&Hacek;','&hairsp;','&half;','&hamilt;','&HARDcy;','&hardcy;','&hArr;','&harr;','&harrcir;','&harrw;','&Hat;','&hbar;','&Hcirc;','&hcirc;','&hearts;','&heartsuit;','&hellip;','&hercon;','&Hfr;','&hfr;','&HilbertSpace;','&hksearow;','&hkswarow;','&hoarr;','&homtht;','&hookleftarrow;','&hookrightarrow;','&Hopf;','&hopf;','&horbar;','&HorizontalLine;','&Hscr;','&hscr;','&hslash;','&Hstrok;','&hstrok;','&HumpDownHump;','&HumpEqual;','&hybull;','&hyphen;','&Iacute;','&Iacute','&iacute;','&iacute','&ic;','&Icirc;','&Icirc','&icirc;','&icirc','&Icy;','&icy;','&Idot;','&IEcy;','&iecy;','&iexcl;','&iexcl','&iff;','&Ifr;','&ifr;','&Igrave;','&Igrave','&igrave;','&igrave','&ii;','&iiiint;','&iiint;','&iinfin;','&iiota;','&IJlig;','&ijlig;','&Im;','&Imacr;','&imacr;','&image;','&ImaginaryI;','&imagline;','&imagpart;','&imath;','&imof;','&imped;','&Implies;','&in;','&incare;','&infin;','&infintie;','&inodot;','&Int;','&int;','&intcal;','&integers;','&Integral;','&intercal;','&Intersection;','&intlarhk;','&intprod;','&InvisibleComma;','&InvisibleTimes;','&IOcy;','&iocy;','&Iogon;','&iogon;','&Iopf;','&iopf;','&Iota;','&iota;','&iprod;','&iquest;','&iquest','&Iscr;','&iscr;','&isin;','&isindot;','&isinE;','&isins;','&isinsv;','&isinv;','&it;','&Itilde;','&itilde;','&Iukcy;','&iukcy;','&Iuml;','&Iuml','&iuml;','&iuml','&Jcirc;','&jcirc;','&Jcy;','&jcy;','&Jfr;','&jfr;','&jmath;','&Jopf;','&jopf;','&Jscr;','&jscr;','&Jsercy;','&jsercy;','&Jukcy;','&jukcy;','&Kappa;','&kappa;','&kappav;','&Kcedil;','&kcedil;','&Kcy;','&kcy;','&Kfr;','&kfr;','&kgreen;','&KHcy;','&khcy;','&KJcy;','&kjcy;','&Kopf;','&kopf;','&Kscr;','&kscr;','&lAarr;','&Lacute;','&lacute;','&laemptyv;','&lagran;','&Lambda;','&lambda;','&Lang;','&lang;','&langd;','&langle;','&lap;','&Laplacetrf;','&laquo;','&laquo','&Larr;','&lArr;','&larr;','&larrb;','&larrbfs;','&larrfs;','&larrhk;','&larrlp;','&larrpl;','&larrsim;','&larrtl;','&lat;','&lAtail;','&latail;','&late;','&lates;','&lBarr;','&lbarr;','&lbbrk;','&lbrace;','&lbrack;','&lbrke;'))
  entities = append(entities, c('&lbrksld;','&lbrkslu;','&Lcaron;','&lcaron;','&Lcedil;','&lcedil;','&lceil;','&lcub;','&Lcy;','&lcy;','&ldca;','&ldquo;','&ldquor;','&ldrdhar;','&ldrushar;','&ldsh;','&lE;','&le;','&LeftAngleBracket;','&LeftArrow;','&Leftarrow;','&leftarrow;','&LeftArrowBar;','&LeftArrowRightArrow;','&leftarrowtail;','&LeftCeiling;','&LeftDoubleBracket;','&LeftDownTeeVector;','&LeftDownVector;','&LeftDownVectorBar;','&LeftFloor;','&leftharpoondown;','&leftharpoonup;','&leftleftarrows;','&LeftRightArrow;','&Leftrightarrow;','&leftrightarrow;','&leftrightarrows;','&leftrightharpoons;','&leftrightsquigarrow;','&LeftRightVector;','&LeftTee;','&LeftTeeArrow;','&LeftTeeVector;','&leftthreetimes;','&LeftTriangle;','&LeftTriangleBar;','&LeftTriangleEqual;','&LeftUpDownVector;','&LeftUpTeeVector;','&LeftUpVector;','&LeftUpVectorBar;','&LeftVector;','&LeftVectorBar;','&lEg;','&leg;','&leq;','&leqq;','&leqslant;','&les;','&lescc;','&lesdot;','&lesdoto;','&lesdotor;','&lesg;','&lesges;','&lessapprox;','&lessdot;','&lesseqgtr;','&lesseqqgtr;','&LessEqualGreater;','&LessFullEqual;','&LessGreater;','&lessgtr;','&LessLess;','&lesssim;','&LessSlantEqual;','&LessTilde;','&lfisht;','&lfloor;','&Lfr;','&lfr;','&lg;','&lgE;','&lHar;','&lhard;','&lharu;','&lharul;','&lhblk;','&LJcy;','&ljcy;','&Ll;','&ll;','&llarr;','&llcorner;','&Lleftarrow;','&llhard;','&lltri;','&Lmidot;','&lmidot;','&lmoust;','&lmoustache;','&lnap;','&lnapprox;','&lnE;','&lne;','&lneq;','&lneqq;','&lnsim;','&loang;','&loarr;','&lobrk;','&LongLeftArrow;','&Longleftarrow;','&longleftarrow;','&LongLeftRightArrow;','&Longleftrightarrow;','&longleftrightarrow;','&longmapsto;','&LongRightArrow;','&Longrightarrow;','&longrightarrow;','&looparrowleft;','&looparrowright;','&lopar;','&Lopf;','&lopf;','&loplus;','&lotimes;','&lowast;','&lowbar;','&LowerLeftArrow;','&LowerRightArrow;','&loz;','&lozenge;','&lozf;','&lpar;','&lparlt;','&lrarr;','&lrcorner;','&lrhar;','&lrhard;','&lrm;','&lrtri;','&lsaquo;','&Lscr;','&lscr;','&Lsh;','&lsh;','&lsim;','&lsime;','&lsimg;','&lsqb;','&lsquo;','&lsquor;','&Lstrok;','&lstrok;','&LT;','&LT','&Lt;','&lt;','&lt','&ltcc;','&ltcir;','&ltdot;','&lthree;','&ltimes;','&ltlarr;','&ltquest;','&ltri;','&ltrie;','&ltrif;','&ltrPar;','&lurdshar;','&luruhar;','&lvertneqq;','&lvnE;','&macr;','&macr','&male;','&malt;','&maltese;','&Map;','&map;','&mapsto;','&mapstodown;','&mapstoleft;','&mapstoup;','&marker;','&mcomma;','&Mcy;','&mcy;','&mdash;','&mDDot;','&measuredangle;','&MediumSpace;','&Mellintrf;','&Mfr;','&mfr;','&mho;','&micro;','&micro','&mid;','&midast;','&midcir;','&middot;','&middot','&minus;','&minusb;','&minusd;','&minusdu;','&MinusPlus;','&mlcp;','&mldr;','&mnplus;','&models;','&Mopf;','&mopf;','&mp;','&Mscr;','&mscr;','&mstpos;','&Mu;','&mu;','&multimap;','&mumap;','&nabla;','&Nacute;','&nacute;','&nang;','&nap;','&napE;','&napid;','&napos;','&napprox;','&natur;','&natural;','&naturals;','&nbsp;','&nbsp','&nbump;','&nbumpe;','&ncap;','&Ncaron;','&ncaron;','&Ncedil;','&ncedil;','&ncong;','&ncongdot;','&ncup;','&Ncy;','&ncy;','&ndash;','&ne;','&nearhk;','&neArr;','&nearr;','&nearrow;','&nedot;','&NegativeMediumSpace;','&NegativeThickSpace;','&NegativeThinSpace;','&NegativeVeryThinSpace;','&nequiv;','&nesear;','&nesim;','&NestedGreaterGreater;','&NestedLessLess;','&NewLine;','&nexist;','&nexists;','&Nfr;','&nfr;','&ngE;','&nge;','&ngeq;','&ngeqq;','&ngeqslant;','&nges;','&nGg;','&ngsim;','&nGt;','&ngt;','&ngtr;','&nGtv;','&nhArr;','&nharr;','&nhpar;','&ni;','&nis;','&nisd;','&niv;','&NJcy;','&njcy;','&nlArr;','&nlarr;','&nldr;','&nlE;','&nle;','&nLeftarrow;'))
  entities = append(entities, c('&nleftarrow;','&nLeftrightarrow;','&nleftrightarrow;','&nleq;','&nleqq;','&nleqslant;','&nles;','&nless;','&nLl;','&nlsim;','&nLt;','&nlt;','&nltri;','&nltrie;','&nLtv;','&nmid;','&NoBreak;','&NonBreakingSpace;','&Nopf;','&nopf;','&Not;','&not;','&not','&NotCongruent;','&NotCupCap;','&NotDoubleVerticalBar;','&NotElement;','&NotEqual;','&NotEqualTilde;','&NotExists;','&NotGreater;','&NotGreaterEqual;','&NotGreaterFullEqual;','&NotGreaterGreater;','&NotGreaterLess;','&NotGreaterSlantEqual;','&NotGreaterTilde;','&NotHumpDownHump;','&NotHumpEqual;','&notin;','&notindot;','&notinE;','&notinva;','&notinvb;','&notinvc;','&NotLeftTriangle;','&NotLeftTriangleBar;','&NotLeftTriangleEqual;','&NotLess;','&NotLessEqual;','&NotLessGreater;','&NotLessLess;','&NotLessSlantEqual;','&NotLessTilde;','&NotNestedGreaterGreater;','&NotNestedLessLess;','&notni;','&notniva;','&notnivb;','&notnivc;','&NotPrecedes;','&NotPrecedesEqual;','&NotPrecedesSlantEqual;','&NotReverseElement;','&NotRightTriangle;','&NotRightTriangleBar;','&NotRightTriangleEqual;','&NotSquareSubset;','&NotSquareSubsetEqual;','&NotSquareSuperset;','&NotSquareSupersetEqual;','&NotSubset;','&NotSubsetEqual;','&NotSucceeds;','&NotSucceedsEqual;','&NotSucceedsSlantEqual;','&NotSucceedsTilde;','&NotSuperset;','&NotSupersetEqual;','&NotTilde;','&NotTildeEqual;','&NotTildeFullEqual;','&NotTildeTilde;','&NotVerticalBar;','&npar;','&nparallel;','&nparsl;','&npart;','&npolint;','&npr;','&nprcue;','&npre;','&nprec;','&npreceq;','&nrArr;','&nrarr;','&nrarrc;','&nrarrw;','&nRightarrow;','&nrightarrow;','&nrtri;','&nrtrie;','&nsc;','&nsccue;','&nsce;','&Nscr;','&nscr;','&nshortmid;','&nshortparallel;','&nsim;','&nsime;','&nsimeq;','&nsmid;','&nspar;','&nsqsube;','&nsqsupe;','&nsub;','&nsubE;','&nsube;','&nsubset;','&nsubseteq;','&nsubseteqq;','&nsucc;','&nsucceq;','&nsup;','&nsupE;','&nsupe;','&nsupset;','&nsupseteq;','&nsupseteqq;','&ntgl;','&Ntilde;','&Ntilde','&ntilde;','&ntilde','&ntlg;','&ntriangleleft;','&ntrianglelefteq;','&ntriangleright;','&ntrianglerighteq;','&Nu;','&nu;','&num;','&numero;','&numsp;','&nvap;','&nVDash;','&nVdash;','&nvDash;','&nvdash;','&nvge;','&nvgt;','&nvHarr;','&nvinfin;','&nvlArr;','&nvle;','&nvlt;','&nvltrie;','&nvrArr;','&nvrtrie;','&nvsim;','&nwarhk;','&nwArr;','&nwarr;','&nwarrow;','&nwnear;','&Oacute;','&Oacute','&oacute;','&oacute','&oast;','&ocir;','&Ocirc;','&Ocirc','&ocirc;','&ocirc','&Ocy;','&ocy;','&odash;','&Odblac;','&odblac;','&odiv;','&odot;','&odsold;','&OElig;','&oelig;','&ofcir;','&Ofr;','&ofr;','&ogon;','&Ograve;','&Ograve','&ograve;','&ograve','&ogt;','&ohbar;','&ohm;','&oint;','&olarr;','&olcir;','&olcross;','&oline;','&olt;','&Omacr;','&omacr;','&Omega;','&omega;','&Omicron;','&omicron;','&omid;','&ominus;','&Oopf;','&oopf;','&opar;','&OpenCurlyDoubleQuote;','&OpenCurlyQuote;','&operp;','&oplus;','&Or;','&or;','&orarr;','&ord;','&order;','&orderof;','&ordf;','&ordf','&ordm;','&ordm','&origof;','&oror;','&orslope;','&orv;','&oS;','&Oscr;','&oscr;','&Oslash;','&Oslash','&oslash;','&oslash','&osol;','&Otilde;','&Otilde','&otilde;','&otilde','&Otimes;','&otimes;','&otimesas;','&Ouml;','&Ouml','&ouml;','&ouml','&ovbar;','&OverBar;','&OverBrace;','&OverBracket;','&OverParenthesis;','&par;','&para;','&para','&parallel;','&parsim;','&parsl;','&part;','&PartialD;','&Pcy;','&pcy;','&percnt;','&period;','&permil;','&perp;','&pertenk;','&Pfr;','&pfr;','&Phi;','&phi;','&phiv;','&phmmat;','&phone;','&Pi;','&pi;','&pitchfork;','&piv;','&planck;','&planckh;','&plankv;','&plus;','&plusacir;','&plusb;','&pluscir;','&plusdo;','&plusdu;','&pluse;','&PlusMinus;','&plusmn;','&plusmn','&plussim;','&plustwo;','&pm;','&Poincareplane;','&pointint;'))
  entities = append(entities, c('&Popf;','&popf;','&pound;','&pound','&Pr;','&pr;','&prap;','&prcue;','&prE;','&pre;','&prec;','&precapprox;','&preccurlyeq;','&Precedes;','&PrecedesEqual;','&PrecedesSlantEqual;','&PrecedesTilde;','&preceq;','&precnapprox;','&precneqq;','&precnsim;','&precsim;','&Prime;','&prime;','&primes;','&prnap;','&prnE;','&prnsim;','&prod;','&Product;','&profalar;','&profline;','&profsurf;','&prop;','&Proportion;','&Proportional;','&propto;','&prsim;','&prurel;','&Pscr;','&pscr;','&Psi;','&psi;','&puncsp;','&Qfr;','&qfr;','&qint;','&Qopf;','&qopf;','&qprime;','&Qscr;','&qscr;','&quaternions;','&quatint;','&quest;','&questeq;','&QUOT;','&quot;','&rAarr;','&race;','&Racute;','&racute;','&radic;','&raemptyv;','&Rang;','&rang;','&rangd;','&range;','&rangle;','&raquo;','&raquo','&Rarr;','&rArr;','&rarr;','&rarrap;','&rarrb;','&rarrbfs;','&rarrc;','&rarrfs;','&rarrhk;','&rarrlp;','&rarrpl;','&rarrsim;','&Rarrtl;','&rarrtl;','&rarrw;','&rAtail;','&ratail;','&ratio;','&rationals;','&RBarr;','&rBarr;','&rbarr;','&rbbrk;','&rbrace;','&rbrack;','&rbrke;','&rbrksld;','&rbrkslu;','&Rcaron;','&rcaron;','&Rcedil;','&rcedil;','&rceil;','&rcub;','&Rcy;','&rcy;','&rdca;','&rdldhar;','&rdquo;','&rdquor;','&rdsh;','&Re;','&real;','&realine;','&realpart;','&reals;','&rect;','&REG;','&REG','&reg;','&reg','&ReverseElement;','&ReverseEquilibrium;','&ReverseUpEquilibrium;','&rfisht;','&rfloor;','&Rfr;','&rfr;','&rHar;','&rhard;','&rharu;','&rharul;','&Rho;','&rho;','&rhov;','&RightAngleBracket;','&RightArrow;','&Rightarrow;','&rightarrow;','&RightArrowBar;','&RightArrowLeftArrow;','&rightarrowtail;','&RightCeiling;','&RightDoubleBracket;','&RightDownTeeVector;','&RightDownVector;','&RightDownVectorBar;','&RightFloor;','&rightharpoondown;','&rightharpoonup;','&rightleftarrows;','&rightleftharpoons;','&rightrightarrows;','&rightsquigarrow;','&RightTee;','&RightTeeArrow;','&RightTeeVector;','&rightthreetimes;','&RightTriangle;','&RightTriangleBar;','&RightTriangleEqual;','&RightUpDownVector;','&RightUpTeeVector;','&RightUpVector;','&RightUpVectorBar;','&RightVector;','&RightVectorBar;','&ring;','&risingdotseq;','&rlarr;','&rlhar;','&rlm;','&rmoust;','&rmoustache;','&rnmid;','&roang;','&roarr;','&robrk;','&ropar;','&Ropf;','&ropf;','&roplus;','&rotimes;','&RoundImplies;','&rpar;','&rpargt;','&rppolint;','&rrarr;','&Rrightarrow;','&rsaquo;','&Rscr;','&rscr;','&Rsh;','&rsh;','&rsqb;','&rsquo;','&rsquor;','&rthree;','&rtimes;','&rtri;','&rtrie;','&rtrif;','&rtriltri;','&RuleDelayed;','&ruluhar;','&rx;','&Sacute;','&sacute;','&sbquo;','&Sc;','&sc;','&scap;','&Scaron;','&scaron;','&sccue;','&scE;','&sce;','&Scedil;','&scedil;','&Scirc;','&scirc;','&scnap;','&scnE;','&scnsim;','&scpolint;','&scsim;','&Scy;','&scy;','&sdot;','&sdotb;','&sdote;','&searhk;','&seArr;','&searr;','&searrow;','&sect;','&sect','&semi;','&seswar;','&setminus;','&setmn;','&sext;','&Sfr;','&sfr;','&sfrown;','&sharp;','&SHCHcy;','&shchcy;','&SHcy;','&shcy;','&ShortDownArrow;','&ShortLeftArrow;','&shortmid;','&shortparallel;','&ShortRightArrow;','&ShortUpArrow;','&shy;','&shy','&Sigma;','&sigma;','&sigmaf;','&sigmav;','&sim;','&simdot;','&sime;','&simeq;','&simg;','&simgE;','&siml;','&simlE;','&simne;','&simplus;','&simrarr;','&slarr;','&SmallCircle;','&smallsetminus;','&smashp;','&smeparsl;','&smid;','&smile;','&smt;','&smte;','&smtes;','&SOFTcy;','&softcy;','&sol;','&solb;','&solbar;','&Sopf;','&sopf;','&spades;','&spadesuit;','&spar;','&sqcap;','&sqcaps;','&sqcup;','&sqcups;','&Sqrt;','&sqsub;'))
  entities = append(entities, c('&sqsube;','&sqsubset;','&sqsubseteq;','&sqsup;','&sqsupe;','&sqsupset;','&sqsupseteq;','&squ;','&Square;','&square;','&SquareIntersection;','&SquareSubset;','&SquareSubsetEqual;','&SquareSuperset;','&SquareSupersetEqual;','&SquareUnion;','&squarf;','&squf;','&srarr;','&Sscr;','&sscr;','&ssetmn;','&ssmile;','&sstarf;','&Star;','&star;','&starf;','&straightepsilon;','&straightphi;','&strns;','&Sub;','&sub;','&subdot;','&subE;','&sube;','&subedot;','&submult;','&subnE;','&subne;','&subplus;','&subrarr;','&Subset;','&subset;','&subseteq;','&subseteqq;','&SubsetEqual;','&subsetneq;','&subsetneqq;','&subsim;','&subsub;','&subsup;','&succ;','&succapprox;','&succcurlyeq;','&Succeeds;','&SucceedsEqual;','&SucceedsSlantEqual;','&SucceedsTilde;','&succeq;','&succnapprox;','&succneqq;','&succnsim;','&succsim;','&SuchThat;','&Sum;','&sum;','&sung;','&Sup;','&sup;','&sup1;','&sup1','&sup2;','&sup2','&sup3;','&sup3','&supdot;','&supdsub;','&supE;','&supe;','&supedot;','&Superset;','&SupersetEqual;','&suphsol;','&suphsub;','&suplarr;','&supmult;','&supnE;','&supne;','&supplus;','&Supset;','&supset;','&supseteq;','&supseteqq;','&supsetneq;','&supsetneqq;','&supsim;','&supsub;','&supsup;','&swarhk;','&swArr;','&swarr;','&swarrow;','&swnwar;','&szlig;','&szlig','&Tab;','&target;','&Tau;','&tau;','&tbrk;','&Tcaron;','&tcaron;','&Tcedil;','&tcedil;','&Tcy;','&tcy;','&tdot;','&telrec;','&Tfr;','&tfr;','&there4;','&Therefore;','&therefore;','&Theta;','&theta;','&thetasym;','&thetav;','&thickapprox;','&thicksim;','&ThickSpace;','&thinsp;','&ThinSpace;','&thkap;','&thksim;','&THORN;','&THORN','&thorn;','&thorn','&Tilde;','&tilde;','&TildeEqual;','&TildeFullEqual;','&TildeTilde;','&times;','&times','&timesb;','&timesbar;','&timesd;','&tint;','&toea;','&top;','&topbot;','&topcir;','&Topf;','&topf;','&topfork;','&tosa;','&tprime;','&TRADE;','&trade;','&triangle;','&triangledown;','&triangleleft;','&trianglelefteq;','&triangleq;','&triangleright;','&trianglerighteq;','&tridot;','&trie;','&triminus;','&TripleDot;','&triplus;','&trisb;','&tritime;','&trpezium;','&Tscr;','&tscr;','&TScy;','&tscy;','&TSHcy;','&tshcy;','&Tstrok;','&tstrok;','&twixt;','&twoheadleftarrow;','&twoheadrightarrow;','&Uacute;','&Uacute','&uacute;','&uacute','&Uarr;','&uArr;','&uarr;','&Uarrocir;','&Ubrcy;','&ubrcy;','&Ubreve;','&ubreve;','&Ucirc;','&Ucirc','&ucirc;','&ucirc','&Ucy;','&ucy;','&udarr;','&Udblac;','&udblac;','&udhar;','&ufisht;','&Ufr;','&ufr;','&Ugrave;','&Ugrave','&ugrave;','&ugrave','&uHar;','&uharl;','&uharr;','&uhblk;','&ulcorn;','&ulcorner;','&ulcrop;','&ultri;','&Umacr;','&umacr;','&uml;','&uml','&UnderBar;','&UnderBrace;','&UnderBracket;','&UnderParenthesis;','&Union;','&UnionPlus;','&Uogon;','&uogon;','&Uopf;','&uopf;','&UpArrow;','&Uparrow;','&uparrow;','&UpArrowBar;','&UpArrowDownArrow;','&UpDownArrow;','&Updownarrow;','&updownarrow;','&UpEquilibrium;','&upharpoonleft;','&upharpoonright;','&uplus;','&UpperLeftArrow;','&UpperRightArrow;','&Upsi;','&upsi;','&upsih;','&Upsilon;','&upsilon;','&UpTee;','&UpTeeArrow;','&upuparrows;','&urcorn;','&urcorner;','&urcrop;','&Uring;','&uring;','&urtri;','&Uscr;','&uscr;','&utdot;','&Utilde;','&utilde;','&utri;','&utrif;','&uuarr;','&Uuml;','&Uuml','&uuml;','&uuml','&uwangle;','&vangrt;','&varepsilon;','&varkappa;','&varnothing;','&varphi;','&varpi;','&varpropto;','&vArr;','&varr;','&varrho;','&varsigma;','&varsubsetneq;','&varsubsetneqq;','&varsupsetneq;','&varsupsetneqq;','&vartheta;','&vartriangleleft;','&vartriangleright;','&Vbar;','&vBar;','&vBarv;','&Vcy;'))
  entities = append(entities, c('&vcy;','&VDash;','&Vdash;','&vDash;','&vdash;','&Vdashl;','&Vee;','&vee;','&veebar;','&veeeq;','&vellip;','&Verbar;','&verbar;','&Vert;','&vert;','&VerticalBar;','&VerticalLine;','&VerticalSeparator;','&VerticalTilde;','&VeryThinSpace;','&Vfr;','&vfr;','&vltri;','&vnsub;','&vnsup;','&Vopf;','&vopf;','&vprop;','&vrtri;','&Vscr;','&vscr;','&vsubnE;','&vsubne;','&vsupnE;','&vsupne;','&Vvdash;','&vzigzag;','&Wcirc;','&wcirc;','&wedbar;','&Wedge;','&wedge;','&wedgeq;','&weierp;','&Wfr;','&wfr;','&Wopf;','&wopf;','&wp;','&wr;','&wreath;','&Wscr;','&wscr;','&xcap;','&xcirc;','&xcup;','&xdtri;','&Xfr;','&xfr;','&xhArr;','&xharr;','&Xi;','&xi;','&xlArr;','&xlarr;','&xmap;','&xnis;','&xodot;','&Xopf;','&xopf;','&xoplus;','&xotime;','&xrArr;','&xrarr;','&Xscr;','&xscr;','&xsqcup;','&xuplus;','&xutri;','&xvee;','&xwedge;','&Yacute;','&Yacute','&yacute;','&yacute','&YAcy;','&yacy;','&Ycirc;','&ycirc;','&Ycy;','&ycy;','&yen;','&yen','&Yfr;','&yfr;','&YIcy;','&yicy;','&Yopf;','&yopf;','&Yscr;','&yscr;','&YUcy;','&yucy;','&Yuml;','&yuml;','&yuml','&Zacute;','&zacute;','&Zcaron;','&zcaron;','&Zcy;','&zcy;','&Zdot;','&zdot;','&zeetrf;','&ZeroWidthSpace;','&Zeta;','&zeta;','&Zfr;','&zfr;','&ZHcy;','&zhcy;','&zigrarr;','&Zopf;','&zopf;','&Zscr;','&zscr;','&zwj;','&zwnj;'))
  unicodes = c('&#193;','&#193;','&#225;','&#225;','&#258;','&#259;','&#8766;','&#8767;','&#8766; &#819;','&#194;','&#194;','&#226;','&#226;','&#180;','&#180;','&#1040;','&#1072;','&#198;','&#198;','&#230;','&#230;','&#8289;','&#120068;','&#120094;','&#192;','&#192;','&#224;','&#224;','&#8501;','&#8501;','&#913;','&#945;','&#256;','&#257;','&#10815;','&#38;','&#38;','&#38;','&#38;','&#10835;','&#8743;','&#10837;','&#10844;','&#10840;','&#10842;','&#8736;','&#10660;','&#8736;','&#8737;','&#10664;','&#10665;','&#10666;','&#10667;','&#10668;','&#10669;','&#10670;','&#10671;','&#8735;','&#8894;','&#10653;','&#8738;','&#197;','&#9084;','&#260;','&#261;','&#120120;','&#120146;','&#8776;','&#10863;','&#10864;','&#8778;','&#8779;','&#39;','&#8289;','&#8776;','&#8778;','&#197;','&#197;','&#229;','&#229;','&#119964;','&#119990;','&#8788;','&#42;','&#8776;','&#8781;','&#195;','&#195;','&#227;','&#227;','&#196;','&#196;','&#228;','&#228;','&#8755;','&#10769;','&#8780;','&#1014;','&#8245;','&#8765;','&#8909;','&#8726;','&#10983;','&#8893;','&#8966;','&#8965;','&#8965;','&#9141;','&#9142;','&#8780;','&#1041;','&#1073;','&#8222;','&#8757;','&#8757;','&#8757;','&#10672;','&#1014;','&#8492;','&#8492;','&#914;','&#946;','&#8502;','&#8812;','&#120069;','&#120095;','&#8898;','&#9711;','&#8899;','&#10752;','&#10753;','&#10754;','&#10758;','&#9733;','&#9661;','&#9651;','&#10756;','&#8897;','&#8896;','&#10509;','&#10731;','&#9642;','&#9652;','&#9662;','&#9666;','&#9656;','&#9251;','&#9618;','&#9617;','&#9619;','&#9608;','&#61; &#8421;','&#8801; &#8421;','&#10989;','&#8976;','&#120121;','&#120147;','&#8869;','&#8869;','&#8904;','&#10697;','&#9559;','&#9558;','&#9557;','&#9488;','&#9556;','&#9555;','&#9554;','&#9484;','&#9552;','&#9472;','&#9574;','&#9572;','&#9573;','&#9516;','&#9577;','&#9575;','&#9576;','&#9524;','&#8863;','&#8862;','&#8864;','&#9565;','&#9564;','&#9563;','&#9496;','&#9562;','&#9561;','&#9560;','&#9492;','&#9553;','&#9474;','&#9580;','&#9579;','&#9578;','&#9532;','&#9571;','&#9570;','&#9569;','&#9508;','&#9568;','&#9567;','&#9566;','&#9500;','&#8245;','&#728;','&#728;','&#166;','&#166;','&#8492;','&#119991;','&#8271;','&#8765;','&#8909;','&#92;','&#10693;','&#10184;','&#8226;','&#8226;','&#8782;','&#10926;','&#8783;','&#8782;','&#8783;','&#262;','&#263;','&#8914;','&#8745;','&#10820;','&#10825;','&#10827;','&#10823;','&#10816;','&#8517;','&#8745; &#65024;','&#8257;','&#711;','&#8493;','&#10829;','&#268;','&#269;','&#199;','&#199;','&#231;','&#231;','&#264;','&#265;','&#8752;','&#10828;','&#10832;','&#266;','&#267;','&#184;','&#184;','&#184;','&#10674;','&#162;','&#162;','&#183;','&#183;','&#8493;','&#120096;','&#1063;','&#1095;','&#10003;','&#10003;','&#935;','&#967;','&#9675;','&#710;','&#8791;','&#8634;','&#8635;','&#8859;','&#8858;','&#8861;','&#8857;','&#174;','&#9416;','&#8854;','&#8853;','&#8855;','&#10691;','&#8791;','&#10768;','&#10991;','&#10690;','&#8754;','&#8221;','&#8217;','&#9827;','&#9827;','&#8759;','&#58;','&#10868;','&#8788;','&#8788;','&#44;','&#64;','&#8705;')
  unicodes = append(unicodes, c('&#8728;','&#8705;','&#8450;','&#8773;','&#10861;','&#8801;','&#8751;','&#8750;','&#8750;','&#8450;','&#120148;','&#8720;','&#8720;','&#169;','&#169;','&#169;','&#169;','&#8471;','&#8755;','&#8629;','&#10799;','&#10007;','&#119966;','&#119992;','&#10959;','&#10961;','&#10960;','&#10962;','&#8943;','&#10552;','&#10549;','&#8926;','&#8927;','&#8630;','&#10557;','&#8915;','&#8746;','&#10824;','&#8781;','&#10822;','&#10826;','&#8845;','&#10821;','&#8746; &#65024;','&#8631;','&#10556;','&#8926;','&#8927;','&#8910;','&#8911;','&#164;','&#164;','&#8630;','&#8631;','&#8910;','&#8911;','&#8754;','&#8753;','&#9005;','&#8225;','&#8224;','&#8504;','&#8609;','&#8659;','&#8595;','&#8208;','&#10980;','&#8867;','&#10511;','&#733;','&#270;','&#271;','&#1044;','&#1076;','&#8517;','&#8518;','&#8225;','&#8650;','&#10513;','&#10871;','&#176;','&#176;','&#8711;','&#916;','&#948;','&#10673;','&#10623;','&#120071;','&#120097;','&#10597;','&#8643;','&#8642;','&#180;','&#729;','&#733;','&#96;','&#732;','&#8900;','&#8900;','&#8900;','&#9830;','&#9830;','&#168;','&#8518;','&#989;','&#8946;','&#247;','&#247;','&#247;','&#8903;','&#8903;','&#1026;','&#1106;','&#8990;','&#8973;','&#36;','&#120123;','&#120149;','&#168;','&#729;','&#8412;','&#8784;','&#8785;','&#8784;','&#8760;','&#8724;','&#8865;','&#8966;','&#8751;','&#168;','&#8659;','&#8656;','&#8660;','&#10980;','&#10232;','&#10234;','&#10233;','&#8658;','&#8872;','&#8657;','&#8661;','&#8741;','&#8595;','&#8659;','&#8595;','&#10515;','&#8693;','&#785;','&#8650;','&#8643;','&#8642;','&#10576;','&#10590;','&#8637;','&#10582;','&#10591;','&#8641;','&#10583;','&#8868;','&#8615;','&#10512;','&#8991;','&#8972;','&#119967;','&#119993;','&#1029;','&#1109;','&#10742;','&#272;','&#273;','&#8945;','&#9663;','&#9662;','&#8693;','&#10607;','&#10662;','&#1039;','&#1119;','&#10239;','&#201;','&#201;','&#233;','&#233;','&#10862;','&#282;','&#283;','&#8790;','&#202;','&#202;','&#234;','&#234;','&#8789;','&#1069;','&#1101;','&#10871;','&#278;','&#8785;','&#279;','&#8519;','&#8786;','&#120072;','&#120098;','&#10906;','&#200;','&#200;','&#232;','&#232;','&#10902;','&#10904;','&#10905;','&#8712;','&#9191;','&#8467;','&#10901;','&#10903;','&#274;','&#275;','&#8709;','&#8709;','&#9723;','&#8709;','&#9643;','&#8195;','&#8196;','&#8197;','&#330;','&#331;','&#8194;','&#280;','&#281;','&#120124;','&#120150;','&#8917;','&#10723;','&#10865;','&#949;','&#917;','&#949;','&#1013;','&#8790;','&#8789;','&#8770;','&#10902;','&#10901;','&#10869;','&#61;','&#8770;','&#8799;','&#8652;','&#8801;','&#10872;','&#10725;','&#10609;','&#8787;','&#8496;','&#8495;','&#8784;','&#10867;','&#8770;','&#919;','&#951;','&#208;','&#208;','&#240;','&#240;','&#203;','&#203;','&#235;','&#235;','&#8364;','&#33;','&#8707;','&#8707;','&#8496;','&#8519;','&#8519;','&#8786;','&#1060;','&#1092;','&#9792;','&#64259;','&#64256;','&#64260;','&#120073;','&#120099;','&#64257;','&#9724;','&#9642;','&#102; &#106;','&#9837;','&#64258;','&#9649;','&#402;','&#120125;','&#120151;','&#8704;','&#8704;','&#8916;','&#10969;','&#8497;'))
  unicodes = append(unicodes, c('&#10765;','&#189;','&#189;','&#8531;','&#188;','&#188;','&#8533;','&#8537;','&#8539;','&#8532;','&#8534;','&#190;','&#190;','&#8535;','&#8540;','&#8536;','&#8538;','&#8541;','&#8542;','&#8260;','&#8994;','&#8497;','&#119995;','&#501;','&#915;','&#947;','&#988;','&#989;','&#10886;','&#286;','&#287;','&#290;','&#284;','&#285;','&#1043;','&#1075;','&#288;','&#289;','&#8807;','&#8805;','&#10892;','&#8923;','&#8805;','&#8807;','&#10878;','&#10878;','&#10921;','&#10880;','&#10882;','&#10884;','&#8923; &#65024;','&#10900;','&#120074;','&#120100;','&#8921;','&#8811;','&#8921;','&#8503;','&#1027;','&#1107;','&#8823;','&#10917;','&#10898;','&#10916;','&#10890;','&#10890;','&#8809;','&#10888;','&#10888;','&#8809;','&#8935;','&#120126;','&#120152;','&#96;','&#8805;','&#8923;','&#8807;','&#10914;','&#8823;','&#10878;','&#8819;','&#119970;','&#8458;','&#8819;','&#10894;','&#10896;','&#62;','&#62;','&#8811;','&#62;','&#62;','&#10919;','&#10874;','&#8919;','&#10645;','&#10876;','&#10886;','&#10616;','&#8919;','&#8923;','&#10892;','&#8823;','&#8819;','&#8809; &#65024;','&#8809; &#65024;','&#711;','&#8202;','&#189;','&#8459;','&#1066;','&#1098;','&#8660;','&#8596;','&#10568;','&#8621;','&#94;','&#8463;','&#292;','&#293;','&#9829;','&#9829;','&#8230;','&#8889;','&#8460;','&#120101;','&#8459;','&#10533;','&#10534;','&#8703;','&#8763;','&#8617;','&#8618;','&#8461;','&#120153;','&#8213;','&#9472;','&#8459;','&#119997;','&#8463;','&#294;','&#295;','&#8782;','&#8783;','&#8259;','&#8208;','&#205;','&#205;','&#237;','&#237;','&#8291;','&#206;','&#206;','&#238;','&#238;','&#1048;','&#1080;','&#304;','&#1045;','&#1077;','&#161;','&#161;','&#8660;','&#8465;','&#120102;','&#204;','&#204;','&#236;','&#236;','&#8520;','&#10764;','&#8749;','&#10716;','&#8489;','&#306;','&#307;','&#8465;','&#298;','&#299;','&#8465;','&#8520;','&#8464;','&#8465;','&#305;','&#8887;','&#437;','&#8658;','&#8712;','&#8453;','&#8734;','&#10717;','&#305;','&#8748;','&#8747;','&#8890;','&#8484;','&#8747;','&#8890;','&#8898;','&#10775;','&#10812;','&#8291;','&#8290;','&#1025;','&#1105;','&#302;','&#303;','&#120128;','&#120154;','&#921;','&#953;','&#10812;','&#191;','&#191;','&#8464;','&#119998;','&#8712;','&#8949;','&#8953;','&#8948;','&#8947;','&#8712;','&#8290;','&#296;','&#297;','&#1030;','&#1110;','&#207;','&#207;','&#239;','&#239;','&#308;','&#309;','&#1049;','&#1081;','&#120077;','&#120103;','&#567;','&#120129;','&#120155;','&#119973;','&#119999;','&#1032;','&#1112;','&#1028;','&#1108;','&#922;','&#954;','&#1008;','&#310;','&#311;','&#1050;','&#1082;','&#120078;','&#120104;','&#312;','&#1061;','&#1093;','&#1036;','&#1116;','&#120130;','&#120156;','&#119974;','&#120000;','&#8666;','&#313;','&#314;','&#10676;','&#8466;','&#923;','&#955;','&#10218;','&#10216;','&#10641;','&#10216;','&#10885;','&#8466;','&#171;','&#171;','&#8606;','&#8656;','&#8592;','&#8676;','&#10527;','&#10525;','&#8617;','&#8619;','&#10553;','&#10611;','&#8610;','&#10923;','&#10523;','&#10521;','&#10925;','&#10925; &#65024;','&#10510;','&#10508;','&#10098;','&#123;','&#91;','&#10635;'))
  unicodes = append(unicodes, c('&#10639;','&#10637;','&#317;','&#318;','&#315;','&#316;','&#8968;','&#123;','&#1051;','&#1083;','&#10550;','&#8220;','&#8222;','&#10599;','&#10571;','&#8626;','&#8806;','&#8804;','&#10216;','&#8592;','&#8656;','&#8592;','&#8676;','&#8646;','&#8610;','&#8968;','&#10214;','&#10593;','&#8643;','&#10585;','&#8970;','&#8637;','&#8636;','&#8647;','&#8596;','&#8660;','&#8596;','&#8646;','&#8651;','&#8621;','&#10574;','&#8867;','&#8612;','&#10586;','&#8907;','&#8882;','&#10703;','&#8884;','&#10577;','&#10592;','&#8639;','&#10584;','&#8636;','&#10578;','&#10891;','&#8922;','&#8804;','&#8806;','&#10877;','&#10877;','&#10920;','&#10879;','&#10881;','&#10883;','&#8922; &#65024;','&#10899;','&#10885;','&#8918;','&#8922;','&#10891;','&#8922;','&#8806;','&#8822;','&#8822;','&#10913;','&#8818;','&#10877;','&#8818;','&#10620;','&#8970;','&#120079;','&#120105;','&#8822;','&#10897;','&#10594;','&#8637;','&#8636;','&#10602;','&#9604;','&#1033;','&#1113;','&#8920;','&#8810;','&#8647;','&#8990;','&#8666;','&#10603;','&#9722;','&#319;','&#320;','&#9136;','&#9136;','&#10889;','&#10889;','&#8808;','&#10887;','&#10887;','&#8808;','&#8934;','&#10220;','&#8701;','&#10214;','&#10229;','&#10232;','&#10229;','&#10231;','&#10234;','&#10231;','&#10236;','&#10230;','&#10233;','&#10230;','&#8619;','&#8620;','&#10629;','&#120131;','&#120157;','&#10797;','&#10804;','&#8727;','&#95;','&#8601;','&#8600;','&#9674;','&#9674;','&#10731;','&#40;','&#10643;','&#8646;','&#8991;','&#8651;','&#10605;','&#8206;','&#8895;','&#8249;','&#8466;','&#120001;','&#8624;','&#8624;','&#8818;','&#10893;','&#10895;','&#91;','&#8216;','&#8218;','&#321;','&#322;','&#60;','&#60;','&#8810;','&#60;','&#60;','&#10918;','&#10873;','&#8918;','&#8907;','&#8905;','&#10614;','&#10875;','&#9667;','&#8884;','&#9666;','&#10646;','&#10570;','&#10598;','&#8808; &#65024;','&#8808; &#65024;','&#175;','&#175;','&#9794;','&#10016;','&#10016;','&#10501;','&#8614;','&#8614;','&#8615;','&#8612;','&#8613;','&#9646;','&#10793;','&#1052;','&#1084;','&#8212;','&#8762;','&#8737;','&#8287;','&#8499;','&#120080;','&#120106;','&#8487;','&#181;','&#181;','&#8739;','&#42;','&#10992;','&#183;','&#183;','&#8722;','&#8863;','&#8760;','&#10794;','&#8723;','&#10971;','&#8230;','&#8723;','&#8871;','&#120132;','&#120158;','&#8723;','&#8499;','&#120002;','&#8766;','&#924;','&#956;','&#8888;','&#8888;','&#8711;','&#323;','&#324;','&#8736; &#8402;','&#8777;','&#10864; &#824;','&#8779; &#824;','&#329;','&#8777;','&#9838;','&#9838;','&#8469;','&#160;','&#160;','&#8782; &#824;','&#8782; &#824;','&#10819;','&#327;','&#328;','&#325;','&#326;','&#8775;','&#10861; &#824;','&#10818;','&#1053;','&#1085;','&#8211;','&#8800;','&#10532;','&#8663;','&#8599;','&#8599;','&#8784; &#824;','&#8203;','&#8203;','&#8203;','&#8203;','&#8802;','&#10536;','&#8770; &#824;','&#8811;','&#8810;','&#10;','&#8708;','&#8708;','&#120081;','&#120107;','&#8807; &#824;','&#8817;','&#8817;','&#8807; &#824;','&#10878; &#824;','&#10878; &#824;','&#8921; &#824;','&#8821;','&#8811; &#8402;','&#8815;','&#8815;','&#8811; &#824;','&#8654;','&#8622;','&#10994;','&#8715;','&#8956;','&#8954;','&#8715;','&#1034;','&#1114;','&#8653;','&#8602;','&#8229;','&#8806; &#824;','&#8816;','&#8653;'))
  unicodes = append(unicodes, c('&#8602;','&#8654;','&#8622;','&#8816;','&#8806; &#824;','&#10877; &#824;','&#10877; &#824;','&#8814;','&#8920; &#824;','&#8820;','&#8810; &#8402;','&#8814;','&#8938;','&#8940;','&#8810; &#824;','&#8740;','&#8288;','&#160;','&#8469;','&#120159;','&#10988;','&#172;','&#172;','&#8802;','&#8813;','&#8742;','&#8713;','&#8800;','&#8770; &#824;','&#8708;','&#8815;','&#8817;','&#8807; &#824;','&#8811; &#824;','&#8825;','&#10878; &#824;','&#8821;','&#8782; &#824;','&#8783; &#824;','&#8713;','&#8949; &#824;','&#8953; &#824;','&#8713;','&#8951;','&#8950;','&#8938;','&#10703; &#824;','&#8940;','&#8814;','&#8816;','&#8824;','&#8810; &#824;','&#10877; &#824;','&#8820;','&#10914; &#824;','&#10913; &#824;','&#8716;','&#8716;','&#8958;','&#8957;','&#8832;','&#10927; &#824;','&#8928;','&#8716;','&#8939;','&#10704; &#824;','&#8941;','&#8847; &#824;','&#8930;','&#8848; &#824;','&#8931;','&#8834; &#8402;','&#8840;','&#8833;','&#10928; &#824;','&#8929;','&#8831; &#824;','&#8835; &#8402;','&#8841;','&#8769;','&#8772;','&#8775;','&#8777;','&#8740;','&#8742;','&#8742;','&#11005; &#8421;','&#8706; &#824;','&#10772;','&#8832;','&#8928;','&#10927; &#824;','&#8832;','&#10927; &#824;','&#8655;','&#8603;','&#10547; &#824;','&#8605; &#824;','&#8655;','&#8603;','&#8939;','&#8941;','&#8833;','&#8929;','&#10928; &#824;','&#119977;','&#120003;','&#8740;','&#8742;','&#8769;','&#8772;','&#8772;','&#8740;','&#8742;','&#8930;','&#8931;','&#8836;','&#10949; &#824;','&#8840;','&#8834; &#8402;','&#8840;','&#10949; &#824;','&#8833;','&#10928; &#824;','&#8837;','&#10950; &#824;','&#8841;','&#8835; &#8402;','&#8841;','&#10950; &#824;','&#8825;','&#209;','&#209;','&#241;','&#241;','&#8824;','&#8938;','&#8940;','&#8939;','&#8941;','&#925;','&#957;','&#35;','&#8470;','&#8199;','&#8781; &#8402;','&#8879;','&#8878;','&#8877;','&#8876;','&#8805; &#8402;','&#62; &#8402;','&#10500;','&#10718;','&#10498;','&#8804; &#8402;','&#60; &#8402;','&#8884; &#8402;','&#10499;','&#8885; &#8402;','&#8764; &#8402;','&#10531;','&#8662;','&#8598;','&#8598;','&#10535;','&#211;','&#211;','&#243;','&#243;','&#8859;','&#8858;','&#212;','&#212;','&#244;','&#244;','&#1054;','&#1086;','&#8861;','&#336;','&#337;','&#10808;','&#8857;','&#10684;','&#338;','&#339;','&#10687;','&#120082;','&#120108;','&#731;','&#210;','&#210;','&#242;','&#242;','&#10689;','&#10677;','&#937;','&#8750;','&#8634;','&#10686;','&#10683;','&#8254;','&#10688;','&#332;','&#333;','&#937;','&#969;','&#927;','&#959;','&#10678;','&#8854;','&#120134;','&#120160;','&#10679;','&#8220;','&#8216;','&#10681;','&#8853;','&#10836;','&#8744;','&#8635;','&#10845;','&#8500;','&#8500;','&#170;','&#170;','&#186;','&#186;','&#8886;','&#10838;','&#10839;','&#10843;','&#9416;','&#119978;','&#8500;','&#216;','&#216;','&#248;','&#248;','&#8856;','&#213;','&#213;','&#245;','&#245;','&#10807;','&#8855;','&#10806;','&#214;','&#214;','&#246;','&#246;','&#9021;','&#8254;','&#9182;','&#9140;','&#9180;','&#8741;','&#182;','&#182;','&#8741;','&#10995;','&#11005;','&#8706;','&#8706;','&#1055;','&#1087;','&#37;','&#46;','&#8240;','&#8869;','&#8241;','&#120083;','&#120109;','&#934;','&#966;','&#981;','&#8499;','&#9742;','&#928;','&#960;','&#8916;','&#982;','&#8463;','&#8462;','&#8463;','&#43;','&#10787;','&#8862;','&#10786;','&#8724;','&#10789;','&#10866;','&#177;','&#177;','&#177;','&#10790;','&#10791;','&#177;','&#8460;','&#10773;'))
  unicodes = append(unicodes, c('&#8473;','&#120161;','&#163;','&#163;','&#10939;','&#8826;','&#10935;','&#8828;','&#10931;','&#10927;','&#8826;','&#10935;','&#8828;','&#8826;','&#10927;','&#8828;','&#8830;','&#10927;','&#10937;','&#10933;','&#8936;','&#8830;','&#8243;','&#8242;','&#8473;','&#10937;','&#10933;','&#8936;','&#8719;','&#8719;','&#9006;','&#8978;','&#8979;','&#8733;','&#8759;','&#8733;','&#8733;','&#8830;','&#8880;','&#119979;','&#120005;','&#936;','&#968;','&#8200;','&#120084;','&#120110;','&#10764;','&#8474;','&#120162;','&#8279;','&#119980;','&#120006;','&#8461;','&#10774;','&#63;','&#8799;','&#34;','&#34;','&#8667;','&#8765; &#817;','&#340;','&#341;','&#8730;','&#10675;','&#10219;','&#10217;','&#10642;','&#10661;','&#10217;','&#187;','&#187;','&#8608;','&#8658;','&#8594;','&#10613;','&#8677;','&#10528;','&#10547;','&#10526;','&#8618;','&#8620;','&#10565;','&#10612;','&#10518;','&#8611;','&#8605;','&#10524;','&#10522;','&#8758;','&#8474;','&#10512;','&#10511;','&#10509;','&#10099;','&#125;','&#93;','&#10636;','&#10638;','&#10640;','&#344;','&#345;','&#342;','&#343;','&#8969;','&#125;','&#1056;','&#1088;','&#10551;','&#10601;','&#8221;','&#8221;','&#8627;','&#8476;','&#8476;','&#8475;','&#8476;','&#8477;','&#9645;','&#174;','&#174;','&#174;','&#174;','&#8715;','&#8651;','&#10607;','&#10621;','&#8971;','&#8476;','&#120111;','&#10596;','&#8641;','&#8640;','&#10604;','&#929;','&#961;','&#1009;','&#10217;','&#8594;','&#8658;','&#8594;','&#8677;','&#8644;','&#8611;','&#8969;','&#10215;','&#10589;','&#8642;','&#10581;','&#8971;','&#8641;','&#8640;','&#8644;','&#8652;','&#8649;','&#8605;','&#8866;','&#8614;','&#10587;','&#8908;','&#8883;','&#10704;','&#8885;','&#10575;','&#10588;','&#8638;','&#10580;','&#8640;','&#10579;','&#730;','&#8787;','&#8644;','&#8652;','&#8207;','&#9137;','&#9137;','&#10990;','&#10221;','&#8702;','&#10215;','&#10630;','&#8477;','&#120163;','&#10798;','&#10805;','&#10608;','&#41;','&#10644;','&#10770;','&#8649;','&#8667;','&#8250;','&#8475;','&#120007;','&#8625;','&#8625;','&#93;','&#8217;','&#8217;','&#8908;','&#8906;','&#9657;','&#8885;','&#9656;','&#10702;','&#10740;','&#10600;','&#8478;','&#346;','&#347;','&#8218;','&#10940;','&#8827;','&#10936;','&#352;','&#353;','&#8829;','&#10932;','&#10928;','&#350;','&#351;','&#348;','&#349;','&#10938;','&#10934;','&#8937;','&#10771;','&#8831;','&#1057;','&#1089;','&#8901;','&#8865;','&#10854;','&#10533;','&#8664;','&#8600;','&#8600;','&#167;','&#167;','&#59;','&#10537;','&#8726;','&#8726;','&#10038;','&#120086;','&#120112;','&#8994;','&#9839;','&#1065;','&#1097;','&#1064;','&#1096;','&#8595;','&#8592;','&#8739;','&#8741;','&#8594;','&#8593;','&#173;','&#173;','&#931;','&#963;','&#962;','&#962;','&#8764;','&#10858;','&#8771;','&#8771;','&#10910;','&#10912;','&#10909;','&#10911;','&#8774;','&#10788;','&#10610;','&#8592;','&#8728;','&#8726;','&#10803;','&#10724;','&#8739;','&#8995;','&#10922;','&#10924;','&#10924; &#65024;','&#1068;','&#1100;','&#47;','&#10692;','&#9023;','&#120138;','&#120164;','&#9824;','&#9824;','&#8741;','&#8851;','&#8851; &#65024;','&#8852;','&#8852; &#65024;','&#8730;','&#8847;'))
  unicodes = append(unicodes, c('&#8849;','&#8847;','&#8849;','&#8848;','&#8850;','&#8848;','&#8850;','&#9633;','&#9633;','&#9633;','&#8851;','&#8847;','&#8849;','&#8848;','&#8850;','&#8852;','&#9642;','&#9642;','&#8594;','&#119982;','&#120008;','&#8726;','&#8995;','&#8902;','&#8902;','&#9734;','&#9733;','&#1013;','&#981;','&#175;','&#8912;','&#8834;','&#10941;','&#10949;','&#8838;','&#10947;','&#10945;','&#10955;','&#8842;','&#10943;','&#10617;','&#8912;','&#8834;','&#8838;','&#10949;','&#8838;','&#8842;','&#10955;','&#10951;','&#10965;','&#10963;','&#8827;','&#10936;','&#8829;','&#8827;','&#10928;','&#8829;','&#8831;','&#10928;','&#10938;','&#10934;','&#8937;','&#8831;','&#8715;','&#8721;','&#8721;','&#9834;','&#8913;','&#8835;','&#185;','&#185;','&#178;','&#178;','&#179;','&#179;','&#10942;','&#10968;','&#10950;','&#8839;','&#10948;','&#8835;','&#8839;','&#10185;','&#10967;','&#10619;','&#10946;','&#10956;','&#8843;','&#10944;','&#8913;','&#8835;','&#8839;','&#10950;','&#8843;','&#10956;','&#10952;','&#10964;','&#10966;','&#10534;','&#8665;','&#8601;','&#8601;','&#10538;','&#223;','&#223;','&#9;','&#8982;','&#932;','&#964;','&#9140;','&#356;','&#357;','&#354;','&#355;','&#1058;','&#1090;','&#8411;','&#8981;','&#120087;','&#120113;','&#8756;','&#8756;','&#8756;','&#920;','&#952;','&#977;','&#977;','&#8776;','&#8764;','&#8287; &#8202;','&#8201;','&#8201;','&#8776;','&#8764;','&#222;','&#222;','&#254;','&#254;','&#8764;','&#732;','&#8771;','&#8773;','&#8776;','&#215;','&#215;','&#8864;','&#10801;','&#10800;','&#8749;','&#10536;','&#8868;','&#9014;','&#10993;','&#120139;','&#120165;','&#10970;','&#10537;','&#8244;','&#8482;','&#8482;','&#9653;','&#9663;','&#9667;','&#8884;','&#8796;','&#9657;','&#8885;','&#9708;','&#8796;','&#10810;','&#8411;','&#10809;','&#10701;','&#10811;','&#9186;','&#119983;','&#120009;','&#1062;','&#1094;','&#1035;','&#1115;','&#358;','&#359;','&#8812;','&#8606;','&#8608;','&#218;','&#218;','&#250;','&#250;','&#8607;','&#8657;','&#8593;','&#10569;','&#1038;','&#1118;','&#364;','&#365;','&#219;','&#219;','&#251;','&#251;','&#1059;','&#1091;','&#8645;','&#368;','&#369;','&#10606;','&#10622;','&#120088;','&#120114;','&#217;','&#217;','&#249;','&#249;','&#10595;','&#8639;','&#8638;','&#9600;','&#8988;','&#8988;','&#8975;','&#9720;','&#362;','&#363;','&#168;','&#168;','&#95;','&#9183;','&#9141;','&#9181;','&#8899;','&#8846;','&#370;','&#371;','&#120140;','&#120166;','&#8593;','&#8657;','&#8593;','&#10514;','&#8645;','&#8597;','&#8661;','&#8597;','&#10606;','&#8639;','&#8638;','&#8846;','&#8598;','&#8599;','&#978;','&#965;','&#978;','&#933;','&#965;','&#8869;','&#8613;','&#8648;','&#8989;','&#8989;','&#8974;','&#366;','&#367;','&#9721;','&#119984;','&#120010;','&#8944;','&#360;','&#361;','&#9653;','&#9652;','&#8648;','&#220;','&#220;','&#252;','&#252;','&#10663;','&#10652;','&#1013;','&#1008;','&#8709;','&#981;','&#982;','&#8733;','&#8661;','&#8597;','&#1009;','&#962;','&#8842; &#8202;','&#10955; &#8202;','&#8843; &#8202;','&#10956; &#8202;','&#977;','&#8882;','&#8883;','&#10987;','&#10984;','&#10985;','&#1042;'))
  unicodes = append(unicodes, c('&#1074;','&#8875;','&#8873;','&#8872;','&#8866;','&#10982;','&#8897;','&#8744;','&#8891;','&#8794;','&#8942;','&#8214;','&#124;','&#8214;','&#124;','&#8739;','&#124;','&#10072;','&#8768;','&#8202;','&#120089;','&#120115;','&#8882;','&#8834; &#8402;','&#8835; &#8402;','&#120141;','&#120167;','&#8733;','&#8883;','&#119985;','&#120011;','&#10955; &#65024;','&#8842; &#65024;','&#10956; &#65024;','&#8843; &#65024;','&#8874;','&#10650;','&#372;','&#373;','&#10847;','&#8896;','&#8743;','&#8793;','&#8472;','&#120090;','&#120116;','&#120142;','&#120168;','&#8472;','&#8768;','&#8768;','&#119986;','&#120012;','&#8898;','&#9711;','&#8899;','&#9661;','&#120091;','&#120117;','&#10234;','&#10231;','&#926;','&#958;','&#10232;','&#10229;','&#10236;','&#8955;','&#10752;','&#120143;','&#120169;','&#10753;','&#10754;','&#10233;','&#10230;','&#119987;','&#120013;','&#10758;','&#10756;','&#9651;','&#8897;','&#8896;','&#221;','&#221;','&#253;','&#253;','&#1071;','&#1103;','&#374;','&#375;','&#1067;','&#1099;','&#165;','&#165;','&#120092;','&#120118;','&#1031;','&#1111;','&#120144;','&#120170;','&#119988;','&#120014;','&#1070;','&#1102;','&#376;','&#255;','&#255;','&#377;','&#378;','&#381;','&#382;','&#1047;','&#1079;','&#379;','&#380;','&#8488;','&#8203;','&#918;','&#950;','&#8488;','&#120119;','&#1046;','&#1078;','&#8669;','&#8484;','&#120171;','&#119989;','&#120015;','&#8205;','&#8204;'))
  hash = new.env()
  sapply(seq_along(entities), function(i) assign(entities[i], unicodes[i], hash))
  remove(entities, unicodes)
  htm = gsubfun(htm, '&[A-z]+[1-8]*;?', function(x) {
    for (i in nchar(x):3) {y = substr(x, 1, i); if (exists(y, hash, inherits = FALSE)) return(paste(get(y, hash, inherits = FALSE), substr(x, i + 1, nchar(x)), sep = ''));}
    return(x)
  })
  htm = gsubfun(htm, '&#[Xx][[:xdigit:]]+;', function(x) paste('&#', strtoi(substr(x, 4, nchar(x) - 1), base = 16), ';', sep = ''))
  htm = gsubfun(htm, '&#[0-9]+;', function(x) {
    i = as.integer(substr(x, 3, nchar(x) - 1))
    if (i < 32) i = c(9688,8968,8969,8970,8971,124,45,8729,9688,9,10,11,12,13,9836,9728,10186,9664,8597,8252,183,8869,8868,8867,8593,8866,8594,8592,8970,8596,9650,9660)[i + 1]
    if (i > 126 & i < 161) i = c(0,8364,129,44,402,8222,8230,8224,8225,710,8240,352,8249,339,141,381,143,144,8216,8217,8220,8221,8226,8211,8212,732,8482,353,8250,339,157,382,376,32)[i - 126]
    return(intToUtf8(i))
  })
  htm = gsub('[[:space:]]*\n\n[[:space:]]*', '\n\n', gsub('[ \t]*\n *', '\n', gsub('^[[:space:]]*|[[:space:]]*$', '', gsub(' {2,}', ' ', gsub('[[:blank:]]*\t[[:blank:]]*', '\t', htm)))))
  htm = gsub('<[/A-z!]+[^<>]*>', '', htm)
  return(htm)
}

#' Extract simple plain texts from a web page at a certain URL
#'
#' @param URL A character indicating the URL of a web page.
#' @param encoding Encoding method (e.g., "UTF-8", "latin1", "bytes", "unknown", etc.).
#' @param ... Other \code{\link{htm2txt}} arguments.
#' @return A character containing plain texts converted from the htm document at the URL.
#' @examples
#' text = gettxt("https://www.wikipedia.org/")
#' @export
gettxt <- function(URL, encoding = "UTF-8", ...) return(htm2txt(paste(readLines(URL, warn = FALSE, encoding = encoding), sep = '', collapse = ' '), ...))

#' Display simple plain texts in a web page at a certain URL
#'
#' @param URL A character indicating the URL of a web page.
#' @param ... Other \code{\link{gettxt}} arguments.
#' @return None (invisible NULL).
#' @examples browse("https://www.wikipedia.org/")
#' @export
browse <- function(URL, ...) cat(gettxt(URL, ...))

Try the htm2txt package in your browser

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

htm2txt documentation built on June 12, 2022, 5:09 p.m.