diffobj/0000755000176200001440000000000015001401012011635 5ustar liggesusersdiffobj/tests/0000755000176200001440000000000015001306424013012 5ustar liggesusersdiffobj/tests/_helper/0000755000176200001440000000000015000460760014433 5ustar liggesusersdiffobj/tests/_helper/tools.R0000644000176200001440000000065214122754044015726 0ustar liggesusers# Mock a function by tracing it's guts out. Untrace to unmock. # Quick and dirty, not thoroughly tested. mock <- function(f, tracer, where=f, print=FALSE) { editor <- function(name, file, title) {body(name) <- tracer; name} old.edit <- options(editor=editor) on.exit(options(old.edit)) invisible( eval( bquote(trace(.(substitute(f)), edit=TRUE, print=FALSE, where=.(where))), parent.frame() ) ) } diffobj/tests/_helper/check.R0000644000176200001440000000265115000460760015637 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # This file is part of "aammrtf - An Almost Most Minimal R Test Framework" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 or 3 of the License. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. flist <- function(x, y) paste0(x, paste0("'", basename(y), "'", collapse=", ")) report <- function(x) {writeLines(character(13)); stop(x, call.=FALSE)} test.out <- list.files(pattern="\\.Rout$") non.ascii <- which(lengths(lapply(test.out, tools::showNonASCIIfile)) > 0) if(length(non.ascii)) warning(flist("Some outputs contain non-ASCII:\n", test.out[non.ascii])) tar <- list.files(pattern='\\.Rout\\.save$', full.names=TRUE) cur <- file.path(dirname(tar), sub('\\.save$', '', basename(tar))) awol <- !file.exists(cur) if(any(awol)) report(flist(".Rout files missing (failed?):\n", cur[awol])) diff.dat <- Map(tools::Rdiff, tar[!awol], cur[!awol], useDiff=TRUE, Log=TRUE) diffs <- vapply(diff.dat, '[[', 1, 'status') if(any(!!diffs)) report(flist("Test output differences:\n", cur[!!diffs])) diffobj/tests/_helper/init.R0000644000176200001440000000236014122754044015527 0ustar liggesusers# Tests intended to be run with tools:::.runPackageTests() (i.e. R CMD check) # Note, need to be loose with the directory check if(nzchar(Sys.getenv('NOT_CRAN'))) stopifnot(grepl('tests', basename(getwd())), exists("NAME")) rdsf <- function(x) readRDS(file.path("_helper", "objs", NAME, sprintf("%s.rds", x))) txtf <- function(x) readLines(file.path("_helper", "objs", NAME, sprintf("%s.txt", x))) srdsf <- function(x, i) saveRDS(x, file.path("_helper", "objs", NAME, sprintf("%s.rds", i)), version=2) stxtf <- function(x, i) writeLines(x, file.path("_helper", "objs", NAME, sprintf("%s.txt", i))) library(diffobj) all.opts <- c( list( useFancyQuotes=FALSE, # all.equals uses fancy quotes diffobj.format="ansi8", # force ANSI colors diffobj.color.mode="yb",# force yb diffobj.pager="off", # run tests without pager width=80L, encoding="UTF-8", # so Gabor's name renders properly on win... warnPartialMatchArgs=TRUE, warnPartialMatchAttr=TRUE, warnPartialMatchDollar=TRUE ) ) options(c(diffobj_set_def_opts(), all.opts)) # tests predate 3.5. if(R.version$major >= 4 || R.version$major >= 3 && R.version$minor >= "5.0") suppressWarnings(RNGversion("3.5.2")); source("_helper/commonobjects.R") diffobj/tests/_helper/objs/0000755000176200001440000000000015001306424015365 5ustar liggesusersdiffobj/tests/_helper/objs/diffDeparse/0000755000176200001440000000000014122754044017611 5ustar liggesusersdiffobj/tests/_helper/objs/diffDeparse/100.rds0000644000176200001440000000050314122754044020621 0ustar liggesusers[K0EAݗ'J0zݼlM}YoknMcR8'ITDŽ-KXrBM">!*''Ԝ^QD͖xtwx_0 J/02w沞3g~N͒f^֦{jfM3FyA^W5yCɸïw;AsR2P%{IȄ| '|mj_4jl>tLd@Ind鑠9Ydr#Y&C<$+d<>z<K]9^mQC[>diffobj/tests/_helper/objs/diffDeparse/200.rds0000644000176200001440000000052714122754044020630 0ustar liggesusersN0ENĞMH]UP6@ PԸ@osb[fa{n\&"A$d9 h磱BANXZGa1||ʙ *>>elO6O~Kk{iRe}\;ǎ¼ O!-p3<₱E͜E˅zxxxijN5=^D\B\F\۬|W@%b3kUT^C7w7-v|XA/F;{ǬTAECu-*?kTty%1>J[('q uӈJra+odiffobj/tests/_helper/objs/summary/0000755000176200001440000000000014122754044017072 5ustar liggesusersdiffobj/tests/_helper/objs/summary/600.rds0000644000176200001440000000034714122754044020115 0ustar liggesusersM 0 c'TS; x[[bۧo U6ԡz&AG8tHFgAo'S&RѝaD)]O,(ÄdzR\B0 4a*`l{6937 {.5\O{ӫv$[rgG鏞gM?S oe5`"xWh&x8Q\h#>iHjB%M$S#t@L%*lPKAF0徏q{% 꼼˗ܠZz.IP ©F@%y.6juZoIV@y<AFkևyVL_T{3kupybڢ岾. HZDH5e5^ 1h"T,biD(F dj{mZSpyhԢ($q `eW'ِ͌Jc5'͋͐Od~אt+=rLt=+K|'ll"-owx*۫f]f$J\ža'V3vfbp<WĴi?DU$KDarBiN,m҄Ϙ2b",ksmhw,+m/VWH(#=W}xv`55CsgXjJ^ު_>K+jƅ3D*K"S._LAzSbxǀejE uAĭ6yH3 jieRa7nY>TeVދ6fjxdC76Rӵy%^KvBw~hA[WaF_&8Ss+ozxj&V$ėz֍޸$uoj]N]{Y?ZsT1iF]׸oU1ğzKqr:3LXicLuƩy٥t[Ԇuw'"m=, 9wuO)w_`6zb >A8cW@9%%fl\h*$&I3֝4QX N7~|skuN)e4?sugg>LP=jf_"{W} ;R5M{Uf+e=}|zbL0"2Ȳdiffobj/tests/_helper/objs/summary/100.rds0000644000176200001440000000032114122754044020100 0ustar liggesusersM 0 c7 w/9*p; x[];ԉA=4y4_ <'l:CEd]msdnp wY]yGoO9dzdiffobj/tests/_helper/objs/summary/450.rds0000644000176200001440000000013014122754044020106 0ustar liggesusersb```b`fbb`b1# 'OJM.)VH,JUHHK-,MIjbaBRȜxB@.xYZdiffobj/tests/_helper/objs/summary/700.rds0000644000176200001440000000051514122754044020113 0ustar liggesusersVAO0~]FĻwt1[q^Lz2D!PnM |m_XB%W01~L7*@!e|(:36]6MZJixk?uױTbc~G^bBq1Lꍑ|r.}imQ^erjru¸*Tƍ].wcg1"82]UVMC0Щ;z(KMyaG 5!礞3WBh7zmsΛ]n |23FVLI7j diffobj/tests/_helper/objs/summary/100.txt0000644000176200001440000000021014122754044020124 0ustar liggesusers Found differences in 1 hunk: 1 insertion, 1 deletion, 0 matches (lines) Diff map (line:char scale is 1:1 for single chars, ): DI diffobj/tests/_helper/objs/summary/500.rds0000644000176200001440000000041714122754044020112 0ustar liggesusersRMo0 R#]| P=II֥m:Sa -Rَ@(}^]Ɵ<TɡO0;ح 5Gޔ 1xńr:IE3{΍%7zb~0΢ ]tSLK0WYi6}ڹA~gŊE<b:&} ϖ 1O(!F;Yod!qA,Uzǿ:!۴O{ry~}1$1D diffobj/tests/_helper/objs/summary/300.rds0000644000176200001440000000032114122754044020102 0ustar liggesusersO @ŧU.1!D;YAIt%]կ)Dμٷ0G !@8\p 3nK;a2)YC,:sDܲԴ6v.FX%mZu YOʘ^EҠMP[#6g&e3anUJNAP\wջ çT'R+ skId͟`Vdiffobj/tests/_helper/objs/summary/200.rds0000644000176200001440000000030314122754044020101 0ustar liggesusersՒ 0 c7 w/9*P&;7<-sŶu{}1uϰCK.DB\r@ 3 yjzWbZryֽQ{j;8 $C?6F;)3^1}BQ v7&v|0KO gwk،юPy_%Ȑ2 ) cx[Pdiffobj/tests/_helper/objs/summary/800.rds0000644000176200001440000000045314122754044020115 0ustar liggesusersSMO0 5.!q#ԭle:!,j]hZG8NL &qNo# Bo:GѵmM,KPLbZq9gQHk9X]EW|LICnE+NJri62 =#yztKOn쯞trz\KṯxW/sG|<ǎ:x٪'ue0cp1/mqS0gg;#\k2l+Wg,[<[yLFh@rA~^~qLdiffobj/tests/_helper/objs/summary/400.rds0000644000176200001440000000023614122754044020110 0ustar liggesusersMN0 4I"! V.tegaal)&%>a:1wS @ B:2?%o;Gr@*& [ LSIpWai^RX.d=~u@_#Nۚ2k(2{NRdiffobj/tests/_helper/objs/style/0000755000176200001440000000000014122754044016535 5ustar liggesusersdiffobj/tests/_helper/objs/style/100.rds0000644000176200001440000000157214122754044017554 0ustar liggesusersX͎0]ZN\8q  %v']qFzX.,VGx8p#3qMTԉ3nEQ4fhv m]=~8y[_b~(Uݎ_{zXS /Uj(AV/s Vh"Җ -t}ψ;P7O:Ӫ62$nSpWԇH-ŶozZ؅lR?KUȂ#(< 3h3[ =ж/L. ѷA.4ÙdR7G@gU,bÈcRC]K5diffobj/tests/_helper/objs/style/500.rds0000644000176200001440000000055114122754044017554 0ustar liggesusersN@e{\i X1xWAUz^7>ofA$Bbɜ3۶>!mY²rJEF=R՜.Jf9a*+8tVד28E5aTkV ߤx\Ό[z߁rHӜH[n./)}Fayf/ X0%X0"0#0.X05X0n 0b0a(0cha܃a*3jF9G0cx38g0x3+qa#3DҌ1ñ㨩t+7*6diffobj/tests/_helper/objs/style/300.rds0000644000176200001440000000271214122754044017553 0ustar liggesusersYnDvY^t$$`QHIWE -TbUI&8beo \c#0cq5M53gΜ}߱t:^sa|BitMF,]I2eNW xzQ< sףpB<"H8&}7gCbt@>x t.a/'!~ܮ_6d3C9隧: x=}o!6n8q)O8bh0Ȇ^n)U#sk[zQ~\E@>YjfUͬ|xfn$8+'m~x(>4eVpErԱ+52c:e.̦6{b_K#W9 ۗP͞ϙ"͞WcV<*p$LPO앚e62[2aYz5,sjY4aǯU5zԽlX{nXfcd{1nǚL7ݐtc>YY}Wxיngh{3v3g|8z?Y>W9|nZNV !t6Ǭ^fJoZjŇ ,7<) qeldc{5yo7$ 55XX90rR,dXi0W` eranMOMMfƶx'Uc[$>rU J̈́T>qK`Hats\@2:FU|iH&9 (nдW ݧ= ɿg|"7/LÅYO{ݙUF !e@ݴ{ABd(6/ۢ{5L{x0ev/5KVo?iZϑ \u*vHH;mEۯ^l8.H3JCe7B7VQ&516!fk ?ɻ@Cdiffobj/tests/_helper/objs/style/200.rds0000644000176200001440000000025614122754044017553 0ustar liggesusersb```b`fbb`b1+ 'v66ε `vNjIIjQD $hkW` U5G1upP01VR ݘP=v[䂙`D(&AdC%c%c3.X1BeIR`!PT30Ediffobj/tests/_helper/objs/style/400.rds0000644000176200001440000000046614122754044017560 0ustar liggesusersk0vyUů.$w}V3szoѹxOnln6k.o/oLsrRF^м֊fZf!i3ƍVb*< bjZNMWe-t/Kdiffobj/tests/_helper/objs/trim/0000755000176200001440000000000014122754044016350 5ustar liggesusersdiffobj/tests/_helper/objs/trim/50.rds0000644000176200001440000000024014122754044017302 0ustar liggesusersb```b`f `f`aƹ6@2W62P$$ M<Y@h))ۂK\03021B5CdM\oĆ FsR/Xl `Qdiffobj/tests/_helper/objs/trim/100.rds0000644000176200001440000000052214122754044017361 0ustar liggesusers}K0u>(RuO"2nmIJm/iݗK.?~_B9둾SWf;' = PEaIW+ST"rZ5\ClB `uYJT |BD3.$zۜjToPj/ڿQZSܮͺc"ðȃ9jŒ'T5^fȵ-iP%9„Dwr"`6]dh<7l6ߝ9߮J?-C_cwu htij=lƧ=A!S 7ǥmqdiffobj/tests/_helper/objs/trim/300.rds0000644000176200001440000000047314122754044017370 0ustar liggesuserseMO@ăxЙ7OJ &&CEAJw6)3ݝa62mOPbr<+<*jUmݼa3{$@@D@ $@ AbP@1(`L` 8͉=18B$CHo7ϲfԢڽGfrWr`s 5QOYMLZ*իzS+UՉu>ԧRoE6tn=4 >@ȭ.[YvЅd++. 2diffobj/tests/_helper/objs/trim/200.rds0000644000176200001440000000033414122754044017363 0ustar liggesusers 0 dzu w/}u={#beIMIJAbQ;VlƸ#޿7~(ܩK#H`"B$Ir[szUXbsn EUf&KCZ8Wx 5Nxզdlp%}{5h#LpmfطcfILkW&R?fCdiffobj/tests/_helper/objs/guides/0000755000176200001440000000000014122754044016655 5ustar liggesusersdiffobj/tests/_helper/objs/guides/100.rds0000644000176200001440000000034714122754044017673 0ustar liggesusersA0EBMLܳ0iikhb aB\hzn,ChLd13̼)m/HRҕ;Vsa6jCu؆4>A탩k*u(ڼ`xa}l(\xjtC67hY! "s/z+%y ÷h*^l~_\ {X.{E,^$i[xdiffobj/tests/_helper/objs/guides/200.rds0000644000176200001440000000032114122754044017664 0ustar liggesusersb```b`ffd`b1; 'v66ε `v"&vp%&IhJfrL,uL4X+H! @\K\h X *J0ͲDRh,Jf堆 XB XC65еeu--Ѵaa!VRiB#fP4j&sNj ?^!adiffobj/tests/_helper/objs/diffChr/0000755000176200001440000000000014122754044016742 5ustar liggesusersdiffobj/tests/_helper/objs/diffChr/600.rds0000644000176200001440000000053614122754044017765 0ustar liggesusersK0cEw_,du0@\eV|J۸^|؟.I7c۹!5I.w};BYȶ,dٕy*cCru}q/NmÈu&Qb宁텃,Es(T1{Pf8}"b#X`1'WXP/ QsA9oy!cx8KS w:C0&?#ZDZ>EIQFsi]nF\Zq7!3wen$4&P𼐩Gcb|N.~]y4;B㺏;b j}z~lz%y5,ˉrU2B?diffobj/tests/_helper/objs/diffChr/1400.rds0000644000176200001440000000026014122754044020036 0ustar liggesusersb```b`ffd`b1; 'v66ε `vFNjIID $hkW`jc`c¦a A.X, T@x`3'9X@aы0`QG(z&:QD?d``a59'5H@ h ;diffobj/tests/_helper/objs/diffChr/1200.rds0000644000176200001440000000037214122754044020040 0ustar liggesusersb```b`fbb`b1; 'v66ε `vrF9@I\ XY@!\CS  RCo, rLh"˒]NAbB t?&iHJ32 ,J7$0;2Rsr89xlS*vVVVcg%vO"tQ@Ғ&YP3sR/XVSdiffobj/tests/_helper/objs/diffChr/200.txt0000644000176200001440000000110314122754044017777 0ustar liggesusersNo visible differences between objects, but there are some differences suppressed by `ignore.white.space`, `convert.hz.white.space`, `strip.sgr`, and/or `trim`. Set all those arguments to FALSE to highlight the differences. < a > b @@ 1,3 @@  @@ 1,3 @@  hello world hello world umbrellas umbrellas tomatoes tomatoes diffobj/tests/_helper/objs/diffChr/300.txt0000644000176200001440000000056514122754044020013 0ustar liggesusers< a > b @@ 1,3 @@  @@ 1,3 @@  < hello world > hello world umbrellas umbrellas tomatoes tomatoes diffobj/tests/_helper/objs/diffChr/900.rds0000644000176200001440000000025014122754044017761 0ustar liggesusersb```b`fbb`b1+ 'v66ε `vRD $hkW`VU5G1upP01VR ݘP=!v[䂙TC-_ HRIL$9Ʉ h#<< E?diffobj/tests/_helper/objs/diffChr/100.rds0000644000176200001440000000031014122754044017746 0ustar liggesusersb```b`fbb`b17 'v66ε `!@I\I9:@1\C  U6ACxmi fE#L{buhDHuFAF$s&9N9΄RX<Ƒ$7G200Md̜xB>hydiffobj/tests/_helper/objs/diffChr/1300.rds0000644000176200001440000000031714122754044020040 0ustar liggesusersb```b`ffd`b1' 308HGI\0;YQG!GO"4ɵ+0*I-)I*:8(()nB nK\0,eD`,T*9X4+P͜$B`Q͜dB`Q),F4~DuqE2 DF9y@,W diffobj/tests/_helper/objs/diffChr/400.txt0000644000176200001440000000023114122754044020002 0ustar liggesusers< a > b @@ 1,3 @@ @@ 1,3 @@ < hello world > hello world umbrellas umbrellas tomatoes tomatoes diffobj/tests/_helper/objs/diffChr/100.txt0000644000176200001440000000050314122754044020001 0ustar liggesusersNo visible differences between objects, but there are some differences suppressed by `ignore.white.space`, `convert.hz.white.space`, `strip.sgr`, and/or `trim`. Set all those arguments to FALSE to highlight the differences. < "hello . wo.. > "hello. wo.. @@ 1 @@ @@ 1 @@ hello . world hello. world diffobj/tests/_helper/objs/diffChr/225.rds0000644000176200001440000000022314122754044017761 0ustar liggesusersb```b`fbb`b1|N m(mi뗯PYZZZR\R'ml hڀĢd=*I\U h #4< P<~diffobj/tests/_helper/objs/diffChr/500.rds0000644000176200001440000000051614122754044017762 0ustar liggesusersSK0^T}ɳ?X D#0W6.ŤWҖ1x1M}\!<)u8Dsp2:⿎ 770Q/_D j/)9gV*P|!`G^ YzE a @@ 1,3 @@ @@ 1,3 @@ ~ > z o o o ~ > p o o o < a b c e > A b c e < x w z f ~ < e f g h ~ diffobj/tests/_helper/objs/diffChr/300.rds0000644000176200001440000000324414122754044017761 0ustar liggesusersn#7EݽIg@!A*K@4O֘e |zвZLeZ¶ST|$io!<|| s)i<_rdjo-9HwV0#ZfmN0sגK`ki%tƵ] [aRocJgk}L36$l4 []d%r(fmJ0C̣&˼sw!򾈼Kw%EލȻW$ 3hmDxsDP9-w90l+†ulDޭȻymYm-+6" u f#QEaΉfH4&ʁ8"l!Ɣ7̈RbSfyg.W^.O86zE^׌ bd{&lQ<y"oG:fhy†BOI+a;uOT>{J)=ayͮ&D޶y"o5 Ѻ0l}†BTKB;{(fmD0CXB&"T䝉sw!򾈼KwuH&zfmC0SDYf[Kf6'ִ%†\*Dޡ;y"D:f΂ a {Y E]zx<Q[aL!תaz3W 8'lav{2y"Hw*K=>nMAa&ҚϑcW]v=#q1w6eRE%Q-Uus@KvI0㷷3툼]7y{"o_Cv3,aL!bu[HbX#Ɩ(fhO0wii!"oSmm#vE\퉼}"\末7FĚ2aÌ_&[D)1lm†BMfi?bU5 )609E{}Eޡ;y"L{xlj1dD~)D޵ȻW+3pN0S5I) kdE07"o.^Q[3Y†Bǖ 1Վy"F݊;1Dަy"oG튼szqyBː2aLq\aq92>و(f`.a9b/;\n&ls†b~W~3g.jczUW8y7j0N W fjSi9(f †Oolkg=]uvU7^WxխU7^uu՗ژ"oSm9fmFd l†BK#8V'D90@ 3LDWlYϥƫ׺ĝ mf Yi9 w4'Vc.a V"k> l),ŵYlC3pa/gcB4pz3 ] S#leG튼y"}}`HZa&>=lN֏Sb= | }]diffobj/tests/_helper/objs/diffChr/250.rds0000644000176200001440000000024714122754044017765 0ustar liggesusersb```b`fbb`b1 riChK\|̤T̴ԢԼbԒH!Z:㎊ ,;(gcHؙT-vVbT$- 9 y (a``a59'5H@Y}UMdiffobj/tests/_helper/objs/diffChr/200.rds0000644000176200001440000000027614122754044017762 0ustar liggesusersb```b`fbb`b1; 'v66ε `@I\I9:@1\CS U6Fq- rbjN`NP&٨BdC>/v <҈G0 (oD5 =/qAK)4F{6Nvbh8-B]lx gA򿐐5P8ldiffobj/tests/_helper/objs/diffChr/400.rds0000644000176200001440000000055114122754044017760 0ustar liggesusersTMK@](޽Q B b#5iMt7AgMM3v$! tOrzH؏~߈uȱ0VG[ʒU5:0{(Vߛ /tCT0$x g낝w,Sl)6e]QIā;HCkOƶyuᚹE'(>U^4.m3 羁짾32H)( =@dhqZD\< oYGR}a"_]>r*H”dt:kO;0!3DgU&0'*iW)diffobj/tests/_helper/objs/diffChr/1000.rds0000644000176200001440000000026114122754044020033 0ustar liggesusersb```b`fbb`b1+ 'v66ε `Ry~~L^D $hkW`RU5G1upP01VR Pa#0n ,4Q x,栛 C &9PsR/X ^Rпdiffobj/tests/_helper/objs/context/0000755000176200001440000000000014122754044017061 5ustar liggesusersdiffobj/tests/_helper/objs/context/200.txt0000644000176200001440000000022314122754044020120 0ustar liggesusers< a > b @@ 2,3 @@ @@ 2,3 @@ b b < c > C d d ... omitted 2/3 hunks diffobj/tests/_helper/objs/context/100.rds0000644000176200001440000000032614122754044020074 0ustar liggesusersb```b`fbb`b17 '66ε `vrF%@I\,ohU5E 5upP0Q`M YlPiZ䂙`(&nAc] NAs("}^D,Hr_ "}FXψ+!}!D Hr_>&mP[sR/X Gdiffobj/tests/_helper/objs/context/100.txt0000644000176200001440000000036314122754044020124 0ustar liggesusers< a > b @@ 2,3 @@ @@ 2,3 @@ b b < c > C d d @@ 19,3 @@ @@ 19,3 @@ s s < t > T u u diffobj/tests/_helper/objs/context/500.rds0000644000176200001440000000051314122754044020076 0ustar liggesusersKk@o'n,J7ADk@Dĕ҅G57'c&xd|seN`D$ꕧ e۶+M]'{>vdN8(TPl6ͲU1բ7zO(uo_k) Y%DJ0%P.Gv@J"y"yNXD )yRI眝Hi*!"gj}By#)X%Ds*$yncm̾cgGRڳJx+Fb?"ґUBD!f o*x# 5 ,L@PcsR/XT00qrdiffobj/tests/_helper/objs/context/200.rds0000644000176200001440000000051614122754044020076 0ustar liggesusersMO1@.ML? &ɣ`䤀"RT $fw{N^_g;=ՎIHM|mܱfΆ7ֳl8u' " D@mQF׬B?c3A[Dzh ~ zKRwn>Pk'Lw2ݫ&"4TMDA5QǣJ=>/Gv"4VMDX#4QMDI5AgD^Tݴҽ(s^ډ(P[/N>TdTMDK5AoDDTKx0nH:" diffobj/tests/_helper/objs/context/150.rds0000644000176200001440000000051714122754044020103 0ustar liggesusersN@F&$u1`HCb\4.QD}xt(Ɂ,:7gΝE/1㚉,=S7[~>޽tܡΆ?6l8qG " D@rS'׳ ^Ӗ .n24Z=9y_Zu2Id&"4&" MDROQNDA4A'i"LD^nZޝwv" V2ډ Ӈ4AOi"L_D=˵=6Xwǃ!w diffobj/tests/_helper/objs/context/400.rds0000644000176200001440000000043514122754044020100 0ustar liggesusersO 0ߦ vbѩct:Pւ᣹T^a{lϳM(QLJ>|m6#eChaT9L%IolٺIlx?tDZO 7IdK2(ۅe1E-aGRLQ]Јݲ4;(3Ǻ+ U)* wfe_fw\=RLQݫm);P wlٿ+Zѯ!ldiffobj/tests/_helper/objs/diffObj/0000755000176200001440000000000014122754044016740 5ustar liggesusersdiffobj/tests/_helper/objs/diffObj/100.rds0000644000176200001440000000061514122754044017754 0ustar liggesusersTAK0κ]^BPfʆN<<.BJS'mjeb_/B:rx=4@%+,$"If[.H`JtM3h̖^7XcM܏ OpzB bK#_ lF/ fs0^楧}Cl,ԎN?7/2 ź -3w>j9diffobj/tests/_helper/objs/diffObj/300.rds0000644000176200001440000000134614122754044017760 0ustar liggesusersWo0gI/4ii'kfJ&Nmun9lR"E#i;siL0`%}o/4MhDL+v{hY{f\<4x'0)~a: ..ϱ 8 BD [s#ƾx p9  \[jVR-U t&Z^er6uŪH ii Y7z x䍮uBed`}? [v۔9v&hة*ha?~r˭ad%j~@ɶ^|imɝ'Qb6rf#?zvWˋslTS+ۼvxW! pBZ}T9Ǐa )*a xc=uJy։B MP9%¬Rh}7pCj8.\6grdyNcצrfG9 Rh)*C}{j 0;f--# KXe̅?.,QU*9] vQ_F~qXw1ZX! pr#S^Uȴ]ssD"L49*һon65W{,YPْ[HhXJ'6Ļ8zT<ӈ}]~koHH$SmR\*diffobj/tests/_helper/objs/diffPrint/0000755000176200001440000000000014122754044017322 5ustar liggesusersdiffobj/tests/_helper/objs/diffPrint/600.rds0000644000176200001440000000041314122754044020337 0ustar liggesusersS=0 9B[B?^8#n(uN;JAgY٭Ah׿N)1|؛zQm~'&hZsi[. q T)ܦ4TW$0&r_cE?{vDLl֯$:>$fjns5S#(9|Kƺܵ8Y]!rIEb6aY}[i/9C[#;OS7R+diffobj/tests/_helper/objs/diffPrint/2350.rds0000644000176200001440000000063714122754044020433 0ustar liggesusersVJ0^= iҴ$lq E=~86t#Cޛi.cEq%JJscen|4{?n|c/fɗLS v{G BVM<0lr1ϡ?'s;^t:)2LQl1"jý}/c8PԴcQt @#;z((h GzR8M@/z wEmdV{ >߈QM6%)cnm' *&o aGe?#/O(ؓdp04W-nj>ڱrJ&Iȇ-/wy}@lj]tyݝ‰>C9=hs~uL:Oy&*Z=`h!mlܯ5R,3õ6^hM&E2S%J1i`21CMhxOЀRtg*9zfB =8ђCq5%pqmU&I`^,{.!q1_whxSA1_&9oNj&s hn.uR=rj! ds^`h4-3EnQ:X5h 9@rhߐk!~΁UJ~_!Qȭ&0?G%4l.z ڄZrz{Nf"w<閼![+J aI}2wݛ#CcޛwC_Zxݒ }_k<}YfW4_(mOqۢ.ݜYq64Niƴ"*6iֿ}S]67jxgOWuo 'ÍKOպڱ!xseZ\ > tzUvr@ߐD Y!\Ȑ@CÊtPB qt! 倾!0]AɆ,Rd9o'0HR, ũcg(BC))|9o(24tTmmv %41 UPM w ~[.pHO2aNCg)qJ4'e9@`5t8 nfN2al,M?XjSmS+Cjdiffobj/tests/_helper/objs/diffPrint/2700.rds0000644000176200001440000000045314122754044020426 0ustar liggesusersb```b`fbb`b17 '66ε `vNfq&D \;RĒ C+KTP"f : @ @"`S5g- rLhtal, P@FQ1EU*j0t $&P' p%&p`9v7d +>#ST,׆7.Hhc$ÕkB0\#|n 2K(d1'ob؂'$>$X0BcIR`!PQWGdiffobj/tests/_helper/objs/diffPrint/1200.rds0000644000176200001440000000056214122754044020421 0ustar liggesusersTJ0^D{i)"> "Xx.&iN~ N7LfR(HQkmȆ~o#ϯ[77Lj\|[`܇Փqvz׌=UC.G:Et_[%w5GkbB mau,'pTjK\ߵy8 }]3[{ffͼc2 ^)S.c"wnM_Q:ޙXomqJ̓]8tw`3IiȒ I%jRPg`'(!O)@R1O4&/yT1$#2 ZMFȦМg|˥}e~hϋdiffobj/tests/_helper/objs/diffPrint/200.txt0000644000176200001440000000277314122754044020375 0ustar liggesusers< m1 > m2 @@ 1,7 @@  @@ 1,9 @@  Header row 1 Header row 1 header row 2 header row 2 <  [1]  1 2 3 4 5 6 7 8 9 10 11 >  [1]  2 3 4 5 6 7 8 9 10 11 12 [12] 12 13 14 15 16 17 18 19 20 21 22 [12] 13 14 15 16 17 18 19 20 21 22 23 < [23] 23 24 25 26 27 28 29 30 > [23] 24 25 26 27 28 29 30 31 32 33 34 ~ > [34] 35 36 37 38 39 40 41 42 43 44 45 ~ > [45] 46 47 48 49 50 51 Footer row 1 Footer row 1 diffobj/tests/_helper/objs/diffPrint/900.rds0000644000176200001440000000064114122754044020345 0ustar liggesusersUN04i/ H>!E=rAO#`Ďnj=hgvM_oX(V3܉}S*ȸ:cc2yd|H{V2r6ߛڅ_ezq0{Hq]Qj+(nfodpI]2XMyh`TO*jZesq6*Ow،R 6~HW28CBAEћZ,`2VK w*5q|MdǞV:tB- vFPz)q-zƚ;,boL6ڮ)Oo_)8Vp}ttZwZQBX;lLRJβ/DZZUbqsc8;U!DIuήO^n+ `diffobj/tests/_helper/objs/diffPrint/2150.rds0000644000176200001440000000110314122754044020416 0ustar liggesusersj0O6-EdYE S 3a#qJQ@x˽{B`6 [P`Z-ZbtR)`зPBM.2()4bFc*YhTc< -|)`з0s)*M wSy?fXhcXuN1y`\ r!^qX+> ˾Կ*q2(M۾b3'(E5 9H<}tSܗQk<@PMUV>i3hi}dN`vs:I-Qmz@]gw@⾥@E>d'\1x}h8m868N<06 "6862rHǠ,ڮ-.uٗ8k.9=:k diffobj/tests/_helper/objs/diffPrint/1600.rds0000644000176200001440000000034514122754044020424 0ustar liggesusersb```b`fbb`b1 'V66ε `vNq HMrMM+ :8(X+I Gfki ShX0rd`u cф`-QTmS5p-I!Hq(T@$ !yFpFD%jBD "%8XP9y@, uX,diffobj/tests/_helper/objs/diffPrint/100.rds0000644000176200001440000000036714122754044020342 0ustar liggesusers0 &&,}bh&> atNN>ZJ@#]~Oe ƀ%f0YvپUJ}Xi0bγNN|){ CG6ժ6l}\4dox?Bn^Mt Gnn,"r2V@]0A4 @Cn,hHy_^[&kou}v٨b{nu>omn c˝)Zbc L.oЫqKn6ꄆzkmoߖ[y'4_ 4"3\"׶[Ƃ_[}nuyyQ3l:yBGQMݖzO ěϚH_sê1{^f]0J\;p<m\F$jʫb*&Dbu*u 4pչL$/? ۘ Cdiffobj/tests/_helper/objs/diffPrint/3000.rds0000644000176200001440000000047014122754044020417 0ustar liggesusersSJ0= xzRܖ&[o$,ʒYצGbmtӦŝC&y3o^J_. 8 Z/0 7k^KI e.~9pNY7r"8ωN#͜vwcIۮF[׬{H3$ XڗZ4pm)z{z4˔e=?{2Kc9!Hg,YɖyQ6.3;^Aն<ԕRݔ rBjk|%ɶRm-IO"v֩Ƶte!{|GBdiffobj/tests/_helper/objs/diffPrint/2380.rds0000644000176200001440000000115314122754044020430 0ustar liggesusersW0vKeN nN:!krҹ I !95-{'x|@Fׇ{ {'}?' oe>K*Mvk1C}r2<:.l331bzN,9?rk‘21HOɚ}Y5٠mRl*-%}>LXqn 0sw3+@g}8+D-(vLOU]/)g(Xϣ!'?B3wl`UTwN}JqB7qz]IyZIYRq.8LVi.VC:ELQ٩|w˸yr\9D.gՄ9d_B֭hLG%1V^^жW wʽ.>e,"AC8! >|WeA(rY"t€Â_v 740Ji55XC^=_=ـl?UW(r;ê`{m?)A! veUMhn!#_Kx`]: C7diffobj/tests/_helper/objs/diffPrint/2370.rds0000644000176200001440000000106414122754044020430 0ustar liggesusersk0dzexe7}; dl c+*VǚE/﷟ca=aNOuo˲}~T|PF_{iA:ߠ)|8x^2x򪾣H+Gzra|ȟm!C2̊V1> )C+#2rO<C<.U[dU1!p$i6O!%joĐK\\!I6 |.Ԑ$M Buv#%jW mb /}GeBNWՆI\ j7V\!Iĕ6FyC\!I'"V jHq\ 5$IӸ`a]>՞| 3$IӸ`"Gb*;ɥ·!I8_1rRF I4.Xc<ϽnŅi\P7wbɅi\|+GÎfH>b}hzlY6+c{y{C@@!KJ0S:ﯼ1ᖲ }]>JXO%f]6RmOGnD3M,RA%ґşb"]5]XF{ն7p#sXjë|;9Wz*~yT [Nv3'{ Iq;}w9.ƝЙ9?9a ݸ&s0\qrGp&tN^zy"BK ba-diffobj/tests/_helper/objs/diffPrint/175.rds0000644000176200001440000000035614122754044020354 0ustar liggesusersՓ 0ϴнTm cqv˥(Q0]rI "rӄB1)Fkh,^/xp5<['Z"+:J[W,ӚLTnGkev!t.O2WX(D֕K_oTPW\va^t𼆜fBʟ; |ɢLi%nw%❽hdiffobj/tests/_helper/objs/diffPrint/2200.rds0000644000176200001440000000132514122754044020420 0ustar liggesusersXj0V=zYePJ@-,IS\*yx4&=^o~53__d6\oϯjfϻ$18YfG3^\VIjx_8_^k,W̓1<ݗ(hTRKu|d de!Y| Zayz04N:STT'FuKŤY`CĄ ߐ׾U~F.Bo1E2$C$(B*k^-qhl\U5\Y`G56$l?W+'hpi^5(, !s-% Yu[(ޜ؈mM|K>|C?~n5Wh^-\ykl?@+Ț),T#N޼r6NiSވmC,+|,>$X߼CkC{ߌk8a ȹIpe!Wj۱޽q}']EC6${sIS!o.7qRQGV" $gO>§ 9!a_ Ǘywɩ)[T< ^wB"LiIC8ɌONax4y$Ŀ.)diffobj/tests/_helper/objs/diffPrint/3300.rds0000644000176200001440000000037614122754044020427 0ustar liggesusersmKPMp8{3)"`LCJ/fOKK^M[wGD 1͔f##iɲLU*(v]LL?Plk殪o)}0ux(W\F'q3x1xw0Ǻ5]pP5־uDS YF 4ᢅ6:[sL:kE[rs"iԺj""_^%=diffobj/tests/_helper/objs/diffPrint/700.rds0000644000176200001440000000035314122754044020343 0ustar liggesusers?0"]M?$j &:דᵯh{KA.( İyi2'pZ>\O`5ԜA)ǵʌ'5hQb8;j#ҖEdiffobj/tests/_helper/objs/diffPrint/1900.rds0000644000176200001440000000102614122754044020424 0ustar liggesuserso0p$$nvye4BhS!4#! .Ka%vyq)J 94v~|S؈'l4;eOm*XK%9½\,2Cs?K1 +؁F,+} wi{cw )6_۪XV%oIT3VF_T`Haftus T{؃af-Q«d0l8\m"M#Fio AyvE ۶PW*݋ ?.>!xp(1 e4v3@8b؁X+U=c2A ]nENP yHrhç >lnFd|IX}d)[% 7;wKt{+v_%Jc38] -Q[Ӽğqv:2fq9=k. ndiffobj/tests/_helper/objs/diffPrint/2300.rds0000644000176200001440000000075114122754044020423 0ustar liggesusersV]k0l_6 ̧ c{*lBmⱛ-F̈́{= B(B(BL_5p l2w<<S 5H lQrVڼESŚ<`]NX8GmP̉Ĕf`Xmzln)$d@L^\ퟟHQ'rt$|\OX9HA|! m&QCuuW-I $|B@^K41uM]YX!:d~"Gm$Ҵ|Y ͌G.f&_3s,ԝav$ K5𻄀|v+ۑ !׳Nm|6zZ z~"WHH`:|,!4C'4$ֺvfNԽH :;GPוo`5B\) diffobj/tests/_helper/objs/diffPrint/3100.rds0000644000176200001440000000043514122754044020421 0ustar liggesusersSj0 Vn`]LN-kU{I 1 0CIbO98^diKe$}?Bl{Ãe#SsIOviS ۑ f2 @@ 1,5 @@  @@ 1,5 @@   [1] 1 2 3 4 5 6 7 8   [1] 1 2 3 4 5 6 7 8   [9] 9 10 11 12 13 14 15 16   [9] 9 10 11 12 13 14 15 16  <  [17] 17 18 19 20 21 22 23 24  > [17] 17 18 19 20 22 23 24 25   [25] 25 26 27 28 29 30 31 32  [25] 26 27 28 29 30 31 32 33   [33] 33 34 35 36 37 38 39 40  [33] 34 35 36 37 38 39 40 41  @@ 11,4 @@  @@ 11,4 @@   [81] 81 82 83 84 85 86 87 88  [81] 82 83 84 85 86 87 88 89   [89] 89 90 91 92 93 94 95 96  [89] 90 91 92 93 94 95 96 97  <  [97] 97 98 99 100 > [97] 98 99 101 < 100 Levels: 1 2 3 4 5 6 7 8 9 ... 100 > 99 Levels: 1 2 3 4 5 6 7 8 9 ... 101 diffobj/tests/_helper/objs/diffPrint/500.rds0000644000176200001440000000076214122754044020345 0ustar liggesusersVN05i+le/vN @:f&>s:nT;q=_߫~*Ԫ(Tۻ0<v^H]'%ؽpd8v|cxW@/Ou8B+ I-7վ<j eM_5N~Ck\\("QsSӭ(l6 ''Su=uͲԋ$ZO֣z$WMbjDp|4/@Ɖr}f;1p.qBf0'2èK"!e6K15id8f"at0(b .g+Iv^JKd;0ѥ8Z VӬHĶĢH,rbiab48&&Ok,Դ?)XGN,edFaOd{R((ZvVxgï#^t3 {"ۓrgG1:,OVLV4$ l=F鬑5JuK81'Vm::[Fq pt8pon;9K7kdiffobj/tests/_helper/objs/diffPrint/2400.rds0000644000176200001440000000127314122754044020424 0ustar liggesusersXMo05^@BeOVV8_B*qSE#RS'~av<9l^f@lj]tyݝ‰>C9=hs~uL:Oy&*Z=`h!mlܯ5R,3õ6^hM&E2S%J1i`21CMhxOЀRtg*9zfB =8ђCq5%pqmU&I`^,{.!q1_whxSA1_&9oNj&s hn.uR=rj! ds^`h4-3EnQ:X5h 9@rhߐk!~΁UJ~_!Qȭ&0?G%4l.z ڄZrz{Nf"w<閼![+J aI}2wݛ#CcޛwC_Zxݒ }_k<}YfWtE+%s4 Ǥj`Zԙ}9H r'L_< diffobj/tests/_helper/objs/diffPrint/2800.rds0000644000176200001440000000045514122754044020431 0ustar liggesusersŔN0Nػx,NZ*dj'F\׵ 7w?w_Q@Abr Ck)We7DT F]h ;{?e@#dӨ4ͲCoE0uvd}i}ꬲ=&֧Kf'Cu^yyO?3`չdiffobj/tests/_helper/objs/diffPrint/2383.rds0000644000176200001440000000165714122754044020444 0ustar liggesusersn0U'K E DPyE3@!HDCΝE)LJ?txto gI09+߾O~{{$9[b]lM=`y/iι~gfNxd_q2$=t{tِ\O7s>WX\?Aûf%>2,I^#T$hT(C|1Q=PD#B?/ _܃ET ɨ*TQna%PBt(d$Y`mx!AZV2 ޿cT`.e;RJ&A@EHTLFAE`s0|2_*V!6{t`*9xbͩFv_WP@-Ÿ:%qpg$` AuFzN1/N4/lOH;Qz] ǽhT?]hsh͡:s>{Raمq^ȳHa^v>*{i4Ž5r4EP< |HwaZ,;]e49>..jհ  ɽRGGF74}~@j"jh~{l {t'NJr'UJа$y^J˰$k ^a Y5ʮ2O¬Omo!PSdieioM}7|ӨbZYb/Y/(,ҋJ3b̒z@)qfi9_o(/;oie{>̰(7̋\~,MB+Ò8/Y\{ă楑b}_G `wi"X$KȢX̋pdIXR#̋ef 'a:[+* W^s;!diffobj/tests/_helper/objs/diffPrint/1650.rds0000644000176200001440000000041014122754044020422 0ustar liggesusersb```b`fbb`b1/ '66ε `vNfqӃȀLrL `TL ,APPHC$)BNYki 6EpPʠfb+Xfa*`kvcl7 tlV`3cF]~uXF8=O騱bD-;3xe:%l:,PH[H j f b&ZFb$O]<52.ĥ<{w(;Ƹ8,3+n?tZ"h}N@z>ZGF0MH ˸*,,I~YUi4} Lhf"fTq8\BAEcY@`q# HMo|TAR)íS{NJgE2%DәxLZen***;+|S:;(/+~L/{CԠi jPIkgeˬT,*Dp8r?cJ?x38;qGlY~ez{.~B|~)ҏUdiffobj/tests/_helper/objs/diffPrint/200.rds0000644000176200001440000000037414122754044020341 0ustar liggesusers0 &&޹İ%> !у7Ƀ'؍&bЮןr^1`>!ST"YbsVhBLi =jީ1M1NB^1m3*e]˄WdD }XRȤjGOX_>1%8O4'1yޛiT&̛pp[pnnv %Pbtv> 4уQ8)&0jۃʤoImdiffobj/tests/_helper/objs/diffPrint/150.rds0000644000176200001440000000034214122754044020340 0ustar liggesusers}10";1(mQi0aBݬ?x(dx^rpK@@$$ İBj,پ_/K{z6 "?";zN[SX7+ #Q]Fd=2y8ʐlz~qguAxUtGlQ"U[ "r1bZFVqzC,_qRp&/Adiffobj/tests/_helper/objs/diffPrint/800.rds0000644000176200001440000000037714122754044020352 0ustar liggesusers;0ka&H`Bݬ?x{y<|$v8r>gJ¼^Rh}Uew8OAC^@hĠk4ԖTFdi9t c4e$@!D8=\sB:i\t`n8ߴtkꥃM.3L/8ٰ)s>.~b}kħ`Fz`.UGB/diffobj/tests/_helper/objs/diffPrint/3200.rds0000644000176200001440000000043714122754044020424 0ustar liggesusersJ0/ҬY3D{ax!^ *4 9iNwLDISIvyDFrq*暳6˕<wmnŶ/^\uq?0[6X0@:Q+g3ReUR׷]_{SD)QJDipq{U)M=ĮZ/O!,z:,f(QAeYϿ-2J(M7ùj-o[udiffobj/tests/_helper/objs/diffPrint/400.rds0000644000176200001440000000107214122754044020337 0ustar liggesusersN0 C"!KwQM#T͑ā>jӚA Oos;TgݵԏUxZroϗ03'W5-lnsYdeqi8#,ҙۢTg`e-tPcaB318TM +4Goicg>zͳoϛ}K1hb?  jZXf=^_,hzmM&&4YSޙ8 =JV*lH00B (Ԣ}6fRKs;F`10B (Ԣ}6Vۦ;e\S`(-;mDH4g-;Ӆ2;C0c#;71\INg΂kbD2gR=lbB~I{1,0"J/S ̉dΤzĄ&3AsʚW-_n[ܿsL diffobj/tests/_helper/objs/diffPrint/175.txt0000644000176200001440000000275314122754044020406 0ustar liggesusers< nhtemp > nhtemp2 @@ 4,4 @@  @@ 4,5 @@  Frequency = 1  Frequency = 1  ~  [1]  49.9 52.3 49.4 51.1 <  [1] 49.9 52.3 49.4 51.1 49.4 47.9 >  [5] -999.0 47.9 49.8 50.9  [7] 49.8 50.9 49.3 51.9 50.8 49.6  [9]  49.3 51.9 50.8 49.6 [13] 49.3 50.6 48.4 50.7 50.9 50.6 [13]  49.3 50.6 48.4 50.7 @@ 8,4 @@  @@ 10,5 @@  ~ [21]  51.8 51.1 49.8 50.2 [19] 51.5 52.8 51.8 51.1 49.8 50.2 [25]  50.4 51.6 51.8 50.9 < [25] 50.4 51.6 51.8 50.9 48.8 51.7 > [29]  48.8 -999.0 51.0 50.6 [31] 51.0 50.6 51.7 51.5 52.1 51.3 [33]  51.7 51.5 52.1 51.3 [37] 51.0 54.0 51.4 52.7 53.1 54.6 [37]  51.0 54.0 51.4 52.7 diffobj/tests/_helper/objs/diffPrint/2250.rds0000644000176200001440000000132614122754044020426 0ustar liggesusersX=o0e,-P {o] A/(:FH DiP{_\x$/@=H2w'*TrI~wqSUg{a1 CfYWvG3^^ˍ6k{gp/2]˂z=<>_nl:J4~R\9?/ Y%M`ȒC_|VH10y{\婯ih#4AL@tT'ƌsKbR,ab"oXk_*j?Gc,M[hO)!MBzHfd!8B.qh\\uV& lwq3.AUW$gHl9Ybfml 9mSM&9dұ_hǦYo?7ٚq.V9ռ%6wMTפl B[E1'So9X49@rZ&˒Ck44hM^Okv<_{3h}~o00$,Ap^қN؈O!/-bHC³RuĤfE<75dgO9eᩮĐe]J`5_??獐asw%(uYYf>NK q-5)diffobj/tests/_helper/objs/diffPrint/1800.rds0000644000176200001440000000101414122754044020420 0ustar liggesusersKN0M HHذWX R#Z183IݒqE'L&~BhV7t^w7l_wxwx>;<z=dX^ҭFfڦ!z_z_ :Me,Qa:|q՟q!^Z ( 2 lI21dL$GcI&3i% (0I(FL1JI2U|LIg" &ēLgRSS%dL*Ȥ|t>)Ȥ">2I,1idf2&sLZ(O H>e9 `>er瓆 Ti&N0Bꓷ/H2؝cbYę`!w>))݅|z<4C\ޮbq'! ;ׅsr=jCʏ diffobj/tests/_helper/objs/diffPrint/2600.rds0000644000176200001440000000047014122754044020424 0ustar liggesusersN0/Nw-T4By 3xt7@%<\s8r :ƀu8\\y3h}8<7?7)LP*&~w7b}Pދq3ح +T\)}ce|ZTTĨx=ٹD.[VhjZ*7vu}L(aښ|C3eNb+URb/3t?G^Qg2 -ju-qNfLHNmfQd:@W^EG۰Y vBdiffobj/tests/_helper/objs/diffPrint/150.txt0000644000176200001440000000065614122754044020377 0ustar liggesusers< f3 > f4 @@ 1,2 @@  @@ 1,2 @@   [1] a b c d e f g h i j  [1] a b c d e f g h i j < Levels: a b c d e f g h i j > Levels: a b c d e f g h i j k diffobj/tests/_helper/objs/diffPrint/1000.rds0000644000176200001440000000060014122754044020410 0ustar liggesusersMN0M HHH,Uv"!TXHV0Gy?iCxG~3~)**U><7msZ6{ /K}wY:a]vwښ#8AqWHģeN,f kxuE$;N+.8Ri] \"?r0X'F ,昧"5D!?M!9'XnJlsKBX,GrjX5EB\12 f"RhkDJxT20U2Bu0)^(a0063diffobj/tests/_helper/objs/limit/0000755000176200001440000000000014122754044016513 5ustar liggesusersdiffobj/tests/_helper/objs/limit/600.rds0000644000176200001440000000036614122754044017537 0ustar liggesusersO @ŧU{bf!Dx1&$+tGi%03y(h1`F1v4eobB!M1M{> Ŵp0[R-,\[IUBDHoM# sDdӈ|_藄qqxu۶1qN}>Qf!;=]v^cIj% r6Zkdiffobj/tests/_helper/objs/limit/1200.rds0000644000176200001440000000032114122754044017603 0ustar liggesusersb```b`fbb`b1 'v66ε `#@I\I Iz@Q\CC U]+ ~K\0,eq I XtacY6:Q`c2Y6:S`c Y6P`c*Y6R`cY6Q`c:Y6S`cY6zP`c&Y6zR`cY6zᴑ h##f<  ґ-diffobj/tests/_helper/objs/limit/900.rds0000644000176200001440000000042714122754044017540 0ustar liggesusers=o0&CRR.*SQ2%%H@UcҘ(e3}8s31`ByBQL$ǡ*Wf?T hqsڈlH̰Uf۷=o˾oZu!^)iᒃ6źN|HG*#z!5a|]nb\fF 8G":]yXʼ!y4 ,r.A}֝F4FK ׇvMdiffobj/tests/_helper/objs/limit/100.rds0000644000176200001440000000021014122754044017516 0ustar liggesusersb```b`fbb`b1|N mlk$-slG\\;\'Ps- rs3KJRSr2Ru 2J:X::sR/X0<8diffobj/tests/_helper/objs/limit/1300.rds0000644000176200001440000000021614122754044017607 0ustar liggesusersb```b`ffd`b1|N m'mlk$-sԒԢbH$.o AMђ4SJ()d(*deCd``a`dIR`!ֳdiffobj/tests/_helper/objs/limit/700.rds0000644000176200001440000000033114122754044017530 0ustar liggesuserseM @U$w?]ѸZ wg{1`F?I`†mei"Qϗ+/kƄg‰ h4>ԘL,񤖷V ʱBMKӴ߱q:z#_/_ߨ7AP-0,]ڦQH\.|f^&:t֣\;< ka *ڊXG=~cçת Vy?rZ;!T:{m9$n/t_i$8ɴB[SAwB[$nH '^hI׵y7mĪK냶2C=_6l_1klu__)w+'asIof$ܭ|p# !țp V\I 4|ZkNt:YȔnFQr_;"a_4><%LCvbdiffobj/tests/_helper/objs/limit/1100.rds0000644000176200001440000000025214122754044017605 0ustar liggesusersb```b`fbb`b1 ri'hc\ if;BU:5upP014P PešP43P&Lt@ݏEFz===̒K}CC̼bXsR/Xp #Sdiffobj/tests/_helper/objs/limit/200.rds0000644000176200001440000000024314122754044017525 0ustar liggesusersb```b`fbb`b1 rihc\ if;Bp:(4upP01UR PEa30n ,`*( ێGyB~nfIIjBNf^j1:&2Fr< ?u$diffobj/tests/_helper/objs/limit/800.rds0000644000176200001440000000033114122754044017531 0ustar liggesuserseO @ŧUf~A$wѣqRpof߼c~ܒ,u׹F<|JBoZ&?L8fGDf=Z+M ̹֊AѼR9ַVhii;.0118GQJX[ sF;a%F~`Y(Ѹz6XF[|zy{diffobj/tests/_helper/objs/limit/1000.rds0000644000176200001440000000033514122754044017606 0ustar liggesusers} @i e,>BǠSϡUS|` `Švkw\(FԔ|&j51B?F"qёaiw"Wo&J`jJ9Lѵ]XP˔Fضj@:B`w8:&#譑.z diffobj/tests/_helper/objs/pager/0000755000176200001440000000000014122754044016473 5ustar liggesusersdiffobj/tests/_helper/objs/pager/200.txt0000644000176200001440000000010514122754044017531 0ustar liggesusers< 2 > 3 @@ 1 @@ @@ 1 @@ < 2 > 3 diffobj/tests/_helper/objs/pager/300.txt0000644000176200001440000000000014122754044017524 0ustar liggesusersdiffobj/tests/_helper/objs/pager/100.txt0000644000176200001440000000010514122754044017530 0ustar liggesusers< 1 > 2 @@ 1 @@ @@ 1 @@ < 1 > 2 diffobj/tests/_helper/objs/diffFile/0000755000176200001440000000000014122754044017105 5ustar liggesusersdiffobj/tests/_helper/objs/diffFile/s.o.3f1f68.R0000644000176200001440000001737614122754044020661 0ustar liggesusers ## Create a mapping between the string and its style-less version. ## This is useful to work with the colored string. #' @importFrom utils tail map_to_ansi <- function(x, text = NULL) { if (is.null(text)) { text <- non_matching(re_table(ansi_regex, x), x, empty=TRUE) } map <- lapply( text, function(text) { cbind( pos = cumsum(c(1, text[, "length"], Inf)), offset = c(text[, "start"] - 1, tail(text[, "end"], 1), NA) ) }) function(pos) { pos <- rep(pos, length.out = length(map)) mapply(pos, map, FUN = function(pos, table) { if (pos < 1) { pos } else { slot <- which(pos < table[, "pos"])[1] - 1 table[slot, "offset"] + pos - table[slot, "pos"] + 1 } }) } } #' Count number of characters in an ANSI colored string #' #' This is a color-aware counterpart of \code{base::nchar}, #' which does not do well, since it also counts the ANSI control #' characters. #' #' @param x Character vector, potentially ANSO styled, or a vector to be #' coarced to character. #' @param ... Additional arguments, passed on to \code{base::nchar} #' after removing ANSI escape sequences. #' @return Numeric vector, the length of the strings in the character #' vector. #' #' @family ANSI string operations #' @export #' @examples #' str <- paste( #' red("red"), #' "default", #' green("green") #' ) #' #' cat(str, "\n") #' nchar(str) #' col_nchar(str) #' nchar(strip_style(str)) col_nchar <- function(x, ...) { base::nchar(strip_style(x), ...) } #' Substring(s) of an ANSI colored string #' #' This is a color-aware counterpart of \code{base::substr}. #' It works exactly like the original, but keeps the colors #' in the substrings. The ANSI escape sequences are ignored when #' calculating the positions within the string. #' #' @param x Character vector, potentially ANSI styled, or a vector to #' coarced to character. #' @param start Starting index or indices, recycled to match the length #' of \code{x}. #' @param stop Ending index or indices, recycled to match the length #' of \code{x}. #' @return Character vector of the same length as \code{x}, containing #' the requested substrings. ANSI styles are retained. #' #' @family ANSI string operations #' @export #' @examples #' str <- paste( #' red("red"), #' "default", #' green("green") #' ) #' #' cat(str, "\n") #' cat(col_substr(str, 1, 5), "\n") #' cat(col_substr(str, 1, 15), "\n") #' cat(col_substr(str, 3, 7), "\n") #' #' substr(strip_style(str), 1, 5) #' substr(strip_style(str), 1, 15) #' substr(strip_style(str), 3, 7) #' #' str2 <- "another " %+% #' red("multi-", sep = "", underline("style")) %+% #' " text" #' #' cat(str2, "\n") #' cat(col_substr(c(str, str2), c(3,5), c(7, 18)), sep = "\n") #' substr(strip_style(c(str, str2)), c(3,5), c(7, 18)) col_substr <- function(x, start, stop) { if(!is.character(x)) x <- as.character(x) if(!length(x)) return(x) ansi <- re_table(ansi_regex, x) text <- non_matching(ansi, x, empty=TRUE) mapper <- map_to_ansi(x, text = text) nstart <- mapper(start) nstop <- mapper(stop) bef <- base::substr(x, 1, nstart - 1) aft <- base::substr(x, nstop + 1, base::nchar(x)) ansi_bef <- vapply(regmatches(bef, gregexpr(ansi_regex, bef)), paste, collapse = "", FUN.VALUE = "") ansi_aft <- vapply(regmatches(aft, gregexpr(ansi_regex, aft)), paste, collapse = "", FUN.VALUE = "") paste(sep = "", ansi_bef, base::substr(x, nstart, nstop), ansi_aft) } #' Substring(s) of an ANSI colored string #' #' This is the color-aware counterpart of \code{base::substring}. #' It works exactly like the original, but keeps the colors in the #' substrings. The ANSI escape sequences are ignored when #' calculating the positions within the string. #' #' @param text Character vector, potentially ANSI styled, or a vector to #' coarced to character. It is recycled to the longest of \code{first} #' and \code{last}. #' @param first Starting index or indices, recycled to match the length #' of \code{x}. #' @param last Ending index or indices, recycled to match the length #' of \code{x}. #' @return Character vector of the same length as \code{x}, containing #' the requested substrings. ANSI styles are retained. #' #' @family ANSI string operations #' @export #' @examples #' str <- paste( #' red("red"), #' "default", #' green("green") #' ) #' #' cat(str, "\n") #' cat(col_substring(str, 1, 5), "\n") #' cat(col_substring(str, 1, 15), "\n") #' cat(col_substring(str, 3, 7), "\n") #' #' substring(strip_style(str), 1, 5) #' substring(strip_style(str), 1, 15) #' substring(strip_style(str), 3, 7) #' #' str2 <- "another " %+% #' red("multi-", sep = "", underline("style")) %+% #' " text" #' #' cat(str2, "\n") #' cat(col_substring(str2, c(3,5), c(7, 18)), sep = "\n") #' substring(strip_style(str2), c(3,5), c(7, 18)) col_substring <- function(text, first, last = 1000000L) { if (!is.character(text)) text <- as.character(text) n <- max(lt <- length(text), length(first), length(last)) if (lt && lt < n) text <- rep_len(text, length.out = n) col_substr(text, as.integer(first), as.integer(last)) } #' Split an ANSI colored string #' #' This is the color-aware counterpart of \code{base::strsplit}. #' It works almost exactly like the original, but keeps the colors in the #' substrings. #' #' @param x Character vector, potentially ANSI styled, or a vector to #' coarced to character. #' @param split Character vector of length 1 (or object which can be coerced to #' such) containing regular expression(s) (unless \code{fixed = TRUE}) to use #' for splitting. If empty matches occur, in particular if \code{split} has #' zero characters, \code{x} is split into single characters. #' @param ... Extra arguments are passed to \code{base::strsplit}. #' @return A list of the same length as \code{x}, the \eqn{i}-th element of #' which contains the vector of splits of \code{x[i]}. ANSI styles are #' retained. #' #' @family ANSI string operations #' @export #' @examples #' str <- red("I am red---") %+% #' green("and I am green-") %+% #' underline("I underlined") #' #' cat(str, "\n") #' #' # split at dashes, keep color #' cat(col_strsplit(str, "[-]+")[[1]], sep = "\n") #' strsplit(strip_style(str), "[-]+") #' #' # split to characters, keep color #' cat(col_strsplit(str, "")[[1]], "\n", sep = " ") #' strsplit(strip_style(str), "") col_strsplit <- function(x, split, ...) { split <- try(as.character(split), silent=TRUE) if(inherits(split, "try-error") || !is.character(split) || length(split) > 1L) stop("`split` must be character of length <= 1, or must coerce to that") if(!length(split)) split <- "" plain <- strip_style(x) splits <- re_table(split, plain, ...) chunks <- non_matching(splits, plain, empty = TRUE) # silently recycle `split`; note currently `re_table` doesn't use this but # should eventually split.r <- if(length(split) > length(x)) head(split, length(x)) else head(rep(split, ceiling(length(x) / length(split))), length(x)) # Drop empty chunks to align with `substr` behavior chunks <- lapply( seq_along(chunks), function(i) { y <- chunks[[i]] # empty split means drop empty first match if(nrow(y) && !nzchar(split.r[[i]]) && !head(y, 1L)[, "length"]) { y <- y[-1L, , drop=FALSE] } # drop empty last matches if(nrow(y) && !tail(y, 1L)[, "length"]) y[-nrow(y), , drop=FALSE] else y } ) zero.chunks <- !vapply(chunks, nrow, integer(1L)) # Pull out zero chunks from colored string b/c col_substring won't work # with them res <- vector("list", length(chunks)) res[zero.chunks] <- list(character(0L)) res[!zero.chunks] <- mapply( chunks[!zero.chunks], x[!zero.chunks], SIMPLIFY = FALSE, FUN = function(tab, xx) col_substring(xx, tab[, "start"], tab[, "end"]) ) res } diffobj/tests/_helper/objs/diffFile/100.rds0000644000176200001440000000146314122754044020123 0ustar liggesusersW1o@6iXM$mҨPVEbh.>q>[sH]W%~IIqh8;}O>Ep>z.t nt>=..Hv\ۇ<$<9,y>l>TQ_3ZdDN E5sY% th@ә+> lҨzȀ<,`8iVcmz5Ɋdcj5!TSD ܼvv+*Y?ՊˀPd:)֣g}7/̗y:oHd$lG)gbkK 0rɺb1f#CA~8r =>{utw:sαllP,q$Kxx0[ xF>rFj h~]r*Z!A FzMdCϔ2כH+rO?f)^C"YZ#nj; mС\ IJ=֜nq&Hv2*,\_Y䲡D,tH%2.2&b 6|UsIRӰT/&dcZHst_ĠE -4i:H+|l:Hdkѽx6;+?V.ɜE@rcqvFXejeA˒\#}+Sr $bܼn= q_mY diffobj/tests/_helper/objs/diffFile/s.o.30dbe0.R0000644000176200001440000001763314122754044020715 0ustar liggesusers ## Create a mapping between the string and its style-less version. ## This is useful to work with the colored string. #' @importFrom utils tail map_to_ansi <- function(x, text = NULL) { if (is.null(text)) { text <- non_matching(re_table(ansi_regex, x), x, empty=TRUE) } map <- lapply( text, function(text) { cbind( pos = cumsum(c(1, text[, "length"], Inf)), offset = c(text[, "start"] - 1, tail(text[, "end"], 1), NA) ) }) function(pos) { pos <- rep(pos, length.out = length(map)) mapply(pos, map, FUN = function(pos, table) { if (pos < 1) { pos } else { slot <- which(pos < table[, "pos"])[1] - 1 table[slot, "offset"] + pos - table[slot, "pos"] + 1 } }) } } #' Count number of characters in an ANSI colored string #' #' This is a color-aware counterpart of \code{base::nchar}, #' which does not do well, since it also counts the ANSI control #' characters. #' #' @param x Character vector, potentially ANSO styled, or a vector to be #' coarced to character. #' @param ... Additional arguments, passed on to \code{base::nchar} #' after removing ANSI escape sequences. #' @return Numeric vector, the length of the strings in the character #' vector. #' #' @family ANSI string operations #' @export #' @examples #' str <- paste( #' red("red"), #' "default", #' green("green") #' ) #' #' cat(str, "\n") #' nchar(str) #' col_nchar(str) #' nchar(strip_style(str)) col_nchar <- function(x, ...) { base::nchar(strip_style(x), ...) } #' Substring(s) of an ANSI colored string #' #' This is a color-aware counterpart of \code{base::substr}. #' It works exactly like the original, but keeps the colors #' in the substrings. The ANSI escape sequences are ignored when #' calculating the positions within the string. #' #' @param x Character vector, potentially ANSI styled, or a vector to #' coarced to character. #' @param start Starting index or indices, recycled to match the length #' of \code{x}. #' @param stop Ending index or indices, recycled to match the length #' of \code{x}. #' @return Character vector of the same length as \code{x}, containing #' the requested substrings. ANSI styles are retained. #' #' @family ANSI string operations #' @export #' @examples #' str <- paste( #' red("red"), #' "default", #' green("green") #' ) #' #' cat(str, "\n") #' cat(col_substr(str, 1, 5), "\n") #' cat(col_substr(str, 1, 15), "\n") #' cat(col_substr(str, 3, 7), "\n") #' #' substr(strip_style(str), 1, 5) #' substr(strip_style(str), 1, 15) #' substr(strip_style(str), 3, 7) #' #' str2 <- "another " %+% #' red("multi-", sep = "", underline("style")) %+% #' " text" #' #' cat(str2, "\n") #' cat(col_substr(c(str, str2), c(3,5), c(7, 18)), sep = "\n") #' substr(strip_style(c(str, str2)), c(3,5), c(7, 18)) col_substr <- function(x, start, stop) { if(!is.character(x)) x <- as.character(x) if(!length(x)) return(x) start <- as.integer(start) stop <- as.integer(stop) if(!length(start) || !length(stop)) stop("invalid substring arguments") if(anyNA(start) || anyNA(stop)) stop("non-numeric substring arguments not supported") ansi <- re_table(ansi_regex, x) text <- non_matching(ansi, x, empty=TRUE) mapper <- map_to_ansi(x, text = text) nstart <- mapper(start) nstop <- mapper(stop) bef <- base::substr(x, 1, nstart - 1) aft <- base::substr(x, nstop + 1, base::nchar(x)) ansi_bef <- vapply(regmatches(bef, gregexpr(ansi_regex, bef)), paste, collapse = "", FUN.VALUE = "") ansi_aft <- vapply(regmatches(aft, gregexpr(ansi_regex, aft)), paste, collapse = "", FUN.VALUE = "") paste(sep = "", ansi_bef, base::substr(x, nstart, nstop), ansi_aft) } #' Substring(s) of an ANSI colored string #' #' This is the color-aware counterpart of \code{base::substring}. #' It works exactly like the original, but keeps the colors in the #' substrings. The ANSI escape sequences are ignored when #' calculating the positions within the string. #' #' @param text Character vector, potentially ANSI styled, or a vector to #' coarced to character. It is recycled to the longest of \code{first} #' and \code{last}. #' @param first Starting index or indices, recycled to match the length #' of \code{x}. #' @param last Ending index or indices, recycled to match the length #' of \code{x}. #' @return Character vector of the same length as \code{x}, containing #' the requested substrings. ANSI styles are retained. #' #' @family ANSI string operations #' @export #' @examples #' str <- paste( #' red("red"), #' "default", #' green("green") #' ) #' #' cat(str, "\n") #' cat(col_substring(str, 1, 5), "\n") #' cat(col_substring(str, 1, 15), "\n") #' cat(col_substring(str, 3, 7), "\n") #' #' substring(strip_style(str), 1, 5) #' substring(strip_style(str), 1, 15) #' substring(strip_style(str), 3, 7) #' #' str2 <- "another " %+% #' red("multi-", sep = "", underline("style")) %+% #' " text" #' #' cat(str2, "\n") #' cat(col_substring(str2, c(3,5), c(7, 18)), sep = "\n") #' substring(strip_style(str2), c(3,5), c(7, 18)) col_substring <- function(text, first, last = 1000000L) { if (!is.character(text)) text <- as.character(text) n <- max(lt <- length(text), length(first), length(last)) if (lt && lt < n) text <- rep_len(text, length.out = n) col_substr(text, as.integer(first), as.integer(last)) } #' Split an ANSI colored string #' #' This is the color-aware counterpart of \code{base::strsplit}. #' It works almost exactly like the original, but keeps the colors in the #' substrings. #' #' @param x Character vector, potentially ANSI styled, or a vector to #' coarced to character. #' @param split Character vector of length 1 (or object which can be coerced to #' such) containing regular expression(s) (unless \code{fixed = TRUE}) to use #' for splitting. If empty matches occur, in particular if \code{split} has #' zero characters, \code{x} is split into single characters. #' @param ... Extra arguments are passed to \code{base::strsplit}. #' @return A list of the same length as \code{x}, the \eqn{i}-th element of #' which contains the vector of splits of \code{x[i]}. ANSI styles are #' retained. #' #' @family ANSI string operations #' @export #' @examples #' str <- red("I am red---") %+% #' green("and I am green-") %+% #' underline("I underlined") #' #' cat(str, "\n") #' #' # split at dashes, keep color #' cat(col_strsplit(str, "[-]+")[[1]], sep = "\n") #' strsplit(strip_style(str), "[-]+") #' #' # split to characters, keep color #' cat(col_strsplit(str, "")[[1]], "\n", sep = " ") #' strsplit(strip_style(str), "") col_strsplit <- function(x, split, ...) { split <- try(as.character(split), silent=TRUE) if(inherits(split, "try-error") || !is.character(split) || length(split) > 1L) stop("`split` must be character of length <= 1, or must coerce to that") if(!length(split)) split <- "" plain <- strip_style(x) splits <- re_table(split, plain, ...) chunks <- non_matching(splits, plain, empty = TRUE) # silently recycle `split`; doesn't matter currently since we don't support # split longer than 1, but might in future split.r <- rep(split, length.out=length(x)) # Drop empty chunks to align with `substr` behavior chunks <- lapply( seq_along(chunks), function(i) { y <- chunks[[i]] # empty split means drop empty first match if(nrow(y) && !nzchar(split.r[[i]]) && !head(y, 1L)[, "length"]) { y <- y[-1L, , drop=FALSE] } # drop empty last matches if(nrow(y) && !tail(y, 1L)[, "length"]) y[-nrow(y), , drop=FALSE] else y } ) zero.chunks <- !vapply(chunks, nrow, integer(1L)) # Pull out zero chunks from colored string b/c col_substring won't work # with them res <- vector("list", length(chunks)) res[zero.chunks] <- list(character(0L)) res[!zero.chunks] <- mapply( chunks[!zero.chunks], x[!zero.chunks], SIMPLIFY = FALSE, FUN = function(tab, xx) col_substring(xx, tab[, "start"], tab[, "end"]) ) res } diffobj/tests/_helper/objs/html/0000755000176200001440000000000014122754044016341 5ustar liggesusersdiffobj/tests/_helper/objs/html/100.rds0000644000176200001440000000052514122754044017355 0ustar liggesusersՕAO0`hbGh8Y7E<&:VS )m,JgeAᢸpXdIq)'1.%z1qK4ʜ`20WkaDO铔Ms'nY]W~1L$H**M;;6۱tD4jAO*}d:޵Qb, NJ/y( ݽP/Ɩ>̛#NŢpm*֡3s5|3UTJ5Zw،p:RyVPdiffobj/tests/_helper/objs/html/350.rds0000644000176200001440000000664414122754044017374 0ustar liggesuserskoyCO(IYٲ}Ņ_t@XK1eȕe%1ϋ.EJerc9ʗʗ+\Y%0ݯ]?]COt|' pdp%C<v|$YkB^[+K~'D vE1{ޔI$UǕRhh`A|8j,7>|=ÐE$P߻ s. zDHzw PS B`Hys$U ex HQ*;[\WX?H ">%=OZ2 s^#M|gQ v`YϡPہk.{hʼn8^ GhD}p;aR%n$SKfe"} pYDG:»'0#(I\okbz-&Xf|g2_uTY}`>T{T ,!qE_!{w}nFPkM:-^u#3 IkeǤofInVyB{Pǿ{Mpb~r1DnS?UGg_-G{ycLբq߼[T|XյP'}#]K83Gǻ٫L+h_ņIC ބP%-[8}$=ױZ_j^m4+ 3 }Y2R, #> KD"1@Y0k6޷͆nL<*fl`P 8lNxGL<{ RY,4da}%vqLS L;ts'jnq5%/ϩjJ ΎֿQM崲-l@}~.Kh6~D:v ,vy*O@,/? A[>Z"Nj`ȚF➺':qB2 pBu*S)V\*$y"$Uw>)j=g,խ1gC8![I@`xC.>ǃ냋rM뇾q^ ' G#iNNNǭ\^\\O>\ՇqI,NUVB58{AVo4PKuu@xuVWfQt_CKNZ6 ^M/~Pm7;f$3 TUb1cr.x`sI#dVZռCJ߷Ϡ^fqFȊ|LPDNhQקb4?p 1t!Iðʄ_01wH $};4A:_t!LODnm<5()4/ju..].ԩjs E[ &N? = an̩fJR2GG]>.&~<lB ytBzt/rQ VV8x7X^@Xm ֙=jI\F-JmI|f6N'ȧRUDmװ s~flŔ);T.G89,<4tf, Z8^: atswZh˰jҞD^Js4VD-pzQM`6 I~غ:S-TRV,M%BM q,>RrmR9xXU"U)j橶ºhM;#hQV!gZU t0K%ҷ9I/x8l1jM^J^F335[ ɏF uũ+HKZjǰ )2{4**Ml"m)o : Y10RtR<-PuzM/afM%mƶ".6)gCF9p@bŦA$$dQ=f8>WAV(dJZnG<ܮ )B+!n<^¬Rl3Y_/T,RgXJqCsHYCHy5fjz)zꚠwNFcN8!O4, 0Iq8YaΰB2cnDɢK.(ʅr\86$e=g$jJߗMs=-s:>4E/^Q txҸ{٤\SȆ]>3Sۥmm,r٤ޏԪSOϙQV|ҫiz v ^7H|PA&U>mR5juOG fK(Nsc ljj$uO(i ILM-̋%CV+6[DRl<{z>²ʗo tZY 7diffobj/tests/_helper/objs/html/300.rds0000644000176200001440000000666314122754044017370 0ustar liggesuserskoF}|9'LU\$7GƖmv`) BXK5eɕe_?RdQ, z,K+++_|E_o_|򷕕.ڟ'~:>8s8! kׁwW>䁬G!/% "Ǣ˽tkoʍ$X|* ˎ~=d4 b>ZP[} {ha`a "|Y(p ބX9nx|"fx a$n=;`c{E)!0<92ba\U$(ޝx+_j@`\]OQuÞ'y-w9&>賨;,̎Fby?5=z DO/}JE4pL wV0g)iXpz8}5*ʥn QpBk"(–"e&[`w %!2.:7y!Uchߗ3gvlcr0EͲl3QYNJIl-I Ev46iB9*QqvSQk>wqzEr=_Ip$K֍F~1L sv^36^Zwr NfS.&ŃŁ<I6(";^{tgW2iX̳PqV"T.y`TWƶ/n{{;S3Q ɹ3i(RbM7%3r2sˈT,F|"#J[Xxk.s7`]1Cu\33믊OR,>0 \Č=j L*]O8"/J=PlB>7}rzԵ&:r̙js5r{kb9ɼX97؛ffsWx~f)F{[[dQ,|?snۯx4˚snzmXjcry73S}Xy+<=O?Ϧ]8y ?9΋"7)П*#Q3篖s&jQ8s߼[6[PbUnCM6w-ጦOC59܉Q|b sNlLu;{b$ϙ']+o3-[fz4zZFpqȂip* w)g\<:4>nC$z-l۷~B"߱鰴ygH,YB`k`{`g`[ '_.pN-nEOA׉'ŽPJ ez<;etp#kN7W7J XTXPE̬Fwt7pimГ=`AH#uգU\܀H8,YaTD7b}n9E]9D;0QǽҢ*O}UCDG1Z~ ~f9.̇{6y6GC4T!edڼí5T$#!᭢#LQ9Og.vO89JGֈOpp >\_\?5Epc kR^?=X G(>Q8?> QON۟pprھ8n}z>\_]-Nbq"0GŮQ_ ~ܥx _0־"FJkz\sRcA ~3s *bzဪ Q[,&b ]l?i}Jp8Yˣ7h_0\i,NY"b] mu9TBa!."IS1sO&W $oqў&ȱU鉈߭Ӡ+%UKtTO8Н~屾?:rP㨝HyP/@"s`PHZ `Vx J[,=etM_V3G!GcSE Jr û0[B}pOL3%Z{Ƈ#Z.XWL}tqYv6rdw!<:!=uJ:| IFh ++xӃIy/ 6UuLu?%G$>3jXT͙Ssms0jOYX 9|?C3 z{fJ f#go:3-dgu/ }x0;-eXyDk{ik"TTKa9Qj_ΗJV=&x ꄤHZT'rSPSB#Ԉ\xn0Ad!V"H?kʿr-y.ZAin3Z԰cașVո%]! Rm&nh*&^8+N2aZS{RnFLdH!Ck;uqj6RR"1tͧj%J$[H[|khm#TcEe qˢGD7TooS!(5jEJ+ qS9Ւq:C!裫:].r`\ Nպߪ.M7u1 pAf$3 )\%Nk\.~NiKĈlj8WW7fk4=c&Ä<6R3`ʏTzYS$jIm*qaҺ; u@Gme\2Xd>I4 0qT NOU2 /#kDBf:cȭOa:E0~ zaⷥxf 3Kc*D'D0RVP9R^|Z奄1>ze&蝓ES6u%" 4LkRa*NV$3, 9Qf 8#ra>N4Ij99grSjOŜGϢ9Mg:4n^6)aס& v^[= \6's&{TU7_/j^~XWh"#AA窻TmXҶ5Jՠ=u'.`#l܀&[I DaZ.Cm1Sz|;bIǐՊF77f)=)ϞOv"f_Y*WBo/L9diffobj/tests/_helper/objs/html/200.rds0000644000176200001440000000250314122754044017354 0ustar liggesusersYKoFVPzeQk5-;GEA"%96^>\ZVΒLE\i)R$~oZ/n_ۃ֣֗7j*47jKΰJf$pvy ]l==%L&,R %B 1\rG+G!BkfLh0/_s}pIr!g)8|'xD&%Kҧ~O Ou}H1RłTc+t҄y8 h#Zh'fU*I}5^F H Xt@yܒ^yFFF$r],CV.H>7f#"s#R7Y=)5)[p)E }}a#Ԕ؟ڏKeQ1hijآղ/HZfI5e! N5'10EU,dIX9Q Ȯ-Px{U)\fjt␸P`HM 3cJ{Z$+M 5 ")3s̋%G͗^mOR~>P]f8L]E~<Vt;Q r.QRLLj_zUü^,b9LJv|d>4_{YR?%FB9\ +jR1Vzgz3;4oʸwk+A2j!i%KfH11<8c2]+GW,TP+;k.6Z}o,J|)slƭZX3Y]ؽ5Խ /Օ;Zaw?AGS/)Nǹ=qL7FUwUN_m=hsnSAԹ5SNa߽؆]ϛ:zY_FuT91~5tuoxkKӗ#JnngxHӣ#jDƓܿ)3.z'B*:C(KՆ2xAsuM40Ӡw)}7O$Ⴙ5y(>3' cf\}{*FVKJ1o ɉM݋ỽ0fۥ.X(M&~ellJF 7 d"s&gMϛ(_4Q|kz_r-}|W_6_diffobj/tests/_helper/objs/html/400.rds0000644000176200001440000000106114122754044017354 0ustar liggesusersMo0pHTąrN ˢ(cV`0qȋf` 73"m$kQ rhſ֓'C_Y"9,ermǜQ=N؆ىnJYN#oxDyx([~cJ6ٝm$ԆD~( &)crD<DŽr'1p33\ag.\-3pn4qˡNJV "20G'e*isn ɂ "KzݝY%(\&07ӡwh3OLM-etdfocM9t!Gp`>C()\ Nܜ~G~. )-Xb|`Iz/{#A/WFkb=$ A bTe[$v!=? xE0"8FkuG?-[dsBkݒ:g]" O Rdiffobj/tests/_helper/objs/atomic/0000755000176200001440000000000014122754044016651 5ustar liggesusersdiffobj/tests/_helper/objs/atomic/600.rds0000644000176200001440000000073714122754044017677 0ustar liggesusersVKK1N(BQ-BEQdwn`l }XZ]9$3||\",T,dc*=zk滺osCɄZw}٨{{zqz}X-?jX͂;76}keіXmoMji a{(R}>cs'XfGH]6*J;"%N4L 11r`!' sQTB2'ƭJ)91xy'~r@aЌK\zaDe@L4ND{. M8a[3 "(~ ,|frx=3TFe@hrplO͏U^/ky?bS/I-[_Z _n}~23)-hӯk䣼,biRG9Bk)~#Tp diffobj/tests/_helper/objs/atomic/3400.rds0000644000176200001440000000052114122754044017747 0ustar liggesusersTN@đHH4S+B(QNŷP%|bc/: |W\eZ3mκNӦi;w-:Lۆ.w:wL۹;gʛs+yth޽c"ӱa S!İP"Vqj *7u diffobj/tests/_helper/objs/atomic/2500.rds0000644000176200001440000000244714122754044017760 0ustar liggesusersYˎD ݳ =/X].KBh~vHK|5!ON:ItN$qG{]9|jZOOo@ߵ>$>ks_43~?~ 8ccʗ+D+JKqeAr&/YiW}.y`ajU'3iX46i>:}7b"\ @j=R:L" dIN^םFS`́VY3LfG/z='7r7?qKoM]֢N::rp-]:y>e~f9yA^W7voMU1Y!!*)DP)UA* Yf;`pRYǣㆼ%{#QD)J=R +ƎdlkNs/@`:}?ؽqr 2m־u+́HZ8sA/O'CF}dsꈌf@= Tn@ Pͪ@kQg Vy1"S`́Euٹ|eOߏ yJG~&иeLĢ)=gaX25kn8Y=~ykꕣaf{}JKG;s!vB̅XCH>qI֝Ȩj&HԓD5IԒDJͪ@%kQ%g 7G9"/@ՙ?zhƹGGhByAٝsi'qޑV^M$,KV",{x.9S%UsAr.$ kN0Xk`3 )㋞0SFMY8gD8ڙ3+gV$fYyM΂ĺ$։'HPO I*WhV k1a-*֢\P E;`#pAֽcG[qGޓ#_ipQLTȄÿuJ'4Wq*g P̻xv1c`z?Jqt~х]c?׹L:s!uB̅TCyHɍ=ԺӤ։'HQO))E-\fUSbZL95UwgXK`խVo,)8# 򒼺?14;їȃN6Wϋ|Ӝg(~wQ>:Ƞ8>2Ua[X*ԫK׺bh}xB _^ߓ$$OcUiP€?2T:dQ$.?D*g*1])iv3L B`9RH)E~%jV0͊bLTRH~\( 6tRڄb)BO5JNpR!cɬ!d ~quldiffobj/tests/_helper/objs/atomic/1450.rds0000644000176200001440000000050614122754044017755 0ustar liggesusers[K@IAI+^a!z͆޽<+ųݡhSC;,=""|E<M87EDu:cuXjmz8ikF wdS[iM J+$♫kn!tDGgxzX {Nʙo\Tȏ8/L `9wl&9 Wv1,U0mlF``ig<ǜ{} Wԧ.j]Nm-;O +Bmɬūdiffobj/tests/_helper/objs/atomic/2700.rds0000644000176200001440000000053714122754044017760 0ustar liggesusersTj@h6m)te]hRRb 81M?]zu:>[ zΜk8nQ> cz@Z 8Min xO!/QW1~p! $|D9PcWGgnS? 8 ,G;vF_9:z;s*z}on@j$&/4[a*,UX 4aM_)Kl$yk+yZC{ -G1 Mh97;bY{(Rw|/dLpS~l|Ukdiffobj/tests/_helper/objs/atomic/1200.rds0000644000176200001440000000051214122754044017743 0ustar liggesusersKK@IA݄1i% og&cOg23M\9i|]'b'H➨SS3Vgդ֦?Rqˎ0mQJaLhyrc zꉶZ{7[vCF܁)p綇pϜUwwd>煮v@I@dD4uT?)tU"3f$C,lxoigǜCO 8\5Tjݔ.; XG)/A$diffobj/tests/_helper/objs/atomic/900.rds0000644000176200001440000000037414122754044017677 0ustar liggesusers 0T w/!'kE[5VO>%]P2t3v3c [GtҲTn|ƬUNpi7mIkwQ_V&7sEk}WX?)BsZu}AͥMO#F]-iY_Z6ԲEhi\"1\L ́ +qLk/kTnܥYWKep0Bҿ~h;Rdiffobj/tests/_helper/objs/atomic/1600.rds0000644000176200001440000000071714122754044017756 0ustar liggesusersUNP-&&4w͂ڂ!1|g(>{ ¯{Z4FIN;sf枆iIMZR". ZJ}X_5 86_Z-x`X鬁 1A*̴"Pc> gݰ RtT)ri/jAcf=)=PMդ~MU2K h@>,I"ΊrdZx _O[W|؛ML%udoC:QǤD`'xR9hUP)P&5N7g>l6GSt/tDqn-6v]t-`yNHf9ݱ-DIp4v+U*PpMPUjɱu4& gN=o*C٠7^RIh&mkw_ʿ|' diffobj/tests/_helper/objs/atomic/100.rds0000644000176200001440000000072614122754044017670 0ustar liggesusersWOO0&& $~Rc7l8a!hO_ۗba 휔ɱ_/:%) ;֦kk9D ['/ b\^M>h>%/^LV8TT3[9QOFżE%p"P= =oT)? M?]M3Bۧ^!ŒVv#. @0=. |y5T>?V}̈́CgdPc. 8J^^>7[UNE'([ʡ: y88ᒪIzSkht/NAP/I%JCܩ8Y^ Ｄm$SL#+w⃓;SLʆvr8*L4~  E-P; diffobj/tests/_helper/objs/atomic/1300.rds0000644000176200001440000000077214122754044017754 0ustar liggesusersN@EF4]($*"(*𡍗ҹ49ts!Ä!F Œ5Ƥx?sIWs+<"76L{i-@=XaGx+|[fɾ?b-ӪKp܀[{z`Ŀ,?]Z`?bjV ;P A܃FrUIU5'm :tq {2&jY08HMAF%{YMc:ScFf`N @lP#Nd7ʕ,[5r'`΁<8GIP5=&\S k0أw'({8:_w n{Ttn2mi;t&R'A diffobj/tests/_helper/objs/atomic/3000.rds0000644000176200001440000000025514122754044017747 0ustar liggesusersb```b`fbb`b13 'N66ε `v"&+,APH2d 70BB +D%RR2qX9V$R)f$1 ,L@71BƜxB`g`P&diffobj/tests/_helper/objs/atomic/2900.rds0000644000176200001440000000024714122754044017760 0ustar liggesusersb```b`fbb`b13 '66ε `v"%LrJMrp(6upP0TF4P5Սц`D%RR2(!lAr7v$ UJJPsaXn`9'5H@hadiffobj/tests/_helper/objs/atomic/2520.rds0000644000176200001440000000120414122754044017750 0ustar liggesusers@M"EJ* 3,#Ebu}M)]H2G`K1?32ڭjN?Ѹ3rğֱy<Ƈe+㾬VnhCECi?YڊS7f҂1҇ ˸+edEU*T6vTNoVyKg֌yk'09,`cs F ~]\Ql P lai=OSgJx:.ʗ#bjƫW6^m^qVt BzЇ a)("U#R3"="3Og꒹Y̙bs3Ŝ)U\Ql>PBz=0CFFd^jp^Vt f0,ak؄VͺиѸѸѸѸV%% oAI$DoI*2WQj_櫠y~,Pʾ,,'s%3W?4Z|m0Ck diffobj/tests/_helper/objs/atomic/2530.rds0000644000176200001440000000132314122754044017753 0ustar liggesusersN@*uE7VxTU86 @H,*eOg%8H_lO|.s1 a4F`yơVO\TF'u➬hs69[zk#NTViv 7:X™mȟGQ,M9-p@ mL7 JɺXoVuϘ۾h9\Fp W0NmB# /_ _Ge[C 氀hO~aT١N<ˬmhjFV6Zm/Fl3w:Lp])AghʒG3E)` nx*:kfFw u#̞ILg=왔kٖA@!@z@>cA9ăaIzVUUEV.Z]'Fl30K1L`ZlwJ*w]G6}* u[OvnW~b-dܲ;oy!wֹ0a6Jk9xji/amO diffobj/tests/_helper/objs/atomic/2200.rds0000644000176200001440000000120614122754044017745 0ustar liggesusers@6 !h {BH[ (ǠIx*I$&΍2=g|f/oT]>򾺯O; _2&U?>: B=x2%^5ew׵uz9\'_rGY-U UHUSe~Zz UȫW#F^-O'UȫW%J^5ԏ򣴖JQUɫW%ԏZKy*UȫW|q-sRPTS\p`h+HU`XtƲ-w 3/P0LS ө29}Jqka@Mj +ǭ@x <7KHY_D"@ BߖhenrUN`xi69.)x ^Y1X,KHs9DJȲpY?F=H@$  D3N,t I~w폧g>`| diffobj/tests/_helper/objs/atomic/3300.rds0000644000176200001440000000050114122754044017744 0ustar liggesusersAN0EݤB =9 3v )bGw5+!8gb4&!faEo'WƘT0¬ͥo=s6&ڏx;GIzKb ŹNiIc再^k}ϽFo): 8FZ!jT\q D'-qGI,ICHDH|&'Ho&h4iΦ k nR#4\Ry:yv|8 #Ǘ|!Sc w X4?ejga֕j_eUb/VVy[diffobj/tests/_helper/objs/atomic/700.rds0000644000176200001440000000061514122754044017673 0ustar liggesusersN0M$$vSh U nsCc;ĩB1$ZJ~!':'jxD}ѥOQk4΂6ꛯ [#|C@ݶt!v!u7~QR.o30!)#(gxi*$UL:ĚB$LXynj(YؠB!%v! .K؉*tGn?0`k=03JiFer@9 jSY"pVcbIsR~sA=B h68x!H, z2FQ"/.D#{NrJS-[%diffobj/tests/_helper/objs/atomic/1900.rds0000644000176200001440000000052714122754044017760 0ustar liggesusersN0EM HHXd H;5>q&q["M^{۝1&3y,?>p5˜Ǧ,=K!ŃeUVH.JxVJR#)CSZj}:DElQnT?R=>$p 0aRX+B0FV3tFPƁq`Ɓq۵q2:ӀEi'\1N6eՇyZGGUQ2Ҁ3^0."`Q0 FWg%{F|:1#\whSuI,K^N?g9al3~2%bYSŹP]$na3.9__ Tx [ diffobj/tests/_helper/objs/atomic/3100.rds0000644000176200001440000000026714122754044017753 0ustar liggesusersb```b`fbb`b13 'N66ε `v"&+,APH2d nAAna,DXFB JPRR2(AeF \W4MZ ʤ*! Xng9'5H@diffobj/tests/_helper/objs/atomic/500.rds0000644000176200001440000000065114122754044017671 0ustar liggesusersK0cc+"O^jJ+0PJk"30Bxy«%H.Jťm}#.efrWd\kt>ǵj],/X"\)AdP_^?,Ӟ&yp8G^@{*2(e,, ²K=q„ĩI.N'Grti8/OJRX Kaܬho89ŵ*(oaa71a*Y2}}yrdiffobj/tests/_helper/objs/atomic/1500.rds0000644000176200001440000000071414122754044017752 0ustar liggesusersIOP e{6[`HgAAh\ű0;,^nim|}7snﻅuI,'llH)i "mh'.qv|ru^?ϋEE 3[Zdh\ J,lrcڕb=PȖz򢷤 )n-;eh.kxOL?YBնdk0`ƾ:gT Nu Elg%dζ_:c ``^+x L^䎨1Es1rB.%AT8 v^NsF<ܝf>Vy5zg 唞錢hJcpf jiYb7tz:vךmЉ~N5(jNs.B4-lS w,M FC_|2K`P^}·VR\`6oڲj 19Q C gbƑHx٠ͅ)^z1hr572TR/^4Jh:AtMK#Şd&A͛$-6I||}atk͛9v3#1,>i_8 IF$ɘd2CìqxGȃ p  fVY5ոWҝi"RJ *܀[p>kQRHR")T~E[Ს^чr#diffobj/tests/_helper/objs/atomic/1100.rds0000644000176200001440000000035614122754044017750 0ustar liggesusersK @o- mYdJ!DؿEwV_X ѹA)SiCT*5[e)y8 ͉t6NwۖŵQr_q-}N)9QK$\-b <0S0s^x;{ϐb_7xe^b%X ``Lu=:NgpOhTB eQ*_ʂdiffobj/tests/_helper/objs/atomic/200.rds0000644000176200001440000000062614122754044017670 0ustar liggesusersՕK0cGcu+"O^m`7\?>n07dRj}ZCR9 VI` NI% bUAdAbyPA,;)y!ɾ`g &0؃;pp '`3@gdYu2 ʵK$'K$% v_Z7Inv\NG@/ηdiffobj/tests/_helper/objs/atomic/2540.rds0000644000176200001440000000127514122754044017762 0ustar liggesusersn@M HHlX) 3z$M6MobJH,jqx0K4v"}c{ʲnV{5|[kzǻn7ȿ/I7ӓm۽KEiyډavB;)Q2cYedXTv <8NS©e%s6g:A) pp Wmat!ȑ /_XV5N` 3bstJЫC%d<ubhuEVoQ#Ap C8陣7}LU}Դ(9!)` X !OЬmat^HάԴ0{3Ş)LgJ7胐l#8> ´48 G25RYVVVZ=zhFl pp Wp v\iԵ(S SO|S5Mմ0ld[,Jpp Wp Fl+@s.4j4j4j4j4j+IZB8f~%~$wer<<7[fyQaz};{َoay͗bi݌\ts3Vx+>?yq73ʌ 3TZ֡ge v diffobj/tests/_helper/objs/atomic/400.rds0000644000176200001440000000065014122754044017667 0ustar liggesusersՖO0ࢉegDab Ɠz1C&k8Ʒ1p aYhxXŲUIGT*ۧ?9 {7fJRW V+c5wz"ۅF́3@mKܚt>WlD"Lф%c?*O|5e+-AS7Wrc!L0H=%H@aI7[gNb EL2x a"p N#zh:<Nk.Wjnڵ9_A#ƌG1i(I_KqmOX{1a]}7v9#3~I|+Oey}%+95InȃocU{Phj瀱Z w7diffobj/tests/_helper/objs/atomic/1250.rds0000644000176200001440000000051614122754044017754 0ustar liggesusersSN0uJ$$\9А(BMY)@YRrSTǞE!̛73VζRm-`P}E9mMDPIj{uklqjq#s*ϫtM.nݒ"Vsu,y;qV)^.1ptR;7k|.#l8e^&'s mkK|>̍{㮸ϙl\hsMGaOu3BS(8fXKxsNf9u{+\ހG1pN-WEP'ض+5Wdiffobj/tests/_helper/objs/atomic/1800.rds0000644000176200001440000000052314122754044017753 0ustar liggesusersN@Wڋ&&޽x`Jg1} MoųOvYJwf9WUQbupȹ'Z,/xfYd>(w|NS >A% A(I>m<[֡B%o%&*'i6i|4;HjMY$M]i7Gǻ :.UF+%ZUV3QWq<ҘLS-X;J0!8g΁wyZkmv9^wP}Ud͂ű0[*ʑ*U)IGJH!jj& e4/Oo\_\%#N87G</xO|Wn8θ nq{<Ox ^w|_?UM7p g\='<x;>/|⪡83q[xWq~q q׸-p< x+| ߸8kwgox>o\_\tGp5np;x3^77./#N87G</xO|W#p'qx# ' ~n8θ nq{<Ox ^w|_?L7p g\='<x;>/|j83q[xWq~q q׸-p< x+| ߸8kwgox>o\_\tGp5np;x3^77./#N8 ܆diffobj/tests/_helper/objs/diffStr/0000755000176200001440000000000014122754044016776 5ustar liggesusersdiffobj/tests/_helper/objs/diffStr/600.rds0000644000176200001440000000134614122754044020021 0ustar liggesusersWo0gI/4ii'kfJ&Nmun9lR"E#i;siL0`%}o/4MhDL+v{hY{f\<4x'0)~a: ..ϱ 8 BD [s#ƾx p9  \[jVR-U t&Z^er6uŪH ii Y7z x䍮uBed`}? [v۔9v&hة*ha?~r˭ad%j~@ɶ^|imɝ'Qb6rf#?zvWˋslTS+ۼvxW! pBZ}T9Ǐa )*a xc=uJy։B MP9%¬Rh}7pCj8.\6grdyNcצrfG9 Rh)*C}{j 0;f--# KXe̅?.,QU*9] vQ_F~qXw1ZX! pr#S^UȴnuãxBߝ}& YFSJr) O ye*w$ʪHm긦WVu'ا-BLٴ1XW5̓*)J;6cdPu[h.* YÄ1{ :eTJ{*"4<1.©aBuB?}n'LlG<-k̔(&M߸"; i ),i-U";I^9Wqڏe=vjۙ Z`|%zO#$%[LM"`'36LLU^t׉.mC❝(g씑\=^ Kb>\ diffobj/tests/_helper/objs/diffStr/100.rds0000644000176200001440000000511514122754044020012 0ustar liggesusers\͋K"@wobgYIXXrXrvw洐{99y߲$=+!nm=IklrՋW_g~DjH??RҌ˪JwS䠟'w郫ψw\[\MtZtkcz;7m_eEC{zo58?@0H` $?kˣ!QVdK~ўd+g٭M/]{,ԋ"A;=bB1qCns[}4{@\zq\g̵˻];qn[Ê7dQ|k{W|_}g A>UQ9=x_KaBF8!"Y>EEߛ; PR]Ŝa[qqg.eR.2?IY?*執ttj)bxT5Pz. rU0j]wˉ{yDu q5NsI#bi\zz2~sϣs,'w/P]UOCr{mD-byÚjEjlr7y5fChHc8Kɩ@\kH&8(.fX)w_}a,'meoDN5^MIz>QB@:YIR A@iTc] Eɐ.QNȨMΏ@ '+E0V`|m%x*6Ģ1]m ?[hkCT|' ^[R\WaBKQaL%ܪ߱9͟k+ >+Oy G*dȒs.IZUݺk%֓1CS0(hԕBd8qP٧ (N߭^QNII*HR67HZ btC /0Z2ʹb'MVd4`]PjעH^}޶4ܦIUF1韴\ϲ1"I֑upe?#i'rX֑AudY)yJ l O]5 lH :! tDo d9VQgx`D:q-DƷXm*Hޗ62TxDkg^죢w-]9!̲衝,kܷdYOƭ_DCi֓q;hƙgM'Q$F!_?%omP ['CiP6$coLz>/zm<$Dvavw͟vqT4s[-{L"ǑD?/ ۮyN߽AK7w+0#teP|f<iVOPPN]n .ɱnBЦ-V 7rV ,Cph{l'/.t2#8w$p"K|Ѝftte=Yw8=Y{i ǧ~VsG?A `=]muۻdݔ˜g6dNkFSc{sQ8i]_GaYW}1F1V7A:}v4m,ad9MOLq7 Q,#i=]G3xb\pV3 sf] c9c[a֦]Q0h šKWb]q܌fk{FΉQ+z2l! SHQ('d4CXuV;k7ė=,K*&OegV`+Leq|qh;~gf)}~2X0ȰdnA~2|7al+z{xX$coM=1Kkșa+Тw.f}k5ɠaG[&|G-. T` 'O w7&||ϐwTZO>zIUeO[:ߘhHUdiffobj/tests/_helper/objs/diffStr/700.rds0000644000176200001440000000074414122754044020023 0ustar liggesusersn@)zi&2!=7,_DĘHeK>D鲀|H-qW BC7l%wMsl8m?ƓT!n #P[Ѫy$X=7ǀ>Iz ,?p&#֞:u@g{=-80:(rtN6VJzd$ Hsu,7[q|Bˀ,`\wfϗMR!1Æzozf$"0V)BrGsjS+BS)(fmW* V6+ Z/RT \LJRrp_!ZgjSRgVv3|< mK'[Z,G9(,-Ӥ.jƧ_l͢[$4EƸY Q ] M$wdiffobj/tests/_helper/objs/diffStr/100.txt0000644000176200001440000000030314122754044020033 0ustar liggesusers< str(list(a = 1)) > str(list(a = 1.. @@ 1,2 @@ @@ 1,3 @@ < List of 1 > List of 2 $ a: num 1 $ a : num 1 ~ > $ cabera: num 3 diffobj/tests/_helper/objs/diffStr/500.rds0000644000176200001440000000171414122754044020017 0ustar liggesusersXn0V~(н#!De)t dh @JrJN):wܹs}>BQJJ%E`Hww'ZimmmX[sڶh {#4-* zW^C<𷷺du3)!&@>kl56ҷb篇ay|n\p4jWYi=BMIj/HG𔗿\q: jφAZг&#HIA@_ШHd9ILW]eO=;".CEh3*#UkZpW`:46K} ?=`u`m tU9#.yRʑg(t#[|VvJF\6yݜs;u_*hI&*ӕmwӺZ#ԇmj0ӔpIKZSW]eo}8!znQDEqT5 Y IB[=\~@UvU?LA$<ڸe )(lv8{S-VWgӇӪ6u6W &*N:<|BG>%g6SA4r5yh _uĖL+Zygkrv!VMkUs-F4>_s">/"*/ R nyp>M3P:a2]$~.Pbe]\^n̕M񌸂]#EG>d"TrSd@ȖOf,빩^R2"g<:4uխh!ͲZم*?p,*} /X$,ck/u+M "dz|(eLdiffobj/tests/_helper/objs/diffStr/300.rds0000644000176200001440000000074514122754044020020 0ustar liggesusersN0F9Y3uE &+aq 7>>g캍}0]'=so>_ QFhްZh N;C޽mXxڟ`;d-`MK?6&>$8={<,u_LsHp8Tl~p&#֞u@g{=M0*rt΢6VJd$ Hsuj,7[ pCˀ,`\wf-OBb `ߪI$E`0Rh=}zUL O웹u L'8T5=lWbM;uEoy p*`Vz\{ :S]xT::#Aia/FXy =xvp{`%>iԁwp7l|bl")2EjXj_`'owdiffobj/tests/_helper/objs/diffStr/1100.rds0000644000176200001440000000042314122754044020070 0ustar liggesusersRMK@& xmajH@ABt dɶ6\T9{>!#ḝ{H1IƮh$͆9ȼi 妝!ۚC!x6ViYMU (Ez?Cv!gOSh.L s\XGnIͩMuCO3diffobj/tests/_helper/objs/diffStr/200.rds0000644000176200001440000000056314122754044020015 0ustar liggesusersTN@]i/jL{7+]ZKC#IX?/5 Pi%3 O!1{)cD:W$K,=̚u){nұ Ia |I7U)>D_u32`lÇD e1LYX]> eamNV:= 0ƚ/Dn#6 220) # test <- subset(penguins, year == 2008) # a <- test$bill_length_mm # b <- comparison$bill_length_mm a <- c(39.6, 40.1, 35, 42, 34.5, 41.4, 39, 40.6, 36.5, 37.6, 35.7, 41.3, 37.6, 41.1, 36.4, 41.6, 35.5, 41.1, 35.9, 41.8, 33.5, 39.7, 39.6, 45.8, 35.5, 42.8, 40.9, 37.2, 36.2, 42.1, 34.6, 42.9, 36.7, 35.1, 37.3, 41.3, 36.3, 36.9, 38.3, 38.9, 35.7, 41.1, 34, 39.6, 36.2, 40.8, 38.1, 40.3, 33.1, 43.2, 49.1, 48.4, 42.6, 44.4, 44, 48.7, 42.7, 49.6, 45.3, 49.6, 50.5, 43.6, 45.5, 50.5, 44.9, 45.2, 46.6, 48.5, 45.1, 50.1, 46.5, 45, 43.8, 45.5, 43.2, 50.4, 45.3, 46.2, 45.7, 54.3, 45.8, 49.8, 46.2, 49.5, 43.5, 50.7, 47.7, 46.4, 48.2, 46.5, 46.4, 48.6, 47.5, 51.1, 45.2, 45.2, 50.5, 49.5, 46.4, 52.8, 40.9, 54.2, 42.5, 51, 49.7, 47.5, 47.6, 52, 46.9, 53.5, 49, 46.2, 50.9, 45.5) b <- c(39.1, 39.5, 40.3, NA, 36.7, 39.3, 38.9, 39.2, 34.1, 42, 37.8, 37.8, 41.1, 38.6, 34.6, 36.6, 38.7, 42.5, 34.4, 46, 37.8, 37.7, 35.9, 38.2, 38.8, 35.3, 40.6, 40.5, 37.9, 40.5, 39.5, 37.2, 39.5, 40.9, 36.4, 39.2, 38.8, 42.2, 37.6, 39.8, 36.5, 40.8, 36, 44.1, 37, 39.6, 41.1, 37.5, 36, 42.3, 46.1, 50, 48.7, 50, 47.6, 46.5, 45.4, 46.7, 43.3, 46.8, 40.9, 49, 45.5, 48.4, 45.8, 49.3, 42, 49.2, 46.2, 48.7, 50.2, 45.1, 46.5, 46.3, 42.9, 46.1, 44.5, 47.8, 48.2, 50, 47.3, 42.8, 45.1, 59.6, 49.6, 50.5, 50.5, 50.1, 50.4, 46.2, 54.3, 49.8, 49.5, 50.7, 46.4, 48.2, 48.6, 45.2, 52.5, 50, 50.8, 52.1, 52.2, 49.5, 50.8, 46.9, 51.1, 55.9, 49.1, 49.8, 51.5, 55.1, 48.8, 50.4, 46.5, 50, 51.3, 45.4, 52.7, 45.2, 46.1, 51.3, 46, 51.3, 46.6, 51.7, 47, 52, 45.9, 50.5, 50.3, 58, 46.4, 49.2, 42.4, 48.5, 43.2, 50.6, 46.7, 52) # In <0.3.4: Exceeded buffer for finding fake snake ses(a[-c(15:38, 50:90)], b[-c(40:85, 100:125)], max.diffs=80) # In <0.3.4: Faux Snake Process Failed ses(a[-(18:38)], b[-(50:80)], max.diffs=115) # - issue 157 ------------------------------------------------------------------ # Arguably could match on 'A' instead of 'X' and be more compact a <- c('a', 'b', 'c', 'A', 'X', 'Y', 'Z', 'W') b <- c('X', 'C', 'A', 'U', 1, 2, 3) ses(a, b, max.diffs=13) # segfault (but may have beend debugging code) ses(letters[1:2], LETTERS[1:2], max.diffs = 4) # snake overrun ses(c("G", "C", "T", "C", "A", "C", "G", "C"), c("T", "G"), max.diffs=2) # effect of max.diffs on compactness (waldo logical comparison) ses(c('A','A','A','A','A'), c('B','A','B','A','B'), max.diffs=0) ses(c('A','A','A','A','A'), c('B','A','B','A','B'), max.diffs=1) ses(c('A','A','A','A','A'), c('B','A','B','A','B'), max.diffs=2) # back snake all matches before faux snake triggered ses_dat( a=c("T", "A", "A", "C", "C", "A"), b=c("A", "G", "A", "A"), max.diffs = 0 ) # - errors --------------------------------------------------------------------- try(ses('a', 'b', max.diffs='hello')) # "must be scalar integer" try(ses('a', 'b', warn='hello')) # "must be TRUE or FALSE" a <- structure(1, class='diffobj_ogewlhgiadfl2') try(ses(a, 1)) # "could not be coerced") try(ses(1, a)) # "could not be coerced" # We want to have a test file that fully covers the C code in order to run # valgrind with just that one. We were unable to isolate simple diffs that # triggered all the code, but we were able to do it with the below in addition # to the above. # - Repeat tests for full coverage in SES file --------------------------------- # From test.diffStr.R # formula display changed if( R.Version()$major >= 3 && R.Version()$minor >= "3.1" || R.Version()$major >= 4) { rdsf1 <- function(x) readRDS(file.path("_helper", "objs", "diffStr", sprintf("%s.rds", x))) all.equal( as.character( diffStr(mdl1, mdl2, extra=list(strict.width="wrap"), line.limit=30) ), rdsf1(500) ) } # from testthat.warnings.R A3 <- c("a b c", "d e f A B C D", "g h i", "f") B3 <- c("a b c", "xd e f E Q L S", "g h i", "q") diffChr(A3, B3, max.diffs=2) # warn: "Exceeded diff" # - ses_dat -------------------------------------------------------------------- a <- b <- do.call(paste0, expand.grid(LETTERS, LETTERS)) set.seed(2) b <- b[-sample(length(b), 100)] a <- a[-sample(length(b), 100)] dat <- ses_dat(a, b) all.equal(dat[['val']][dat[['op']] != 'Delete'], b) all.equal(dat[['val']][dat[['op']] != 'Insert'], a) all.equal(a[dat[['id.a']][!is.na(dat[['id.a']])]], a) dat2 <- ses_dat(a, b, extra=FALSE) all.equal(dat[1:2], dat2) all.equal(length(dat2), 2L) try(ses_dat(a, b, extra=NA)) # 'TRUE or FALSE' # - encoding agnostic #144 ----------------------------------------------------- # h/t @hadley, these are different in string cache, but should compare equal # as per ?identical x <- c("fa\xE7ile", "fa\ue7ile") Encoding(x) <- c("latin1", "UTF-8") y <- rev(x) all.equal(diffobj::ses(x, y), character()) diffobj/tests/test-html.R0000644000176200001440000000364414122754044015075 0ustar liggesusersNAME <- "html" source(file.path('_helper', 'init.R')) # Verify that internal css works # - HTML Output Modes ---------------------------------------------------------- all.equal( as.character( diffPrint( letters[1:3], LETTERS[1:3], style=StyleHtmlLightYb(html.output="diff.only") ) ), rdsf(100) ) all.equal( as.character( diffPrint( letters[1:6], LETTERS[1:6], style=StyleHtmlLightYb(html.output="diff.w.style") ) ), rdsf(200) ) all.equal( as.character( diffPrint( letters[1:6], LETTERS[1:6], style=StyleHtmlLightYb(html.output="page") ) ), rdsf(300) ) all.equal( as.character( diffPrint( letters[1:6], LETTERS[1:6], mode="unified", style=StyleHtmlLightYb(html.output="page") ) ), rdsf(350) ) # - Sub CSS -------------------------------------------------------------------- # Mess up the CSS to test that we can change CSS file local({ f <- tempfile() on.exit(unlink(f)) cat("div.row {background-color: red;}\n", file=f) all.equal( as.character( diffPrint( letters, LETTERS, style=StyleHtmlLightYb(css=f, html.output="diff.w.style") ) ), rdsf(400) ) }) # - Tag funs ------------------------------------------------------------------- div_a <- div_f("A", c(color="red")) all.equal( div_a(c("a", "b")), c( "
a
", "
b
" ) ) span_a <- span_f() all.equal(span_a(c("a", "b")), c("a", "b")) try(div_a(TRUE)) # "must be character" all.equal(div_a(character()),character()) # - nchar ---------------------------------------------------------------------- all.equal(nchar_html("25"), 2) all.equal(nchar_html("25 "), 3) # - cont_f --------------------------------------------------------------------- try(cont_f("hello")(1:3)) # "must be character" diffobj/tests/test-core.Rout.save0000644000176200001440000001426614122754044016550 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "core" > source(file.path('_helper', 'init.R')) > > # The Myers paper strings > > A <- c("a", "b", "c", "a", "b", "b", "a") > B <- c("c", "b", "a", "b", "a", "c") > > # - diff myers simple ---------------------------------------------------------- > > identical( + diffobj:::myers_simple(character(), character()), + list(target = integer(0), current = integer(0)) + ) [1] TRUE > identical( + diffobj:::myers_simple("a", character()), + list(target = NA_integer_, current = integer(0)) + ) [1] TRUE > identical( + diffobj:::myers_simple(character(), "a"), + list(target = integer(0), current = NA_integer_) + ) [1] TRUE > identical( + diffobj:::myers_simple("a", "a"), list(target = 0L, current = 0L) + ) [1] TRUE > identical( + diffobj:::myers_simple("a", "b"), + list(target = 1L, current = 1L) + ) [1] TRUE > identical( + diffobj:::myers_simple(c("a", "b"), "b"), + list(target = c(NA, 0L), current = 0L) + ) [1] TRUE > identical( + diffobj:::myers_simple(c("a", "b"), "a"), + list(target = c(0L, NA), current = 0L) + ) [1] TRUE > identical( + diffobj:::myers_simple("a", c("a", "b")), + list(target = 0L, current = c(0L, NA)) + ) [1] TRUE > identical( + diffobj:::myers_simple("b", c("a", "b")), + list(target = 0L, current = c(NA, 0L)) + ) [1] TRUE > identical( + diffobj:::myers_simple(c("a", "b"), c("b", "c")), + list(target = c(NA, 0L), current = c(0L, NA)) + ) [1] TRUE > identical( + diffobj:::myers_simple(c("a", "b", "c", "d"), c("a", "c", "d", "b")), + list(target = c(0L, NA, 0L, 0L), current = c(0L, 0L, 0L, NA)) + ) [1] TRUE > # Actual Myers sample string > identical( + diffobj:::myers_simple(A, B), + list(target = c(NA, NA, 0L, 0L, 0L, NA, 0L), current = c(0L, NA, 0L, 0L, 0L, NA)) + ) [1] TRUE > # - diff myers mba ------------------------------------------------------------- > > identical(ses(character(), character()), character()) [1] TRUE > identical(ses("a", character()), "1d0") [1] TRUE > identical(ses(character(), "a"), "0a1") [1] TRUE > identical(ses("a", "a"), character()) [1] TRUE > identical(ses("a", "b"), "1c1") [1] TRUE > identical(ses(c("a", "b"), "b"), "1d0") [1] TRUE > identical(ses(c("a", "b"), "a"), "2d1") [1] TRUE > identical(ses("a", c("a", "b")), "1a2") [1] TRUE > identical(ses("b", c("a", "b")), "0a1") [1] TRUE > identical(ses(c("a", "b"), c("b", "c")), c("1d0", "2a2")) [1] TRUE > identical( + ses(c("a", "b", "c", "d"), c("a", "c", "d", "b")), c("2d1", "4a4") + ) [1] TRUE > # Actual Myers sample string > identical(ses(A, B), c("1,2d0", "4d1", "5a3", "7a6")) [1] TRUE > # This used to cause errors due to under-allocated buffer vector > identical(ses(letters[1:10], LETTERS[1:2]), "1,10c1,2") [1] TRUE > > # A little more complex with changes, this was a problem at some point > > A2 <- c("A", "B", "C") > B2 <- c("X", "A", "Y", "C") > identical(ses(A2, B2), c("0a1", "2c3")) [1] TRUE > > # More complicated strings; intended for use with contexts for hunks, > # but making sure the diffs are correct > > A1 <- c("A", "AA", "B", "C", "D", "E", "F", "G", "H") > B1 <- c("A", "B", "X", "W", "D", "DD", "E", "Y", "Z") > C1 <- c("X", "D", "E", "Y", "Z", "H") > > identical(ses(A1, B1), c("2d1", "4c3,4", "5a6", "7,9c8,9")) [1] TRUE > identical(ses(A1, C1), c("1,4c1", "7,8c4,5")) [1] TRUE > > A5 <- c("A", "AA", "B", "C", "D", "E", "F", "G", "H") > B5 <- c("A", "B", "X", "W", "D", "E", "F", "W", "G") > identical(ses(A5, B5), c("2d1", "4c3,4", "7a8", "9d9")) [1] TRUE > > # NAs treated as strings > > identical(ses(c(NA, "a", "b"), c("a", "b", NA)), c("1d0", "3a3")) [1] TRUE > > # Coersion to character > > identical(ses(1:5, 4:6), c("1,3d0", "5a3")) [1] TRUE > > # - print/summary -------------------------------------------------------------- > capture.output( + res.1 <- summary(diffobj:::diff_myers(A, B), with.match=TRUE) + ) [1] " type string len offset" "1 Delete ab 2 1" [3] "2 Match c 1 3" "3 Delete a 1 4" [5] "4 Match b 1 5" "5 Insert a 1 3" [7] "6 Match ba 2 6" "7 Insert c 1 6" > identical( + res.1, + structure(list(type = structure(c(3L, 1L, 3L, 1L, 2L, 1L, 2L), .Label = c("Match", + "Insert", "Delete"), class = "factor"), string = c("ab", "c", + "a", "b", "a", "ba", "c"), len = c(2L, 1L, 1L, 1L, 1L, 2L, 1L + ), offset = c(1L, 3L, 4L, 5L, 3L, 6L, 6L)), class = "data.frame", row.names = c(NA, + -7L)) + ) [1] TRUE > capture.output( + res.2 <- summary(diffobj:::diff_myers(A, B), with.match=FALSE) + ) [1] " type len offset" "1 Delete 2 1" "2 Match 1 3" [4] "3 Delete 1 4" "4 Match 1 5" "5 Insert 1 3" [7] "6 Match 2 6" "7 Insert 1 6" > identical( + res.2, + structure(list(type = structure(c(3L, 1L, 3L, 1L, 2L, 1L, 2L), .Label = c("Match", "Insert", "Delete"), class = "factor"), len = c(2L, 1L, 1L, 1L, 1L, 2L, 1L), offset = c(1L, 3L, 4L, 5L, 3L, 6L, 6L)), .Names = c("type", "len", "offset"), row.names = c(NA, -7L), class = "data.frame") + ) [1] TRUE > identical( + capture.output(print(diffobj:::diff_myers(A, B))), ses(A, B) + ) [1] TRUE > # # - translate > # aa <- c("a", "b", "b", "c", "e") > # bb <- c("x", "y", "c", "f", "e") > # identical( > # diffobj:::diffObjCompact(diffobj:::diff_myers(A, B)), > # list(target = c(NA, NA, 0L, NA, 0L, 0L, 0L), current = c(0L, 0L, NA, 0L, 0L, NA)) > # ) > # identical( > # diffobj:::diffObjCompact(diffobj:::diff_myers(aa, bb)), > # list(target = c(1L, 2L, NA, 0L, 0L), current = c(1L, 2L, 0L, NA, 0L)) > # ) > # > # } ) > > proc.time() user system elapsed 1.154 0.117 1.282 diffobj/tests/test-diffChr.R0000644000176200001440000001365415000460760015473 0ustar liggesusersNAME <- "diffChr" source(file.path('_helper', 'init.R')) # - Corner Cases --------------------------------------------------------------- # Corner cases from https://neil.fraser.name/writing/diff/ # Both of these appear handled correctly by the algorithm here # first one: suboptimal edit script due to two sided approach A1 <- c("X", "A", "X", "C", "X", "A", "B", "C") B1 <- c("A", "B", "C", "Y") all.equal(as.character(diffChr(A1, B1)), rdsf(100)) # second one: failure to find intersection at ends of paths (paths run into # each other eventually) A2 <- c("A", "B", "X", "A", "B") B2 <- c("A", "Y", "B") all.equal(as.character(diffChr(A2, B2)), rdsf(200)) # Simple corner cases all.equal( as.character(diffChr(character(), character())), rdsf(225) ) all.equal(as.character(diffChr("", "")), rdsf(250)) # - Larger strings ------------------------------------------------------------- # diffChr(X[1:2000], X[2001:4000]) all.equal(as.character(diffChr(chr.7, chr.8)), rdsf(300)) # Too slow to run; useful for benchmarking though # X1 <- X[1:2e4] # X2 <- X1[-sample(seq_along(X1), 2e3)] # X2[sample(seq_along(X2), 4e3)] <- "XXXXXX" # res <- diffChr(X1, X2) # res <- diffChr(X[1:10000], X[7500:17500]) # res <- ses(X[1:10000], X[7500:17500]) # res <- diffChr(X[1:25000], X[10001:50000], max.diffs=65000) # - Sentences chr.5 <- c( "hello there how are you doing", "humpty dumpty took a big fall", "lorem ipsum dolor sic est boom", "a computer once wrote a phrase" ) chr.6 <- c( "hello THERE how are you doing", "and another SENTENCE blah blah", "humpty dumpty TOOK a big fall", "a COMPUTER once wrote a phrase" ) all.equal(as.character(diffChr(chr.5, chr.6)), rdsf(400)) all.equal( as.character(diffChr(chr.5, chr.6, mode="unified")), rdsf(500) ) all.equal( as.character(diffChr(chr.5, chr.6, mode="context")), rdsf(600) ) # - Whitespace ----------------------------------------------------------------- all.equal( as.character(diffChr(c("a", "b", "c"), c("a ", "b", "c"))), rdsf(800) ) all.equal( as.character( diffChr(c("a", "b", "c"), c("a ", "b", "c"), ignore.white.space=FALSE) ), rdsf(900) ) # New lines count as new elements all.equal( as.character(diffChr("woo\nhoo\nfoo", c("woo", "foo"))), rdsf(1000) ) all.equal( capture.output(diffChr("hello . world", "hello. world", format='raw')), txtf(100) ) # - SGR ------------------------------------------------------------------------ a <- c("hello \033[31mworld\033[m", "umbrellas", "tomatoes") b <- c("hello world", "umbrellas", "tomatoes") local({ old.opt <- options(diffobj.sgr.supported=TRUE) on.exit(options(old.opt)) diff <- diffChr(a, b) # warn: 'contained ANSI CSI SGR' try(diffChr(a, b, strip.sgr=1:3)) # "TRUE, FALSE, or NULL" try(diffChr(a, b, sgr.supported=1:3)) # "TRUE, FALSE, or NULL" c( all.equal(capture.output(show(diff)), txtf(200)), all.equal(capture.output(show(diffChr(a, b, strip.sgr=FALSE))), txtf(300)), all.equal(capture.output(show(diffChr(a, b, format='raw'))), txtf(400)) ) }) # - Alignment ------------------------------------------------------------------ chr.7 <- c("a b c d e", "F G h i j k", "xxx", "yyy", "k l m n o") chr.8 <- c("f g h i j k", "hello", "goodbye", "yo", "k l m n o") all.equal(as.character(diffChr(chr.7, chr.8)), rdsf(1100)) all.equal( as.character(diffChr(chr.7, chr.8, align=4/6)), rdsf(1100) # same as above ) # No longer aligns all.equal( as.character(diffChr(chr.7, chr.8, align=4.01/6)), rdsf(1200) ) all.equal( as.character(diffChr(chr.7, chr.8, align=AlignThreshold(min.chars=4))), rdsf(1100) # same as earlier ) all.equal( as.character(diffChr(chr.7, chr.8, align=AlignThreshold(min.chars=5))), rdsf(1200) # same as above ) ## Normally this would not align, but we allow symbols to count towards ## alignment chr.7a <- c("a b c e", "d [ f g") chr.7b <- "D [ f g" a1 <- AlignThreshold(threshold=0, min.chars=2, count.alnum.only=FALSE) all.equal( as.character(diffChr(chr.7a, chr.7b, align=a1, format='raw')), structure( c("< chr.7a > chr.7b ", "@@ 1,2 @@ @@ 1 @@ ", "< a b c e ~ ", "< d [ f g > D [ f g "), len = 4L) ) # corner case where alignment alog exits early because it runs out of B values # to match A values to. b <- c('a b c e', 'x w z f', 'e f g h') a <- c('z o o o', 'p o o o', 'A b c e') al <- AlignThreshold(threshold=0, min.chars=0) all.equal( capture.output(show(diffChr(b, a, align=al, format='raw'))), txtf(500) ) # - NAs ------------------------------------------------------------------------ all.equal( as.character( diffChr(c(NA, letters[1:3]), c(letters[1:3], LETTERS[1:2], NA)) ), rdsf(1300) ) all.equal( as.character( diffChr(c(letters[1:3]), c(letters[1:3], LETTERS[1:2], NA)) ), rdsf(1400) ) all.equal( as.character( diffChr(c(NA, letters[1:3]), c(letters[1:3], LETTERS[1:2])) ), rdsf(1500) ) # - Nested dots issue 134, h/t Noam Ross --------------------------------------- fn <- function(target, current, ...) { diffChr(target, current, ...) } all.equal( as.character(fn("a", "b", format = "raw")), structure( c( "< target > current ", "@@ 1 @@ @@ 1 @@ ", "< a > b "), len = 3L ) ) # - Newlines in input, issue 135, h/t Flying Sheep ----------------------------- a <- 'A Time Series:\n[1] 1 2 3 4' b <- 'A Time Series:\n[1] 9 4 1 4' all.equal( c(as.character(diffobj::diffChr(a, b, format = 'raw'))), c("< a > b ", "@@ 1,2 @@ @@ 1,2 @@ ", " A Time Series: A Time Series:", "< [1] 1 2 3 4 > [1] 9 4 1 4 ") ) # - Attributes causing dispatch in guides, issue 142 --------------------------- zlold <- c("0x0000, 0x001F", "0x007F, 0x009F", "0x0300, 0x036F") zlnew <- structure( c("0x0000, 0x001F", "0x008F, 0x009F", "0x0300, 0x036F"), .Dim = 3L ) diffChr(zlold, zlnew) # no warning # - do.call, issue 158 --------------------------------------------------------- do.call(diffChr, list(1:2, 3:4, format='raw')) diffobj/tests/test-guide.R0000644000176200001440000001771215000460760015222 0ustar liggesusersNAME <- "guides" source(file.path('_helper', 'init.R')) # - detect_2d_guides ----------------------------------------------------------- iris.dply <- c("Source: local data frame [150 x 5]", "Groups: Species [3]", "", " Sepal.Length Sepal.Width", " (dbl) (dbl)", "1 5.1 3.5", "2 4.9 3.0", "3 4.7 3.2", "4 4.6 3.1", "5 5.0 3.6", "6 5.4 3.9", "7 4.6 3.4", "8 5.0 3.4", "9 4.4 2.9", "10 4.9 3.1", ".. ... ...", "Variables not shown: Petal.Length", " (dbl), Petal.Width (dbl), Species", " (fctr)") all.equal(diffobj:::detect_2d_guides(iris.dply), 4:5) # wrapping data table with separator (#96) DT.txt <- c( " V1 V2 V3", " 1: 0.3201122 0.6907066 0.5004968", " --- ", "1000: 0.3547379 0.2836985 0.8121208", " V4 V5", " 1: 0.331665 0.6788726", " --- ", "1000: 0.553012 0.7789110" ) all.equal( diffobj:::detect_2d_guides(DT.txt), c(1L, 5L) ) # Narrow width old.opt <- options(width=40) all.equal(diffobj:::detect_2d_guides(capture.output(iris)), c(1, 152)) all.equal( diffobj:::detect_2d_guides(capture.output(USAccDeaths)), c(1, 8, 15) ) # Time series all.equal(diffobj:::detect_2d_guides(capture.output(UKgas)), 1) # no row.names (#111) df1 <- capture.output(print(data.frame(a=1:3), row.names=FALSE)) no.rn.guide <- diffobj:::detect_2d_guides(df1) # no warning all.equal(no.rn.guide, 1L) df2 <- capture.output(print(data.frame(x="A"), row.names=FALSE)) no.rn.guide.2 <- diffobj:::detect_2d_guides(df2) # no warning all.equal(no.rn.guide.2, 1L) options(old.opt) # - detect_list_guides --------------------------------------------------------- l.1 <- list(1, 1:3, matrix(1:3, 1)) l.2 <- list(a=1, list(1:3, b=4, c=list(1, b=2)), matrix(1:3, 1)) c.l.1 <- capture.output(l.1) c.l.2 <- capture.output(l.2) # cbind(c.l.2, seq_along(c.l.2) %in% diffobj:::detect_list_guides(c.l.2)) all.equal(diffobj:::detect_list_guides(capture.output(l.1)), c(1, 4, 7)) all.equal( diffobj:::detect_list_guides(capture.output(l.2)), c(1, 5, 8, 12, 15, 20) ) # - detect_matrix_guides ------------------------------------------------------- mx3 <- mx4 <- mx5 <- mx5a <- mx11 <- matrix( c( "averylongwordthatcanlahblah", "causeasinglewidecolumnblah", "matrixtowrapseveraltimes", "inarrowscreen", "onceuponatime", "agreenduckflew", "overthemountains", "inalongofantelopes", "ineedthreemore", "entriesactually", "nowonlytwomore", "iwaswrongearlier" ), nrow=3, ncol=4 ) mx3.c <- capture.output(mx3) all.equal(diffobj:::detect_matrix_guides(mx3.c, NULL), c(1, 5)) dimnames(mx4) <- list(A=NULL, B=NULL) mx4.c <- capture.output(mx4) all.equal( diffobj:::detect_matrix_guides(mx4.c, dimnames(mx4)), c(1, 2, 6, 7) ) attr(mx5, "blah") <- letters[1:10] mx5.c <- capture.output(mx5) all.equal( diffobj:::detect_matrix_guides(mx5.c, dimnames(mx5)), c(1, 5) ) # Simple matrices that don't wrap mx6 <- mx7 <- mx7.1 <- matrix(1:4, 2) mx6.c <- capture.output(mx6) all.equal(diffobj:::detect_matrix_guides(mx6.c, dimnames(mx6)), 1) dimnames(mx7) <- list(A=letters[1:2], B=LETTERS[25:26]) mx7.c <- capture.output(mx7) all.equal(diffobj:::detect_matrix_guides(mx7.c, dimnames(mx7)), c(1, 2)) dimnames(mx7.1) <- list(letters[1:2], B=LETTERS[25:26]) mx7.1.c <- capture.output(mx7.1) all.equal(diffobj:::detect_matrix_guides(mx7.1.c, dimnames(mx7.1)), c(1, 2)) # Single col matrix mx8 <- matrix(1:2, 2) mx8.c <- capture.output(mx8) all.equal(diffobj:::detect_matrix_guides(mx8.c, dimnames(mx8)), 1) # Wrapping matrices with colnames mx9 <- mx3 dimnames(mx9) <- list(A=letters[1:3], B=LETTERS[20:23]) mx9.c <- capture.output(mx9) all.equal( diffobj:::detect_matrix_guides(mx9.c, dimnames(mx9)), c(1:2, 6:7) ) mx10 <- mx9 attr(mx10, "blah") <- matrix(1:4, 2) mx10.c <- capture.output(mx10) all.equal( diffobj:::detect_matrix_guides(mx10.c, dimnames(mx10)), c(1:2, 6:7) ) local({ old.opt <- options(width=30L) on.exit(options(old.opt)) attr(mx11, "blah") <- letters[1:15] mx11.c <- capture.output(mx11) all.equal( diffobj:::detect_matrix_guides(mx11.c, dimnames(mx11)), c(1, 5, 9, 13) ) }) # - detect_array_guides -------------------------------------------------------- a.1 <- array(1:6, dim=c(2, 1, 3)) a.2 <- array(1:6, dim=c(2, 1, 3), dimnames=list(NULL, "X", LETTERS[1:3])) a.3 <- array( 1:6, dim=c(2, 1, 3), dimnames=list(rows=NULL, cols="X", LETTERS[1:3]) ) a.4 <- `attr<-`(a.3, "hello", "random attribute") a.5 <- array(1:36, dim=c(6, 2, 3)) a.6 <- array(1:2, c(2, 1, 1)) c.a.1 <- capture.output(a.1) c.a.2 <- capture.output(a.2) c.a.3 <- capture.output(a.3) c.a.4 <- capture.output(a.4) c.a.5 <- capture.output(a.5) c.a.6 <- capture.output(a.6) # helper funs to vizualize the guide line detection # viz_dag <- function(capt, obj) # cbind( # capt, # seq_along(capt) %in% diffobj:::detect_array_guides(capt, dimnames(obj)) # ) # viz_dag(c.a.1, a.1) # viz_dag(c.a.2, a.2) # viz_dag(c.a.3, a.3) # viz_dag(c.a.4, a.4) # viz_dag(c.a.5, a.5) # viz_dag(c.a.6, a.6) all.equal( diffobj:::detect_array_guides(c.a.1, dimnames(a.1)), c(1L, 2L, 7L, 8L, 13L, 14L) ) all.equal( diffobj:::detect_array_guides(c.a.2, dimnames(a.2)), c(1L, 2L, 7L, 8L, 13L, 14L) ) all.equal( diffobj:::detect_array_guides(c.a.3, dimnames(a.3)), c(1L, 2L, 8L, 9L, 15L, 16L) ) all.equal( diffobj:::detect_array_guides(c.a.4, dimnames(a.4)), c(1L, 2L, 8L, 9L, 15L, 16L) ) all.equal( diffobj:::detect_array_guides(c.a.5, dimnames(a.5)), c(1L, 2L, 11L, 12L, 21L, 22L) ) all.equal( diffobj:::detect_array_guides(c.a.6, dimnames(a.6)), c(1L, 2L) ) # - detect_s4_guides ----------------------------------------------------------- setClass("gtest2", slots=c(hello="integer", `good bye`="list")) setClass("gtest1", slots=c( sub.class="gtest2", blah="character", gah="list", sub.class.2="gtest2" ) ) obj <- new( "gtest1", sub.class=new( "gtest2", hello=1:3, `good bye`=list("a", list(l1=5, l2="wow")) ), blah=letters, gah=list(one=1:10, two=LETTERS), sub.class.2=new( "gtest2", hello=3:1, `good bye`=list("B", list(l1=5, l2="wow")) ) ) # note at this point the nested stuff doesn't work, so we're just shooting for # the simple match c.1 <- capture.output(obj) identical( diffobj:::detect_s4_guides(c.1, obj), c(1L, 2L, 21L, 25L, 34L) ) # small diff as that has a non-default show method diff <- diffChr("a", "b", format='raw') diff.out <- capture.output(show(diff)) all.equal( diffobj:::detect_s4_guides(diff.out, diff), integer() ) # - custom guide fun ----------------------------------------------------------- a <- b <- matrix(1:100) b[50] <- -99L fun1 <- function(x, y) c(1L, 14L, 53L) all.equal(as.character(diffPrint(a, b, guides=fun1)), rdsf(100)) if(getRversion() >= "3.2.2") { capture.output( # warn: "If you did not specify a `guides`" trim.err <- as.character(diffPrint(a, b, guides=function(x, y) stop("boom"))), type="message" ) all.equal(trim.err, rdsf(200)) } # "must produce an integer vector" try(diffobj:::apply_guides(1:26, LETTERS, function(x, y) 35L)) # - errors --------------------------------------------------------------------- try(guidesStr(1:26, rep(NA_character_, 26)))# "Cannot compute guides" try(guidesPrint(1:26, rep(NA_character_, 26)))# "Cannot compute guides" # - corner cases --------------------------------------------------------------- all.equal( diffobj:::split_by_guides(letters, integer()), list(structure(letters, idx=seq_along(letters))) ) try(guidesStr(1:26, rep(NA_character_, 26))) # "Cannot compute guides" try(guidesPrint(1:26, rep(NA_character_, 26))) # "Cannot compute guides" # - issue 117 - 2d guide failure ----------------------------------------------- # Thanks to Sebastian Meyer (@bastician) for MRE a <- b <- data.frame(ID = 0, value = 1) b$value <- 2 a <- a[c(rep(1, 86), 2)] b <- b[c(rep(1, 86), 2)] diffPrint(a, b, mode = "unified", format='raw', context=0) diffobj/tests/test-check.R0000644000176200001440000000666414122754044015213 0ustar liggesusersNAME <- "check" source(file.path('_helper', 'init.R')) # - is.less_flags -------------------------------------------------------------- isTRUE(diffobj:::is.less_flags("RVXF")) isTRUE(diffobj:::is.less_flags("rvxF")) identical(diffobj:::is.less_flags(c("rvxF", "RVXF")), FALSE) identical(diffobj:::is.less_flags(23), FALSE) identical(diffobj:::is.less_flags("rv xF"), FALSE) # - is.int.2L ------------------------------------------------------------------ isTRUE(diffobj:::is.int.2L(1:2)) isTRUE(diffobj:::is.int.2L(as.numeric(1:2))) identical(diffobj:::is.int.2L(c(1.3, 2.2)), FALSE) identical(diffobj:::is.int.2L(1:3), FALSE) identical(diffobj:::is.int.2L(c(1, NA)), FALSE) # - arg.funs ------------------------------------------------------------------- isTRUE(diffobj:::is.one.arg.fun(function(x) NULL)) isTRUE(diffobj:::is.one.arg.fun(function(x, y=5) NULL)) diffobj:::is.one.arg.fun(function(..., x) NULL) # "cannot have `...` as " diffobj:::is.one.arg.fun(NULL) # "is not a fun" diffobj:::is.one.arg.fun(function() NULL) # "have at least" diffobj:::is.one.arg.fun(function(x, y) NULL) # "cannot have any" isTRUE(diffobj:::is.two.arg.fun(function(x, y) NULL)) isTRUE(diffobj:::is.two.arg.fun(function(x, y=5) NULL)) diffobj:::is.two.arg.fun(function(x, ..., y) NULL) # "cannot have `...` as " diffobj:::is.two.arg.fun(NULL) # "is not a fun" diffobj:::is.two.arg.fun(function(x) NULL) # "have at least") diffobj:::is.two.arg.fun(function(x, y, z) NULL) # "cannot have any" # - valid_object --------------------------------------------------------------- s.h <- StyleHtml() s.h@wrap <- TRUE try(diffobj:::valid_object(s.h, "style", stop)) #an invalid `StyleHtml` object pal <- PaletteOfStyles() pal["html", "light", "yb"] <- list(s.h) try(# "`palette.of.styles` is an invalid" diffChr( "A", "B", palette.of.styles=pal, style="auto", format="html", brightness="light", color.mode="yb" ) ) # - brightness ----------------------------------------------------------------- try(diffPrint(1:3, 3:6, brightness=NA)) # "must be character" try(diffPrint(1:3, 3:6, brightness="red")) # "may only contain values" try(diffPrint(1:3, 3:6, brightness=c(raw='light'))) # "one empty name" try(diffPrint(1:3, 3:6, brightness=c('light', 'dark'))) # have names # - misc ----------------------------------------------------------------------- diffobj:::is.one.file.name(1) # "must be character" try(diffPrint(1:3, 2:6, extra="hello")) # "must be a list" try(diffPrint(1:3, 2:6, context=TRUE)) # "Argument `context` must" try(diffPrint(1:3, 2:6, mode=1)) # "must be character" try(diffPrint(1:3, 2:6, tab.stops=-1)) # "strictly positive" try(diffPrint(1:3, 2:6, hunk.limit='hello')) # "integer vector" try(diffPrint(1:3, 2:6, guides='hello')) # "or a function" try(diffPrint(1:3, 2:6, guides=function(x, y, z) NULL))# "cannot have any non" try(diffPrint(1:3, 2:6, trim='hello')) # "TRUE, FALSE, or a function" try(diffPrint(1:3, 2:6, trim=function(x, y, z) NULL)) # "cannot have any non" try(diffPrint(1:3, 2:6, interactive='hello')) # "must be TRUE or" try(diffPrint(1:3, 2:6, max.diffs=1:10)) # "must be integer" try(diffPrint(1:3, 2:6, tar.banner=1:10)) # "must be atomic" try(diffPrint(1:3, 2:6, style=1:10)) # "must be \"auto\", a" try(diffPrint(1:3, 2:6, pager=1:10)) # "must be one of" try(diffPrint(1:3, 2:6, format=1:10)) # "must be character" try(diffPrint(1:3, 2:6, palette.of.styles=1:10)) # "must be a `PaletteOfStyles`" try(diffChr(letters, LETTERS, context=NA)) # "must be integer" diffobj/tests/test-rdiff.Rout.save0000644000176200001440000000651014122754044016703 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "rdiff" > source(file.path('_helper', 'init.R')) > > # - diff util detection -------------------------------------------------------- > > identical(has_Rdiff(function(...) warning("test warning")), FALSE) [1] TRUE > isTRUE(has_Rdiff(function(...) NULL)) [1] TRUE > > # - errors --------------------------------------------------------------------- > > try(Rdiff_chr(stop('hello'), 'goodbye')) # "Unable to coerce" Error in try(as.character(from)) : hello Error in Rdiff_chr(stop("hello"), "goodbye") : Unable to coerce `target` to character. > try(Rdiff_chr('hello', stop('goodbye'))) # "Unable to coerce" Error in try(as.character(to)) : goodbye Error in Rdiff_chr("hello", stop("goodbye")) : Unable to coerce `current` to character. > try(Rdiff_obj(stop('hello'), 'goodbye')) # "Unable to store" Error in vapply(list(from, to), function(x) { : hello Error in Rdiff_obj(stop("hello"), "goodbye") : Unable to store text representation of objects > > # - Rdiff_chr/obj -------------------------------------------------------------- > > # Only run tests on machines that are likely to have diff utility > > if(identical(.Platform$OS.type, "unix") && has_Rdiff()) { + local({ + A2 <- c("A", "B", "C") + B2 <- c("X", "A", "Y", "C") + A3 <- 1:3 + B3 <- c(100L, 1L, 200L, 3L) + + # Rdiff_chr + + ref.res <- c("0a1", "2c3") + ref.res.1 <- c("0a1", "> X", "2c3", "< B", "---", "> Y") + + a <- identical(Rdiff_chr(A2, B2, silent=TRUE, minimal=TRUE), ref.res) + capt <- capture.output(res <- Rdiff_chr(A2, B2, silent=FALSE, minimal=TRUE)) + b <- identical(res, ref.res) + c <- identical(capt, res) + capt.1 <- capture.output( + res.1 <- Rdiff_chr(A2, B2, silent=FALSE, minimal=FALSE) + ) + d <- identical(capt.1, ref.res.1) + e <- identical(res.1, ref.res.1) + + # test coersion + f <- identical(Rdiff_chr(A3, B3, minimal=TRUE, silent=TRUE), ref.res) + + # Rdiff_obj + + ref.res2 <- c("1c1", "< [1] \"A\" \"B\" \"C\"", "---", "> [1] \"X\" \"A\" \"Y\" \"C\"" ) + ref.res3 <- c("1c1") + + g <- identical(Rdiff_obj(A2, B2, silent=TRUE), ref.res2) + h <- identical(Rdiff_obj(A2, B2, minimal=TRUE, silent=TRUE), ref.res3) + + # with rds + f1 <- tempfile() + f2 <- tempfile() + saveRDS(A2, f1) + saveRDS(B2, f2) + on.exit(unlink(c(f1, f2))) + + i <- identical(Rdiff_obj(f1, B2, silent=TRUE), ref.res2) + j <- identical(Rdiff_obj(A2, f2, silent=TRUE), ref.res2) + k <- identical(Rdiff_obj(f1, f2, silent=TRUE), ref.res2) + + res <- c(a, b, c, d, e, f, g, h, i, k) + if(!all(res)) stop("Failed: ", deparse(which(!res))) + }) + } > > proc.time() user system elapsed 0.535 0.139 0.673 diffobj/tests/test-limit.R0000644000176200001440000000425514122754044015246 0ustar liggesusersNAME <- "limit" source(file.path('_helper', 'init.R')) # - Simple limit --------------------------------------------------------------- A <- B <- letters[1:5] B[2] <- "B" B[6] <- "F" # diffChr(A, B) all.equal(as.character(diffChr(A, B, line.limit=2)), rdsf(100)) all.equal(as.character(diffChr(A, B, line.limit=3)), rdsf(200)) # - More Extensive Limits ------------------------------------------------------ Puromycin2 <- Puromycin set.seed(1) Puromycin2$conc[c(8, 15:19, 22)] <- round(runif(7), 2) Puromycin2$state[17] <- "treated" all.equal( as.character( diffPrint(Puromycin, Puromycin2, line.limit=15, mode="sidebyside") ), rdsf(300) ) # # Not working right # diffPrint(Puromycin, Puromycin2, line.limit=15, mode="context") all.equal( as.character( diffPrint(Puromycin, Puromycin2, line.limit=15, mode="unified") ), rdsf(500) ) all.equal( as.character( diffPrint(Puromycin, Puromycin2, line.limit=5, mode="sidebyside") ), rdsf(600) ) all.equal( as.character( diffPrint(Puromycin, Puromycin2, line.limit=5, mode="context") ), rdsf(700) ) all.equal( as.character( diffPrint(Puromycin, Puromycin2, line.limit=5, mode="unified") ), rdsf(800) ) Puromycin3 <- Puromycin2 names(Puromycin3)[3L] <- "blargh" all.equal( as.character( diffPrint(Puromycin, Puromycin3, line.limit=7, mode="sidebyside") ), rdsf(900) ) all.equal( as.character( diffPrint(Puromycin, Puromycin3, line.limit=6, mode="context") ), rdsf(1000) ) # - Dual limit values ---------------------------------------------------------- A <- letters[1:10] B <- LETTERS[1:10] all.equal( as.character(diffChr(A, B, line.limit=c(10, 3))), rdsf(1100) ) all.equal( as.character(diffChr(A, B, line.limit=c(13, 3))), rdsf(1200) ) try(diffChr(A, B, line.limit=c(3, 13))) # "larger than or" # - Cause errors --------------------------------------------------------------- try(diffChr(letters, LETTERS, line.limit=1:3)) # "vector of length" # - Vanishing header ----------------------------------------------------------- # issue 64 all.equal( as.character( diffChr( letters, letters[-13], context=auto_context(0, 10), line.limit=1L, pager="off" ) ), rdsf(1300) ) diffobj/tests/zz-test-check.R0000644000176200001440000000003215000460760015626 0ustar liggesuserssource('_helper/check.R') diffobj/tests/valgrind/0000755000176200001440000000000014122754044014630 5ustar liggesusersdiffobj/tests/valgrind/mdl-cur.txt0000644000176200001440000000120114122754044016726 0ustar liggesusersList of 13 $ coefficients : Named num [1:4] 2.251 0.804 1.459 1.947 $ residuals : Named num [1:150] 0.0361 0.2379 -0.1228 -0.1424 -0.1442 ... $ effects : Named num [1:150] -71.566 -1.188 0.279 8.525 -0.114 ... $ rank : int 4 $ fitted.values: Named num [1:150] 5.06 4.66 4.82 4.74 5.14 ... $ assign : int [1:4] 0 1 2 2 $ qr :List of 5 $ df.residual : int 146 $ contrasts :List of 1 $ xlevels :List of 1 $ call : language lm(formula = frm2, data = iris) $ terms :Classes 'terms', 'formula' language Sepal.Length ~ Sepal.Width + Species $ model :'data.frame': 150 obs. of 3 variables: - attr(*, "class")= chr "lm" diffobj/tests/valgrind/mdl-tar.txt0000644000176200001440000000112414122754044016727 0ustar liggesusersList of 12 $ coefficients : Named num [1:2] 6.526 -0.223 $ residuals : Named num [1:150] -0.644 -0.956 -1.111 -1.234 -0.722 ... $ effects : Named num [1:150] -71.566 -1.188 -1.081 -1.187 -0.759 ... $ rank : int 2 $ fitted.values: Named num [1:150] 5.74 5.86 5.81 5.83 5.72 ... $ assign : int [1:2] 0 1 $ qr :List of 5 $ df.residual : int 148 $ xlevels : Named list() $ call : language lm(formula = frm1, data = iris) $ terms :Classes 'terms', 'formula' language Sepal.Length ~ Sepal.Width $ model :'data.frame': 150 obs. of 2 variables: - attr(*, "class")= chr "lm" diffobj/tests/valgrind/tests-valgrind.R0000644000176200001440000002110614122754044017721 0ustar liggesusers# These tests are intended to be run under valgrind so we can make sure there # are no compiled code issues. It's basically impossible to run the full test # suite under valgrind because there are lots of false positives from the PCRE # library. # # Orinally these were the ses tests, but even the testthat overhead caused too # many issues so we're just running the code without checking results. writeLines("basic") # expect_equal(ses(letters[1:10], letters[1:10]), character()) ses(letters[1:10], letters[1:10]) # expect_equal(ses(letters[1:10], LETTERS[1:10]), "1,10c1,10") ses(letters[1:10], LETTERS[1:10]) # expect_equal(ses(letters[1:5], LETTERS[1:10]), "1,5c1,10") ses(letters[1:5], LETTERS[1:10]) # expect_equal(ses(letters[1:10], LETTERS[1:5]), "1,10c1,5") ses(letters[1:10], LETTERS[1:5]) # expect_equal(ses(letters[2:10], letters[1:7]), c("0a1", "7,9d7")) ses(letters[2:10], letters[1:7]) # expect_equal(ses(letters[c(1:5, 1:5, 1:5)], c("e", "d", "a", # "b", "c")), c("1,4d0", "6,8d1", "10d2", "14,15d5")) ses(letters[c(1:5, 1:5, 1:5)], c("e", "d", "a", "b", "c")) # expect_equal(ses(c("e", "d", "a", "b", "c"), letters[c(1:5, 1:5, # 1:5)]), c("0a1,4", "1a6,8", "2a10", "5a14,15")) ses(c("e", "d", "a", "b", "c"), letters[c(1:5, 1:5, 1:5)]) writeLines("trigger edit distance 1 branches") # expect_equal(ses("a", c("a", "b")), "1a2") ses("a", c("a", "b")) # expect_equal(ses(c("a", "b"), "a"), "2d1") ses(c("a", "b"), "a") # expect_equal(ses("c", c("b", "c")), "0a1") ses("c", c("b", "c")) # expect_equal(ses(c("b", "c"), "c"), "1d0") ses(c("b", "c"), "c") # expect_equal(ses("a", character()), "1d0") ses("a", character()) # expect_equal(ses(character(), "a"), "0a1") ses(character(), "a") # expect_equal(ses(character(), character()), character()) ses(character(), character()) ## this is from the atomic tests, haven't dug into why they actually trigger ## the desired branches, but it is fairly complex set.seed(2) w1 <- sample(c("carrot", "cat", "cake", "eat", "rabbit", "holes", "the", "a", "pasta", "boom", "noon", "sky", "hat", "blah", "paris", "dog", "snake"), 25, replace = TRUE) w4 <- w3 <- w2 <- w1 w2[sample(seq_along(w1), 5)] <- LETTERS[1:5] w3 <- w1[8:15] w4 <- c(w1[1:5], toupper(w1[1:5]), w1[6:15], toupper(w1[1:5])) # expect_equal(ses(w1, w4), c("5a6,10", "15,21d19", "23,25c21,25")) ses(w1, w4) writeLines("longer strings") # A bigger string string <- do.call(paste0, expand.grid(LETTERS, LETTERS, LETTERS)) # expect_equal(ses(string, c("hello", string[-c(5, 500, 1000)], # "goodbye")), c("0a1", "5d5", "500d499", "1000d998", "17576a17575")) ses(string, c("hello", string[-c(5, 500, 1000)], "goodbye")) # expect_equal(ses(c(string[200:500], "hello", string[-(1:400)][-c(5, # 500, 1000)]), string), c("0a1,199", "207,306d405", "800a900", # "1299a1400")) ses(c(string[200:500], "hello", string[-(1:400)][-c(5, 500, 1000)]), string) writeLines("max diffs") # expect_warning(ses(letters[1:10], LETTERS[1:10], max.diffs = 5), # "Exceeded `max.diffs`") suppressWarnings(ses(letters[1:10], LETTERS[1:10], max.diffs = 5)) # expect_equal(ses(letters[1:10], LETTERS[1:10], max.diffs = 5, # warn = FALSE), "1,10c1,10") ses(letters[1:10], LETTERS[1:10], max.diffs = 5, warn = FALSE) # expect_equal(ses(letters[1:10], c(letters[1], LETTERS[2:5], letters[6:10]), # max.diffs = 5, warn = FALSE), "2,5c2,5") ses(letters[1:10], c(letters[1], LETTERS[2:5], letters[6:10]), max.diffs = 5, warn = FALSE) # expect_equal(ses(letters[1:10], c(letters[1], LETTERS[2:5], letters[6:8], # LETTERS[9], letters[10]), max.diffs = 5, warn = FALSE), c("2,5c2,5", # "9c9")) ses(letters[1:10], c(letters[1], LETTERS[2:5], letters[6:8], LETTERS[9], letters[10]), max.diffs = 5, warn = FALSE) writeLines("corner cases?") # expect_equal(ses(letters[1:4], letters[1:3]), "4d3") ses(letters[1:4], letters[1:3]) # expect_equal(ses(letters[1:3], letters[1:4]), "3a4") ses(letters[1:3], letters[1:4]) # ses(1, 2:9, max.diffs = 8) # h/t @gadenbui, data is extracted from palmerpenguins@0.1.0::penguins # # comparison <- subset(penguins, year == 2007 | flipper_length_mm > 220) # test <- subset(penguins, year == 2008) # a <- test$bill_length_mm # b <- comparison$bill_length_mm a <- c(39.6, 40.1, 35, 42, 34.5, 41.4, 39, 40.6, 36.5, 37.6, 35.7, 41.3, 37.6, 41.1, 36.4, 41.6, 35.5, 41.1, 35.9, 41.8, 33.5, 39.7, 39.6, 45.8, 35.5, 42.8, 40.9, 37.2, 36.2, 42.1, 34.6, 42.9, 36.7, 35.1, 37.3, 41.3, 36.3, 36.9, 38.3, 38.9, 35.7, 41.1, 34, 39.6, 36.2, 40.8, 38.1, 40.3, 33.1, 43.2, 49.1, 48.4, 42.6, 44.4, 44, 48.7, 42.7, 49.6, 45.3, 49.6, 50.5, 43.6, 45.5, 50.5, 44.9, 45.2, 46.6, 48.5, 45.1, 50.1, 46.5, 45, 43.8, 45.5, 43.2, 50.4, 45.3, 46.2, 45.7, 54.3, 45.8, 49.8, 46.2, 49.5, 43.5, 50.7, 47.7, 46.4, 48.2, 46.5, 46.4, 48.6, 47.5, 51.1, 45.2, 45.2, 50.5, 49.5, 46.4, 52.8, 40.9, 54.2, 42.5, 51, 49.7, 47.5, 47.6, 52, 46.9, 53.5, 49, 46.2, 50.9, 45.5) b <- c(39.1, 39.5, 40.3, NA, 36.7, 39.3, 38.9, 39.2, 34.1, 42, 37.8, 37.8, 41.1, 38.6, 34.6, 36.6, 38.7, 42.5, 34.4, 46, 37.8, 37.7, 35.9, 38.2, 38.8, 35.3, 40.6, 40.5, 37.9, 40.5, 39.5, 37.2, 39.5, 40.9, 36.4, 39.2, 38.8, 42.2, 37.6, 39.8, 36.5, 40.8, 36, 44.1, 37, 39.6, 41.1, 37.5, 36, 42.3, 46.1, 50, 48.7, 50, 47.6, 46.5, 45.4, 46.7, 43.3, 46.8, 40.9, 49, 45.5, 48.4, 45.8, 49.3, 42, 49.2, 46.2, 48.7, 50.2, 45.1, 46.5, 46.3, 42.9, 46.1, 44.5, 47.8, 48.2, 50, 47.3, 42.8, 45.1, 59.6, 49.6, 50.5, 50.5, 50.1, 50.4, 46.2, 54.3, 49.8, 49.5, 50.7, 46.4, 48.2, 48.6, 45.2, 52.5, 50, 50.8, 52.1, 52.2, 49.5, 50.8, 46.9, 51.1, 55.9, 49.1, 49.8, 51.5, 55.1, 48.8, 50.4, 46.5, 50, 51.3, 45.4, 52.7, 45.2, 46.1, 51.3, 46, 51.3, 46.6, 51.7, 47, 52, 45.9, 50.5, 50.3, 58, 46.4, 49.2, 42.4, 48.5, 43.2, 50.6, 46.7, 52) # In <0.3.4: Exceeded buffer for finding fake snake ses(a[-c(15:38, 50:90)], b[-c(40:85, 100:125)], max.diffs=80) # In <0.3.4: Faux Snake Process Failed ses(a[-(18:38)], b[-(50:80)], max.diffs=115) # issue 157 # Arguably could match on 'A' instead of 'X' and be more comparct a <- c('a', 'b', 'c', 'A', 'X', 'Y', 'Z', 'W') b <- c('X', 'C', 'A', 'U', 1, 2, 3) ses(a, b, max.diffs=13) # segfault (but may have beend debugging code) ses(letters[1:2], LETTERS[1:2], max.diffs = 4) # snake overrun ses(c("G", "C", "T", "C", "A", "C", "G", "C"), c("T", "G"), max.diffs=2) # effect of max.diffs on compactness (waldo logical comparison) ses(c('A','A','A','A','A'), c('B','A','B','A','B'), max.diffs=0) ses(c('A','A','A','A','A'), c('B','A','B','A','B'), max.diffs=1) ses(c('A','A','A','A','A'), c('B','A','B','A','B'), max.diffs=2) # back snake all matches before faux snake triggered ses_dat( a=c("T", "A", "A", "C", "C", "A"), b=c("A", "G", "A", "A"), max.diffs = 0 ) writeLines("errors") # expect_error(ses("a", "b", max.diffs = "hello"), "must be scalar integer") try(ses("a", "b", max.diffs = "hello"), silent=TRUE) # expect_error(ses("a", "b", warn = "hello"), "must be TRUE or FALSE") try(ses("a", "b", warn = "hello"), silent=TRUE) # We want to have a test file that fully covers the C code in order to run # valgrind with just that one. We were unable to isolate simple diffs that # triggered all the code, but we were able to do it with the below in addition # to the above. # test_that("Repeat tests for full coverage in SES file", { # # From test.diffStr.R # formula display changed writeLines("model prep") frm1 <- as.formula("Sepal.Length ~ Sepal.Width", env=.GlobalEnv) frm2 <- as.formula("Sepal.Length ~ Sepal.Width + Species", env=.GlobalEnv) mdl1 <- lm(frm1, iris) mdl2 <- lm(frm2, iris) writeLines("diff str") # as.character( # diffStr(mdl1, mdl2, # extra = list(strict.width = "wrap"), line.limit = 30) # ) ## we captured the text being diffed above at the actual level, and ## also at the highest level ses( readLines('valgrind/mdl-tar.txt'), readLines('valgrind/mdl-cur.txt') ) ses( readLines('valgrind/mdl-tar-all.txt'), readLines('valgrind/mdl-cur-all.txt') ) # from testthat.warnings.R writeLines("exceeded diff") A3 <- c("a b c", "d e f A B C D", "g h i", "f") B3 <- c("a b c", "xd e f E Q L S", "g h i", "q") suppressWarnings(ses(A3, B3, max.diffs = 2)) writeLines("done") diffobj/tests/valgrind/mdl-tar-all.txt0000644000176200001440000000551314122754044017503 0ustar liggesusersList of 12 $ coefficients : Named num [1:2] 6.526 -0.223 ..- attr(*, "names")= chr [1:2] "(Intercept)" "Sepal.Width" $ residuals : Named num [1:150] -0.644 -0.956 -1.111 -1.234 -0.722 ... ..- attr(*, "names")= chr [1:150] "1" "2" "3" "4" ... $ effects : Named num [1:150] -71.566 -1.188 -1.081 -1.187 -0.759 ... ..- attr(*, "names")= chr [1:150] "(Intercept)" "Sepal.Width" "" "" ... $ rank : int 2 $ fitted.values: Named num [1:150] 5.74 5.86 5.81 5.83 5.72 ... ..- attr(*, "names")= chr [1:150] "1" "2" "3" "4" ... $ assign : int [1:2] 0 1 $ qr :List of 5 ..$ qr : num [1:150, 1:2] -12.2474 0.0816 0.0816 0.0816 0.0816 ... .. ..- attr(*, "dimnames")=List of 2 .. .. ..$ : chr [1:150] "1" "2" "3" "4" ... .. .. ..$ : chr [1:2] "(Intercept)" "Sepal.Width" .. ..- attr(*, "assign")= int [1:2] 0 1 ..$ qraux: num [1:2] 1.08 1.02 ..$ pivot: int [1:2] 1 2 ..$ tol : num 1e-07 ..$ rank : int 2 ..- attr(*, "class")= chr "qr" $ df.residual : int 148 $ xlevels : Named list() $ call : language lm(formula = frm1, data = iris) $ terms :Classes 'terms', 'formula' language Sepal.Length ~ Sepal.Width .. ..- attr(*, "variables")= language list(Sepal.Length, Sepal.Width) .. ..- attr(*, "factors")= int [1:2, 1] 0 1 .. .. ..- attr(*, "dimnames")=List of 2 .. .. .. ..$ : chr [1:2] "Sepal.Length" "Sepal.Width" .. .. .. ..$ : chr "Sepal.Width" .. ..- attr(*, "term.labels")= chr "Sepal.Width" .. ..- attr(*, "order")= int 1 .. ..- attr(*, "intercept")= int 1 .. ..- attr(*, "response")= int 1 .. ..- attr(*, ".Environment")= .. ..- attr(*, "predvars")= language list(Sepal.Length, Sepal.Width) .. ..- attr(*, "dataClasses")= Named chr [1:2] "numeric" "numeric" .. .. ..- attr(*, "names")= chr [1:2] "Sepal.Length" "Sepal.Width" $ model :'data.frame': 150 obs. of 2 variables: ..$ Sepal.Length: num [1:150] 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ... ..$ Sepal.Width : num [1:150] 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ... ..- attr(*, "terms")=Classes 'terms', 'formula' language Sepal.Length ~ Sepal.Width .. .. ..- attr(*, "variables")= language list(Sepal.Length, Sepal.Width) .. .. ..- attr(*, "factors")= int [1:2, 1] 0 1 .. .. .. ..- attr(*, "dimnames")=List of 2 .. .. .. .. ..$ : chr [1:2] "Sepal.Length" "Sepal.Width" .. .. .. .. ..$ : chr "Sepal.Width" .. .. ..- attr(*, "term.labels")= chr "Sepal.Width" .. .. ..- attr(*, "order")= int 1 .. .. ..- attr(*, "intercept")= int 1 .. .. ..- attr(*, "response")= int 1 .. .. ..- attr(*, ".Environment")= .. .. ..- attr(*, "predvars")= language list(Sepal.Length, Sepal.Width) .. .. ..- attr(*, "dataClasses")= Named chr [1:2] "numeric" "numeric" .. .. .. ..- attr(*, "names")= chr [1:2] "Sepal.Length" "Sepal.Width" - attr(*, "class")= chr "lm" diffobj/tests/valgrind/mdl-cur-all.txt0000644000176200001440000000677414122754044017520 0ustar liggesusersList of 13 $ coefficients : Named num [1:4] 2.251 0.804 1.459 1.947 ..- attr(*, "names")= chr [1:4] "(Intercept)" "Sepal.Width" "Speciesversicolor" "Speciesvirginica" $ residuals : Named num [1:150] 0.0361 0.2379 -0.1228 -0.1424 -0.1442 ... ..- attr(*, "names")= chr [1:150] "1" "2" "3" "4" ... $ effects : Named num [1:150] -71.566 -1.188 0.279 8.525 -0.114 ... ..- attr(*, "names")= chr [1:150] "(Intercept)" "Sepal.Width" "Speciesversicolor" "Speciesvirginica" ... $ rank : int 4 $ fitted.values: Named num [1:150] 5.06 4.66 4.82 4.74 5.14 ... ..- attr(*, "names")= chr [1:150] "1" "2" "3" "4" ... $ assign : int [1:4] 0 1 2 2 $ qr :List of 5 ..$ qr : num [1:150, 1:4] -12.2474 0.0816 0.0816 0.0816 0.0816 ... .. ..- attr(*, "dimnames")=List of 2 .. .. ..$ : chr [1:150] "1" "2" "3" "4" ... .. .. ..$ : chr [1:4] "(Intercept)" "Sepal.Width" "Speciesversicolor" "Speciesvirginica" .. ..- attr(*, "assign")= int [1:4] 0 1 2 2 .. ..- attr(*, "contrasts")=List of 1 .. .. ..$ Species: chr "contr.treatment" ..$ qraux: num [1:4] 1.08 1.02 1.05 1.11 ..$ pivot: int [1:4] 1 2 3 4 ..$ tol : num 1e-07 ..$ rank : int 4 ..- attr(*, "class")= chr "qr" $ df.residual : int 146 $ contrasts :List of 1 ..$ Species: chr "contr.treatment" $ xlevels :List of 1 ..$ Species: chr [1:3] "setosa" "versicolor" "virginica" $ call : language lm(formula = frm2, data = iris) $ terms :Classes 'terms', 'formula' language Sepal.Length ~ Sepal.Width + Species .. ..- attr(*, "variables")= language list(Sepal.Length, Sepal.Width, Species) .. ..- attr(*, "factors")= int [1:3, 1:2] 0 1 0 0 0 1 .. .. ..- attr(*, "dimnames")=List of 2 .. .. .. ..$ : chr [1:3] "Sepal.Length" "Sepal.Width" "Species" .. .. .. ..$ : chr [1:2] "Sepal.Width" "Species" .. ..- attr(*, "term.labels")= chr [1:2] "Sepal.Width" "Species" .. ..- attr(*, "order")= int [1:2] 1 1 .. ..- attr(*, "intercept")= int 1 .. ..- attr(*, "response")= int 1 .. ..- attr(*, ".Environment")= .. ..- attr(*, "predvars")= language list(Sepal.Length, Sepal.Width, Species) .. ..- attr(*, "dataClasses")= Named chr [1:3] "numeric" "numeric" "factor" .. .. ..- attr(*, "names")= chr [1:3] "Sepal.Length" "Sepal.Width" "Species" $ model :'data.frame': 150 obs. of 3 variables: ..$ Sepal.Length: num [1:150] 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ... ..$ Sepal.Width : num [1:150] 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ... ..$ Species : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ... ..- attr(*, "terms")=Classes 'terms', 'formula' language Sepal.Length ~ Sepal.Width + Species .. .. ..- attr(*, "variables")= language list(Sepal.Length, Sepal.Width, Species) .. .. ..- attr(*, "factors")= int [1:3, 1:2] 0 1 0 0 0 1 .. .. .. ..- attr(*, "dimnames")=List of 2 .. .. .. .. ..$ : chr [1:3] "Sepal.Length" "Sepal.Width" "Species" .. .. .. .. ..$ : chr [1:2] "Sepal.Width" "Species" .. .. ..- attr(*, "term.labels")= chr [1:2] "Sepal.Width" "Species" .. .. ..- attr(*, "order")= int [1:2] 1 1 .. .. ..- attr(*, "intercept")= int 1 .. .. ..- attr(*, "response")= int 1 .. .. ..- attr(*, ".Environment")= .. .. ..- attr(*, "predvars")= language list(Sepal.Length, Sepal.Width, Species) .. .. ..- attr(*, "dataClasses")= Named chr [1:3] "numeric" "numeric" "factor" .. .. .. ..- attr(*, "names")= chr [1:3] "Sepal.Length" "Sepal.Width" "Species" - attr(*, "class")= chr "lm" diffobj/tests/test-warnings.Rout.save0000644000176200001440000000633014122754044017441 0ustar liggesusers R version 4.0.4 beta (2021-02-06 r79953) -- "Lost Library Book" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "warnings" > source(file.path('_helper', 'init.R')) > > # tests designed to produce warnings > > # - Extra args for `str` ------------------------------------------------------- > > a <- "hello" > b <- "goodbye" > > invisible(diffStr(a, b, extra=list(comp.str="^"))) # "Specifying" Warning message: In capt_fun(target, current, etc = etc.proc, err = err, extra) : Specifying `comp.str` may cause `str` output level folding to be incorrect > invisible(diffStr(a, b, extra=list(comp="^"))) # "Specifying") Warning messages: 1: In match.call(definition, call, expand.dots, envir) : partial argument match of 'comp' to 'comp.str' 2: In capt_fun(target, current, etc = etc.proc, err = err, extra) : Specifying `comp.str` may cause `str` output level folding to be incorrect > invisible(diffStr(a, b, extra=list(indent.str="..."))) # "Specifying" Warning message: In capt_fun(target, current, etc = etc.proc, err = err, extra) : Specifying `indent.str` may cause `str` output level folding to be incorrect > invisible(diffStr(a, b, extra=list(indent="..."))) # "Specifying" Warning messages: 1: In match.call(definition, call, expand.dots, envir) : partial argument match of 'indent' to 'indent.str' 2: In capt_fun(target, current, etc = etc.proc, err = err, extra) : Specifying `indent.str` may cause `str` output level folding to be incorrect > > # - Max diffs ------------------------------------------------------------------ > > # Max limit warnings work properly; these are not fully fleshed out > > A3 <- c("a b c", "d e f A B C D", "g h i", "f") > B3 <- c("a b c", "xd e f E Q L S", "g h i", "q") > > invisible(diffChr(A3, B3, max.diffs=2)) # warn: "Exceeded diff" Warning message: Exceeded diff limit during diff computation (6 vs. 2 allowed); overall diff is likely not optimal > > # - Overriden formals ---------------------------------------------------------- > > # warn "Provided `style` argument will override the provided `format` argument" > invisible(diffChr(letters, LETTERS, style=StyleRaw(), format="ansi8")) Warning message: In diffChr(target = letters, current = LETTERS, style = StyleRaw(), : Provided `style` argument will override the provided `format` argument > > # warn: "Provided `style` .* `format` and `color.mode` arguments" > invisible( + diffChr(letters, LETTERS, style=StyleRaw(), format="ansi8", color.mode="rgb") + ) Warning message: In diffChr(target = letters, current = LETTERS, style = StyleRaw(), : Provided `style` argument will override the provided `format` and `color.mode` arguments. > > > proc.time() user system elapsed 0.827 0.134 0.966 diffobj/tests/test-s4.R0000644000176200001440000000242714122754044014455 0ustar liggesusersNAME <- "s4" source(file.path('_helper', 'init.R')) # - diff data validation works # # These are not currently in use # expect_match(diffobj:::valid_dat("hello"), "should be a list") # D0 <- D1 <- D2 <- D3 <- D4 <- D5 <- D6 <- D7 <- # diffPrint(letters, LETTERS)@tar.dat # expect_match(diffobj:::valid_dat(unname(D0)), "should have names") # length(D1[[1L]]) <- 1L # expect_match(diffobj:::valid_dat(D1), "should have equal length") # D2$orig <- integer(length(D2$orig)) # expect_match(diffobj:::valid_dat(D2), "should be character") # D3$trim.ind.start <- character(length(D3$trim.ind.start)) # expect_match(diffobj:::valid_dat(D3), "should be integer") # D4$word.ind <- integer(length(D4$word.ind)) # expect_match(diffobj:::valid_dat(D4), "should be list") # D5$word.ind <- vector("list", length(D5$word.ind)) # expect_match(diffobj:::valid_dat(D5), "not in expected format") # D6$tok.rat <- D6$tok.rat + 2 # expect_match(diffobj:::valid_dat(D6), "with all values between") # D7$fill <- integer(length(D7$fill)) # expect_match(diffobj:::valid_dat(D7), "should be logical") # - any ------------------------------------------------------------------------ isTRUE(any(diffChr('a', 'b'))) identical(any(diffChr('a', 'a')), FALSE) try(any(diffChr('a', 'a'), 2)) # "supports only one argument" diffobj/tests/test-file.R0000644000176200001440000000501414122754044015041 0ustar liggesusersNAME <- "diffFile" source(file.path('_helper', 'init.R')) # - Code File ------------------------------------------------------------------ # # compare two crayon file versions # # These should eventually just be downloaded and made into diffFile tests f.p.1 <- file.path("_helper", "objs", "diffFile", "s.o.3f1f68.R") f.p.2 <- file.path("_helper", "objs", "diffFile", "s.o.30dbe0.R") # url.1 <- "https://raw.githubusercontent.com/gaborcsardi/crayon/3f1f68ab177b82a27e754a58264af801f7194820/R/string_operations.r" # url.2 <- "https://raw.githubusercontent.com/gaborcsardi/crayon/30dbe0d4d92157350af3cb3aeebd6d9a9cdf5c0e/R/string_operations.r" # f.1 <- readLines(url.1) # f.2 <- readLines(url.2) # writeLines(f.1, f.p.1) # writeLines(f.2, f.p.2) all.equal(as.character(diffFile(f.p.1, f.p.2)), rdsf(100)) # - RDS ------------------------------------------------------------------------ f1 <- tempfile() f2 <- tempfile() mx1 <- mx2 <- matrix(1:9, 3) mx2[5] <- 99 saveRDS(mx1, f1) saveRDS(mx2, f2) is(diffobj:::get_rds(f1), "matrix") is(diffobj:::get_rds(f2), "matrix") ref <- as.character(diffPrint(mx1, mx2)) identical(as.character(diffPrint(mx1, f2, cur.banner="mx2")), ref) identical(as.character(diffPrint(f1, mx2, tar.banner="mx1")), ref) identical( as.character(diffPrint(f1, f2, tar.banner="mx1", cur.banner="mx2")), ref ) isTRUE(!identical(as.character(diffPrint(mx1, f2, rds=FALSE)), ref)) unlink(c(f1, f2)) # - file ----------------------------------------------------------------------- f1 <- tempfile() f2 <- tempfile() letters2 <- letters letters2[15] <- "HELLO" writeLines(letters, f1) writeLines(letters2, f2) identical( as.character(diffChr(letters, letters2, tar.banner="f1", cur.banner="f2")), as.character(diffFile(f1, f2)) ) unlink(c(f1, f2)) # issue 133 h/t Noam Ross, thanks for the test x <- tempfile() y <- tempfile() cat("Hello\nthere\n", file = x) file.copy(x, y) identical( as.character(diffFile(x, y, format = "raw")), structure( c("No visible differences between objects.", "< x > y ", "@@ 1,2 @@ @@ 1,2 @@ ", " Hello Hello ", " there there "), len = 5L) ) unlink(c(x, y)) # - CSV ------------------------------------------------------------------------ f1 <- tempfile() f2 <- tempfile() iris2 <- iris iris2$Sepal.Length[25] <- 9.9 write.csv(iris, f1, row.names=FALSE) write.csv(iris2, f2, row.names=FALSE) identical( as.character(diffPrint(iris, iris2, tar.banner="f1", cur.banner="f2")), as.character(diffCsv(f1, f2)) ) unlink(c(f1, f2)) diffobj/tests/test-ses.Rout.save0000644000176200001440000003071014122754044016402 0ustar liggesusers R version 4.0.4 (2021-02-15) -- "Lost Library Book" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "ses" > source(file.path('_helper', 'init.R')) > > # Any tests added here should also be added to the valgrind test file > > # - basic ---------------------------------------------------------------------- > > all.equal(ses(letters[1:10], letters[1:10]), character()) [1] TRUE > all.equal(ses(letters[1:10], LETTERS[1:10]), "1,10c1,10") [1] TRUE > all.equal(ses(letters[1:5], LETTERS[1:10]), "1,5c1,10") [1] TRUE > all.equal(ses(letters[1:10], LETTERS[1:5]), "1,10c1,5") [1] TRUE > all.equal(ses(letters[2:10], letters[1:7]), c("0a1", "7,9d7")) [1] TRUE > all.equal( + ses(letters[c(1:5, 1:5, 1:5)], c("e", "d", "a", "b", "c")), + c("1,4d0", "6,8d1", "10d2", "14,15d5") + ) [1] TRUE > all.equal( + ses(c("e", "d", "a", "b", "c"), letters[c(1:5, 1:5, 1:5)]), + c("0a1,4", "1a6,8", "2a10", "5a14,15") + ) [1] TRUE > # edit distance = 1 > > # - trigger edit distance 1 branches ------------------------------------------- > > all.equal(ses("a", c("a", "b")), "1a2") [1] TRUE > all.equal(ses(c("a", "b"), "a"), "2d1") [1] TRUE > all.equal(ses("c", c("b", "c")), "0a1") [1] TRUE > all.equal(ses(c("b", "c"), "c"), "1d0") [1] TRUE > > all.equal(ses("a", character()), "1d0") [1] TRUE > all.equal(ses(character(), "a"), "0a1") [1] TRUE > all.equal(ses(character(), character()), character()) [1] TRUE > > ## this is from the atomic tests, haven't dug into why they actually trigger > ## the desired branches, but it is fairly complex > set.seed(2) > w1 <- sample( + c( + "carrot", "cat", "cake", "eat", "rabbit", "holes", "the", "a", "pasta", + "boom", "noon", "sky", "hat", "blah", "paris", "dog", "snake" + ), 25, replace=TRUE + ) > w4 <- w3 <- w2 <- w1 > w2[sample(seq_along(w1), 5)] <- LETTERS[1:5] > w3 <- w1[8:15] > w4 <- c(w1[1:5], toupper(w1[1:5]), w1[6:15], toupper(w1[1:5])) > > all.equal(ses(w1, w4), c("5a6,10", "15,21d19", "23,25c21,25")) [1] TRUE > > # - longer strings ------------------------------------------------------------- > > # A bigger string > > string <- do.call(paste0, expand.grid(LETTERS, LETTERS, LETTERS)) > > all.equal( + ses(string, c("hello", string[-c(5, 500, 1000)], "goodbye")), + c("0a1", "5d5", "500d499", "1000d998", "17576a17575") + ) [1] TRUE > all.equal( + ses(c(string[200:500], "hello", string[-(1:400)][-c(5, 500, 1000)]), string), + c("0a1,199", "207,306d405", "800a900", "1299a1400") + ) [1] TRUE > > # - max diffs ------------------------------------------------------------------ > > ses(letters[1:10], LETTERS[1:10], max.diffs=5) # "Exceeded `max.diffs`" [1] "1,10c1,10" Warning message: In diff_myers(args[["a"]], args[["b"]], max.diffs = args[["max.diffs"]], : Exceeded `max.diffs`: 20 vs 5 allowed. Diff is probably suboptimal. > all.equal( + ses(letters[1:10], LETTERS[1:10], max.diffs=5, warn=FALSE), + "1,10c1,10" + ) [1] TRUE > all.equal( + ses( + letters[1:10], + c(letters[1], LETTERS[2:5], letters[6:10]), max.diffs=5, warn=FALSE + ), + "2,5c2,5" + ) [1] TRUE > all.equal( + ses( + letters[1:10], + c(letters[1], LETTERS[2:5], letters[6:8], LETTERS[9], letters[10]), + max.diffs=5, warn=FALSE + ), + c("2,5c2,5", "9c9") + ) [1] TRUE > # - Issue 152 -------------------------------------------------------------- > > # h/t @hadley, used to error, now warns > > all.equal(ses(letters[1:4], letters[1:3]), "4d3") [1] TRUE > all.equal(ses(letters[1:3], letters[1:4]), "3a4") [1] TRUE > ses(1, 2:9, max.diffs = 8) [1] "1c1,8" Warning message: In diff_myers(args[["a"]], args[["b"]], max.diffs = args[["max.diffs"]], : Exceeded `max.diffs`: 9 vs 8 allowed. Diff is probably suboptimal. > > # h/t @gadenbui, data is extracted from palmerpenguins@0.1.0::penguins > # > # comparison <- subset(penguins, year == 2007 | flipper_length_mm > 220) > # test <- subset(penguins, year == 2008) > # a <- test$bill_length_mm > # b <- comparison$bill_length_mm > > a <- c(39.6, 40.1, 35, 42, 34.5, 41.4, 39, 40.6, 36.5, 37.6, 35.7, + 41.3, 37.6, 41.1, 36.4, 41.6, 35.5, 41.1, 35.9, 41.8, 33.5, 39.7, + 39.6, 45.8, 35.5, 42.8, 40.9, 37.2, 36.2, 42.1, 34.6, 42.9, 36.7, + 35.1, 37.3, 41.3, 36.3, 36.9, 38.3, 38.9, 35.7, 41.1, 34, 39.6, + 36.2, 40.8, 38.1, 40.3, 33.1, 43.2, 49.1, 48.4, 42.6, 44.4, 44, + 48.7, 42.7, 49.6, 45.3, 49.6, 50.5, 43.6, 45.5, 50.5, 44.9, 45.2, + 46.6, 48.5, 45.1, 50.1, 46.5, 45, 43.8, 45.5, 43.2, 50.4, 45.3, + 46.2, 45.7, 54.3, 45.8, 49.8, 46.2, 49.5, 43.5, 50.7, 47.7, 46.4, + 48.2, 46.5, 46.4, 48.6, 47.5, 51.1, 45.2, 45.2, 50.5, 49.5, 46.4, + 52.8, 40.9, 54.2, 42.5, 51, 49.7, 47.5, 47.6, 52, 46.9, 53.5, + 49, 46.2, 50.9, 45.5) > b <- c(39.1, 39.5, 40.3, NA, 36.7, 39.3, 38.9, 39.2, 34.1, 42, 37.8, + 37.8, 41.1, 38.6, 34.6, 36.6, 38.7, 42.5, 34.4, 46, 37.8, 37.7, + 35.9, 38.2, 38.8, 35.3, 40.6, 40.5, 37.9, 40.5, 39.5, 37.2, 39.5, + 40.9, 36.4, 39.2, 38.8, 42.2, 37.6, 39.8, 36.5, 40.8, 36, 44.1, + 37, 39.6, 41.1, 37.5, 36, 42.3, 46.1, 50, 48.7, 50, 47.6, 46.5, + 45.4, 46.7, 43.3, 46.8, 40.9, 49, 45.5, 48.4, 45.8, 49.3, 42, + 49.2, 46.2, 48.7, 50.2, 45.1, 46.5, 46.3, 42.9, 46.1, 44.5, 47.8, + 48.2, 50, 47.3, 42.8, 45.1, 59.6, 49.6, 50.5, 50.5, 50.1, 50.4, + 46.2, 54.3, 49.8, 49.5, 50.7, 46.4, 48.2, 48.6, 45.2, 52.5, 50, + 50.8, 52.1, 52.2, 49.5, 50.8, 46.9, 51.1, 55.9, 49.1, 49.8, 51.5, + 55.1, 48.8, 50.4, 46.5, 50, 51.3, 45.4, 52.7, 45.2, 46.1, 51.3, + 46, 51.3, 46.6, 51.7, 47, 52, 45.9, 50.5, 50.3, 58, 46.4, 49.2, + 42.4, 48.5, 43.2, 50.6, 46.7, 52) > > # In <0.3.4: Exceeded buffer for finding fake snake > ses(a[-c(15:38, 50:90)], b[-c(40:85, 100:125)], max.diffs=80) [1] "1,3c1,9" "5,13c11,12" "15,25c14,48" "26a50" "28,29d51" [6] "31c53,57" "33c59,60" "35,42c62,67" "44,49d68" Warning message: In diff_myers(args[["a"]], args[["b"]], max.diffs = args[["max.diffs"]], : Exceeded `max.diffs`: 101 vs 80 allowed. Diff is probably suboptimal. > > # In <0.3.4: Faux Snake Process Failed > ses(a[-(18:38)], b[-(50:80)], max.diffs=115) [1] "1,3c1,9" "5,7c11,26" "9,12c28,38" "13a40,46" [5] "15,54c48,82" "56,68d83" "70,74c85,88" "75a90,98" [9] "77c100,101" "79,86c103,108" "88,93d109" Warning message: In diff_myers(args[["a"]], args[["b"]], max.diffs = args[["max.diffs"]], : Exceeded `max.diffs`: 182 vs 115 allowed. Diff is probably suboptimal. > > # - issue 157 ------------------------------------------------------------------ > > # Arguably could match on 'A' instead of 'X' and be more compact > a <- c('a', 'b', 'c', 'A', 'X', 'Y', 'Z', 'W') > b <- c('X', 'C', 'A', 'U', 1, 2, 3) > ses(a, b, max.diffs=13) [1] "1,4d0" "6,8c2,7" > > # segfault (but may have beend debugging code) > ses(letters[1:2], LETTERS[1:2], max.diffs = 4) [1] "1,2c1,2" > > # snake overrun > ses(c("G", "C", "T", "C", "A", "C", "G", "C"), c("T", "G"), max.diffs=2) [1] "0a1" "2,8d2" Warning message: In diff_myers(args[["a"]], args[["b"]], max.diffs = args[["max.diffs"]], : Exceeded `max.diffs`: 8 vs 2 allowed. Diff is probably suboptimal. > > # effect of max.diffs on compactness (waldo logical comparison) > ses(c('A','A','A','A','A'), c('B','A','B','A','B'), max.diffs=0) [1] "1c1" "3c3" "5c5" Warning message: In diff_myers(args[["a"]], args[["b"]], max.diffs = args[["max.diffs"]], : Exceeded `max.diffs`: 6 vs 0 allowed. Diff is probably suboptimal. > ses(c('A','A','A','A','A'), c('B','A','B','A','B'), max.diffs=1) [1] "0a1" "2c3" "4,5c5" Warning message: In diff_myers(args[["a"]], args[["b"]], max.diffs = args[["max.diffs"]], : Exceeded `max.diffs`: 6 vs 1 allowed. Diff is probably suboptimal. > ses(c('A','A','A','A','A'), c('B','A','B','A','B'), max.diffs=2) [1] "0a1" "2,4c3" "5a5" Warning message: In diff_myers(args[["a"]], args[["b"]], max.diffs = args[["max.diffs"]], : Exceeded `max.diffs`: 6 vs 2 allowed. Diff is probably suboptimal. > > # back snake all matches before faux snake triggered > ses_dat( + a=c("T", "A", "A", "C", "C", "A"), + b=c("A", "G", "A", "A"), max.diffs = 0 + ) "ses_dat" object (Match: 3, Delete: 3, Insert: 1): D: T C C M: A A A I: G Warning message: In diff_myers(args[["a"]], args[["b"]], max.diffs = args[["max.diffs"]], : Exceeded `max.diffs`: 4 vs 0 allowed. Diff is probably suboptimal. > > # - errors --------------------------------------------------------------------- > > try(ses('a', 'b', max.diffs='hello')) # "must be scalar integer" Error in ses_prep(a = a, b = b, max.diffs = max.diffs, warn = warn) : Argument `max.diffs` must be scalar integer. > try(ses('a', 'b', warn='hello')) # "must be TRUE or FALSE" Error in ses_prep(a = a, b = b, max.diffs = max.diffs, warn = warn) : Argument `warn` must be TRUE or FALSE. > > a <- structure(1, class='diffobj_ogewlhgiadfl2') > try(ses(a, 1)) # "could not be coerced") Error in as.character.diffobj_ogewlhgiadfl2(a) : failure2 Error in ses_prep(a = a, b = b, max.diffs = max.diffs, warn = warn) : Argument `a` is not character and could not be coerced to such > try(ses(1, a)) # "could not be coerced" Error in as.character.diffobj_ogewlhgiadfl2(b) : failure2 Error in ses_prep(a = a, b = b, max.diffs = max.diffs, warn = warn) : Argument `b` is not character and could not be coerced to such > > # We want to have a test file that fully covers the C code in order to run > # valgrind with just that one. We were unable to isolate simple diffs that > # triggered all the code, but we were able to do it with the below in addition > # to the above. > > # - Repeat tests for full coverage in SES file --------------------------------- > # From test.diffStr.R > # formula display changed > if( + R.Version()$major >= 3 && R.Version()$minor >= "3.1" || + R.Version()$major >= 4) { + rdsf1 <- function(x) + readRDS(file.path("_helper", "objs", "diffStr", sprintf("%s.rds", x))) + all.equal( + as.character( + diffStr(mdl1, mdl2, extra=list(strict.width="wrap"), line.limit=30) + ), + rdsf1(500) + ) + } [1] TRUE > # from testthat.warnings.R > > A3 <- c("a b c", "d e f A B C D", "g h i", "f") > B3 <- c("a b c", "xd e f E Q L S", "g h i", "q") > > diffChr(A3, B3, max.diffs=2) # warn: "Exceeded diff" < A3 > B3 @@ 1,4 @@  @@ 1,4 @@  a b c a b c < d e f A B C D > xd e f E Q L S < g h i > g h i < f > q Warning message: Exceeded diff limit during diff computation (6 vs. 2 allowed); overall diff is likely not optimal > > # - ses_dat -------------------------------------------------------------------- > > a <- b <- do.call(paste0, expand.grid(LETTERS, LETTERS)) > set.seed(2) > b <- b[-sample(length(b), 100)] > a <- a[-sample(length(b), 100)] > > dat <- ses_dat(a, b) > all.equal(dat[['val']][dat[['op']] != 'Delete'], b) [1] TRUE > all.equal(dat[['val']][dat[['op']] != 'Insert'], a) [1] TRUE > all.equal(a[dat[['id.a']][!is.na(dat[['id.a']])]], a) [1] TRUE > > dat2 <- ses_dat(a, b, extra=FALSE) > all.equal(dat[1:2], dat2) [1] TRUE > all.equal(length(dat2), 2L) [1] TRUE > > try(ses_dat(a, b, extra=NA)) # 'TRUE or FALSE' Error in ses_dat(a, b, extra = NA) : Argument `extra` must be TRUE or FALSE. > > # - encoding agnostic #144 ----------------------------------------------------- > > # h/t @hadley, these are different in string cache, but should compare equal > # as per ?identical > x <- c("fa\xE7ile", "fa\ue7ile") > Encoding(x) <- c("latin1", "UTF-8") > y <- rev(x) > all.equal(diffobj::ses(x, y), character()) [1] TRUE > > proc.time() user system elapsed 1.135 0.107 1.244 diffobj/tests/test-guide.Rout.save0000644000176200001440000002502315000460760016701 0ustar liggesusers R Under development (unstable) (2021-07-17 r80639) -- "Unsuffered Consequences" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "guides" > source(file.path('_helper', 'init.R')) > > # - detect_2d_guides ----------------------------------------------------------- > > iris.dply <- c("Source: local data frame [150 x 5]", "Groups: Species [3]", "", " Sepal.Length Sepal.Width", " (dbl) (dbl)", "1 5.1 3.5", "2 4.9 3.0", "3 4.7 3.2", "4 4.6 3.1", "5 5.0 3.6", "6 5.4 3.9", "7 4.6 3.4", "8 5.0 3.4", "9 4.4 2.9", "10 4.9 3.1", ".. ... ...", "Variables not shown: Petal.Length", " (dbl), Petal.Width (dbl), Species", " (fctr)") > > all.equal(diffobj:::detect_2d_guides(iris.dply), 4:5) [1] TRUE > # wrapping data table with separator (#96) > > DT.txt <- c( + " V1 V2 V3", + " 1: 0.3201122 0.6907066 0.5004968", + " --- ", + "1000: 0.3547379 0.2836985 0.8121208", + " V4 V5", + " 1: 0.331665 0.6788726", + " --- ", + "1000: 0.553012 0.7789110" + ) > all.equal( + diffobj:::detect_2d_guides(DT.txt), + c(1L, 5L) + ) [1] TRUE > # Narrow width > > old.opt <- options(width=40) > all.equal(diffobj:::detect_2d_guides(capture.output(iris)), c(1, 152)) [1] TRUE > all.equal( + diffobj:::detect_2d_guides(capture.output(USAccDeaths)), c(1, 8, 15) + ) [1] TRUE > # Time series > all.equal(diffobj:::detect_2d_guides(capture.output(UKgas)), 1) [1] TRUE > # no row.names (#111) > > df1 <- capture.output(print(data.frame(a=1:3), row.names=FALSE)) > no.rn.guide <- diffobj:::detect_2d_guides(df1) # no warning > all.equal(no.rn.guide, 1L) [1] TRUE > > df2 <- capture.output(print(data.frame(x="A"), row.names=FALSE)) > no.rn.guide.2 <- diffobj:::detect_2d_guides(df2) # no warning > all.equal(no.rn.guide.2, 1L) [1] TRUE > options(old.opt) > > # - detect_list_guides --------------------------------------------------------- > > l.1 <- list(1, 1:3, matrix(1:3, 1)) > l.2 <- list(a=1, list(1:3, b=4, c=list(1, b=2)), matrix(1:3, 1)) > c.l.1 <- capture.output(l.1) > c.l.2 <- capture.output(l.2) > # cbind(c.l.2, seq_along(c.l.2) %in% diffobj:::detect_list_guides(c.l.2)) > all.equal(diffobj:::detect_list_guides(capture.output(l.1)), c(1, 4, 7)) [1] TRUE > all.equal( + diffobj:::detect_list_guides(capture.output(l.2)), + c(1, 5, 8, 12, 15, 20) + ) [1] TRUE > > # - detect_matrix_guides ------------------------------------------------------- > mx3 <- mx4 <- mx5 <- mx5a <- mx11 <- matrix( + c( + "averylongwordthatcanlahblah", "causeasinglewidecolumnblah", + "matrixtowrapseveraltimes", "inarrowscreen", "onceuponatime", + "agreenduckflew", "overthemountains", "inalongofantelopes", + "ineedthreemore", "entriesactually", "nowonlytwomore", "iwaswrongearlier" + ), + nrow=3, ncol=4 + ) > mx3.c <- capture.output(mx3) > all.equal(diffobj:::detect_matrix_guides(mx3.c, NULL), c(1, 5)) [1] TRUE > > dimnames(mx4) <- list(A=NULL, B=NULL) > mx4.c <- capture.output(mx4) > all.equal( + diffobj:::detect_matrix_guides(mx4.c, dimnames(mx4)), c(1, 2, 6, 7) + ) [1] TRUE > attr(mx5, "blah") <- letters[1:10] > mx5.c <- capture.output(mx5) > all.equal( + diffobj:::detect_matrix_guides(mx5.c, dimnames(mx5)), c(1, 5) + ) [1] TRUE > # Simple matrices that don't wrap > > mx6 <- mx7 <- mx7.1 <- matrix(1:4, 2) > > mx6.c <- capture.output(mx6) > all.equal(diffobj:::detect_matrix_guides(mx6.c, dimnames(mx6)), 1) [1] TRUE > > dimnames(mx7) <- list(A=letters[1:2], B=LETTERS[25:26]) > mx7.c <- capture.output(mx7) > all.equal(diffobj:::detect_matrix_guides(mx7.c, dimnames(mx7)), c(1, 2)) [1] TRUE > > dimnames(mx7.1) <- list(letters[1:2], B=LETTERS[25:26]) > mx7.1.c <- capture.output(mx7.1) > all.equal(diffobj:::detect_matrix_guides(mx7.1.c, dimnames(mx7.1)), c(1, 2)) [1] TRUE > > # Single col matrix > > mx8 <- matrix(1:2, 2) > > mx8.c <- capture.output(mx8) > all.equal(diffobj:::detect_matrix_guides(mx8.c, dimnames(mx8)), 1) [1] TRUE > > # Wrapping matrices with colnames > > mx9 <- mx3 > dimnames(mx9) <- list(A=letters[1:3], B=LETTERS[20:23]) > mx9.c <- capture.output(mx9) > all.equal( + diffobj:::detect_matrix_guides(mx9.c, dimnames(mx9)), c(1:2, 6:7) + ) [1] TRUE > > mx10 <- mx9 > attr(mx10, "blah") <- matrix(1:4, 2) > mx10.c <- capture.output(mx10) > all.equal( + diffobj:::detect_matrix_guides(mx10.c, dimnames(mx10)), c(1:2, 6:7) + ) [1] TRUE > local({ + old.opt <- options(width=30L) + on.exit(options(old.opt)) + attr(mx11, "blah") <- letters[1:15] + mx11.c <- capture.output(mx11) + + all.equal( + diffobj:::detect_matrix_guides(mx11.c, dimnames(mx11)), c(1, 5, 9, 13) + ) + }) [1] TRUE > # - detect_array_guides -------------------------------------------------------- > > a.1 <- array(1:6, dim=c(2, 1, 3)) > a.2 <- array(1:6, dim=c(2, 1, 3), dimnames=list(NULL, "X", LETTERS[1:3])) > a.3 <- array( + 1:6, dim=c(2, 1, 3), + dimnames=list(rows=NULL, cols="X", LETTERS[1:3]) + ) > a.4 <- `attr<-`(a.3, "hello", "random attribute") > a.5 <- array(1:36, dim=c(6, 2, 3)) > a.6 <- array(1:2, c(2, 1, 1)) > c.a.1 <- capture.output(a.1) > c.a.2 <- capture.output(a.2) > c.a.3 <- capture.output(a.3) > c.a.4 <- capture.output(a.4) > c.a.5 <- capture.output(a.5) > c.a.6 <- capture.output(a.6) > # helper funs to vizualize the guide line detection > # viz_dag <- function(capt, obj) > # cbind( > # capt, > # seq_along(capt) %in% diffobj:::detect_array_guides(capt, dimnames(obj)) > # ) > # viz_dag(c.a.1, a.1) > # viz_dag(c.a.2, a.2) > # viz_dag(c.a.3, a.3) > # viz_dag(c.a.4, a.4) > # viz_dag(c.a.5, a.5) > # viz_dag(c.a.6, a.6) > all.equal( + diffobj:::detect_array_guides(c.a.1, dimnames(a.1)), + c(1L, 2L, 7L, 8L, 13L, 14L) + ) [1] TRUE > all.equal( + diffobj:::detect_array_guides(c.a.2, dimnames(a.2)), + c(1L, 2L, 7L, 8L, 13L, 14L) + ) [1] TRUE > all.equal( + diffobj:::detect_array_guides(c.a.3, dimnames(a.3)), + c(1L, 2L, 8L, 9L, 15L, 16L) + ) [1] TRUE > all.equal( + diffobj:::detect_array_guides(c.a.4, dimnames(a.4)), + c(1L, 2L, 8L, 9L, 15L, 16L) + ) [1] TRUE > all.equal( + diffobj:::detect_array_guides(c.a.5, dimnames(a.5)), + c(1L, 2L, 11L, 12L, 21L, 22L) + ) [1] TRUE > all.equal( + diffobj:::detect_array_guides(c.a.6, dimnames(a.6)), + c(1L, 2L) + ) [1] TRUE > # - detect_s4_guides ----------------------------------------------------------- > > setClass("gtest2", slots=c(hello="integer", `good bye`="list")) > setClass("gtest1", + slots=c( + sub.class="gtest2", blah="character", gah="list", sub.class.2="gtest2" + ) ) > obj <- new( + "gtest1", + sub.class=new( + "gtest2", hello=1:3, `good bye`=list("a", list(l1=5, l2="wow")) + ), + blah=letters, gah=list(one=1:10, two=LETTERS), + sub.class.2=new( + "gtest2", hello=3:1, `good bye`=list("B", list(l1=5, l2="wow")) + ) + ) > # note at this point the nested stuff doesn't work, so we're just shooting for > # the simple match > > c.1 <- capture.output(obj) > identical( + diffobj:::detect_s4_guides(c.1, obj), + c(1L, 2L, 21L, 25L, 34L) + ) [1] TRUE > # small diff as that has a non-default show method > > diff <- diffChr("a", "b", format='raw') > diff.out <- capture.output(show(diff)) > all.equal( + diffobj:::detect_s4_guides(diff.out, diff), + integer() + ) [1] TRUE > # - custom guide fun ----------------------------------------------------------- > > a <- b <- matrix(1:100) > b[50] <- -99L > > fun1 <- function(x, y) c(1L, 14L, 53L) > > all.equal(as.character(diffPrint(a, b, guides=fun1)), rdsf(100)) [1] TRUE > if(getRversion() >= "3.2.2") { + capture.output( # warn: "If you did not specify a `guides`" + trim.err <- + as.character(diffPrint(a, b, guides=function(x, y) stop("boom"))), + type="message" + ) + all.equal(trim.err, rdsf(200)) + } [1] TRUE Warning message: In apply_guides(current, cur.capt, guide_fun) : `guides*` method produced an error when attempting to compute guide lines ; If you did not specify a `guides` function or define custom `guides*` methods contact maintainer (see `?guides`). Proceeding without guides. > # "must produce an integer vector" > try(diffobj:::apply_guides(1:26, LETTERS, function(x, y) 35L)) Error in diffobj:::apply_guides(1:26, LETTERS, function(x, y) 35L) : `guides*` method must produce an integer vector containing unique index values for the `obj.as.chr` vector; If you did not specify a `guides` function or define custom `guides*` methods contact maintainer (see `?guides`). Proceeding without guides. > > # - errors --------------------------------------------------------------------- > > try(guidesStr(1:26, rep(NA_character_, 26)))# "Cannot compute guides" Error in guidesStr(1:26, rep(NA_character_, 26)) : Cannot compute guides if `obj.as.chr` contains NAs > try(guidesPrint(1:26, rep(NA_character_, 26)))# "Cannot compute guides" Error in guidesPrint(1:26, rep(NA_character_, 26)) : Cannot compute guides if `obj.as.chr` contains NAs > > # - corner cases --------------------------------------------------------------- > > all.equal( + diffobj:::split_by_guides(letters, integer()), + list(structure(letters, idx=seq_along(letters))) + ) [1] TRUE > try(guidesStr(1:26, rep(NA_character_, 26))) # "Cannot compute guides" Error in guidesStr(1:26, rep(NA_character_, 26)) : Cannot compute guides if `obj.as.chr` contains NAs > try(guidesPrint(1:26, rep(NA_character_, 26))) # "Cannot compute guides" Error in guidesPrint(1:26, rep(NA_character_, 26)) : Cannot compute guides if `obj.as.chr` contains NAs > > # - issue 117 - 2d guide failure ----------------------------------------------- > > # Thanks to Sebastian Meyer (@bastician) for MRE > a <- b <- data.frame(ID = 0, value = 1) > b$value <- 2 > a <- a[c(rep(1, 86), 2)] > b <- b[c(rep(1, 86), 2)] > diffPrint(a, b, mode = "unified", format='raw', context=0) < a > b @@ 16 / 16 @@ ~ value < 1 1 > 1 2 > diffobj/tests/test-s4.Rout.save0000644000176200001440000000416514122754044016143 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "s4" > source(file.path('_helper', 'init.R')) > > # - diff data validation works > # > # These are not currently in use > # expect_match(diffobj:::valid_dat("hello"), "should be a list") > # D0 <- D1 <- D2 <- D3 <- D4 <- D5 <- D6 <- D7 <- > # diffPrint(letters, LETTERS)@tar.dat > > # expect_match(diffobj:::valid_dat(unname(D0)), "should have names") > > # length(D1[[1L]]) <- 1L > # expect_match(diffobj:::valid_dat(D1), "should have equal length") > > # D2$orig <- integer(length(D2$orig)) > # expect_match(diffobj:::valid_dat(D2), "should be character") > > # D3$trim.ind.start <- character(length(D3$trim.ind.start)) > # expect_match(diffobj:::valid_dat(D3), "should be integer") > > # D4$word.ind <- integer(length(D4$word.ind)) > # expect_match(diffobj:::valid_dat(D4), "should be list") > > # D5$word.ind <- vector("list", length(D5$word.ind)) > # expect_match(diffobj:::valid_dat(D5), "not in expected format") > > # D6$tok.rat <- D6$tok.rat + 2 > # expect_match(diffobj:::valid_dat(D6), "with all values between") > > # D7$fill <- integer(length(D7$fill)) > # expect_match(diffobj:::valid_dat(D7), "should be logical") > > # - any ------------------------------------------------------------------------ > > isTRUE(any(diffChr('a', 'b'))) [1] TRUE > identical(any(diffChr('a', 'a')), FALSE) [1] TRUE > try(any(diffChr('a', 'a'), 2)) # "supports only one argument" Error : `any` method for `Diff` supports only one argument > > proc.time() user system elapsed 1.302 0.151 1.474 diffobj/tests/test-capture.Rout.save0000644000176200001440000001060414122754044017253 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "capture" > source(file.path('_helper', 'init.R')) > > # - capture width issues ------------------------------------------------------- > > local({ + old.opt <- options(width=40L) + on.exit(options(old.opt)) + etc <- new("Settings", style=StyleRaw(), text.width=5L) # impossible width + # warn: "Unable to set desired " + res <- diffobj:::capture(letters, etc, function(...) do.call(cat, list(...))) + all.equal(nchar(res), c(40L, 40L, 36L)) + }) [1] TRUE Warning message: In diffobj:::capture(letters, etc, function(...) do.call(cat, list(...))) : Unable to set desired width 5, (invalid 'width' parameter, allowed 10...10000);proceeding with existing setting. > > # - errors in capture ---------------------------------------------------------- > > etc <- new("Settings", style=StyleRaw()) > try(diffobj:::capture(stop('boom'), etc, function(...) stop(...))) # boom Error in eval(x, etc@frame) : boom Error in err("Failed attempting to get text representation of object: ", : Failed attempting to get text representation of object: boom > print <- function() NULL > str <- function() NULL > etc@mode <- "auto" > etc@frame <- environment() > try(diffobj:::capt_print(1, 2, etc, function(...) stop(...), list())) # compose Error in match.call(definition, call, expand.dots, envir) : unused argument (x = NULL) Error in err("Unable to compose `print` call") : Unable to compose `print` call > # spec object > try(diffobj:::capt_str(1, 2, etc, function(...) stop(...), list(object=1))) Error in err("You may not specify `object` as part of `extra`") : You may not specify `object` as part of `extra` > try( # attempting to deparse + diffobj:::capt_deparse( + stop('a'), stop('b'), etc, function(...) stop(...), list() + ) + ) Error in do.call(deparse, c(list(target), extra), quote = TRUE) : a Error in err("Error attempting to deparse object(s)") : Error attempting to deparse object(s) > try( # target + suppressWarnings( + diffobj:::capt_file( + tempfile(), tempfile(), etc, function(...) stop(...), list() + ) ) + ) Error in file(con, "r") : cannot open the connection Error in err("Unable to read `target` file.") : Unable to read `target` file. > local({ + f <- tempfile() + on.exit(unlink(f), add=TRUE) + writeLines(letters, f) + try( # "`current`" + suppressWarnings( + diffobj:::capt_file(f, tempfile(), etc, function(...) stop(...), list()) + ) + ) + try( # "`target`" + suppressWarnings( + diffobj:::capt_csv( + tempfile(), tempfile(), etc, function(...) stop(...), list() + ) ) + ) + try( # "`current`" + suppressWarnings( + diffobj:::capt_csv( + f, tempfile(), etc, function(...) stop(...), list() + ) ) + ) + }) Error in file(con, "r") : cannot open the connection Error in err("Unable to read `current` file.") : Unable to read `current` file. Error in file(file, "rt") : cannot open the connection Error in err("Unable to read `target` file.") : Unable to read `target` file. Error in file(file, "rt") : cannot open the connection Error in err("Unable to read `current` file.") : Unable to read `current` file. > bad_obj <- structure(list(NULL), class='diffobj_ogewlhgiadfl3') > try( # "Coercion of `target`" + diffobj:::capt_chr(bad_obj, letters, etc, function(...) stop(...), list()) + ) Error in diffobj:::capt_chr(bad_obj, letters, etc, function(...) stop(...), : Coercion of `target` did not produce character object (list). > try( # "Coercion of `current`" + diffobj:::capt_chr(letters, bad_obj, etc, function(...) stop(...), list()) + ) Error in diffobj:::capt_chr(letters, bad_obj, etc, function(...) stop(...), : Coercion of `current` did not produce character object (list). > > proc.time() user system elapsed 1.053 0.116 1.168 diffobj/tests/test-misc.Rout.save0000644000176200001440000001577514122754044016561 0ustar liggesusers R version 4.0.4 beta (2021-02-06 r79953) -- "Lost Library Book" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "misc" > source(file.path('_helper', 'init.R')) > > # - trim_str ------------------------------------------------------------------- > > a <- structure("hello", class="A", xx="B") > b <- structure(1:10, yy=a) > long.string <- "I'm a string long enough to force wrapping under most cases so that I may be useful for tests andiamareallylongwordtoseehowwrappingbreakslongwordsthatexceed" > obj <- list( + a=a, b=b, c=1:50, + d=long.string, + e=list(1, structure(2, zz=list(a=1, b=list("a", ls=long.string))), e=letters) + ) > # conditional because of issue113 > str.txt <- capture.output(str(obj)) > str.txt.w <- capture.output(str(obj, width=30L, strict.width="wrap")) > > if( + getRversion() >= '3.5.0' && as.numeric(R.Version()[['svn rev']]) >= 73780 + ) { + c( + all.equal( + diffobj:::str_levels(str.txt, wrap=FALSE), + c(0L, 1L, 2L, 1L, 2L, 3L, 1L, 1L, 1L, 2L, 2L, 3L, 4L, 4L, 5L, 5L, 2L) + ), + all.equal( + diffobj:::str_levels(str.txt.w, wrap=TRUE), + c(0L, 1L, 2L, 1L, 1L, 2L, 2L, 3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, + 2L, 2L + ) + ) ) + } else { + c( + all.equal( + diffobj:::str_levels(str.txt, wrap=FALSE), + c(0L, 1L, 3L, 1L, 2L, 4L, 1L, 1L, 1L, 2L, 2L, 3L, 4L, 4L, 5L, 5L, 2L) + ), + all.equal( + diffobj:::str_levels(str.txt.w, wrap=TRUE), + c(0L, 1L, 1L, 3L, 1L, 1L, 2L, 2L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 2L, 2L) + ) ) + } [1] TRUE TRUE > # cat( > # paste( > # format(substr(str.txt.w, 1, 20)), diffobj:::str_levels(str.txt.w, TRUE), > # sep=": " > # ), > # sep="\n" > # ) > > # - rle_sub -------------------------------------------------------------------- > > x <- c(1, 1, 1, 2, 2, 1, 1, 3, 3, 4, 4, 4, 5, 2, 2) > r <- rle(x) > all.equal(diffobj:::rle_sub(r, r$values == 1L), list(1:3, 6:7)) [1] TRUE > all.equal(diffobj:::rle_sub(r, r$values == 2L), list(4:5, 14:15)) [1] TRUE > isTRUE(all(x[unlist(diffobj:::rle_sub(r, r$values == 1L))] == 1)) [1] TRUE > isTRUE(all(x[unlist(diffobj:::rle_sub(r, r$values == 2L))] == 2)) [1] TRUE > isTRUE(all(x[unlist(diffobj:::rle_sub(r, r$values == 3L))] == 3)) [1] TRUE > > # - call funs ------------------------------------------------------------------ > > # Failure case; assumes no S4 dispatch in testthat > calls <- list(quote(a()), quote(b()), quote(notafunctionblah())) > all.equal(diffobj:::which_top(calls), length(calls)) [1] TRUE > diffobj:::extract_call(calls, new.env()) # warn: "Unable to find") $call NULL $tar NULL $cur NULL Warning message: In get_fun(found.call[[1L]], env = par.env) : Unable to find function `notafunctionblah` to match call with. > > # missing param works > > calls2 <- pairlist( + quote(diffChr("a")), quote(diffChr("a")), quote(.local(target, current, ...)) + ) > all.equal( + diffobj:::extract_call(calls2, new.env()), + list(call = quote(diffChr(target = "a", NULL)), tar = "a", cur = NULL) + ) [1] TRUE > # fallback parent frame; can't think of a good way to actually cause this to > # happen > > # all.equal(diffobj:::par_frame(), .GlobalEnv) > > # - lines ---------------------------------------------------------------------- > > old.val <- Sys.getenv("LINES", unset=NA) > Sys.setenv(LINES="25") > all.equal(console_lines(), 25L) [1] TRUE > Sys.setenv(LINES="-25") > all.equal(console_lines(), 48L) [1] TRUE > Sys.unsetenv("LINES") > all.equal(console_lines(), 48L) [1] TRUE > > # - get_funs ------------------------------------------------------------------- > > identical( + diffobj:::get_fun(quote(diffobj::diffPrint), .BaseNamespaceEnv), + diffobj::diffPrint + ) [1] TRUE > identical( + diffobj:::get_fun(quote(diffobj:::diffPrint), .BaseNamespaceEnv), + diffobj::diffPrint + ) [1] TRUE > identical( + diffobj:::get_fun(quote(diffPrint), getNamespace("diffobj")), + diffobj::diffPrint + ) [1] TRUE > gf <- diffobj:::get_fun(quote(notAFunction), getNamespace("diffobj")) # warn Warning message: In diffobj:::get_fun(quote(notAFunction), getNamespace("diffobj")) : Unable to find function `notAFunction` to match call with. > > identical(gf, NULL) [1] TRUE > > # - trimws2 -------------------------------------------------------------------- > > all.equal(diffobj:::trimws2("hello world"), "hello world") [1] TRUE > all.equal(diffobj:::trimws2(" hello world"), "hello world") [1] TRUE > all.equal(diffobj:::trimws2(" hello world "), "hello world") [1] TRUE > all.equal(diffobj:::trimws2(" hello world ", 'left'), "hello world ") [1] TRUE > all.equal(diffobj:::trimws2(" hello world ", 'right'), " hello world") [1] TRUE > > try(diffobj:::trimws2(" hello world ", 'banana')) # "is wrong" Error in diffobj:::trimws2(" hello world ", "banana") : Argument which is wrong > > # - string --------------------------------------------------------------------- > > try(diffobj:::substr2("hello world", 1, 1:2)) # "same length" Error in diffobj:::substr2("hello world", 1, 1:2) : `start` and `stop` must be length 1 or the same length as `x`. > > # - Gutters -------------------------------------------------------------------- > > etc <- new("Settings") > etc@style <- StyleRaw() > etc@style@funs@gutter <- function(x) stop("bad gutters") > try(diffobj:::gutter_dat(etc)) # "Failed attempting to apply gutter." Error in funs@gutter(paste0(gutt.dat.format, funs@gutter.pad(text@gutter.pad))) : bad gutters Error in diffobj:::gutter_dat(etc) : Failed attempting to apply gutter formatting functions; if you did not customize them, contact maintainer. See `?StyleFuns`. > > # - Finalizer error handling --------------------------------------------------- > > try(finalizeHtml(letters, NULL)) # "must be character" Error in .local(x, ...) : Argument `x.chr` must be character > try(finalizeHtml(letters, letters, letters)) # "must be character\\(1L" Error in .local(x, ...) : Argument `js` must be character(1L) and not NA. > > # - c.factor ------------------------------------------------------------------- > > all.equal(diffobj:::c.factor(), factor(character())) [1] TRUE > > # - strip_hz ------------------------------------------------------------------- > > # Can't trigger this directly because wrapper doesn't let this case through > diffobj:::strip_hz_c_int(character(), 8L, TRUE) character(0) > > > > proc.time() user system elapsed 0.607 0.078 0.674 diffobj/tests/test-diffPrint.Rout.save0000644000176200001440000002720214122754044017537 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "diffPrint" > source(file.path('_helper', 'init.R')) > > # Note, atomic prints happen in different test file > > # - Matrices ------------------------------------------------------------------- > > mx.2 <- matrix(1:100, ncol=2) > mx.4 <- mx.3 <- mx.2 > mx.3[31, 2] <- 111L > > mx.3a <- mx.3[-31, ] > set.seed(2) > mx.4[cbind(sample(1:50, 6), sample(1:2, 6, replace=TRUE))] <- + sample(-(1:50), 6) > > mx.5 <- matrix(1:9, 3) > mx.6 <- matrix(12:1, 4) > mx.6[4,] <- c(3L, 6L, 9L) > > # single value difference > all.equal(as.character(diffPrint(mx.2, mx.3)), rdsf(100)) [1] TRUE > # single value unified > all.equal(as.character(diffPrint(mx.2, mx.3, mode="unified")), rdsf(150)) [1] TRUE > # single value context > all.equal(as.character(diffPrint(mx.2, mx.3, mode="context")), rdsf(175)) [1] TRUE > # missing row > all.equal(as.character(diffPrint(mx.2, mx.3a)), rdsf(200)) [1] TRUE > all.equal(as.character(diffPrint(mx.2, mx.3a, mode="unified")), rdsf(300)) [1] TRUE > # More differences > > all.equal(as.character(diffPrint(mx.2, mx.4)), rdsf(400)) [1] TRUE > all.equal(as.character(diffPrint(mx.2, mx.4, mode="unified")), rdsf(500)) [1] TRUE > # Testing alignments > all.equal(as.character(diffPrint(mx.5, mx.6)), rdsf(600)) [1] TRUE > all.equal(as.character(diffPrint(mx.5, mx.6, mode="unified")), rdsf(700)) [1] TRUE > all.equal(as.character(diffPrint(mx.5, mx.6, mode="context")), rdsf(800)) [1] TRUE > # More complex matrix > set.seed(2) > A <- B <- matrix(sample(1:80), nrow=16) > B[cbind(sample(5:16, 4), sample(1:5, 4))] <- sample(30:80, 4) > > all.equal(as.character(diffPrint(A, B)), rdsf(900)) [1] TRUE > all.equal(as.character(diffPrint(A, B, mode="unified")), rdsf(1000)) [1] TRUE > all.equal(as.character(diffPrint(A, B, mode="context")), rdsf(1100)) [1] TRUE > # Style matrices > > all.equal(as.character(diffPrint(diffobj:::.mx1, diffobj:::.mx2)), rdsf(1200)) [1] TRUE > > # - Lists ---------------------------------------------------------------------- > > all.equal(as.character(diffPrint(lst.1, lst.3)), rdsf(1300)) [1] TRUE > all.equal(as.character(diffPrint(lst.1, lst.3, mode="unified")), rdsf(1400)) [1] TRUE > all.equal(as.character(diffPrint(lst.4, lst.5)), rdsf(1500)) [1] TRUE > all.equal(as.character(diffPrint(lst.4, lst.5, mode="context")), rdsf(1600)) [1] TRUE > # Nested first element (https://github.com/brodieG/diffobj/issues/46) > all.equal( + as.character(diffPrint(list(1, list(2, list(1:3))), list(list(list(1:3))))), + rdsf(1650) + ) [1] TRUE > # Interesting but relatively slow example so we don't actually run it in > # tests > > # diffPrint(unclass(mdl1), unclass(mdl2)) > # diffPrint(unclass(mdl1), unclass(mdl2), mode="unified") > > # - Data Frames ---------------------------------------------------------------- > > all.equal(as.character(diffPrint(iris.s, iris.2)), rdsf(1700)) [1] TRUE > all.equal( + as.character(diffPrint(iris.s, iris.2, mode="sidebyside")), rdsf(1800) + ) [1] TRUE > all.equal(as.character(diffPrint(iris.s, iris.c)), rdsf(1900)) [1] TRUE > all.equal(as.character(diffPrint(iris.s, iris.3)), rdsf(2000)) [1] TRUE > > all.equal( + as.character(diffPrint(iris.s, iris.3, mode="sidebyside")), rdsf(2100) + ) [1] TRUE > all.equal(as.character(diffPrint(iris.s, iris.4, mode="unified")), rdsf(2150)) [1] TRUE > all.equal( + as.character(diffPrint(iris.s, iris.4, mode="sidebyside")), rdsf(2200) + ) [1] TRUE > all.equal( + as.character(diffPrint(iris.5, iris.4, mode="sidebyside")), rdsf(2250) + ) [1] TRUE > all.equal(as.character(diffPrint(iris.3a, iris.4a)), rdsf(2300)) [1] TRUE > all.equal( + as.character(diffPrint(iris.s, iris.3, mode="sidebyside")), rdsf(2350) + ) [1] TRUE > all.equal(as.character(diffPrint(iris.s, iris.s[-2])), rdsf(2370)) [1] TRUE > # This one is interesting because the input is pathological because there > # is one line that matches exactly between the two and as such creates a > # matching hunk, but it really is matching by coincidence. > > all.equal( + as.character(diffPrint(iris.s, iris.s[-2], mode="sidebyside")), rdsf(2383) + ) [1] TRUE > # Possible example where we may not want to trim the row headers (Issue #39) > all.equal( + as.character(diffPrint(cars[1:5,], mtcars[1:5,], mode="sidebyside")), + rdsf(2380) + ) [1] TRUE > > # - Guides --------------------------------------------------------------------- > > # Most guides tests are in the guides file, but this confirms interface works > # when starting at `diffPrint` instead of internally > > all.equal( + as.character( + diffPrint( + iris.s, iris.4, mode="sidebyside", guides=function(x, y) integer() + ) ), + rdsf(2400) + ) [1] TRUE > all.equal( + as.character(diffPrint(iris.s, iris.4, mode="sidebyside", guides=FALSE)), + rdsf(2500) + ) [1] TRUE > > # - Arrays > arr.1 <- arr.2 <- array(1:24, c(4, 2, 3)) > arr.2[c(3, 20)] <- 99L > all.equal(as.character(diffPrint(arr.1, arr.2)), rdsf(2600)) [1] TRUE > > # - Mixed > all.equal( + as.character(diffPrint(list(1, 2, 3), matrix(1:9, 3))), + rdsf(2700) + ) [1] TRUE > all.equal( + as.character(diffPrint(list(25, 2, 3), matrix(1:9, 3))), + rdsf(2800) + ) [1] TRUE > all.equal( + as.character( + diffPrint(list(c(1, 4, 7), c(2, 5, 8), c(3, 6, 9)), matrix(1:9, 3)) + ), + rdsf(2900) + ) [1] TRUE > # - `unitizer` corner case ----------------------------------------------------- > > res1 <- structure( + c(-1717, 101, 0.938678984853783), + .Names = c("intercept", "slope", "rsq"), class = "fastlm" + ) > res2 <- structure( + c(-3.541306e+13, 701248600000, 0.938679), + .Names = c("intercept", "slope", "rsq"), class = "fastlm" + ) > all.equal(as.character(diffPrint(res1, res2)), rdsf(3000)) [1] TRUE > all.equal( + as.character(diffPrint(unname(res1), unname(res2))), rdsf(3100) + ) [1] TRUE > > # - factors and other meta ----------------------------------------------------- > > # Thanks Frank > > all.equal( + as.character(diffPrint(factor(1:100), factor(c(1:99, 101)))), rdsf(3200) + ) [1] TRUE > f1 <- factor(1:100) > f2 <- factor(c(1:20, 22:99, 101)) > all.equal(capture.output(diffPrint(f1, f2)), txtf(100)) [1] TRUE > > f3 <- factor(letters[1:10]) > f4 <- factor(letters[1:10], levels=letters[1:11]) > all.equal(capture.output(diffPrint(f3, f4)), txtf(150)) [1] TRUE > > # time series > > nhtemp2 <- nhtemp > nhtemp2[c(5, 30)] <- -999 > all.equal(capture.output(diffPrint(nhtemp, nhtemp2)), txtf(175)) [1] TRUE > > # Meta on both sides > > print.diffobj_test_c1 <- function(x, ...) { + writeLines(c("Header row 1", "header row 2")) + print(c(x)) + writeLines(c("", "Footer row 1", "", "footer row2")) + } > m1 <- structure(1:30, class='diffobj_test_c1') > m2 <- structure(2:51, class='diffobj_test_c1') > all.equal(capture.output(diffPrint(m1, m2)), txtf(200), print=TRUE) [1] TRUE > > # - Raw output ----------------------------------------------------------------- > > all.equal( + as.character(diffPrint(letters, LETTERS, format="raw", pager="off")), + rdsf(3300) + ) [1] TRUE > # - Varying Widths ------------------------------------------------------------- > > all.equal( + as.character(diffPrint(letters, LETTERS, format="raw", disp.width=40)), + rdsf(3400) + ) [1] TRUE > try(diffPrint(letters, LETTERS, disp.width=5)) Error in diffPrint(target = letters, current = LETTERS, disp.width = 5) : Arugment `disp.width` must be integer(1L) and 0, or between 10 and 10000 > > # - covr workaround ------------------------------------------------------------ > > # Needed so that the function definition stuff is marked as covered; really > # it shouldn't even be eligible for coverage, need to discuss further with > # jhester > > invisible(diffobj:::make_diff_fun()) > > # - Encoding Issues ------------------------------------------------------------ > > # issue81, mixed UTF-8 ASCII, encoding a-acute in hex to avoid cross platform > # issues > > a <- "G\xc3\xa1bor Cs\xc3\xa1rdi" > b <- sprintf("%s wow", a) > Encoding(a) <- 'UTF-8' > Encoding(b) <- 'UTF-8' > > # No error > > new <- (as.character(diffPrint(list(hell=a, b=NULL), list(hell=b, b=list())))) > > # can't store this in RDS b/c otherwise won't run properly on oses with > # different encoding (e.g. windows) > > ref <- structure( + c("\033[33m<\033[39m \033[33mlist(hell = a, b = N..\033[39m \033[34m>\033[39m \033[34mlist(hell = b, b = l..\033[39m", + "\033[36m@@ 1,6 @@ \033[39m \033[36m@@ 1,6 @@ \033[39m", + " \033[90m\033[39m$hell\033[90m\033[39m \033[90m\033[39m$hell\033[90m\033[39m ", + "\033[33m<\033[39m \033[90m[1] \033[39m\033[33m\"G\xc3\xa1bor Cs\xc3\xa1rdi\"\033[39m\033[90m\033[39m \033[34m>\033[39m \033[90m[1] \033[39m\033[34m\"G\xc3\xa1bor Cs\xc3\xa1rdi wow\"\033[39m\033[90m\033[39m", + " ", " \033[90m\033[39m$b\033[90m\033[39m \033[90m\033[39m$b\033[90m\033[39m ", + "\033[33m<\033[39m \033[90m\033[39m\033[33mNULL\033[39m\033[90m\033[39m \033[34m>\033[39m \033[90m\033[39m\033[34mlist\033[39m\033[34m()\033[39m\033[90m\033[39m ", + " " + ), + len = 8L + ) > Encoding(ref) <- 'UTF-8' > all.equal(new, ref) [1] TRUE > > # issue 106, this used to fail when trying to check for an RDS with a bytes > # encoded file name > > bytes <- "\x81" > Encoding(bytes) <- "bytes" > isTRUE(!any(diffPrint(bytes, bytes))) [1] TRUE > > # - Quoted Objects ------------------------------------------------------------- > > all.equal( + as.character(diffPrint(quote(zz + 1), quote(zz + 3))), + structure( + c("\033[33m<\033[39m \033[33mquote(..\033[39m \033[34m>\033[39m \033[34mquote(..\033[39m", "\033[36m@@ 1 @@ \033[39m \033[36m@@ 1 @@ \033[39m", "\033[33m<\033[39m \033[90m\033[39mzz + \033[33m1\033[39m\033[90m\033[39m \033[34m>\033[39m \033[90m\033[39mzz + \033[34m3\033[39m\033[90m\033[39m " + ), len = 3L + ) + ) [1] TRUE > all.equal( + as.character(diffPrint(quote(x), quote(y))), + structure( + c("\033[33m<\033[39m \033[33mquote(x)\033[39m \033[34m>\033[39m \033[34mquote(y)\033[39m", "\033[36m@@ 1 @@ \033[39m \033[36m@@ 1 @@ \033[39m", "\033[33m<\033[39m \033[90m\033[39m\033[33mx\033[39m\033[90m\033[39m \033[34m>\033[39m \033[90m\033[39m\033[34my\033[39m\033[90m\033[39m "), + len = 3L + ) + ) [1] TRUE > # - par_frame ------------------------------------------------------------------ > > # check that par_frame is retrieved correctly > env <- new.env() > env$print <- function(x, ...) stop('boom') > try(evalq(diffPrint(1:3, 1:4), env)) # "Failed attempting .*: boom" Error in print(1:4) : boom Error in .local(target, current, ...) : Failed attempting to get text representation of object: boom > > f <- function(a, b, ...) { + print <- function(x, ...) stop('boom2') + diffPrint(a, b, ...) + } > try(f(1:3, 1:4, format='raw')) # "Failed attempting .*: boom2" Error in print(1:4) : boom2 Error in .local(target, current, ...) : Failed attempting to get text representation of object: boom2 > > > proc.time() user system elapsed 5.686 0.658 6.772 diffobj/tests/test-context.Rout.save0000644000176200001440000000466114122754044017302 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "context" > source(file.path('_helper', 'init.R')) > > # - interesting context values ------------------------------------------------- > > all.equal( + as.character(diffChr(chr.9, chr.10, context=0)), + rdsf(100) + ) [1] TRUE > all.equal( + as.character(diffChr(chr.9, chr.10, context=-1L)), + rdsf(150) + ) [1] TRUE > all.equal( + as.character(diffChr(chr.9, chr.10, context="auto")), + rdsf(200) + ) [1] TRUE > all.equal( + as.character(diffChr(chr.9, chr.10, context=0, mode="context")), rdsf(300) + ) [1] TRUE > # - with line limit ------------------------------------------------------------ > > all.equal( + as.character(diffChr(chr.9, chr.10, context="auto", line.limit=18)), + rdsf(400) + ) [1] TRUE > all.equal( + as.character(diffChr(chr.9, chr.10, context="auto", line.limit=25)), + rdsf(500) + ) [1] TRUE > # default to min context > > a <- b <- letters > b[c(3, 20)] <- LETTERS[c(3,20)] > all.equal( + capture.output( + show(diffChr(a, b, line.limit=c(20, 10), context='auto', format='raw')) + ), + txtf(100) + ) [1] TRUE > # trim hunks in auto-context mode > > a <- b <- letters > b[c(3, 10, 20)] <- LETTERS[c(3,10,20)] > all.equal( + capture.output(show( + diffChr( + a, b, hunk.limit=c(2, 1), context=auto_context(1, 5), line.limit=20, + format='raw' + ) + )), + txtf(200) + ) [1] TRUE > # - error handling ------------------------------------------------------------- > > try(auto_context(min=-1, max=1:3)) # "`min` must be" Error in auto_context(min = -1, max = 1:3) : Argument `min` must be integer(1L) and greater than zero > try(auto_context(min=1, max=1:3)) # "`max` must be" Error in auto_context(min = 1, max = 1:3) : Argument `max` must be integer(1L) and not NA > > > proc.time() user system elapsed 1.714 0.151 1.881 diffobj/tests/test-rdiff.R0000644000176200001440000000411714122754044015217 0ustar liggesusersNAME <- "rdiff" source(file.path('_helper', 'init.R')) # - diff util detection -------------------------------------------------------- identical(has_Rdiff(function(...) warning("test warning")), FALSE) isTRUE(has_Rdiff(function(...) NULL)) # - errors --------------------------------------------------------------------- try(Rdiff_chr(stop('hello'), 'goodbye')) # "Unable to coerce" try(Rdiff_chr('hello', stop('goodbye'))) # "Unable to coerce" try(Rdiff_obj(stop('hello'), 'goodbye')) # "Unable to store" # - Rdiff_chr/obj -------------------------------------------------------------- # Only run tests on machines that are likely to have diff utility if(identical(.Platform$OS.type, "unix") && has_Rdiff()) { local({ A2 <- c("A", "B", "C") B2 <- c("X", "A", "Y", "C") A3 <- 1:3 B3 <- c(100L, 1L, 200L, 3L) # Rdiff_chr ref.res <- c("0a1", "2c3") ref.res.1 <- c("0a1", "> X", "2c3", "< B", "---", "> Y") a <- identical(Rdiff_chr(A2, B2, silent=TRUE, minimal=TRUE), ref.res) capt <- capture.output(res <- Rdiff_chr(A2, B2, silent=FALSE, minimal=TRUE)) b <- identical(res, ref.res) c <- identical(capt, res) capt.1 <- capture.output( res.1 <- Rdiff_chr(A2, B2, silent=FALSE, minimal=FALSE) ) d <- identical(capt.1, ref.res.1) e <- identical(res.1, ref.res.1) # test coersion f <- identical(Rdiff_chr(A3, B3, minimal=TRUE, silent=TRUE), ref.res) # Rdiff_obj ref.res2 <- c("1c1", "< [1] \"A\" \"B\" \"C\"", "---", "> [1] \"X\" \"A\" \"Y\" \"C\"" ) ref.res3 <- c("1c1") g <- identical(Rdiff_obj(A2, B2, silent=TRUE), ref.res2) h <- identical(Rdiff_obj(A2, B2, minimal=TRUE, silent=TRUE), ref.res3) # with rds f1 <- tempfile() f2 <- tempfile() saveRDS(A2, f1) saveRDS(B2, f2) on.exit(unlink(c(f1, f2))) i <- identical(Rdiff_obj(f1, B2, silent=TRUE), ref.res2) j <- identical(Rdiff_obj(A2, f2, silent=TRUE), ref.res2) k <- identical(Rdiff_obj(f1, f2, silent=TRUE), ref.res2) res <- c(a, b, c, d, e, f, g, h, i, k) if(!all(res)) stop("Failed: ", deparse(which(!res))) }) } diffobj/tests/test-misc.R0000644000176200001440000001166114122754044015062 0ustar liggesusersNAME <- "misc" source(file.path('_helper', 'init.R')) # - trim_str ------------------------------------------------------------------- a <- structure("hello", class="A", xx="B") b <- structure(1:10, yy=a) long.string <- "I'm a string long enough to force wrapping under most cases so that I may be useful for tests andiamareallylongwordtoseehowwrappingbreakslongwordsthatexceed" obj <- list( a=a, b=b, c=1:50, d=long.string, e=list(1, structure(2, zz=list(a=1, b=list("a", ls=long.string))), e=letters) ) # conditional because of issue113 str.txt <- capture.output(str(obj)) str.txt.w <- capture.output(str(obj, width=30L, strict.width="wrap")) if( getRversion() >= '3.5.0' && as.numeric(R.Version()[['svn rev']]) >= 73780 ) { c( all.equal( diffobj:::str_levels(str.txt, wrap=FALSE), c(0L, 1L, 2L, 1L, 2L, 3L, 1L, 1L, 1L, 2L, 2L, 3L, 4L, 4L, 5L, 5L, 2L) ), all.equal( diffobj:::str_levels(str.txt.w, wrap=TRUE), c(0L, 1L, 2L, 1L, 1L, 2L, 2L, 3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 2L, 2L ) ) ) } else { c( all.equal( diffobj:::str_levels(str.txt, wrap=FALSE), c(0L, 1L, 3L, 1L, 2L, 4L, 1L, 1L, 1L, 2L, 2L, 3L, 4L, 4L, 5L, 5L, 2L) ), all.equal( diffobj:::str_levels(str.txt.w, wrap=TRUE), c(0L, 1L, 1L, 3L, 1L, 1L, 2L, 2L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 2L, 2L) ) ) } # cat( # paste( # format(substr(str.txt.w, 1, 20)), diffobj:::str_levels(str.txt.w, TRUE), # sep=": " # ), # sep="\n" # ) # - rle_sub -------------------------------------------------------------------- x <- c(1, 1, 1, 2, 2, 1, 1, 3, 3, 4, 4, 4, 5, 2, 2) r <- rle(x) all.equal(diffobj:::rle_sub(r, r$values == 1L), list(1:3, 6:7)) all.equal(diffobj:::rle_sub(r, r$values == 2L), list(4:5, 14:15)) isTRUE(all(x[unlist(diffobj:::rle_sub(r, r$values == 1L))] == 1)) isTRUE(all(x[unlist(diffobj:::rle_sub(r, r$values == 2L))] == 2)) isTRUE(all(x[unlist(diffobj:::rle_sub(r, r$values == 3L))] == 3)) # - call funs ------------------------------------------------------------------ # Failure case; assumes no S4 dispatch in testthat calls <- list(quote(a()), quote(b()), quote(notafunctionblah())) all.equal(diffobj:::which_top(calls), length(calls)) diffobj:::extract_call(calls, new.env()) # warn: "Unable to find") # missing param works calls2 <- pairlist( quote(diffChr("a")), quote(diffChr("a")), quote(.local(target, current, ...)) ) all.equal( diffobj:::extract_call(calls2, new.env()), list(call = quote(diffChr(target = "a", NULL)), tar = "a", cur = NULL) ) # fallback parent frame; can't think of a good way to actually cause this to # happen # all.equal(diffobj:::par_frame(), .GlobalEnv) # - lines ---------------------------------------------------------------------- old.val <- Sys.getenv("LINES", unset=NA) Sys.setenv(LINES="25") all.equal(console_lines(), 25L) Sys.setenv(LINES="-25") all.equal(console_lines(), 48L) Sys.unsetenv("LINES") all.equal(console_lines(), 48L) # - get_funs ------------------------------------------------------------------- identical( diffobj:::get_fun(quote(diffobj::diffPrint), .BaseNamespaceEnv), diffobj::diffPrint ) identical( diffobj:::get_fun(quote(diffobj:::diffPrint), .BaseNamespaceEnv), diffobj::diffPrint ) identical( diffobj:::get_fun(quote(diffPrint), getNamespace("diffobj")), diffobj::diffPrint ) gf <- diffobj:::get_fun(quote(notAFunction), getNamespace("diffobj")) # warn identical(gf, NULL) # - trimws2 -------------------------------------------------------------------- all.equal(diffobj:::trimws2("hello world"), "hello world") all.equal(diffobj:::trimws2(" hello world"), "hello world") all.equal(diffobj:::trimws2(" hello world "), "hello world") all.equal(diffobj:::trimws2(" hello world ", 'left'), "hello world ") all.equal(diffobj:::trimws2(" hello world ", 'right'), " hello world") try(diffobj:::trimws2(" hello world ", 'banana')) # "is wrong" # - string --------------------------------------------------------------------- try(diffobj:::substr2("hello world", 1, 1:2)) # "same length" # - Gutters -------------------------------------------------------------------- etc <- new("Settings") etc@style <- StyleRaw() etc@style@funs@gutter <- function(x) stop("bad gutters") try(diffobj:::gutter_dat(etc)) # "Failed attempting to apply gutter." # - Finalizer error handling --------------------------------------------------- try(finalizeHtml(letters, NULL)) # "must be character" try(finalizeHtml(letters, letters, letters)) # "must be character\\(1L" # - c.factor ------------------------------------------------------------------- all.equal(diffobj:::c.factor(), factor(character())) # - strip_hz ------------------------------------------------------------------- # Can't trigger this directly because wrapper doesn't let this case through diffobj:::strip_hz_c_int(character(), 8L, TRUE) diffobj/tests/test-diffPrint.R0000644000176200001440000002305414122754044016053 0ustar liggesusersNAME <- "diffPrint" source(file.path('_helper', 'init.R')) # Note, atomic prints happen in different test file # - Matrices ------------------------------------------------------------------- mx.2 <- matrix(1:100, ncol=2) mx.4 <- mx.3 <- mx.2 mx.3[31, 2] <- 111L mx.3a <- mx.3[-31, ] set.seed(2) mx.4[cbind(sample(1:50, 6), sample(1:2, 6, replace=TRUE))] <- sample(-(1:50), 6) mx.5 <- matrix(1:9, 3) mx.6 <- matrix(12:1, 4) mx.6[4,] <- c(3L, 6L, 9L) # single value difference all.equal(as.character(diffPrint(mx.2, mx.3)), rdsf(100)) # single value unified all.equal(as.character(diffPrint(mx.2, mx.3, mode="unified")), rdsf(150)) # single value context all.equal(as.character(diffPrint(mx.2, mx.3, mode="context")), rdsf(175)) # missing row all.equal(as.character(diffPrint(mx.2, mx.3a)), rdsf(200)) all.equal(as.character(diffPrint(mx.2, mx.3a, mode="unified")), rdsf(300)) # More differences all.equal(as.character(diffPrint(mx.2, mx.4)), rdsf(400)) all.equal(as.character(diffPrint(mx.2, mx.4, mode="unified")), rdsf(500)) # Testing alignments all.equal(as.character(diffPrint(mx.5, mx.6)), rdsf(600)) all.equal(as.character(diffPrint(mx.5, mx.6, mode="unified")), rdsf(700)) all.equal(as.character(diffPrint(mx.5, mx.6, mode="context")), rdsf(800)) # More complex matrix set.seed(2) A <- B <- matrix(sample(1:80), nrow=16) B[cbind(sample(5:16, 4), sample(1:5, 4))] <- sample(30:80, 4) all.equal(as.character(diffPrint(A, B)), rdsf(900)) all.equal(as.character(diffPrint(A, B, mode="unified")), rdsf(1000)) all.equal(as.character(diffPrint(A, B, mode="context")), rdsf(1100)) # Style matrices all.equal(as.character(diffPrint(diffobj:::.mx1, diffobj:::.mx2)), rdsf(1200)) # - Lists ---------------------------------------------------------------------- all.equal(as.character(diffPrint(lst.1, lst.3)), rdsf(1300)) all.equal(as.character(diffPrint(lst.1, lst.3, mode="unified")), rdsf(1400)) all.equal(as.character(diffPrint(lst.4, lst.5)), rdsf(1500)) all.equal(as.character(diffPrint(lst.4, lst.5, mode="context")), rdsf(1600)) # Nested first element (https://github.com/brodieG/diffobj/issues/46) all.equal( as.character(diffPrint(list(1, list(2, list(1:3))), list(list(list(1:3))))), rdsf(1650) ) # Interesting but relatively slow example so we don't actually run it in # tests # diffPrint(unclass(mdl1), unclass(mdl2)) # diffPrint(unclass(mdl1), unclass(mdl2), mode="unified") # - Data Frames ---------------------------------------------------------------- all.equal(as.character(diffPrint(iris.s, iris.2)), rdsf(1700)) all.equal( as.character(diffPrint(iris.s, iris.2, mode="sidebyside")), rdsf(1800) ) all.equal(as.character(diffPrint(iris.s, iris.c)), rdsf(1900)) all.equal(as.character(diffPrint(iris.s, iris.3)), rdsf(2000)) all.equal( as.character(diffPrint(iris.s, iris.3, mode="sidebyside")), rdsf(2100) ) all.equal(as.character(diffPrint(iris.s, iris.4, mode="unified")), rdsf(2150)) all.equal( as.character(diffPrint(iris.s, iris.4, mode="sidebyside")), rdsf(2200) ) all.equal( as.character(diffPrint(iris.5, iris.4, mode="sidebyside")), rdsf(2250) ) all.equal(as.character(diffPrint(iris.3a, iris.4a)), rdsf(2300)) all.equal( as.character(diffPrint(iris.s, iris.3, mode="sidebyside")), rdsf(2350) ) all.equal(as.character(diffPrint(iris.s, iris.s[-2])), rdsf(2370)) # This one is interesting because the input is pathological because there # is one line that matches exactly between the two and as such creates a # matching hunk, but it really is matching by coincidence. all.equal( as.character(diffPrint(iris.s, iris.s[-2], mode="sidebyside")), rdsf(2383) ) # Possible example where we may not want to trim the row headers (Issue #39) all.equal( as.character(diffPrint(cars[1:5,], mtcars[1:5,], mode="sidebyside")), rdsf(2380) ) # - Guides --------------------------------------------------------------------- # Most guides tests are in the guides file, but this confirms interface works # when starting at `diffPrint` instead of internally all.equal( as.character( diffPrint( iris.s, iris.4, mode="sidebyside", guides=function(x, y) integer() ) ), rdsf(2400) ) all.equal( as.character(diffPrint(iris.s, iris.4, mode="sidebyside", guides=FALSE)), rdsf(2500) ) # - Arrays arr.1 <- arr.2 <- array(1:24, c(4, 2, 3)) arr.2[c(3, 20)] <- 99L all.equal(as.character(diffPrint(arr.1, arr.2)), rdsf(2600)) # - Mixed all.equal( as.character(diffPrint(list(1, 2, 3), matrix(1:9, 3))), rdsf(2700) ) all.equal( as.character(diffPrint(list(25, 2, 3), matrix(1:9, 3))), rdsf(2800) ) all.equal( as.character( diffPrint(list(c(1, 4, 7), c(2, 5, 8), c(3, 6, 9)), matrix(1:9, 3)) ), rdsf(2900) ) # - `unitizer` corner case ----------------------------------------------------- res1 <- structure( c(-1717, 101, 0.938678984853783), .Names = c("intercept", "slope", "rsq"), class = "fastlm" ) res2 <- structure( c(-3.541306e+13, 701248600000, 0.938679), .Names = c("intercept", "slope", "rsq"), class = "fastlm" ) all.equal(as.character(diffPrint(res1, res2)), rdsf(3000)) all.equal( as.character(diffPrint(unname(res1), unname(res2))), rdsf(3100) ) # - factors and other meta ----------------------------------------------------- # Thanks Frank all.equal( as.character(diffPrint(factor(1:100), factor(c(1:99, 101)))), rdsf(3200) ) f1 <- factor(1:100) f2 <- factor(c(1:20, 22:99, 101)) all.equal(capture.output(diffPrint(f1, f2)), txtf(100)) f3 <- factor(letters[1:10]) f4 <- factor(letters[1:10], levels=letters[1:11]) all.equal(capture.output(diffPrint(f3, f4)), txtf(150)) # time series nhtemp2 <- nhtemp nhtemp2[c(5, 30)] <- -999 all.equal(capture.output(diffPrint(nhtemp, nhtemp2)), txtf(175)) # Meta on both sides print.diffobj_test_c1 <- function(x, ...) { writeLines(c("Header row 1", "header row 2")) print(c(x)) writeLines(c("", "Footer row 1", "", "footer row2")) } m1 <- structure(1:30, class='diffobj_test_c1') m2 <- structure(2:51, class='diffobj_test_c1') all.equal(capture.output(diffPrint(m1, m2)), txtf(200), print=TRUE) # - Raw output ----------------------------------------------------------------- all.equal( as.character(diffPrint(letters, LETTERS, format="raw", pager="off")), rdsf(3300) ) # - Varying Widths ------------------------------------------------------------- all.equal( as.character(diffPrint(letters, LETTERS, format="raw", disp.width=40)), rdsf(3400) ) try(diffPrint(letters, LETTERS, disp.width=5)) # - covr workaround ------------------------------------------------------------ # Needed so that the function definition stuff is marked as covered; really # it shouldn't even be eligible for coverage, need to discuss further with # jhester invisible(diffobj:::make_diff_fun()) # - Encoding Issues ------------------------------------------------------------ # issue81, mixed UTF-8 ASCII, encoding a-acute in hex to avoid cross platform # issues a <- "G\xc3\xa1bor Cs\xc3\xa1rdi" b <- sprintf("%s wow", a) Encoding(a) <- 'UTF-8' Encoding(b) <- 'UTF-8' # No error new <- (as.character(diffPrint(list(hell=a, b=NULL), list(hell=b, b=list())))) # can't store this in RDS b/c otherwise won't run properly on oses with # different encoding (e.g. windows) ref <- structure( c("\033[33m<\033[39m \033[33mlist(hell = a, b = N..\033[39m \033[34m>\033[39m \033[34mlist(hell = b, b = l..\033[39m", "\033[36m@@ 1,6 @@ \033[39m \033[36m@@ 1,6 @@ \033[39m", " \033[90m\033[39m$hell\033[90m\033[39m \033[90m\033[39m$hell\033[90m\033[39m ", "\033[33m<\033[39m \033[90m[1] \033[39m\033[33m\"G\xc3\xa1bor Cs\xc3\xa1rdi\"\033[39m\033[90m\033[39m \033[34m>\033[39m \033[90m[1] \033[39m\033[34m\"G\xc3\xa1bor Cs\xc3\xa1rdi wow\"\033[39m\033[90m\033[39m", " ", " \033[90m\033[39m$b\033[90m\033[39m \033[90m\033[39m$b\033[90m\033[39m ", "\033[33m<\033[39m \033[90m\033[39m\033[33mNULL\033[39m\033[90m\033[39m \033[34m>\033[39m \033[90m\033[39m\033[34mlist\033[39m\033[34m()\033[39m\033[90m\033[39m ", " " ), len = 8L ) Encoding(ref) <- 'UTF-8' all.equal(new, ref) # issue 106, this used to fail when trying to check for an RDS with a bytes # encoded file name bytes <- "\x81" Encoding(bytes) <- "bytes" isTRUE(!any(diffPrint(bytes, bytes))) # - Quoted Objects ------------------------------------------------------------- all.equal( as.character(diffPrint(quote(zz + 1), quote(zz + 3))), structure( c("\033[33m<\033[39m \033[33mquote(..\033[39m \033[34m>\033[39m \033[34mquote(..\033[39m", "\033[36m@@ 1 @@ \033[39m \033[36m@@ 1 @@ \033[39m", "\033[33m<\033[39m \033[90m\033[39mzz + \033[33m1\033[39m\033[90m\033[39m \033[34m>\033[39m \033[90m\033[39mzz + \033[34m3\033[39m\033[90m\033[39m " ), len = 3L ) ) all.equal( as.character(diffPrint(quote(x), quote(y))), structure( c("\033[33m<\033[39m \033[33mquote(x)\033[39m \033[34m>\033[39m \033[34mquote(y)\033[39m", "\033[36m@@ 1 @@ \033[39m \033[36m@@ 1 @@ \033[39m", "\033[33m<\033[39m \033[90m\033[39m\033[33mx\033[39m\033[90m\033[39m \033[34m>\033[39m \033[90m\033[39m\033[34my\033[39m\033[90m\033[39m "), len = 3L ) ) # - par_frame ------------------------------------------------------------------ # check that par_frame is retrieved correctly env <- new.env() env$print <- function(x, ...) stop('boom') try(evalq(diffPrint(1:3, 1:4), env)) # "Failed attempting .*: boom" f <- function(a, b, ...) { print <- function(x, ...) stop('boom2') diffPrint(a, b, ...) } try(f(1:3, 1:4, format='raw')) # "Failed attempting .*: boom2" diffobj/tests/test-trim.Rout.save0000644000176200001440000004474214122754044016575 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "trim" > source(file.path('_helper', 'init.R')) > > .mx.base <- matrix( + c( + "averylongwordthatcanlahblah", "causeasinglewidecolumnblah", + "matrixtowrapseveraltimes", "inarrowscreen", "onceuponatime", + "agreenduckflew", "overthemountains", "inalongofantelopes", + "ineedthreemore", "entriesactually", "nowonlytwomore", "iwaswrongearlier" + ), + nrow=3, ncol=4 + ) > > # - Atomic --------------------------------------------------------------------- > > set.seed(1) > x <- capture.output(1:50) > y <- capture.output(factor(sample(letters, 50, replace=TRUE))) > > all.equal( + diffobj:::strip_atomic_rh(x), + c(" 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25", "26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50") + ) [1] TRUE > all.equal( + diffobj:::strip_atomic_rh(y), + c("g j o x f x y r q b f e r j u m s z j u y f q d g k a j w i m p m e v r u c", "s k v q u o n u a m t s", "Levels: a b c d e f g i j k m n o p q r s t u v w x y z") + ) [1] TRUE > all.equal(diffobj:::which_atomic_rh(capture.output(1:5)), 1) [1] TRUE > > all.equal(as.character(diffPrint(1:3, 2:6, trim=FALSE)), rdsf(50)) [1] TRUE > > # bad headers > > bh <- c("[1] a b c", "[4] d e f", "[5] h") > all.equal(diffobj:::which_atomic_rh(bh), integer()) [1] TRUE > > # - Matrix > mx1 <- mx2 <- matrix(1:3, 3) > all.equal( + diffobj:::strip_matrix_rh(capture.output(mx1), dimnames(mx1)), + c(" [,1]", " 1", " 2", " 3") + ) [1] TRUE > # shouldn't strip headers from attributes > attr(mx2, "blah") <- matrix(1:2, 2) > all.equal( + diffobj:::strip_matrix_rh(capture.output(mx2), dimnames(mx2)), + c(" [,1]", " 1", " 2", " 3", "attr(,\"blah\")", " [,1]", "[1,] 1", "[2,] 2") + ) [1] TRUE > # Matrices that wrap > > mx3 <- mx4 <- mx5 <- mx6 <- .mx.base > old.opt <- options(width=30) > > all.equal( + diffobj:::strip_matrix_rh(capture.output(mx3), dimnames(mx3)), + c(" [,1] ", "\"averylongwordthatcanlahblah\"", "\"causeasinglewidecolumnblah\" ", "\"matrixtowrapseveraltimes\" ", " [,2] ", "\"inarrowscreen\" ", "\"onceuponatime\" ", "\"agreenduckflew\"", " [,3] ", "\"overthemountains\" ", "\"inalongofantelopes\"", "\"ineedthreemore\" ", " [,4] ", "\"entriesactually\" ", "\"nowonlytwomore\" ", "\"iwaswrongearlier\"") + ) [1] TRUE > # Add rownames; should no longer strip > > rownames(mx4) <- 2:4 > all.equal( + diffobj:::strip_matrix_rh(capture.output(mx4), dimnames(mx4)), + capture.output(mx4) + ) [1] TRUE > # Attributes don't have stuff stripped > > attr(mx6, "blah") <- letters[1:15] > > all.equal( + diffobj:::strip_matrix_rh(capture.output(mx6), dimnames(mx6)), + c(" [,1] ", "\"averylongwordthatcanlahblah\"", "\"causeasinglewidecolumnblah\" ", "\"matrixtowrapseveraltimes\" ", " [,2] ", "\"inarrowscreen\" ", "\"onceuponatime\" ", "\"agreenduckflew\"", " [,3] ", "\"overthemountains\" ", "\"inalongofantelopes\"", "\"ineedthreemore\" ", " [,4] ", "\"entriesactually\" ", "\"nowonlytwomore\" ", "\"iwaswrongearlier\"", "attr(,\"blah\")", " [1] \"a\" \"b\" \"c\" \"d\" \"e\" \"f\"", " [7] \"g\" \"h\" \"i\" \"j\" \"k\" \"l\"", "[13] \"m\" \"n\" \"o\"") + ) [1] TRUE > # Single row matrix > > all.equal( + diffobj:::which_matrix_rh(capture.output(matrix(1:2, nrow=1)), NULL), 2 + ) [1] TRUE > options(width=80) > > # - Table ---------------------------------------------------------------------- > > old.opt <- options(width=30) > > # Data frames > > df1 <- as.data.frame(.mx.base) > all.equal( + diffobj:::strip_table_rh(capture.output(df1)), + c(" V1", "averylongwordthatcanlahblah", " causeasinglewidecolumnblah", " matrixtowrapseveraltimes", " V2", " inarrowscreen", " onceuponatime", "agreenduckflew", " V3", " overthemountains", "inalongofantelopes", " ineedthreemore", " V4", " entriesactually", " nowonlytwomore", "iwaswrongearlier") + ) [1] TRUE > df2 <- df1[c(2, 1, 3), ] > > all.equal( + diffobj:::strip_table_rh(capture.output(df2)), + capture.output(df2) + ) [1] TRUE > # Rownames that start from one and sequential, should get stripped; also, > # colon allowed > > df3 <- df1 > rownames(df3) <- paste0(1:3, ":") > all.equal( + diffobj:::strip_table_rh(capture.output(df3)), + c(" V1", "averylongwordthatcanlahblah", " causeasinglewidecolumnblah", " matrixtowrapseveraltimes", " V2", " inarrowscreen", " onceuponatime", "agreenduckflew", " V3", " overthemountains", "inalongofantelopes", " ineedthreemore", " V4", " entriesactually", " nowonlytwomore", "iwaswrongearlier") + ) [1] TRUE > # Try ts > > all.equal( + diffobj:::strip_table_rh(capture.output(USAccDeaths)), + capture.output(USAccDeaths) + ) [1] TRUE > # Set it so first year is 1 > > USAD2 <- USAccDeaths > tsp(USAD2)[1:2] <- tsp(USAD2)[1:2] - 1972 > > all.equal( + diffobj:::strip_table_rh(capture.output(USAD2)), + c(" Jan Feb Mar Apr", " 9007 8106 8928 9137", " 7750 6981 8038 8422", " 8162 7306 8124 7870", " 7717 7461 7767 7925", " 7792 6957 7726 8106", " 7836 6892 7791 8192", " May Jun Jul Aug", "10017 10826 11317 10744", " 8714 9512 10120 9823", " 9387 9556 10093 9620", " 8623 8945 10078 9179", " 8890 9299 10625 9302", " 9115 9434 10484 9827", " Sep Oct Nov Dec", " 9713 9938 9161 8927", " 8743 9129 8710 8680", " 8285 8466 8160 8034", " 8037 8488 7874 8647", " 8314 8850 8265 8796", " 9110 9070 8633 9240") + ) [1] TRUE > # single row data frame > > all.equal(c(diffobj:::which_table_rh(capture.output(data.frame(1, 2)))), 2) [1] TRUE > > # More than 10 rows data.frame > > all.equal( + c(diffobj:::which_table_rh(capture.output(head(Puromycin, 10L)))), + 2:11 + ) [1] TRUE > # Bad wrap > > bw <- c( + " bad", "1 123", "2 456", + " dab", "1 123", "2 456", + " abd", "1 123") > > all.equal( + diffobj:::wtr_help(bw, diffobj:::.pat.tbl), + c(2L, 3L, 5L, 6L) + ) [1] TRUE > > # - Array > a <- array(1:6, c(3, 1, 2)) > a.c <- capture.output(a) > all.equal( + diffobj:::strip_array_rh(a.c, dimnames(a)), + c(", , 1", "", " [,1]", " 1", " 2", " 3", "", ", , 2", "", " [,1]", " 4", " 5", " 6", "") + ) [1] TRUE > viz_sarh <- function(capt, obj) + cbind( + capt, + as.integer( + seq_along(capt) %in% diffobj:::which_array_rh(capt, dimnames(obj)) + ) + ) > a1 <- a2 <- a3 <- a4 <- array( + "averylongphrasethatwillforcemytwocolumnarraytowrapblahblah", c(2, 2, 2) + ) > ca1 <- capture.output(a1) > viz_sarh(ca1, a1) capt [1,] ", , 1" [2,] "" [3,] " [,1] " [4,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [5,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [6,] " [,2] " [7,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [8,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [9,] "" [10,] ", , 2" [11,] "" [12,] " [,1] " [13,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [14,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [15,] " [,2] " [16,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [17,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [18,] "" [1,] "0" [2,] "0" [3,] "0" [4,] "1" [5,] "1" [6,] "0" [7,] "1" [8,] "1" [9,] "0" [10,] "0" [11,] "0" [12,] "0" [13,] "1" [14,] "1" [15,] "0" [16,] "1" [17,] "1" [18,] "0" > all.equal( + diffobj:::which_array_rh(ca1, dimnames(a1)), + c(4L, 5L, 7L, 8L, 13L, 14L, 16L, 17L) + ) [1] TRUE > colnames(a2) <- c("ABC", "DEF") > ca2 <- capture.output(a2) > viz_sarh(ca2, a2) capt [1,] ", , 1" [2,] "" [3,] " ABC " [4,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [5,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [6,] " DEF " [7,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [8,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [9,] "" [10,] ", , 2" [11,] "" [12,] " ABC " [13,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [14,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [15,] " DEF " [16,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [17,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [18,] "" [1,] "0" [2,] "0" [3,] "0" [4,] "1" [5,] "1" [6,] "0" [7,] "1" [8,] "1" [9,] "0" [10,] "0" [11,] "0" [12,] "0" [13,] "1" [14,] "1" [15,] "0" [16,] "1" [17,] "1" [18,] "0" > all.equal( + diffobj:::which_array_rh(ca2, dimnames(a2)), + c(4L, 5L, 7L, 8L, 13L, 14L, 16L, 17L) + ) [1] TRUE > rownames(a3) <- 1:2 > ca3 <- capture.output(a3) > viz_sarh(ca3, a3) capt [1,] ", , 1" [2,] "" [3,] " [,1] " [4,] "1 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [5,] "2 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [6,] " [,2] " [7,] "1 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [8,] "2 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [9,] "" [10,] ", , 2" [11,] "" [12,] " [,1] " [13,] "1 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [14,] "2 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [15,] " [,2] " [16,] "1 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [17,] "2 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [18,] "" [1,] "0" [2,] "0" [3,] "0" [4,] "0" [5,] "0" [6,] "0" [7,] "0" [8,] "0" [9,] "0" [10,] "0" [11,] "0" [12,] "0" [13,] "0" [14,] "0" [15,] "0" [16,] "0" [17,] "0" [18,] "0" > all.equal(diffobj:::which_array_rh(ca3, dimnames(a3)), integer(0L)) [1] TRUE > > attr(a4, "blahblah") <- matrix(1:4, 2) > ca4 <- capture.output(a4) > viz_sarh(ca4, a4) capt [1,] ", , 1" [2,] "" [3,] " [,1] " [4,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [5,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [6,] " [,2] " [7,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [8,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [9,] "" [10,] ", , 2" [11,] "" [12,] " [,1] " [13,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [14,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [15,] " [,2] " [16,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [17,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [18,] "" [19,] "attr(,\"blahblah\")" [20,] " [,1] [,2]" [21,] "[1,] 1 3" [22,] "[2,] 2 4" [1,] "0" [2,] "0" [3,] "0" [4,] "1" [5,] "1" [6,] "0" [7,] "1" [8,] "1" [9,] "0" [10,] "0" [11,] "0" [12,] "0" [13,] "1" [14,] "1" [15,] "0" [16,] "1" [17,] "1" [18,] "0" [19,] "0" [20,] "0" [21,] "0" [22,] "0" > all.equal( + diffobj:::which_array_rh(ca4, dimnames(a4)), + c(4L, 5L, 7L, 8L, 13L, 14L, 16L, 17L) + ) [1] TRUE > options(width=80) > > # - List ----------------------------------------------------------------------- > > l1 <- list( + matrix(1:4, 2), b=list(abc=c(letters, LETTERS), list(matrix(4:1, 2))) + ) > l1.c <- capture.output(l1) > all.equal( + diffobj:::strip_list_rh(l1.c, l1), + c("[[1]]", " [,1] [,2]", " 1 3", " 2 4", "", "$b", "$b$abc", "\"a\" \"b\" \"c\" \"d\" \"e\" \"f\" \"g\" \"h\" \"i\" \"j\" \"k\" \"l\" \"m\" \"n\" \"o\" \"p\" \"q\" \"r\" \"s\"", "\"t\" \"u\" \"v\" \"w\" \"x\" \"y\" \"z\" \"A\" \"B\" \"C\" \"D\" \"E\" \"F\" \"G\" \"H\" \"I\" \"J\" \"K\" \"L\"", "\"M\" \"N\" \"O\" \"P\" \"Q\" \"R\" \"S\" \"T\" \"U\" \"V\" \"W\" \"X\" \"Y\" \"Z\"", "", "$b[[2]]", "$b[[2]][[1]]", " [,1] [,2]", " 4 2", " 3 1", "", "", "") + ) [1] TRUE > > a <- list(list()) > aa <- list(list(), "a") > b <- list("a", list()) > c <- list(list("a"), "b") > d <- list("a", "b", "c") > > identical( + diffobj:::strip_list_rh(capture.output(d), d), + c("[[1]]", "\"a\"", "", "[[2]]", "\"b\"", "", "[[3]]", "\"c\"", "") + ) [1] TRUE > identical( + diffobj:::strip_list_rh(capture.output(a), a), + c("[[1]]", "list()", "") + ) [1] TRUE > identical( + diffobj:::strip_list_rh(capture.output(aa), aa), + c("[[1]]", "list()", "", "[[2]]", "\"a\"", "") + ) [1] TRUE > identical( + diffobj:::strip_list_rh(capture.output(b), b), + c("[[1]]", "\"a\"", "", "[[2]]", "list()", "") + ) [1] TRUE > identical( + diffobj:::strip_list_rh(capture.output(c), c), + c("[[1]]", "[[1]][[1]]", "\"a\"", "", "", "[[2]]", "\"b\"", "") + ) [1] TRUE > > # - custom trim fun ------------------------------------------------------------ > > a <- matrix(100:102) > b <- matrix(101:103) > fun1 <- function(x, y) cbind(rep(1L, 4), rep(5L, 4)) > > all.equal(as.character(diffPrint(a, b, trim=fun1)), rdsf(100)) [1] TRUE > if(getRversion() >= "3.2.2") { + capture.output( + trim.err <- as.character(diffPrint(a, b, trim=function(x, y) stop("boom"))), + type="message" + ) # warn: "If you did not specify a `trim`" + all.equal(trim.err, rdsf(200)) + } [1] TRUE Warning message: In apply_trim(current, cur.capt.p, etc@trim) : `trim*` method produced an error when attempting to trim ; If you did not specify a `trim` function or define custom `trim*` methods contact maintainer (see `?trim`). Proceeding without trimming. > # purposefully bad trim fun > > try( # "method return value must be a two " + diffPrint(1:100, 2:100, trim=function(x, y) TRUE) + ) Error in apply_trim(target, tar.capt.p, etc@trim) : `trim*` method return value must be a two column integer matrix with no NAs; If you did not specify a `trim` function or define custom `trim*` methods contact maintainer (see `?trim`). Proceeding without trimming. > try( # "Invalid trim function" + diffobj:::apply_trim(letters, letters, function(x) TRUE), + ) Error in diffobj:::apply_trim(letters, letters, function(x) TRUE) : Invalid trim function (does not have at least two arguments). If you did not customize the trim function contact maintainer; see `?trim` > try(# "must have as many rows" + diffobj:::apply_trim( + letters, letters, function(x, y) cbind(1:25, 1:25) + ) + ) Error in diffobj:::apply_trim(letters, letters, function(x, y) cbind(1:25, : `trim*` method output matrix must have as many rows as object character representation has elements; If you did not specify a `trim` function or define custom `trim*` methods contact maintainer (see `?trim`). Proceeding without trimming. > > # - s4 ------------------------------------------------------------------------- > > setClass("DOTrimTest", slots=c(a="numeric", b="list", c="matrix")) > obj <- new( + "DOTrimTest", a=1:40, b=list(a=1, letters, NULL), c=matrix(1:9, 3) + ) > all.equal( + diffobj:::strip_s4_rh(capture.output(obj), obj), rdsf(300) + ) [1] TRUE > > > proc.time() user system elapsed 1.549 0.170 1.803 diffobj/tests/test-html.Rout.save0000644000176200001440000000573414122754044016564 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "html" > source(file.path('_helper', 'init.R')) > > # Verify that internal css works > > # - HTML Output Modes ---------------------------------------------------------- > > all.equal( + as.character( + diffPrint( + letters[1:3], LETTERS[1:3], + style=StyleHtmlLightYb(html.output="diff.only") + ) ), + rdsf(100) + ) [1] TRUE > all.equal( + as.character( + diffPrint( + letters[1:6], LETTERS[1:6], + style=StyleHtmlLightYb(html.output="diff.w.style") + ) ), + rdsf(200) + ) [1] TRUE > all.equal( + as.character( + diffPrint( + letters[1:6], LETTERS[1:6], + style=StyleHtmlLightYb(html.output="page") + ) ), + rdsf(300) + ) [1] TRUE > all.equal( + as.character( + diffPrint( + letters[1:6], LETTERS[1:6], mode="unified", + style=StyleHtmlLightYb(html.output="page") + ) ), + rdsf(350) + ) [1] TRUE > # - Sub CSS -------------------------------------------------------------------- > > # Mess up the CSS to test that we can change CSS file > > local({ + f <- tempfile() + on.exit(unlink(f)) + cat("div.row {background-color: red;}\n", file=f) + all.equal( + as.character( + diffPrint( + letters, LETTERS, + style=StyleHtmlLightYb(css=f, html.output="diff.w.style") + ) + ), + rdsf(400) + ) + }) [1] TRUE > # - Tag funs ------------------------------------------------------------------- > > div_a <- div_f("A", c(color="red")) > all.equal( + div_a(c("a", "b")), + c( + "
a
", + "
b
" + ) + ) [1] TRUE > span_a <- span_f() > all.equal(span_a(c("a", "b")), c("a", "b")) [1] TRUE > > try(div_a(TRUE)) # "must be character" Error in div_a(TRUE) : Argument `x` must be character. > all.equal(div_a(character()),character()) [1] TRUE > > # - nchar ---------------------------------------------------------------------- > > all.equal(nchar_html("25"), 2) [1] TRUE > all.equal(nchar_html("25 "), 3) [1] TRUE > > # - cont_f --------------------------------------------------------------------- > > try(cont_f("hello")(1:3)) # "must be character" Error in cont_f("hello")(1:3) : Argument `x` must be character. > > proc.time() user system elapsed 1.416 0.133 1.555 diffobj/tests/test-banner.Rout.save0000644000176200001440000000243414122754044017057 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "banner" > source(file.path('_helper', 'init.R')) > > # - Banner Capture ------------------------------------------------------------ > > ref <- as.character( + diffPrint(1 + 2, letters, tar.banner="1 + 2", cur.banner="letters") + ) > identical(as.character(diffPrint(1 + 2, letters)), ref) [1] TRUE > invisible( + setMethod( + "diffPrint", c("numeric", "character"), + function(target, current, ...) callNextMethod() + ) ) > identical(as.character(diffPrint(1 + 2, letters)), ref) [1] TRUE > isTRUE( + !identical(as.character(diffPrint(1 + 2, LETTERS)), ref) + ) [1] TRUE > > proc.time() user system elapsed 1.303 0.143 1.449 diffobj/tests/test-context.R0000644000176200001440000000255214122754044015612 0ustar liggesusersNAME <- "context" source(file.path('_helper', 'init.R')) # - interesting context values ------------------------------------------------- all.equal( as.character(diffChr(chr.9, chr.10, context=0)), rdsf(100) ) all.equal( as.character(diffChr(chr.9, chr.10, context=-1L)), rdsf(150) ) all.equal( as.character(diffChr(chr.9, chr.10, context="auto")), rdsf(200) ) all.equal( as.character(diffChr(chr.9, chr.10, context=0, mode="context")), rdsf(300) ) # - with line limit ------------------------------------------------------------ all.equal( as.character(diffChr(chr.9, chr.10, context="auto", line.limit=18)), rdsf(400) ) all.equal( as.character(diffChr(chr.9, chr.10, context="auto", line.limit=25)), rdsf(500) ) # default to min context a <- b <- letters b[c(3, 20)] <- LETTERS[c(3,20)] all.equal( capture.output( show(diffChr(a, b, line.limit=c(20, 10), context='auto', format='raw')) ), txtf(100) ) # trim hunks in auto-context mode a <- b <- letters b[c(3, 10, 20)] <- LETTERS[c(3,10,20)] all.equal( capture.output(show( diffChr( a, b, hunk.limit=c(2, 1), context=auto_context(1, 5), line.limit=20, format='raw' ) )), txtf(200) ) # - error handling ------------------------------------------------------------- try(auto_context(min=-1, max=1:3)) # "`min` must be" try(auto_context(min=1, max=1:3)) # "`max` must be" diffobj/tests/test-diffObj.R0000644000176200001440000000340714122754044015471 0ustar liggesusersNAME <- "diffObj" source(file.path('_helper', 'init.R')) # - simple diffobj ------------------------------------------------------------- # no diff for print all.equal(as.character(diffObj(iris.s, iris.c)), rdsf(100)) # no diff for str all.equal( as.character(diffObj(1:100, c(1:99, 200L))), rdsf(200) ) # diffs for both and must pick one, first one is str, second is print all.equal( as.character(diffObj(mdl1[7], mdl2[7])), rdsf(300) ) all.equal(as.character(diffObj(mdl1, mdl2)), rdsf(400)) # - fits or doesn't ------------------------------------------------------------ # Note, the first test used to favor str until we handicapped print all.equal( diffObj(matrix(1:20, ncol=2), matrix(2:21, ncol=2), line.limit=5)@capt.mode, "str" ) # test kinda slow, would be better to have one with smaller objects with print # methods all.equal( diffObj(mdl1, mdl2, line.limit=15, mode='unified')@capt.mode, "print" ) all.equal(diffObj(1:1000, 1000:1, line.limit=5)@capt.mode, "str") # - misc ----------------------------------------------------------------------- try(diffObj(1, 2, extra=list(TRUE))) # "extra" # - print error ---------------------------------------------------------------- x <- structure("hello", class="diffobj_ogewlhgiadfl") y <- structure("goodbye", class="diffobj_ogewlhgiadfl") try(diffObj(x, y)) # "Error in calling .diffPrint." # Random exmaples to think through `diffObj` output diffObj( pairlist("`logical(2L)` should be length 2 (is 3)"), pairlist("be length 2 (is 3)") ) diffObj( pairlist("`matrix(integer(), nrow = 3)` should be matrix (is list)", "`list(character(1L), 1L)[[2]]` should be type \"integer-like\" (is \"character\")"), pairlist("be class \"matrix\" (is \"list\")", "be type \"integer-like\" (is \"character\") at index [[2]]") ) diffobj/tests/test-banner.R0000644000176200001440000000103014122754044015361 0ustar liggesusersNAME <- "banner" source(file.path('_helper', 'init.R')) # - Banner Capture ------------------------------------------------------------ ref <- as.character( diffPrint(1 + 2, letters, tar.banner="1 + 2", cur.banner="letters") ) identical(as.character(diffPrint(1 + 2, letters)), ref) invisible( setMethod( "diffPrint", c("numeric", "character"), function(target, current, ...) callNextMethod() ) ) identical(as.character(diffPrint(1 + 2, letters)), ref) isTRUE( !identical(as.character(diffPrint(1 + 2, LETTERS)), ref) ) diffobj/tests/test-methods.R0000644000176200001440000000272014122754044015566 0ustar liggesusersNAME <- "methods" source(file.path('_helper', 'init.R')) # try implementing methods that change default behavior outside of package # - Force unified -------------------------------------------------------------- par.env <- new.env() local( envir=par.env, { suppressWarnings( setClass( "testdiffobj", slots=c(a="integer"), where=par.env ) ) # First check that we do actually output in side by side mode print( all.equal( as.character(diffObj(new("testdiffobj", a=1L), new("testdiffobj", a=2L))), rdsf(100) ) ) # Now verify that with our new method, we get unified setMethod("diffObj", c("testdiffobj", "testdiffobj"), function(target, current, ...) { dots <- match.call(expand.dots=FALSE)[["..."]] if("mode" %in% names(dots)) callNextMethod() else callNextMethod(target=target, current=current, ..., mode="unified") }, where=par.env ) on.exit( removeMethod("diffObj", c("testdiffobj", "testdiffobj"), where=par.env) ) print( all.equal( as.character(diffObj(new("testdiffobj", a=1L), new("testdiffobj", a=2L))), rdsf(200) ) ) # Make sure we can still get side by side? print( all.equal( as.character( diffObj( new("testdiffobj", a=1L), new("testdiffobj", a=2L), mode="sidebyside" ) ), rdsf(100) ) ) try( #"Argument `mode` must be" diffObj(new("testdiffobj", a=1L), new("testdiffobj", a=2L), mode="hello") ) }) diffobj/tests/test-pager.R0000644000176200001440000002560514122754044015230 0ustar liggesusersNAME <- "pager" source(file.path('_helper', 'init.R')) source(file.path('_helper', 'tools.R')) # void pager, doesn't do anything, just to test side effect of writing to file void <- function(x) NULL # - Specifying pager ----------------------------------------------------------- style <- gdo("diffobj.style") if(is.null(style)) style <- StyleAnsi8NeutralYb() style@pager@file.ext <- "xyz" # make pager identifiable all.equal( diffChr( letters, LETTERS, style=style, pager="auto", interactive=TRUE )@etc@style@pager@file.ext, "xyz" ) all.equal( diffChr( letters, LETTERS, style=style, pager="off", interactive=TRUE )@etc@style@pager, PagerOff() ) identical( diffChr( letters, LETTERS, style=style, pager="auto", interactive=FALSE )@etc@style@pager, PagerOff() ) # - System Pagers -------------------------------------------------------------- less.orig <- Sys.getenv("LESS") pager_mock <- function(...) { warning(Sys.getenv("LESS")) 42 } is(PagerSystem(), "PagerSystem") is( pg.less <- PagerSystemLess(pager=pager_mock, flags="VWF"), "PagerSystemLess" ) res <- pg.less@pager() # warning: "VWF$" all.equal(res, 42) all.equal(less.orig, Sys.getenv("LESS")) all.equal(PagerSystemLess(pager=pager_mock)@flags, "R") try(PagerSystemLess(pager=pager_mock, flags=letters)) # - use_pager ------------------------------------------------------------------ local({ suppressMessages(mock(diffobj:::console_lines, 10L)) on.exit(suppressMessages(untrace(diffobj:::console_lines))) c( isTRUE(diffobj:::use_pager(PagerSystem(threshold=0L), 1L)), identical(diffobj:::use_pager(PagerSystem(threshold=50L), 25L), FALSE), isTRUE(diffobj:::use_pager(PagerSystem(threshold=-1L), 25L)) ) }) # - Setting LESS var ----------------------------------------------------------- local({ less.orig <- Sys.getenv("LESS", unset=NA) old.opt <- options(crayon.enabled=FALSE) # problems with crayon and LESS on.exit({ diffobj:::reset_less_var(less.orig) # should be tested..., but super simple options(old.opt) }) # Here we change the LESS variable even though we're mocking getenv Sys.unsetenv("LESS") a0 <- isTRUE(is.na(diffobj:::set_less_var("XF"))) a <- all.equal(Sys.getenv("LESS"), "-XF") Sys.setenv(LESS="-X -F") b <- all.equal(diffobj:::set_less_var("VP"), "-X -F") c <- all.equal(Sys.getenv("LESS"), "-X -FVP") diffobj:::reset_less_var("-XF") d <- all.equal(Sys.getenv("LESS"), "-XF") diffobj:::reset_less_var(NA_character_) e <- all.equal(Sys.getenv("LESS"), "") Sys.setenv(LESS="-XF") f <- all.equal(diffobj:::set_less_var("V"), "-XF") g <- all.equal(Sys.getenv("LESS"), "-XFV") c(a0, a, b, c, d, e, f, g) }) # - viewer vs browser ---------------------------------------------------------- local({ viewer <- function(x) "viewer" old.external <- options(viewer=viewer, browser=function(url) "browser") on.exit(options(old.external)) suppressMessages(mock(diffobj::make_blocking, quote(fun))) on.exit(suppressMessages(untrace(diffobj::make_blocking)), add=TRUE) pager <- PagerBrowser() a <- all.equal(pager@pager("blah"), "viewer") options(viewer=NULL) b <- all.equal(pager@pager("blah"), "browser") options(viewer=function(x) stop("viewer error")) res <- pager@pager("blah") # warning: "IDE viewer" c <- all.equal(res, "browser") c(a, b, c) }) # - blocking ------------------------------------------------------------------- # Note that readline just proceeds in non-interactive mode, which is why we # need the mock here local({ suppressMessages(mock(diffobj:::interactive, FALSE)) on.exit(suppressMessages(untrace(diffobj:::interactive))) suppressMessages(mock(diffobj:::readline, quote(warning("readline")))) on.exit(suppressMessages(untrace(diffobj:::readline)), add=TRUE) try(make_blocking("hello")) # "must be a function" try(make_blocking(identity, letters)) # "must be character\\(1L") try(make_blocking(identity, "a", "a")) # "must be TRUE" res <- make_blocking(sum)(1:10) # warn: "readline" a <- all.equal(sum(1:10), res) b <- isTRUE( withVisible( suppressWarnings(make_blocking(sum, invisible=FALSE)(1:10)) )[['visible']] ) c(a, b) }) local({ suppressMessages(mock(diffobj:::interactive, TRUE)) on.exit(suppressMessages(untrace(diffobj:::interactive))) suppressMessages(mock(diffobj:::readline, quote(warning("readline")))) on.exit(suppressMessages(untrace(diffobj:::readline)), add=TRUE) show( # warn "readline" diffChr( "a", "b", format='raw', pager=list(pager=void, make.blocking=TRUE, threshold=0) ) ) show( # warn "readline" diffChr( "a", "b", format='html', pager=list(pager=void, make.blocking=NA, threshold=0) ) ) show(diffChr("a", "b", format='html', pager=list(pager=void))) }) # There should be no warnings in this lot local({ suppressMessages(mock(diffobj:::interactive, TRUE)) on.exit(suppressMessages(untrace(diffobj:::interactive))) suppressMessages(mock(diffobj:::readline, quote(warning("readline")))) on.exit(suppressMessages(untrace(diffobj:::readline)), add=TRUE) f <- tempfile() on.exit(unlink(f), add=TRUE) show( # no warning diffChr( "a", "b", format='html', pager=list(pager=void, make.blocking=NA, file.path=f) ) ) show( # no warning diffChr( "a", "b", format='html', pager=list(pager=void, make.blocking=FALSE, file.path=f) ) ) show( # no warning diffChr("a", "b", format='html', pager=list(pager=void, file.path=f)) ) }) # - html page output ----------------------------------------------------------- pager <- PagerBrowser( pager=function(x) cat(readLines(x), sep="\n"), make.blocking=FALSE ) all.equal( capture.output(show(diffChr("A", "B", pager=pager, style=StyleRaw()))), c("< \"A\" > \"B\" ", "@@ 1 @@ @@ 1 @@ ", "< A > B ") ) pager.warn <- PagerBrowser( pager=function(x) cat(readLines(x), sep="\n"), make.blocking=FALSE ) try( # "Unable to instantiate `Style` object: Argument `js` .* is not a file" diffChr( "A", "B", pager=pager.warn, format="html", style=list(js="notafile") ) ) try( # "Unable to instantiate `Style` object: Argument `css` .* is not a file" diffChr( "A", "B", pager=pager.warn, format="html", style=list(css="notafile") ) ) # Create objects that bypass the validation style.obj.1 <- style.obj.2 <- StyleHtmlLightYb() style.obj.1@css <- "notafile" style.obj.2@js <- "notafile" invisible( capture.output( # warn: "Unable to read provided css file" show(diffChr("A", "B", pager=pager.warn, style=style.obj.1)) ) ) invisible( capture.output( # "Unable to read provided js file" show(diffChr("A", "B", pager=pager.warn, style=style.obj.2)) ) ) # - pager_is_less -------------------------------------------------------------- is.less <- pager_is_less() isTRUE(diffobj:::is.TF(is.less)) less <- tryCatch( system2("which", "less", stdout=TRUE, stderr=TRUE), error=function(e) NULL, warning=function(e) NULL ) sys.cat <- tryCatch( system2("which", "cat", stdout=TRUE, stderr=TRUE), error=function(e) NULL, warning=function(e) NULL ) if(diffobj:::is.chr.1L(less) && file_test("-x", less)) { local({ old.opt <- options(pager=less) on.exit(options(old.opt)) # has to be stopifnot as we can't return TRUE for systems that don't # meet these requirements stopifnot( identical(diffobj:::pager_opt_default(), FALSE), isTRUE(pager_is_less()) ) }) } if(diffobj:::is.chr.1L(sys.cat) && file_test("-x", sys.cat)) { local({ old.opt <- options(pager=sys.cat) on.exit(options(old.opt)) # has to be stopifnot as we can't return TRUE for systems that don't # meet these requirements stopifnot( identical(diffobj:::pager_opt_default(), FALSE), identical(pager_is_less(), FALSE) ) }) } ## force some checks local({ old.opt <- options(pager=NULL) on.exit(options(old.opt)) identical(pager_is_less(), FALSE) }) identical(diffobj:::file_is_less(tempfile()), FALSE) # - file.path ------------------------------------------------------------------ f <- tempfile() show( diffChr( "A", "B", format='raw', pager=list(pager=void, file.path=f, threshold=0L) ) ) all.equal( readLines(f), c("< \"A\" > \"B\" ", "@@ 1 @@ @@ 1 @@ ", "< A > B ") ) show( # No error on this one diffChr( "A", "B", format='raw', pager=list(pager=void, file.path=NA, threshold=0L) ) ) try(Pager(file.path=letters)) # "must be length 1" try(Pager(file.path=1)) # "must be character" # - basic pager ---------------------------------------------------------------- local({ f <- tempfile() on.exit(unlink(f)) c( all.equal( capture.output( show( diffChr( 1, 2, pager=Pager(file.path=f, threshold=0L), format='raw' ) ) ), txtf(100) ), all.equal(txtf(100), readLines(f)) ) }) # - format-pager interaction --------------------------------------------------- local({ old.opt <- options(crayon.colors=7) crayon::num_colors(TRUE) on.exit({ options(old.opt) crayon::num_colors(TRUE) }) c( is( diffChr(1, 2, format='auto', pager="on", interactive=TRUE)@etc@style, "StyleHtml" ), is( diffChr(1, 2, format='auto', pager="on", interactive=FALSE)@etc@style, "StyleRaw" ), is( diffChr( 1, 2, format='auto', pager=PagerBrowser(), interactive=FALSE )@etc@style, "StyleHtml" ) ) }) # - format-pager interaction 2 ------------------------------------------------- local({ old.rs <- Sys.getenv('RSTUDIO', unset=NA) old.rsterm <- Sys.getenv('RSTUDIO_TERM', unset=NA) on.exit({ if(is.na(old.rs)) { Sys.unsetenv('RSTUDIO') } else Sys.setenv('RSTUDIO'=old.rs) if(is.na(old.rsterm)) { Sys.unsetenv('RSTUDIO_TERM') } else Sys.setenv('RSTUDIO_TERM'=old.rsterm) }) Sys.unsetenv('RSTUDIO') Sys.unsetenv('RSTUDIO_TERM') old.opt <- options(crayon.colors=8) crayon::num_colors(TRUE) on.exit({options(old.opt); crayon::num_colors(TRUE)}, add=TRUE) Sys.setenv(RSTUDIO='1') a <- c( is( diffChr(1, 2, format='auto', pager='on', interactive=TRUE)@etc@style, "StyleHtml" ), is( diffChr(1, 2, format='auto', interactive=FALSE)@etc@style, "StyleAnsi" ) ) Sys.setenv(RSTUDIO_TERM='HELLO') crayon::num_colors(TRUE) c( a, is( diffChr(1, 2, format='auto', pager='on', interactive=TRUE)@etc@style, "StyleAnsi" ) ) }) # - format-pager interaction 3 ------------------------------------------------- is( diffPrint(1:3, 3:1, format='auto', interactive=FALSE, term.colors=1)@etc@style, "StyleRaw" ) is( diffPrint(1:3, 3:1, format='auto', interactive=FALSE, term.colors=8)@etc@style, "StyleAnsi" ) # - Default pager writes to screen --------------------------------------------- # issue132 thanks Bill Dunlap local({ f <- tempfile() on.exit(unlink(f)) writeLines("hello world", f) all.equal(capture.output(new("Pager")@pager(f)), "hello world") }) diffobj/tests/test-summary.Rout.save0000644000176200001440000000716514122754044017315 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "summary" > source(file.path('_helper', 'init.R')) > > # Note, atomic prints happen in different test file > > # - Any ------------------------------------------------------------------------ > > identical(any(diffPrint(iris.s, iris.s)), FALSE) [1] TRUE > res <- any(diffPrint(iris.s, iris.c)) # warn: "objects are NOT" Warning message: No visible differences, but objects are NOT `all.equal`. > identical(res, FALSE) [1] TRUE > isTRUE(any(diffPrint(iris.s, iris.4))) [1] TRUE > > > # - Small Summary -------------------------------------------------------------- > > all.equal( + as.character(summary(diffPrint(iris.s, iris.4))), rdsf(100) + ) [1] TRUE > all.equal( + as.character(summary(diffPrint(iris.s, iris.2))), rdsf(200) + ) [1] TRUE > all.equal( + as.character(summary(diffPrint(iris.s, iris.3))), rdsf(300) + ) [1] TRUE > all.equal( + as.character(summary(diffPrint(iris.s, iris.c))), rdsf(400) + ) [1] TRUE > # All equal > > all.equal( + as.character(summary(diffChr(letters, letters))), rdsf(450) + ) [1] TRUE > > # - Big Summary ---------------------------------------------------------------- > > # Make sure we test summary reduction, wrapping > > all.equal( + as.character(summary(diffChr(chr.7, chr.8))), rdsf(500) + ) [1] TRUE > all.equal( + as.character(summary(diffChr(chr.7, chr.8), scale.threshold=1)), rdsf(600) + ) [1] TRUE > all.equal( + as.character(summary(diffChr(chr.7, chr.8), scale.threshold=0)), rdsf(700) + ) [1] TRUE > # Force truncation of summary > all.equal( + as.character( + summary(diffChr(chr.7, chr.8), scale.threshold=0, max.lines=2) + ), + rdsf(800) + ) [1] TRUE > > # - Show ----------------------------------------------------------------------- > > isTRUE( + paste0(capture.output(summary(diffChr(chr.7, chr.8))), collapse="\n") == + as.character(summary(diffChr(chr.7, chr.8))) + ) [1] TRUE > > # - HTML summary --------------------------------------------------------------- > > all.equal( + as.character( + summary( + diffPrint( + iris.s, iris.4, format="html", style=list(html.output="page") + ) ) ), + rdsf(900) + ) [1] TRUE > > # - errors --------------------------------------------------------------------- > > diff <- diffChr("hello green world", "hello red world") > try(summary(diff, max.lines=0)) # "strictly positive" Error in .local(object, ...) : Argument `max.lines` must be integer(1L) and strictly positive > try(summary(diff, width=1:3)) # "integer\\(1L\\)" Error in .local(object, ...) : Argument `width` must be integer(1L) and positive > try(summary(diff, scale.threshold=5)) # "between 0 and 1" Error in .local(object, ...) : Argument `scale.threshold` must be numeric(1L) between 0 and 1 > > # - width wrap ----------------------------------------------------------------- > > diff <- diffChr("hello green world", "hello red world", format='raw') > all.equal(capture.output(show(summary(diff, width=5))), txtf(100)) [1] TRUE > > > proc.time() user system elapsed 3.413 0.271 3.813 diffobj/tests/test-style.R0000644000176200001440000001004514122754044015262 0ustar liggesusersNAME <- "style" source(file.path('_helper', 'init.R')) ## - Style Palette ------------------------------------------------------------ all.equal( capture.output(diffobj:::display_ansi_256_styles()), rdsf(100) ) ## - crayon settings ----------------------------------------------------------- # make sure crayon options are appropriately overriden local({ old.opt <- options(crayon.enabled=FALSE) on.exit(options(old.opt)) print(identical(crayon::green("green"), "green")) # should have ANSI coloring despite crayon disabled print( all.equal( as.character(diffChr(letters[1:3], LETTERS[1:3])), rdsf(200) ) ) identical(crayon::green("green"), "green") }) ## - Palette of Styles --------------------------------------------------------- pos <- PaletteOfStyles() identical( pos[["ansi256", "light", "rgb"]], getClassDef("StyleAnsi256LightRgb", package="diffobj", inherits=FALSE) ) all.equal( capture.output(show(pos)), rdsf(300) ) all.equal( capture.output(summary(pos)), rdsf(400) ) pos["ansi256", "light", "yb"] <- list(StyleRaw()) all.equal( c(pos["ansi256", "light", "yb"]@data), list(StyleRaw()), check.environment=FALSE ) all.equal( pos[["ansi256", "light", "yb"]], StyleRaw(), check.environment=FALSE ) ## - Auto Styles --------------------------------------------------------------- try(diffChr(letters, LETTERS, style="auto", format="xml")) is( diffChr( letters, LETTERS, style="auto", format="auto", brightness="light", term.colors=256 )@etc@style, "StyleAnsi256LightYb" ) is( diffChr( letters, LETTERS, style="auto", format="auto", brightness="light", term.colors=8 )@etc@style, "StyleAnsi8NeutralYb" ) is( diffChr( letters, LETTERS, style="auto", format="auto", interactive=FALSE, term.colors=1 )@etc@style, "StyleRaw" ) is( diffChr( letters, LETTERS, style="auto", format="auto", interactive=TRUE, term.colors=1 # note pager off by default in tests )@etc@style, "StyleRaw" ) is( diffChr( letters, LETTERS, style="auto", format="auto", interactive=TRUE, pager="auto", term.colors=1 )@etc@style, "StyleHtml" ) is( diffChr( letters, LETTERS, style="auto", format="auto", interactive=TRUE, pager="auto", term.colors=9 )@etc@style, "StyleAnsi8NeutralYb" ) is( diffChr( letters, LETTERS, style="auto", format="auto", interactive=TRUE, pager="auto", brightness='light', term.colors=500 )@etc@style, "StyleAnsi256LightYb" ) is( diffChr( letters, LETTERS, style="auto", format="html", interactive=TRUE, pager="auto", color.mode=c("rgb", ansi8="yb") )@etc@style, "StyleHtmlLightRgb" ) is( diffChr( letters, LETTERS, style="auto", format="html", interactive=TRUE, pager="auto", color.mode=c("rgb", html="yb") )@etc@style, "StyleHtmlLightYb" ) ## - Palette Params ------------------------------------------------------------ all.equal( as.character( diffChr( letters, LETTERS, style="auto", format="ansi256", brightness=c("light", ansi256="dark") ) ), rdsf(500) ) all.equal( as.character( diffChr( letters, LETTERS, style="auto", format="ansi256", brightness=c("dark") ) ), rdsf(500) ) ## - Style Validation ---------------------------------------------------------- s.f <- StyleFuns() isTRUE(validObject(s.f)) s.f@word.insert <- function(x, y) NULL try(validObject(s.f)) # word.insert try(diffChr(1,2, format='html', style=list(scale=1:3))) try(diffChr(1,2, format='html', style=list(html.output="a"))) ## - Pallette w/ Objs ---------------------------------------------------------- pal <- PaletteOfStyles() pal["raw", "neutral", "rgb"] <- list(new(pal[["raw", "neutral", "rgb"]])) suppressWarnings( withCallingHandlers( invisible(diffChr( letters, LETTERS, format="raw", brightness="neutral", color.mode="rgb", palette.of.styles=pal, style=list(na.sub="NA") )), warning=function(e) writeLines(conditionMessage(e)) ) ) ## - External Files ------------------------------------------------------------ isTRUE(file_test("-f", diffobj_css())) isTRUE(file_test("-f", diffobj_js())) diffobj/tests/test-text.Rout.save0000644000176200001440000001263614122754044016603 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "text" > source(file.path('_helper', 'init.R')) > > # - simple wrap > > txt1 <- c( + "humpty dumpty sat on a wall and had a big fall", + "humpty sat on a wall and dumped a big fall" + ) > res1 <- diffobj:::wrap(txt1, 10, TRUE, sgr.supported=TRUE) > > identical( + gsub(" *$", "", vapply(res1, paste0, character(1L), collapse="")), txt1 + ) [1] TRUE > all.equal(lapply(res1, nchar), list(rep(10L, 5L), rep(10L, 5L))) [1] TRUE > > txt2 <- "hello world!" > identical( + unlist(diffobj:::wrap(txt2, nchar(txt2), TRUE, sgr.supported=TRUE)), + txt2 + ) [1] TRUE > identical( + paste0( + unlist(diffobj:::wrap(txt2, nchar(txt2) / 2, TRUE, sgr.supported=TRUE)), + collapse="" + ), + txt2 + ) [1] TRUE > > # - wrap with escape sequences > > txt3 <- c( + paste0( + "humpty dumpty ", crayon::style("sat on a wall", "red"), + " and had a big fall", + crayon::style( + crayon::style( + "humpty sat on a wall and dumped a big fall", + "green" + ), + "bgRed" + ), "woohoo" + ), + paste0( + crayon::style("hello ", "inverse"), "beautiful ", + crayon::style("world", "blue") + ) + ) > res3 <- diffobj:::wrap(txt3, 10, TRUE, sgr.supported=TRUE) > > identical( + crayon::strip_style( + gsub(" *$", "", vapply(res3, paste0, character(1L), collapse="")) + ), + crayon::strip_style(txt3) + ) [1] TRUE > all.equal( + lapply(res3, crayon::col_nchar), + list(rep(10L, 10L), rep(10L, 3L)) + ) [1] TRUE > > # - strip hz whitespace > > options(crayon.enabled=FALSE) > all.equal( + diffobj:::strip_hz_control("a\tb", stops=4L, sgr.supported=TRUE), "a b") [1] TRUE > all.equal( + diffobj:::strip_hz_control("ab\t", stops=4L, sgr.supported=TRUE), "ab ") [1] TRUE > all.equal( + diffobj:::strip_hz_control("a\tb\t", stops=4L, sgr.supported=TRUE), "a b ") [1] TRUE > all.equal( + diffobj:::strip_hz_control("\ta\tb\t", stops=4L, sgr.supported=TRUE), + " a b " + ) [1] TRUE > all.equal( + diffobj:::strip_hz_control("\ta\tb\t", stops=c(2L, 4L), sgr.supported=TRUE), + " a b " + ) [1] TRUE > all.equal( + diffobj:::strip_hz_control( + c("ab\t", "\ta\tb\t"), sgr.supported=TRUE, stops=4L + ), + c("ab ", " a b ") + ) [1] TRUE > # recall that nchar("\033") == 1 > all.equal( + diffobj:::strip_hz_control( + "\033[31ma\t\033[39mhello\tb", stops=10L, sgr.supported=FALSE + ), + "\033[31ma \033[39mhello b" + ) [1] TRUE > all.equal( + diffobj:::strip_hz_control( + "\033[31ma\t\033[39mhello\tb", stops=10L, sgr.supported=TRUE + ), + "\033[31ma\033[39m \033[31m\033[39mhello \033[31m\033[39mb" + ) [1] TRUE > # carriage returns > > all.equal( + diffobj:::strip_hz_control("hellothere\rHELLO", sgr.supported=TRUE), + "HELLOthere" + ) [1] TRUE > all.equal( + diffobj:::strip_hz_control( + c("hellothere\rHELLO", "000\r12345678\rabcdef\rABC"), sgr.supported=TRUE + ), + c("HELLOthere", "ABCdef78") + ) [1] TRUE > all.equal( + diffobj:::strip_hz_control("hellothere\r", sgr.supported=TRUE), + "hellothere" + ) [1] TRUE > all.equal( + diffobj:::strip_hz_control(character(), sgr.supported=TRUE), character() + ) [1] TRUE > # newlines > > all.equal( + diffobj:::strip_hz_control(c("a", "", "\n", "a\nb"), sgr.supported=TRUE), + c("a", "", "", "a", "b") + ) [1] TRUE > # with colors > > options(crayon.enabled=TRUE) > > all.equal( + crayon::strip_style( + diffobj:::strip_hz_control( + "\033[31ma\t\033[39mhello\tb", stops=10L, sgr.supported=TRUE) + ), + "a hello b" + ) [1] TRUE > test.chr <- paste0( + crayon::red(crayon::`%+%`("000", crayon::bgBlue("\r12345678"))), + "\rabcdef", crayon::green("\rABC") + ) > # visually inspect these > > # cat("\n") > # cat(test.chr, sep="\n") > res <- diffobj:::strip_hz_control(test.chr, sgr.supported=TRUE) > # cat(res, sep="\n") > all.equal(crayon::strip_style(res), "ABCdef78") [1] TRUE > > # Mix tabs and carriage returns, visual inspection assumes terminal tab > # stops at 8L; note output not exactly the same since it seems tabs don't > # ovewrite prior screen state whereas spaces do > > test.chr.2 <- paste0( + crayon::red(crayon::`%+%`("000", crayon::bgBlue("\r123\t456\t78"))), + "\rab\tcd f", crayon::green("\rABC") + ) > # cat("\n") > # cat(test.chr.2, sep="\n") > res.2 <- diffobj:::strip_hz_control(test.chr.2, stops=8L, sgr.supported=TRUE) > # cat(res.2, sep="\n") > > all.equal(crayon::strip_style(res.2), "ABC cd f 78") [1] TRUE > > # multi line > > test.chr.3 <- c(test.chr, test.chr.2) > # cat("\n") > res.3 <- diffobj:::strip_hz_control(test.chr.3, sgr.supported=TRUE) > # cat(res.3, sep="\n") > # cat(test.chr.3, sep="\n") > > all.equal(crayon::strip_style(res.3), c("ABCdef78", "ABC cd f 78")) [1] TRUE > > > proc.time() user system elapsed 1.047 0.106 1.146 diffobj/tests/test-diffObj.Rout.save0000644000176200001440000001234214122754044017154 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "diffObj" > source(file.path('_helper', 'init.R')) > > # - simple diffobj ------------------------------------------------------------- > > # no diff for print > all.equal(as.character(diffObj(iris.s, iris.c)), rdsf(100)) [1] TRUE > # no diff for str > all.equal( + as.character(diffObj(1:100, c(1:99, 200L))), rdsf(200) + ) [1] TRUE > # diffs for both and must pick one, first one is str, second is print > all.equal( + as.character(diffObj(mdl1[7], mdl2[7])), rdsf(300) + ) [1] TRUE > all.equal(as.character(diffObj(mdl1, mdl2)), rdsf(400)) [1] TRUE > > # - fits or doesn't ------------------------------------------------------------ > > # Note, the first test used to favor str until we handicapped print > all.equal( + diffObj(matrix(1:20, ncol=2), matrix(2:21, ncol=2), line.limit=5)@capt.mode, + "str" + ) [1] TRUE > # test kinda slow, would be better to have one with smaller objects with print > # methods > > all.equal( + diffObj(mdl1, mdl2, line.limit=15, mode='unified')@capt.mode, "print" + ) [1] TRUE > all.equal(diffObj(1:1000, 1000:1, line.limit=5)@capt.mode, "str") [1] TRUE > > # - misc ----------------------------------------------------------------------- > > try(diffObj(1, 2, extra=list(TRUE))) # "extra" Error in .local(target, current, ...) : Argument `extra` must be empty in `diffObj`. > > # - print error ---------------------------------------------------------------- > > x <- structure("hello", class="diffobj_ogewlhgiadfl") > y <- structure("goodbye", class="diffobj_ogewlhgiadfl") > try(diffObj(x, y)) # "Error in calling .diffPrint." Error in print.diffobj_ogewlhgiadfl(structure("goodbye", class = "diffobj_ogewlhgiadfl")) : failure Error in diffObj(target = x, current = y) : Error in calling `diffPrint`: Failed attempting to get text representation of object: failure > > # Random exmaples to think through `diffObj` output > > diffObj( + pairlist("`logical(2L)` should be length 2 (is 3)"), + pairlist("be length 2 (is 3)") + ) < pairlist("`logical(2L)` should be l.. > pairlist("be length 2 (is 3)") @@ 1,3 @@  @@ 1,3 @@  [[1]] [[1]] < [1] "`logical(2L)` should be length 2 > [1] "be length 2 (is 3)" :  (is 3)" ~ > > diffObj( + pairlist("`matrix(integer(), nrow = 3)` should be matrix (is list)", "`list(character(1L), 1L)[[2]]` should be type \"integer-like\" (is \"character\")"), + pairlist("be class \"matrix\" (is \"list\")", "be type \"integer-like\" (is \"character\") at index [[2]]") + ) < pairlist("`matrix(integer(), nrow =.. > pairlist("be class \"matrix\" (is \.. @@ 1,6 @@  @@ 1,6 @@  [[1]] [[1]] < [1] "`matrix(integer(), nrow = 3)` sh > [1] "be class \"matrix\" (is \"list\" : ould be matrix (is list)" : )" [[2]] [[2]] < [1] "`list(character(1L), 1L)[[2]]` s > [1] "be type \"integer-like\" (is \"c : hould be type \"integer-like\" (is \" : haracter\") at index [[2]]" : character\")" ~ > > proc.time() user system elapsed 3.252 0.326 3.687 diffobj/tests/test-subset.Rout.save0000644000176200001440000000460714122754044017123 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "subset" > source(file.path('_helper', 'init.R')) > > A <- B <- letters[1:5] > B[2] <- "B" > B[6] <- "F" > > # - subset --------------------------------------------------------------------- > > local({ + old.opt <- options(diffobj.style=StyleRaw()) + on.exit(options(old.opt)) + a0 <- all.equal( + c(as.character(diffChr(A, B)[1:3])), + c("< A > B ", "@@ 1,5 @@ @@ 1,6 @@ ", " a a ") + + ) + a <- all.equal( + c(as.character(diffChr(A, B)[1])), c(as.character(head(diffChr(A, B), 1))) + ) + b <- all.equal( + c(as.character(diffChr(A, B)[7:8])), c(as.character(tail(diffChr(A, B), 2))) + ) + c(a0, a, b) + }) [1] TRUE TRUE TRUE > # - subset errors -------------------------------------------------------------- > > diff <- diffChr(A, B) > try(diff[NA_real_]) # "contain NAs or both positive" Error in .local(x, i, ...) : `i` may not contain NAs or both positive and negative indices > try(diff[c(-1, 1)]) # "contain NAs or both positive" Error in .local(x, i, ...) : `i` may not contain NAs or both positive and negative indices > try(head(diff, 1, 2)) # "does not support arguments" Error in .local(x, ...) : This method does not support arguments other than `x` or `n` > try(head(diff, NA)) # "must be integer" Error in .local(x, ...) : `n` must be integer(1L) and not NA > try(head(diff, 1:3)) # "must be integer" Error in .local(x, ...) : `n` must be integer(1L) and not NA > try(tail(diff, 1:3)) # "must be integer" Error in .local(x, ...) : `n` must be integer(1L) and not NA > try(tail(diff, 1, 2)) # "does not support arguments" Error in .local(x, ...) : This method does not support arguments other than `x` or `n` > > > > proc.time() user system elapsed 1.519 0.155 1.873 diffobj/tests/test-warnings.R0000644000176200001440000000224014122754044015750 0ustar liggesusersNAME <- "warnings" source(file.path('_helper', 'init.R')) # tests designed to produce warnings # - Extra args for `str` ------------------------------------------------------- a <- "hello" b <- "goodbye" invisible(diffStr(a, b, extra=list(comp.str="^"))) # "Specifying" invisible(diffStr(a, b, extra=list(comp="^"))) # "Specifying") invisible(diffStr(a, b, extra=list(indent.str="..."))) # "Specifying" invisible(diffStr(a, b, extra=list(indent="..."))) # "Specifying" # - Max diffs ------------------------------------------------------------------ # Max limit warnings work properly; these are not fully fleshed out A3 <- c("a b c", "d e f A B C D", "g h i", "f") B3 <- c("a b c", "xd e f E Q L S", "g h i", "q") invisible(diffChr(A3, B3, max.diffs=2)) # warn: "Exceeded diff" # - Overriden formals ---------------------------------------------------------- # warn "Provided `style` argument will override the provided `format` argument" invisible(diffChr(letters, LETTERS, style=StyleRaw(), format="ansi8")) # warn: "Provided `style` .* `format` and `color.mode` arguments" invisible( diffChr(letters, LETTERS, style=StyleRaw(), format="ansi8", color.mode="rgb") ) diffobj/tests/test-diffStr.R0000644000176200001440000000654714122754044015537 0ustar liggesusersNAME <- "diffStr" source(file.path('_helper', 'init.R')) # - lm models ------------------------------------------------------------------ # formula display changed if( R.Version()$major >= 3 && R.Version()$minor >= "3.1" || R.Version()$major > 3 ) all.equal(as.character(diffStr(mdl1, mdl2)), rdsf(100)) # Too strict a line limit, can't get under all.equal( as.character(diffStr(mdl1[7], mdl2[7], line.limit=10)), rdsf(200) ) # Now we can get under all.equal( as.character(diffStr(mdl1[7], mdl2[7], line.limit=15)), rdsf(300) ) # - Simple structure ----------------------------------------------------------- # # Character types all.equal(as.character(diffStr(iris.c, iris.s)), rdsf(400)) # - Strict width --------------------------------------------------------------- # formula display changed if( R.Version()$major >= 3 && R.Version()$minor >= "3.1" || R.Version()$major > 3 ) { c( all.equal( as.character( diffStr(mdl1, mdl2, extra=list(strict.width="wrap"), line.limit=30) ), rdsf(500) ), all.equal( as.character( diffStr(mdl1, mdl2, extra=list(strict.width="cut"), line.limit=30) ), rdsf(550) ) ) } # - max.diffs ------------------------------------------------------------------ invisible(diffStr(iris, mtcars, max.diffs=2)) # warn: "Exceeded diff limit" # - max.level ------------------------------------------------------------------ all.equal( as.character(diffStr(mdl1[7], mdl2[7], extra=list(max.level="auto"))), rdsf(600) ) all.equal( as.character(diffStr(mdl1[7], mdl2[7], extra=list(max.level=2))), rdsf(700) ) # Has a difference, but can't get under; the second is just for reference lst.1 <- lst.2 <- lst.3 <- list(a=list(b=list(c=list(d=list(e=list(25)))))) names(lst.2) <- "A" all.equal( as.character(diffStr(lst.1, lst.2, line.limit=2)), rdsf(800) ) all.equal( as.character(diffStr(lst.1, lst.2, line.limit=2)), rdsf(900) ) # Test that initial run shows difference, but too big, but next one down # doesn't so have to increase level names(lst.3$a$b$c$d) <- "E" all.equal( as.character(diffStr(lst.1, lst.3, line.limit=6)), rdsf(1000) ) # - No visible differences ----------------------------------------------------- all.equal( as.character(diffStr(1:100, c(1:99, 101L))), rdsf(1100) ) # - Quoted Objects ------------------------------------------------------------- all.equal( as.character(diffStr(quote(zz + 1), quote(zz + 3))), structure( c("\033[33m<\033[39m \033[33mstr(quote(zz +..\033[39m \033[34m>\033[39m \033[34mstr(quote(zz +..\033[39m", "\033[36m@@ 1 @@ \033[39m \033[36m@@ 1 @@ \033[39m", "\033[33m<\033[39m \033[90m\033[39m language zz + \033[33m1\033[39m\033[90m\033[39m \033[34m>\033[39m \033[90m\033[39m language zz + \033[34m3\033[39m\033[90m\033[39m" ), len = 3L ) ) all.equal( as.character(diffStr(quote(x), quote(y))), structure(c("\033[33m<\033[39m \033[33mstr(quo..\033[39m \033[34m>\033[39m \033[34mstr(quo..\033[39m", "\033[36m@@ 1 @@ \033[39m \033[36m@@ 1 @@ \033[39m", "\033[33m<\033[39m \033[90m\033[39m symbol \033[33mx\033[39m\033[90m\033[39m \033[34m>\033[39m \033[90m\033[39m symbol \033[34my\033[39m\033[90m\033[39m"), len = 3L) ) # - Spaces with punctuation ---------------------------------------------------- all.equal( capture.output(show(diffStr(list(a=1), list(a=1, cabera=3), format='raw'))), txtf(100) ) diffobj/tests/test-methods.Rout.save0000644000176200001440000000475714122754044017267 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "methods" > source(file.path('_helper', 'init.R')) > > # try implementing methods that change default behavior outside of package > > # - Force unified -------------------------------------------------------------- > > par.env <- new.env() > local( + envir=par.env, { + suppressWarnings( + setClass( + "testdiffobj", slots=c(a="integer"), where=par.env + ) ) + # First check that we do actually output in side by side mode + + print( + all.equal( + as.character(diffObj(new("testdiffobj", a=1L), new("testdiffobj", a=2L))), + rdsf(100) + ) ) + # Now verify that with our new method, we get unified + + setMethod("diffObj", c("testdiffobj", "testdiffobj"), + function(target, current, ...) { + dots <- match.call(expand.dots=FALSE)[["..."]] + if("mode" %in% names(dots)) + callNextMethod() + else + callNextMethod(target=target, current=current, ..., mode="unified") + }, + where=par.env + ) + on.exit( + removeMethod("diffObj", c("testdiffobj", "testdiffobj"), where=par.env) + ) + print( + all.equal( + as.character(diffObj(new("testdiffobj", a=1L), new("testdiffobj", a=2L))), + rdsf(200) + ) ) + # Make sure we can still get side by side? + print( + all.equal( + as.character( + diffObj( + new("testdiffobj", a=1L), new("testdiffobj", a=2L), mode="sidebyside" + ) ), + rdsf(100) + ) ) + try( #"Argument `mode` must be" + diffObj(new("testdiffobj", a=1L), new("testdiffobj", a=2L), mode="hello") + ) + }) [1] TRUE [1] TRUE [1] TRUE Error in diffObj(target = new("testdiffobj", a = 1L), current = new("testdiffobj", : Error in calling `diffStr`: Argument `mode` must be character(1L) and in `c("auto", "unified", "context", "sidebyside")`. > > proc.time() user system elapsed 1.609 0.172 1.801 diffobj/tests/test-diffChr.Rout.save0000644000176200001440000002025115000460760017147 0ustar liggesusers R Under development (unstable) (2021-07-17 r80639) -- "Unsuffered Consequences" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "diffChr" > source(file.path('_helper', 'init.R')) > > # - Corner Cases --------------------------------------------------------------- > > # Corner cases from https://neil.fraser.name/writing/diff/ > # Both of these appear handled correctly by the algorithm here > # first one: suboptimal edit script due to two sided approach > > A1 <- c("X", "A", "X", "C", "X", "A", "B", "C") > B1 <- c("A", "B", "C", "Y") > all.equal(as.character(diffChr(A1, B1)), rdsf(100)) [1] TRUE > > # second one: failure to find intersection at ends of paths (paths run into > # each other eventually) > > A2 <- c("A", "B", "X", "A", "B") > B2 <- c("A", "Y", "B") > all.equal(as.character(diffChr(A2, B2)), rdsf(200)) [1] TRUE > > # Simple corner cases > > all.equal( + as.character(diffChr(character(), character())), rdsf(225) + ) [1] TRUE > all.equal(as.character(diffChr("", "")), rdsf(250)) [1] TRUE > > # - Larger strings ------------------------------------------------------------- > > # diffChr(X[1:2000], X[2001:4000]) > > all.equal(as.character(diffChr(chr.7, chr.8)), rdsf(300)) [1] TRUE > > # Too slow to run; useful for benchmarking though > > # X1 <- X[1:2e4] > # X2 <- X1[-sample(seq_along(X1), 2e3)] > # X2[sample(seq_along(X2), 4e3)] <- "XXXXXX" > # res <- diffChr(X1, X2) > # res <- diffChr(X[1:10000], X[7500:17500]) > # res <- ses(X[1:10000], X[7500:17500]) > # res <- diffChr(X[1:25000], X[10001:50000], max.diffs=65000) > > # - Sentences > chr.5 <- c( + "hello there how are you doing", + "humpty dumpty took a big fall", + "lorem ipsum dolor sic est boom", + "a computer once wrote a phrase" + ) > chr.6 <- c( + "hello THERE how are you doing", + "and another SENTENCE blah blah", + "humpty dumpty TOOK a big fall", + "a COMPUTER once wrote a phrase" + ) > all.equal(as.character(diffChr(chr.5, chr.6)), rdsf(400)) [1] TRUE > all.equal( + as.character(diffChr(chr.5, chr.6, mode="unified")), rdsf(500) + ) [1] TRUE > all.equal( + as.character(diffChr(chr.5, chr.6, mode="context")), rdsf(600) + ) [1] TRUE > # - Whitespace ----------------------------------------------------------------- > > all.equal( + as.character(diffChr(c("a", "b", "c"), c("a ", "b", "c"))), rdsf(800) + ) [1] TRUE > all.equal( + as.character( + diffChr(c("a", "b", "c"), c("a ", "b", "c"), ignore.white.space=FALSE) + ), + rdsf(900) + ) [1] TRUE > # New lines count as new elements > all.equal( + as.character(diffChr("woo\nhoo\nfoo", c("woo", "foo"))), rdsf(1000) + ) [1] TRUE > all.equal( + capture.output(diffChr("hello . world", "hello. world", format='raw')), + txtf(100) + ) [1] TRUE > # - SGR ------------------------------------------------------------------------ > > a <- c("hello \033[31mworld\033[m", "umbrellas", "tomatoes") > b <- c("hello world", "umbrellas", "tomatoes") > > local({ + old.opt <- options(diffobj.sgr.supported=TRUE) + on.exit(options(old.opt)) + diff <- diffChr(a, b) # warn: 'contained ANSI CSI SGR' + try(diffChr(a, b, strip.sgr=1:3)) # "TRUE, FALSE, or NULL" + try(diffChr(a, b, sgr.supported=1:3)) # "TRUE, FALSE, or NULL" + + c( + all.equal(capture.output(show(diff)), txtf(200)), + all.equal(capture.output(show(diffChr(a, b, strip.sgr=FALSE))), txtf(300)), + all.equal(capture.output(show(diffChr(a, b, format='raw'))), txtf(400)) + ) + }) Error in diffChr(target = a, current = b, strip.sgr = 1:3) : Argument `strip.sgr` must be TRUE, FALSE, or NULL In addition: Warning message: In diffChr(target = a, current = b) : `target` or `current` contained ANSI CSI SGR when rendered; these were stripped. Use `strip.sgr=FALSE` to preserve them in the diffs. Error in diffChr(target = a, current = b, sgr.supported = 1:3) : Argument `sgr.supported` must be TRUE, FALSE, or NULL [1] TRUE TRUE TRUE > # - Alignment ------------------------------------------------------------------ > > chr.7 <- c("a b c d e", "F G h i j k", "xxx", "yyy", "k l m n o") > chr.8 <- c("f g h i j k", "hello", "goodbye", "yo", "k l m n o") > > all.equal(as.character(diffChr(chr.7, chr.8)), rdsf(1100)) [1] TRUE > all.equal( + as.character(diffChr(chr.7, chr.8, align=4/6)), rdsf(1100) # same as above + ) [1] TRUE > # No longer aligns > all.equal( + as.character(diffChr(chr.7, chr.8, align=4.01/6)), rdsf(1200) + ) [1] TRUE > all.equal( + as.character(diffChr(chr.7, chr.8, align=AlignThreshold(min.chars=4))), + rdsf(1100) # same as earlier + ) [1] TRUE > all.equal( + as.character(diffChr(chr.7, chr.8, align=AlignThreshold(min.chars=5))), + rdsf(1200) # same as above + ) [1] TRUE > > ## Normally this would not align, but we allow symbols to count towards > ## alignment > chr.7a <- c("a b c e", "d [ f g") > chr.7b <- "D [ f g" > a1 <- AlignThreshold(threshold=0, min.chars=2, count.alnum.only=FALSE) > all.equal( + as.character(diffChr(chr.7a, chr.7b, align=a1, format='raw')), + structure( + c("< chr.7a > chr.7b ", "@@ 1,2 @@ @@ 1 @@ ", + "< a b c e ~ ", "< d [ f g > D [ f g "), len = 4L) + ) [1] TRUE > # corner case where alignment alog exits early because it runs out of B values > # to match A values to. > > b <- c('a b c e', 'x w z f', 'e f g h') > a <- c('z o o o', 'p o o o', 'A b c e') > al <- AlignThreshold(threshold=0, min.chars=0) > all.equal( + capture.output(show(diffChr(b, a, align=al, format='raw'))), txtf(500) + ) [1] TRUE > # - NAs ------------------------------------------------------------------------ > > all.equal( + as.character( + diffChr(c(NA, letters[1:3]), c(letters[1:3], LETTERS[1:2], NA)) + ), + rdsf(1300) + ) [1] TRUE > all.equal( + as.character( + diffChr(c(letters[1:3]), c(letters[1:3], LETTERS[1:2], NA)) + ), + rdsf(1400) + ) [1] TRUE > all.equal( + as.character( + diffChr(c(NA, letters[1:3]), c(letters[1:3], LETTERS[1:2])) + ), + rdsf(1500) + ) [1] TRUE > # - Nested dots issue 134, h/t Noam Ross --------------------------------------- > > fn <- function(target, current, ...) { + diffChr(target, current, ...) + } > all.equal( + as.character(fn("a", "b", format = "raw")), + structure( + c( + "< target > current ", + "@@ 1 @@ @@ 1 @@ ", + "< a > b "), len = 3L + ) + ) [1] TRUE > > # - Newlines in input, issue 135, h/t Flying Sheep ----------------------------- > > a <- 'A Time Series:\n[1] 1 2 3 4' > b <- 'A Time Series:\n[1] 9 4 1 4' > all.equal( + c(as.character(diffobj::diffChr(a, b, format = 'raw'))), + c("< a > b ", + "@@ 1,2 @@ @@ 1,2 @@ ", + " A Time Series: A Time Series:", + "< [1] 1 2 3 4 > [1] 9 4 1 4 ") + ) [1] TRUE > > # - Attributes causing dispatch in guides, issue 142 --------------------------- > > zlold <- c("0x0000, 0x001F", "0x007F, 0x009F", "0x0300, 0x036F") > zlnew <- structure( + c("0x0000, 0x001F", "0x008F, 0x009F", "0x0300, 0x036F"), .Dim = 3L + ) > diffChr(zlold, zlnew) # no warning < zlold > zlnew @@ 1,3 @@  @@ 1,3 @@  0x0000, 0x001F 0x0000, 0x001F < 0x007F, 0x009F > 0x008F, 0x009F 0x0300, 0x036F 0x0300, 0x036F > > # - do.call, issue 158 --------------------------------------------------------- > > do.call(diffChr, list(1:2, 3:4, format='raw')) < 1:2 > 3:4 @@ 1,2 @@ @@ 1,2 @@ < 1 > 3 < 2 > 4 > > diffobj/tests/test-file.Rout.save0000644000176200001440000000675414122754044016542 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "diffFile" > source(file.path('_helper', 'init.R')) > > # - Code File ------------------------------------------------------------------ > > # # compare two crayon file versions > # # These should eventually just be downloaded and made into diffFile tests > > f.p.1 <- file.path("_helper", "objs", "diffFile", "s.o.3f1f68.R") > f.p.2 <- file.path("_helper", "objs", "diffFile", "s.o.30dbe0.R") > > # url.1 <- "https://raw.githubusercontent.com/gaborcsardi/crayon/3f1f68ab177b82a27e754a58264af801f7194820/R/string_operations.r" > # url.2 <- "https://raw.githubusercontent.com/gaborcsardi/crayon/30dbe0d4d92157350af3cb3aeebd6d9a9cdf5c0e/R/string_operations.r" > # f.1 <- readLines(url.1) > # f.2 <- readLines(url.2) > # writeLines(f.1, f.p.1) > # writeLines(f.2, f.p.2) > > all.equal(as.character(diffFile(f.p.1, f.p.2)), rdsf(100)) [1] TRUE > > # - RDS ------------------------------------------------------------------------ > > f1 <- tempfile() > f2 <- tempfile() > > mx1 <- mx2 <- matrix(1:9, 3) > mx2[5] <- 99 > saveRDS(mx1, f1) > saveRDS(mx2, f2) > > is(diffobj:::get_rds(f1), "matrix") [1] TRUE > is(diffobj:::get_rds(f2), "matrix") [1] TRUE > > ref <- as.character(diffPrint(mx1, mx2)) > identical(as.character(diffPrint(mx1, f2, cur.banner="mx2")), ref) [1] TRUE > identical(as.character(diffPrint(f1, mx2, tar.banner="mx1")), ref) [1] TRUE > identical( + as.character(diffPrint(f1, f2, tar.banner="mx1", cur.banner="mx2")), ref + ) [1] TRUE > isTRUE(!identical(as.character(diffPrint(mx1, f2, rds=FALSE)), ref)) [1] TRUE > unlink(c(f1, f2)) > > # - file ----------------------------------------------------------------------- > > f1 <- tempfile() > f2 <- tempfile() > letters2 <- letters > letters2[15] <- "HELLO" > > writeLines(letters, f1) > writeLines(letters2, f2) > > identical( + as.character(diffChr(letters, letters2, tar.banner="f1", cur.banner="f2")), + as.character(diffFile(f1, f2)) + ) [1] TRUE > unlink(c(f1, f2)) > > # issue 133 h/t Noam Ross, thanks for the test > > x <- tempfile() > y <- tempfile() > cat("Hello\nthere\n", file = x) > file.copy(x, y) [1] TRUE > identical( + as.character(diffFile(x, y, format = "raw")), + structure( + c("No visible differences between objects.", + "< x > y ", + "@@ 1,2 @@ @@ 1,2 @@ ", + " Hello Hello ", + " there there "), len = 5L) + ) [1] TRUE > unlink(c(x, y)) > > # - CSV ------------------------------------------------------------------------ > > f1 <- tempfile() > f2 <- tempfile() > > iris2 <- iris > iris2$Sepal.Length[25] <- 9.9 > > write.csv(iris, f1, row.names=FALSE) > write.csv(iris2, f2, row.names=FALSE) > > identical( + as.character(diffPrint(iris, iris2, tar.banner="f1", cur.banner="f2")), + as.character(diffCsv(f1, f2)) + ) [1] TRUE > unlink(c(f1, f2)) > > > proc.time() user system elapsed 2.222 0.271 2.722 diffobj/tests/test-diffDeparse.Rout.save0000644000176200001440000000225414122754044020026 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "diffDeparse" > source(file.path('_helper', 'init.R')) > > # - deparse -------------------------------------------------------------------- > > # First one will be done in unified mode since `deparse` disregards > # option(width=), second will be done side by side > > all.equal(as.character(diffDeparse(letters, LETTERS)), rdsf(100)) [1] TRUE > all.equal( + as.character( + diffDeparse(letters, LETTERS, extra=list(width.cutoff=20)) + ), + rdsf(200) + ) [1] TRUE > > proc.time() user system elapsed 1.418 0.142 1.620 diffobj/tests/test-trim.R0000644000176200001440000002243314122754044015101 0ustar liggesusersNAME <- "trim" source(file.path('_helper', 'init.R')) .mx.base <- matrix( c( "averylongwordthatcanlahblah", "causeasinglewidecolumnblah", "matrixtowrapseveraltimes", "inarrowscreen", "onceuponatime", "agreenduckflew", "overthemountains", "inalongofantelopes", "ineedthreemore", "entriesactually", "nowonlytwomore", "iwaswrongearlier" ), nrow=3, ncol=4 ) # - Atomic --------------------------------------------------------------------- set.seed(1) x <- capture.output(1:50) y <- capture.output(factor(sample(letters, 50, replace=TRUE))) all.equal( diffobj:::strip_atomic_rh(x), c(" 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25", "26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50") ) all.equal( diffobj:::strip_atomic_rh(y), c("g j o x f x y r q b f e r j u m s z j u y f q d g k a j w i m p m e v r u c", "s k v q u o n u a m t s", "Levels: a b c d e f g i j k m n o p q r s t u v w x y z") ) all.equal(diffobj:::which_atomic_rh(capture.output(1:5)), 1) all.equal(as.character(diffPrint(1:3, 2:6, trim=FALSE)), rdsf(50)) # bad headers bh <- c("[1] a b c", "[4] d e f", "[5] h") all.equal(diffobj:::which_atomic_rh(bh), integer()) # - Matrix mx1 <- mx2 <- matrix(1:3, 3) all.equal( diffobj:::strip_matrix_rh(capture.output(mx1), dimnames(mx1)), c(" [,1]", " 1", " 2", " 3") ) # shouldn't strip headers from attributes attr(mx2, "blah") <- matrix(1:2, 2) all.equal( diffobj:::strip_matrix_rh(capture.output(mx2), dimnames(mx2)), c(" [,1]", " 1", " 2", " 3", "attr(,\"blah\")", " [,1]", "[1,] 1", "[2,] 2") ) # Matrices that wrap mx3 <- mx4 <- mx5 <- mx6 <- .mx.base old.opt <- options(width=30) all.equal( diffobj:::strip_matrix_rh(capture.output(mx3), dimnames(mx3)), c(" [,1] ", "\"averylongwordthatcanlahblah\"", "\"causeasinglewidecolumnblah\" ", "\"matrixtowrapseveraltimes\" ", " [,2] ", "\"inarrowscreen\" ", "\"onceuponatime\" ", "\"agreenduckflew\"", " [,3] ", "\"overthemountains\" ", "\"inalongofantelopes\"", "\"ineedthreemore\" ", " [,4] ", "\"entriesactually\" ", "\"nowonlytwomore\" ", "\"iwaswrongearlier\"") ) # Add rownames; should no longer strip rownames(mx4) <- 2:4 all.equal( diffobj:::strip_matrix_rh(capture.output(mx4), dimnames(mx4)), capture.output(mx4) ) # Attributes don't have stuff stripped attr(mx6, "blah") <- letters[1:15] all.equal( diffobj:::strip_matrix_rh(capture.output(mx6), dimnames(mx6)), c(" [,1] ", "\"averylongwordthatcanlahblah\"", "\"causeasinglewidecolumnblah\" ", "\"matrixtowrapseveraltimes\" ", " [,2] ", "\"inarrowscreen\" ", "\"onceuponatime\" ", "\"agreenduckflew\"", " [,3] ", "\"overthemountains\" ", "\"inalongofantelopes\"", "\"ineedthreemore\" ", " [,4] ", "\"entriesactually\" ", "\"nowonlytwomore\" ", "\"iwaswrongearlier\"", "attr(,\"blah\")", " [1] \"a\" \"b\" \"c\" \"d\" \"e\" \"f\"", " [7] \"g\" \"h\" \"i\" \"j\" \"k\" \"l\"", "[13] \"m\" \"n\" \"o\"") ) # Single row matrix all.equal( diffobj:::which_matrix_rh(capture.output(matrix(1:2, nrow=1)), NULL), 2 ) options(width=80) # - Table ---------------------------------------------------------------------- old.opt <- options(width=30) # Data frames df1 <- as.data.frame(.mx.base) all.equal( diffobj:::strip_table_rh(capture.output(df1)), c(" V1", "averylongwordthatcanlahblah", " causeasinglewidecolumnblah", " matrixtowrapseveraltimes", " V2", " inarrowscreen", " onceuponatime", "agreenduckflew", " V3", " overthemountains", "inalongofantelopes", " ineedthreemore", " V4", " entriesactually", " nowonlytwomore", "iwaswrongearlier") ) df2 <- df1[c(2, 1, 3), ] all.equal( diffobj:::strip_table_rh(capture.output(df2)), capture.output(df2) ) # Rownames that start from one and sequential, should get stripped; also, # colon allowed df3 <- df1 rownames(df3) <- paste0(1:3, ":") all.equal( diffobj:::strip_table_rh(capture.output(df3)), c(" V1", "averylongwordthatcanlahblah", " causeasinglewidecolumnblah", " matrixtowrapseveraltimes", " V2", " inarrowscreen", " onceuponatime", "agreenduckflew", " V3", " overthemountains", "inalongofantelopes", " ineedthreemore", " V4", " entriesactually", " nowonlytwomore", "iwaswrongearlier") ) # Try ts all.equal( diffobj:::strip_table_rh(capture.output(USAccDeaths)), capture.output(USAccDeaths) ) # Set it so first year is 1 USAD2 <- USAccDeaths tsp(USAD2)[1:2] <- tsp(USAD2)[1:2] - 1972 all.equal( diffobj:::strip_table_rh(capture.output(USAD2)), c(" Jan Feb Mar Apr", " 9007 8106 8928 9137", " 7750 6981 8038 8422", " 8162 7306 8124 7870", " 7717 7461 7767 7925", " 7792 6957 7726 8106", " 7836 6892 7791 8192", " May Jun Jul Aug", "10017 10826 11317 10744", " 8714 9512 10120 9823", " 9387 9556 10093 9620", " 8623 8945 10078 9179", " 8890 9299 10625 9302", " 9115 9434 10484 9827", " Sep Oct Nov Dec", " 9713 9938 9161 8927", " 8743 9129 8710 8680", " 8285 8466 8160 8034", " 8037 8488 7874 8647", " 8314 8850 8265 8796", " 9110 9070 8633 9240") ) # single row data frame all.equal(c(diffobj:::which_table_rh(capture.output(data.frame(1, 2)))), 2) # More than 10 rows data.frame all.equal( c(diffobj:::which_table_rh(capture.output(head(Puromycin, 10L)))), 2:11 ) # Bad wrap bw <- c( " bad", "1 123", "2 456", " dab", "1 123", "2 456", " abd", "1 123") all.equal( diffobj:::wtr_help(bw, diffobj:::.pat.tbl), c(2L, 3L, 5L, 6L) ) # - Array a <- array(1:6, c(3, 1, 2)) a.c <- capture.output(a) all.equal( diffobj:::strip_array_rh(a.c, dimnames(a)), c(", , 1", "", " [,1]", " 1", " 2", " 3", "", ", , 2", "", " [,1]", " 4", " 5", " 6", "") ) viz_sarh <- function(capt, obj) cbind( capt, as.integer( seq_along(capt) %in% diffobj:::which_array_rh(capt, dimnames(obj)) ) ) a1 <- a2 <- a3 <- a4 <- array( "averylongphrasethatwillforcemytwocolumnarraytowrapblahblah", c(2, 2, 2) ) ca1 <- capture.output(a1) viz_sarh(ca1, a1) all.equal( diffobj:::which_array_rh(ca1, dimnames(a1)), c(4L, 5L, 7L, 8L, 13L, 14L, 16L, 17L) ) colnames(a2) <- c("ABC", "DEF") ca2 <- capture.output(a2) viz_sarh(ca2, a2) all.equal( diffobj:::which_array_rh(ca2, dimnames(a2)), c(4L, 5L, 7L, 8L, 13L, 14L, 16L, 17L) ) rownames(a3) <- 1:2 ca3 <- capture.output(a3) viz_sarh(ca3, a3) all.equal(diffobj:::which_array_rh(ca3, dimnames(a3)), integer(0L)) attr(a4, "blahblah") <- matrix(1:4, 2) ca4 <- capture.output(a4) viz_sarh(ca4, a4) all.equal( diffobj:::which_array_rh(ca4, dimnames(a4)), c(4L, 5L, 7L, 8L, 13L, 14L, 16L, 17L) ) options(width=80) # - List ----------------------------------------------------------------------- l1 <- list( matrix(1:4, 2), b=list(abc=c(letters, LETTERS), list(matrix(4:1, 2))) ) l1.c <- capture.output(l1) all.equal( diffobj:::strip_list_rh(l1.c, l1), c("[[1]]", " [,1] [,2]", " 1 3", " 2 4", "", "$b", "$b$abc", "\"a\" \"b\" \"c\" \"d\" \"e\" \"f\" \"g\" \"h\" \"i\" \"j\" \"k\" \"l\" \"m\" \"n\" \"o\" \"p\" \"q\" \"r\" \"s\"", "\"t\" \"u\" \"v\" \"w\" \"x\" \"y\" \"z\" \"A\" \"B\" \"C\" \"D\" \"E\" \"F\" \"G\" \"H\" \"I\" \"J\" \"K\" \"L\"", "\"M\" \"N\" \"O\" \"P\" \"Q\" \"R\" \"S\" \"T\" \"U\" \"V\" \"W\" \"X\" \"Y\" \"Z\"", "", "$b[[2]]", "$b[[2]][[1]]", " [,1] [,2]", " 4 2", " 3 1", "", "", "") ) a <- list(list()) aa <- list(list(), "a") b <- list("a", list()) c <- list(list("a"), "b") d <- list("a", "b", "c") identical( diffobj:::strip_list_rh(capture.output(d), d), c("[[1]]", "\"a\"", "", "[[2]]", "\"b\"", "", "[[3]]", "\"c\"", "") ) identical( diffobj:::strip_list_rh(capture.output(a), a), c("[[1]]", "list()", "") ) identical( diffobj:::strip_list_rh(capture.output(aa), aa), c("[[1]]", "list()", "", "[[2]]", "\"a\"", "") ) identical( diffobj:::strip_list_rh(capture.output(b), b), c("[[1]]", "\"a\"", "", "[[2]]", "list()", "") ) identical( diffobj:::strip_list_rh(capture.output(c), c), c("[[1]]", "[[1]][[1]]", "\"a\"", "", "", "[[2]]", "\"b\"", "") ) # - custom trim fun ------------------------------------------------------------ a <- matrix(100:102) b <- matrix(101:103) fun1 <- function(x, y) cbind(rep(1L, 4), rep(5L, 4)) all.equal(as.character(diffPrint(a, b, trim=fun1)), rdsf(100)) if(getRversion() >= "3.2.2") { capture.output( trim.err <- as.character(diffPrint(a, b, trim=function(x, y) stop("boom"))), type="message" ) # warn: "If you did not specify a `trim`" all.equal(trim.err, rdsf(200)) } # purposefully bad trim fun try( # "method return value must be a two " diffPrint(1:100, 2:100, trim=function(x, y) TRUE) ) try( # "Invalid trim function" diffobj:::apply_trim(letters, letters, function(x) TRUE), ) try(# "must have as many rows" diffobj:::apply_trim( letters, letters, function(x, y) cbind(1:25, 1:25) ) ) # - s4 ------------------------------------------------------------------------- setClass("DOTrimTest", slots=c(a="numeric", b="list", c="matrix")) obj <- new( "DOTrimTest", a=1:40, b=list(a=1, letters, NULL), c=matrix(1:9, 3) ) all.equal( diffobj:::strip_s4_rh(capture.output(obj), obj), rdsf(300) ) diffobj/tests/test-check.Rout.save0000644000176200001440000002047614122754044016675 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "check" > source(file.path('_helper', 'init.R')) > > # - is.less_flags -------------------------------------------------------------- > > isTRUE(diffobj:::is.less_flags("RVXF")) [1] TRUE > isTRUE(diffobj:::is.less_flags("rvxF")) [1] TRUE > identical(diffobj:::is.less_flags(c("rvxF", "RVXF")), FALSE) [1] TRUE > identical(diffobj:::is.less_flags(23), FALSE) [1] TRUE > identical(diffobj:::is.less_flags("rv xF"), FALSE) [1] TRUE > > # - is.int.2L ------------------------------------------------------------------ > > isTRUE(diffobj:::is.int.2L(1:2)) [1] TRUE > isTRUE(diffobj:::is.int.2L(as.numeric(1:2))) [1] TRUE > identical(diffobj:::is.int.2L(c(1.3, 2.2)), FALSE) [1] TRUE > identical(diffobj:::is.int.2L(1:3), FALSE) [1] TRUE > identical(diffobj:::is.int.2L(c(1, NA)), FALSE) [1] TRUE > > # - arg.funs ------------------------------------------------------------------- > > isTRUE(diffobj:::is.one.arg.fun(function(x) NULL)) [1] TRUE > isTRUE(diffobj:::is.one.arg.fun(function(x, y=5) NULL)) [1] TRUE > > diffobj:::is.one.arg.fun(function(..., x) NULL) # "cannot have `...` as " [1] "cannot have `...` as the first argument" > diffobj:::is.one.arg.fun(NULL) # "is not a fun" [1] "is not a function" > diffobj:::is.one.arg.fun(function() NULL) # "have at least" [1] "does not have at least one arguments" > diffobj:::is.one.arg.fun(function(x, y) NULL) # "cannot have any" [1] "cannot have any non-optional arguments other than first one" > > isTRUE(diffobj:::is.two.arg.fun(function(x, y) NULL)) [1] TRUE > isTRUE(diffobj:::is.two.arg.fun(function(x, y=5) NULL)) [1] TRUE > > diffobj:::is.two.arg.fun(function(x, ..., y) NULL) # "cannot have `...` as " [1] "cannot have `...` as one of the first two arguments" > diffobj:::is.two.arg.fun(NULL) # "is not a fun" [1] "is not a function" > diffobj:::is.two.arg.fun(function(x) NULL) # "have at least") [1] "does not have at least two arguments" > diffobj:::is.two.arg.fun(function(x, y, z) NULL) # "cannot have any" [1] "cannot have any non-optional arguments other than first two" > > # - valid_object --------------------------------------------------------------- > > s.h <- StyleHtml() > s.h@wrap <- TRUE > try(diffobj:::valid_object(s.h, "style", stop)) #an invalid `StyleHtml` object Error in diffobj:::valid_object(s.h, "style", stop) : Argument `style` is an invalid `StyleHtml` object because: - slot `wrap` must be FALSE for `styleHtml` objects. > > pal <- PaletteOfStyles() > pal["html", "light", "yb"] <- list(s.h) > try(# "`palette.of.styles` is an invalid" + diffChr( + "A", "B", palette.of.styles=pal, style="auto", format="html", + brightness="light", color.mode="yb" + ) + ) Error in diffChr(target = "A", current = "B", palette.of.styles = pal, : Argument `palette.of.styles` is an invalid `StyleHtml` because it contains and invalid `Style` object: - slot `wrap` must be FALSE for `styleHtml` objects. > # - brightness ----------------------------------------------------------------- > > try(diffPrint(1:3, 3:6, brightness=NA)) # "must be character" Error in diffPrint(target = 1:3, current = 3:6, brightness = NA) : Argument `brightness` must be character and not contain NAs > try(diffPrint(1:3, 3:6, brightness="red")) # "may only contain values" Error in diffPrint(target = 1:3, current = 3:6, brightness = "red") : Argument `brightness` may only contain values in `c("neutral", "light", "dark")` > try(diffPrint(1:3, 3:6, brightness=c(raw='light'))) # "one empty name" Error in diffPrint(target = 1:3, current = 3:6, brightness = c(raw = "light")) : Argument `brightness` must include at least one empty name `""` if it has names. > try(diffPrint(1:3, 3:6, brightness=c('light', 'dark'))) # have names Error in diffPrint(target = 1:3, current = 3:6, brightness = c("light", : Argument `brightness` must have names if it has length > 1, and those names must include at least an empty name `""` as well as names only from `c("raw", "ansi8", "ansi256", "html")`. > > # - misc ----------------------------------------------------------------------- > > diffobj:::is.one.file.name(1) # "must be character" [1] "must be character(1L) and not NA" > try(diffPrint(1:3, 2:6, extra="hello")) # "must be a list" Error in diffPrint(target = 1:3, current = 2:6, extra = "hello") : Argument `extra` must be a list. > try(diffPrint(1:3, 2:6, context=TRUE)) # "Argument `context` must" Error in diffPrint(target = 1:3, current = 2:6, context = TRUE) : Argument `context` must be integer(1L) and not NA, an object produced by `auto_context`, or "auto". > try(diffPrint(1:3, 2:6, mode=1)) # "must be character" Error in diffPrint(target = 1:3, current = 2:6, mode = 1) : Argument `mode` must be character(1L) and in `c("auto", "unified", "context", "sidebyside")`. > try(diffPrint(1:3, 2:6, tab.stops=-1)) # "strictly positive" Error in diffPrint(target = 1:3, current = 2:6, tab.stops = -1) : Argument `tab.stops` must be integer containing at least one value and with all values strictly positive > try(diffPrint(1:3, 2:6, hunk.limit='hello')) # "integer vector" Error in diffPrint(target = 1:3, current = 2:6, hunk.limit = "hello") : Argument `hunk.limit` must be an integer vector of length 1 or 2 and if length 2, with the first value larger than or equal to the second. > try(diffPrint(1:3, 2:6, guides='hello')) # "or a function" Error in diffPrint(target = 1:3, current = 2:6, guides = "hello") : Argument `guides` must be TRUE, FALSE, or a function > try(diffPrint(1:3, 2:6, guides=function(x, y, z) NULL))# "cannot have any non" Error in diffPrint(target = 1:3, current = 2:6, guides = function(x, y, : Argument `guides` cannot have any non-optional arguments other than first two > try(diffPrint(1:3, 2:6, trim='hello')) # "TRUE, FALSE, or a function" Error in diffPrint(target = 1:3, current = 2:6, trim = "hello") : Argument `trim` must be TRUE, FALSE, or a function > try(diffPrint(1:3, 2:6, trim=function(x, y, z) NULL)) # "cannot have any non" Error in diffPrint(target = 1:3, current = 2:6, trim = function(x, y, : Argument `trim` cannot have any non-optional arguments other than first two > try(diffPrint(1:3, 2:6, interactive='hello')) # "must be TRUE or" Error in diffPrint(target = 1:3, current = 2:6, interactive = "hello") : Argument `interactive` must be TRUE or FALSE. > try(diffPrint(1:3, 2:6, max.diffs=1:10)) # "must be integer" Error in diffPrint(target = 1:3, current = 2:6, max.diffs = 1:10) : Argument `max.diffs` must be integer(1L) and not NA. > try(diffPrint(1:3, 2:6, tar.banner=1:10)) # "must be atomic" Error in diffPrint(target = 1:3, current = 2:6, tar.banner = 1:10) : Argument `tar.banner` must be atomic and length(1L), NULL, a symbol, or a call > try(diffPrint(1:3, 2:6, style=1:10)) # "must be \"auto\", a" Error in diffPrint(target = 1:3, current = 2:6, style = 1:10) : Argument `style` must be "auto", a `Style` object, or a list. > try(diffPrint(1:3, 2:6, pager=1:10)) # "must be one of" Error in diffPrint(target = 1:3, current = 2:6, pager = 1:10) : Argument `pager` must be one of `c("auto", "off", "on")`, a `Pager` object, or a list. > try(diffPrint(1:3, 2:6, format=1:10)) # "must be character" Error in diffPrint(target = 1:3, current = 2:6, format = 1:10) : Argument `format` must be character(1L) and not NA > try(diffPrint(1:3, 2:6, palette.of.styles=1:10)) # "must be a `PaletteOfStyles`" Error in diffPrint(target = 1:3, current = 2:6, palette.of.styles = 1:10) : Argument `palette.of.styles` must be a `PaletteOfStyles` object. > try(diffChr(letters, LETTERS, context=NA)) # "must be integer" Error in diffChr(target = letters, current = LETTERS, context = NA) : Argument `context` must be integer(1L) and not NA, an object produced by `auto_context`, or "auto". > > > > proc.time() user system elapsed 1.280 0.121 1.399 diffobj/tests/test-core.R0000644000176200001440000001076114122754044015057 0ustar liggesusersNAME <- "core" source(file.path('_helper', 'init.R')) # The Myers paper strings A <- c("a", "b", "c", "a", "b", "b", "a") B <- c("c", "b", "a", "b", "a", "c") # - diff myers simple ---------------------------------------------------------- identical( diffobj:::myers_simple(character(), character()), list(target = integer(0), current = integer(0)) ) identical( diffobj:::myers_simple("a", character()), list(target = NA_integer_, current = integer(0)) ) identical( diffobj:::myers_simple(character(), "a"), list(target = integer(0), current = NA_integer_) ) identical( diffobj:::myers_simple("a", "a"), list(target = 0L, current = 0L) ) identical( diffobj:::myers_simple("a", "b"), list(target = 1L, current = 1L) ) identical( diffobj:::myers_simple(c("a", "b"), "b"), list(target = c(NA, 0L), current = 0L) ) identical( diffobj:::myers_simple(c("a", "b"), "a"), list(target = c(0L, NA), current = 0L) ) identical( diffobj:::myers_simple("a", c("a", "b")), list(target = 0L, current = c(0L, NA)) ) identical( diffobj:::myers_simple("b", c("a", "b")), list(target = 0L, current = c(NA, 0L)) ) identical( diffobj:::myers_simple(c("a", "b"), c("b", "c")), list(target = c(NA, 0L), current = c(0L, NA)) ) identical( diffobj:::myers_simple(c("a", "b", "c", "d"), c("a", "c", "d", "b")), list(target = c(0L, NA, 0L, 0L), current = c(0L, 0L, 0L, NA)) ) # Actual Myers sample string identical( diffobj:::myers_simple(A, B), list(target = c(NA, NA, 0L, 0L, 0L, NA, 0L), current = c(0L, NA, 0L, 0L, 0L, NA)) ) # - diff myers mba ------------------------------------------------------------- identical(ses(character(), character()), character()) identical(ses("a", character()), "1d0") identical(ses(character(), "a"), "0a1") identical(ses("a", "a"), character()) identical(ses("a", "b"), "1c1") identical(ses(c("a", "b"), "b"), "1d0") identical(ses(c("a", "b"), "a"), "2d1") identical(ses("a", c("a", "b")), "1a2") identical(ses("b", c("a", "b")), "0a1") identical(ses(c("a", "b"), c("b", "c")), c("1d0", "2a2")) identical( ses(c("a", "b", "c", "d"), c("a", "c", "d", "b")), c("2d1", "4a4") ) # Actual Myers sample string identical(ses(A, B), c("1,2d0", "4d1", "5a3", "7a6")) # This used to cause errors due to under-allocated buffer vector identical(ses(letters[1:10], LETTERS[1:2]), "1,10c1,2") # A little more complex with changes, this was a problem at some point A2 <- c("A", "B", "C") B2 <- c("X", "A", "Y", "C") identical(ses(A2, B2), c("0a1", "2c3")) # More complicated strings; intended for use with contexts for hunks, # but making sure the diffs are correct A1 <- c("A", "AA", "B", "C", "D", "E", "F", "G", "H") B1 <- c("A", "B", "X", "W", "D", "DD", "E", "Y", "Z") C1 <- c("X", "D", "E", "Y", "Z", "H") identical(ses(A1, B1), c("2d1", "4c3,4", "5a6", "7,9c8,9")) identical(ses(A1, C1), c("1,4c1", "7,8c4,5")) A5 <- c("A", "AA", "B", "C", "D", "E", "F", "G", "H") B5 <- c("A", "B", "X", "W", "D", "E", "F", "W", "G") identical(ses(A5, B5), c("2d1", "4c3,4", "7a8", "9d9")) # NAs treated as strings identical(ses(c(NA, "a", "b"), c("a", "b", NA)), c("1d0", "3a3")) # Coersion to character identical(ses(1:5, 4:6), c("1,3d0", "5a3")) # - print/summary -------------------------------------------------------------- capture.output( res.1 <- summary(diffobj:::diff_myers(A, B), with.match=TRUE) ) identical( res.1, structure(list(type = structure(c(3L, 1L, 3L, 1L, 2L, 1L, 2L), .Label = c("Match", "Insert", "Delete"), class = "factor"), string = c("ab", "c", "a", "b", "a", "ba", "c"), len = c(2L, 1L, 1L, 1L, 1L, 2L, 1L ), offset = c(1L, 3L, 4L, 5L, 3L, 6L, 6L)), class = "data.frame", row.names = c(NA, -7L)) ) capture.output( res.2 <- summary(diffobj:::diff_myers(A, B), with.match=FALSE) ) identical( res.2, structure(list(type = structure(c(3L, 1L, 3L, 1L, 2L, 1L, 2L), .Label = c("Match", "Insert", "Delete"), class = "factor"), len = c(2L, 1L, 1L, 1L, 1L, 2L, 1L), offset = c(1L, 3L, 4L, 5L, 3L, 6L, 6L)), .Names = c("type", "len", "offset"), row.names = c(NA, -7L), class = "data.frame") ) identical( capture.output(print(diffobj:::diff_myers(A, B))), ses(A, B) ) # # - translate # aa <- c("a", "b", "b", "c", "e") # bb <- c("x", "y", "c", "f", "e") # identical( # diffobj:::diffObjCompact(diffobj:::diff_myers(A, B)), # list(target = c(NA, NA, 0L, NA, 0L, 0L, 0L), current = c(0L, 0L, NA, 0L, 0L, NA)) # ) # identical( # diffobj:::diffObjCompact(diffobj:::diff_myers(aa, bb)), # list(target = c(1L, 2L, NA, 0L, 0L), current = c(1L, 2L, 0L, NA, 0L)) # ) # # } ) diffobj/tests/test-subset.R0000644000176200001440000000207614122754044015434 0ustar liggesusersNAME <- "subset" source(file.path('_helper', 'init.R')) A <- B <- letters[1:5] B[2] <- "B" B[6] <- "F" # - subset --------------------------------------------------------------------- local({ old.opt <- options(diffobj.style=StyleRaw()) on.exit(options(old.opt)) a0 <- all.equal( c(as.character(diffChr(A, B)[1:3])), c("< A > B ", "@@ 1,5 @@ @@ 1,6 @@ ", " a a ") ) a <- all.equal( c(as.character(diffChr(A, B)[1])), c(as.character(head(diffChr(A, B), 1))) ) b <- all.equal( c(as.character(diffChr(A, B)[7:8])), c(as.character(tail(diffChr(A, B), 2))) ) c(a0, a, b) }) # - subset errors -------------------------------------------------------------- diff <- diffChr(A, B) try(diff[NA_real_]) # "contain NAs or both positive" try(diff[c(-1, 1)]) # "contain NAs or both positive" try(head(diff, 1, 2)) # "does not support arguments" try(head(diff, NA)) # "must be integer" try(head(diff, 1:3)) # "must be integer" try(tail(diff, 1:3)) # "must be integer" try(tail(diff, 1, 2)) # "does not support arguments" diffobj/tests/test-style.Rout.save0000644000176200001440000001417514122754044016757 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "style" > source(file.path('_helper', 'init.R')) > > ## - Style Palette ------------------------------------------------------------ > > all.equal( + capture.output(diffobj:::display_ansi_256_styles()), + rdsf(100) + ) [1] TRUE > ## - crayon settings ----------------------------------------------------------- > > # make sure crayon options are appropriately overriden > local({ + old.opt <- options(crayon.enabled=FALSE) + on.exit(options(old.opt)) + print(identical(crayon::green("green"), "green")) + # should have ANSI coloring despite crayon disabled + print( + all.equal( + as.character(diffChr(letters[1:3], LETTERS[1:3])), rdsf(200) + ) + ) + identical(crayon::green("green"), "green") + }) [1] TRUE [1] TRUE [1] TRUE > ## - Palette of Styles --------------------------------------------------------- > > pos <- PaletteOfStyles() > identical( + pos[["ansi256", "light", "rgb"]], + getClassDef("StyleAnsi256LightRgb", package="diffobj", inherits=FALSE) + ) [1] TRUE > all.equal( + capture.output(show(pos)), rdsf(300) + ) [1] TRUE > all.equal( + capture.output(summary(pos)), rdsf(400) + ) [1] TRUE > > pos["ansi256", "light", "yb"] <- list(StyleRaw()) > all.equal( + c(pos["ansi256", "light", "yb"]@data), list(StyleRaw()), + check.environment=FALSE + ) [1] TRUE > all.equal( + pos[["ansi256", "light", "yb"]], StyleRaw(), + check.environment=FALSE + ) [1] TRUE > > ## - Auto Styles --------------------------------------------------------------- > > try(diffChr(letters, LETTERS, style="auto", format="xml")) Error in diffChr(target = letters, current = LETTERS, style = "auto", : Argument `format` must be one of `c("auto", "raw", "ansi8", "ansi256", "html")`. > is( + diffChr( + letters, LETTERS, style="auto", format="auto", brightness="light", + term.colors=256 + )@etc@style, + "StyleAnsi256LightYb" + ) [1] TRUE > is( + diffChr( + letters, LETTERS, style="auto", format="auto", brightness="light", + term.colors=8 + )@etc@style, + "StyleAnsi8NeutralYb" + ) [1] TRUE > is( + diffChr( + letters, LETTERS, style="auto", format="auto", interactive=FALSE, + term.colors=1 + )@etc@style, + "StyleRaw" + ) [1] TRUE > is( + diffChr( + letters, LETTERS, style="auto", format="auto", interactive=TRUE, + term.colors=1 # note pager off by default in tests + )@etc@style, + "StyleRaw" + ) [1] TRUE > is( + diffChr( + letters, LETTERS, style="auto", format="auto", interactive=TRUE, + pager="auto", term.colors=1 + )@etc@style, + "StyleHtml" + ) [1] TRUE > is( + diffChr( + letters, LETTERS, style="auto", format="auto", interactive=TRUE, + pager="auto", term.colors=9 + )@etc@style, + "StyleAnsi8NeutralYb" + ) [1] TRUE > is( + diffChr( + letters, LETTERS, style="auto", format="auto", interactive=TRUE, + pager="auto", brightness='light', term.colors=500 + )@etc@style, + "StyleAnsi256LightYb" + ) [1] TRUE > is( + diffChr( + letters, LETTERS, style="auto", format="html", interactive=TRUE, + pager="auto", color.mode=c("rgb", ansi8="yb") + )@etc@style, + "StyleHtmlLightRgb" + ) [1] TRUE > is( + diffChr( + letters, LETTERS, style="auto", format="html", interactive=TRUE, + pager="auto", color.mode=c("rgb", html="yb") + )@etc@style, + "StyleHtmlLightYb" + ) [1] TRUE > ## - Palette Params ------------------------------------------------------------ > > all.equal( + as.character( + diffChr( + letters, LETTERS, style="auto", format="ansi256", + brightness=c("light", ansi256="dark") + ) ), + rdsf(500) + ) [1] TRUE > all.equal( + as.character( + diffChr( + letters, LETTERS, style="auto", format="ansi256", brightness=c("dark") + ) ), + rdsf(500) + ) [1] TRUE > ## - Style Validation ---------------------------------------------------------- > > s.f <- StyleFuns() > isTRUE(validObject(s.f)) [1] TRUE > s.f@word.insert <- function(x, y) NULL > try(validObject(s.f)) # word.insert Error in validObject(s.f) : invalid class "StyleFuns" object: Argument `word.insert` may not have non-default formals argument after the first. > > try(diffChr(1,2, format='html', style=list(scale=1:3))) Error in diffChr(target = 1, current = 2, format = "html", style = list(scale = 1:3)) : Unable to instantiate `Style` object: Argument `scale` must be TRUE or FALSE > try(diffChr(1,2, format='html', style=list(html.output="a"))) Error in diffChr(target = 1, current = 2, format = "html", style = list(html.output = "a")) : Unable to instantiate `Style` object: Argument `html.output` must be in `c("auto", "page", "diff.only", "diff.w.style")`. > > ## - Pallette w/ Objs ---------------------------------------------------------- > > pal <- PaletteOfStyles() > pal["raw", "neutral", "rgb"] <- list(new(pal[["raw", "neutral", "rgb"]])) > > suppressWarnings( + withCallingHandlers( + invisible(diffChr( + letters, LETTERS, format="raw", brightness="neutral", color.mode="rgb", + palette.of.styles=pal, style=list(na.sub="NA") + )), + warning=function(e) writeLines(conditionMessage(e)) + ) + ) Extra `style` arguments cannot be applied because selected object `palette.of.styles` is a `Style` instance rather than a `Style` "classRepresentation". See documentation for the `style` parameter for details. > ## - External Files ------------------------------------------------------------ > > isTRUE(file_test("-f", diffobj_css())) [1] TRUE > isTRUE(file_test("-f", diffobj_js())) [1] TRUE > > proc.time() user system elapsed 3.692 0.414 4.303 diffobj/tests/test-atomic.R0000644000176200001440000001156414122754044015405 0ustar liggesusersNAME <- "atomic" source(file.path('_helper', 'init.R')) # - Basic Tests all.equal(as.character(diffPrint(chr.1, chr.2)), rdsf(100)) all.equal( as.character(diffPrint(chr.1, chr.2, mode="unified")), rdsf(200) ) all.equal( as.character(diffPrint(chr.1, chr.2, mode="context")), rdsf(400) ) all.equal( as.character(diffPrint(chr.1[2:3], chr.2[2], mode="sidebyside")), rdsf(500) ) # Check that `extra` works all.equal( as.character( diffPrint(chr.1, chr.2, mode="unified", extra=list(quote=FALSE)) ), rdsf(600) ) # make sure blanks line up correctly all.equal( as.character(diffPrint(chr.3, chr.4)), rdsf(700) ) all.equal( as.character(diffPrint(chr.3, chr.4, mode="unified")), rdsf(800) ) # - Word wrap in atomic A <- A.1 <- B <- c(letters, LETTERS) B[15] <- "Alabama" A.1[5] <- "Ee" C <- A[-15] D <- C E <- B[-45] # Test simple changes to vectors; at 80 columns removing 1:8 corresponds to # row deletion all.equal(as.character(diffPrint(A[-(1:8)], A)), rdsf(900)) all.equal(as.character(diffPrint(A, A[-(1:8)])), rdsf(1000)) all.equal(as.character(diffPrint(A[-1], A[-2])), rdsf(1100)) # Replace single word all.equal(as.character(diffPrint(A, B)), rdsf(1200)) all.equal(as.character(diffPrint(B, A)), rdsf(1250)) # Make sure turning off word.diff also turns of unwrapping, but that we can # turn off unwrapping without turning off word diff all.equal( as.character(diffPrint(A, B, word.diff=FALSE)), rdsf(1300) ) all.equal( as.character(diffPrint(A, B, unwrap.atomic=FALSE)), rdsf(1400) ) # Different wrap frequency and removed words that span lines all.equal( as.character(diffPrint(A, A.1[-(13:18)])), rdsf(1425) ) # Removing words all.equal(as.character(diffPrint(C, B)), rdsf(1450)) # Two hunks all.equal(as.character(diffPrint(D, E)), rdsf(1500)) all.equal(as.character(diffPrint(E, D)), rdsf(1600)) # Vignette example state.abb.2 <- state.abb state.abb.2[38] <- "Pennsylvania" all.equal( as.character(diffPrint(state.abb, state.abb.2)), rdsf(1700) ) # Number corner cases all.equal(as.character(diffPrint(1:100, 2:101)), rdsf(1800)) all.equal(as.character(diffPrint(2:101, 1:100)), rdsf(1900)) all.equal( as.character(diffPrint(2:101, (1:100)[-9])), rdsf(2000) ) all.equal( as.character(diffPrint((2:101)[-98], (1:100)[-9])), rdsf(2100) ) # This is one of those that a better in-hunk align algorithm would benefit int.1 <- int.2 <- 1:100 int.2[c(8, 20, 60)] <- 99 int.2 <- c(50:1, int.2) all.equal(as.character(diffPrint(int.1, int.2)), rdsf(2200)) # - with names rand.chrs <- do.call(paste0, expand.grid(LETTERS, LETTERS)) F <- F1 <- F2 <- (2:105)[-98] G <- G2 <- G3 <- G4 <- G5 <- (1:100)[-9] nm.1 <- rand.chrs[seq_along(F)] nm.2 <- rand.chrs[seq_along(G)] names(F1) <- names(F2) <- nm.1 names(G3) <- names(G2) <- names(G3) <- names(G4) <- names(G5) <- nm.2 names(G3)[c(5, 25, 60)] <- c("XXXXX", rand.chrs[c(300, 350)]) names(G4)[c(5, 25, 60)] <- names(G5)[c(5, 25, 60)] <- c("XX", rand.chrs[c(300, 350)]) attr(F2, "blah") <- 1:5 attr(G5, "blah") <- 3:8 all.equal(as.character(diffPrint(F, G)), rdsf(2300)) all.equal(as.character(diffPrint(F1, G2)), rdsf(2400)) # Challenging case b/c the names wrap with values, and you have to pick one or # the other to match when the wrap frequencies are different all.equal(as.character(diffPrint(F1, G3)), rdsf(2500)) all.equal(as.character(diffPrint(F1, G4)), rdsf(2520)) # Attributes all.equal(as.character(diffPrint(F2, G5)), rdsf(2530)) all.equal(as.character(diffPrint(F1, G5)), rdsf(2540)) # - Original tests set.seed(2) w1 <- sample( c( "carrot", "cat", "cake", "eat", "rabbit", "holes", "the", "a", "pasta", "boom", "noon", "sky", "hat", "blah", "paris", "dog", "snake" ), 25, replace=TRUE ) w4 <- w3 <- w2 <- w1 w2[sample(seq_along(w1), 5)] <- LETTERS[1:5] w3 <- w1[8:15] w4 <- c(w1[1:5], toupper(w1[1:5]), w1[6:15], toupper(w1[1:5])) all.equal(as.character(diffPrint(w1, w2)), rdsf(2600)) all.equal(as.character(diffPrint(w1, w3)), rdsf(2700)) all.equal(as.character(diffPrint(w1, w4)), rdsf(2800)) # - Simple word diffs a <- c("a", "b", "c", "d") b <- c("b", "c", "d", "e") all.equal(as.character(diffPrint(a, b)), rdsf(2900)) a <- c("x", "a", "b", "c", "d", "z") b <- c("x", "b", "c", "d", "e", "z") all.equal(as.character(diffPrint(a, b)), rdsf(3000)) a <- c("x", "a", "b", "c", "d", "z") b <- c("z", "b", "c", "d", "e", "x") all.equal(as.character(diffPrint(a, b)), rdsf(3100)) # - Alignment edge cases all.equal( as.character(diffPrint(20:50, 30:62)), rdsf(3200) ) # below is off; should be aligning matching context line, part of the problem # might be that we're doing the realignment without thinking about what the # other hunk has. # # Possible encode each line as hunk#:diff/mix/cont # all.equal( # as.character(diffPrint(20:50, 35:62)), rdsf(3300) # ) # another interesting example where the existing algo seems to lead to a # reasonable outcome all.equal( as.character(diffPrint(c(1:24,35:45), c(1:8, 17:45))), rdsf(3400) ) diffobj/tests/test-diffStr.Rout.save0000644000176200001440000001077414122754044017221 0ustar liggesusers R version 4.0.4 beta (2021-02-06 r79953) -- "Lost Library Book" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "diffStr" > source(file.path('_helper', 'init.R')) > > # - lm models ------------------------------------------------------------------ > > # formula display changed > if( + R.Version()$major >= 3 && R.Version()$minor >= "3.1" || R.Version()$major > 3 + ) + all.equal(as.character(diffStr(mdl1, mdl2)), rdsf(100)) [1] TRUE > > # Too strict a line limit, can't get under > all.equal( + as.character(diffStr(mdl1[7], mdl2[7], line.limit=10)), rdsf(200) + ) [1] TRUE > # Now we can get under > all.equal( + as.character(diffStr(mdl1[7], mdl2[7], line.limit=15)), rdsf(300) + ) [1] TRUE > > # - Simple structure ----------------------------------------------------------- > # > # Character types > > all.equal(as.character(diffStr(iris.c, iris.s)), rdsf(400)) [1] TRUE > > # - Strict width --------------------------------------------------------------- > # formula display changed > if( + R.Version()$major >= 3 && R.Version()$minor >= "3.1" || R.Version()$major > 3 + ) { + c( + all.equal( + as.character( + diffStr(mdl1, mdl2, extra=list(strict.width="wrap"), line.limit=30) + ), + rdsf(500) + ), + all.equal( + as.character( + diffStr(mdl1, mdl2, extra=list(strict.width="cut"), line.limit=30) + ), + rdsf(550) + ) ) + } [1] TRUE TRUE > # - max.diffs ------------------------------------------------------------------ > > invisible(diffStr(iris, mtcars, max.diffs=2)) # warn: "Exceeded diff limit" Warning message: Exceeded diff limit during diff computation (18 vs. 2 allowed); overall diff is likely not optimal > > # - max.level ------------------------------------------------------------------ > > all.equal( + as.character(diffStr(mdl1[7], mdl2[7], extra=list(max.level="auto"))), + rdsf(600) + ) [1] TRUE > all.equal( + as.character(diffStr(mdl1[7], mdl2[7], extra=list(max.level=2))), + rdsf(700) + ) [1] TRUE > # Has a difference, but can't get under; the second is just for reference > > lst.1 <- lst.2 <- lst.3 <- list(a=list(b=list(c=list(d=list(e=list(25)))))) > names(lst.2) <- "A" > > all.equal( + as.character(diffStr(lst.1, lst.2, line.limit=2)), rdsf(800) + ) [1] TRUE > all.equal( + as.character(diffStr(lst.1, lst.2, line.limit=2)), rdsf(900) + ) [1] TRUE > # Test that initial run shows difference, but too big, but next one down > # doesn't so have to increase level > > names(lst.3$a$b$c$d) <- "E" > all.equal( + as.character(diffStr(lst.1, lst.3, line.limit=6)), rdsf(1000) + ) [1] TRUE > > # - No visible differences ----------------------------------------------------- > > all.equal( + as.character(diffStr(1:100, c(1:99, 101L))), rdsf(1100) + ) [1] TRUE > > # - Quoted Objects ------------------------------------------------------------- > > all.equal( + as.character(diffStr(quote(zz + 1), quote(zz + 3))), + structure( + c("\033[33m<\033[39m \033[33mstr(quote(zz +..\033[39m \033[34m>\033[39m \033[34mstr(quote(zz +..\033[39m", "\033[36m@@ 1 @@ \033[39m \033[36m@@ 1 @@ \033[39m", "\033[33m<\033[39m \033[90m\033[39m language zz + \033[33m1\033[39m\033[90m\033[39m \033[34m>\033[39m \033[90m\033[39m language zz + \033[34m3\033[39m\033[90m\033[39m" + ), len = 3L + ) ) [1] TRUE > > all.equal( + as.character(diffStr(quote(x), quote(y))), + structure(c("\033[33m<\033[39m \033[33mstr(quo..\033[39m \033[34m>\033[39m \033[34mstr(quo..\033[39m", "\033[36m@@ 1 @@ \033[39m \033[36m@@ 1 @@ \033[39m", "\033[33m<\033[39m \033[90m\033[39m symbol \033[33mx\033[39m\033[90m\033[39m \033[34m>\033[39m \033[90m\033[39m symbol \033[34my\033[39m\033[90m\033[39m"), len = 3L) + ) [1] TRUE > > # - Spaces with punctuation ---------------------------------------------------- > > all.equal( + capture.output(show(diffStr(list(a=1), list(a=1, cabera=3), format='raw'))), + txtf(100) + ) [1] TRUE > > > proc.time() user system elapsed 2.434 0.219 2.702 diffobj/tests/test-diffDeparse.R0000644000176200001440000000066714122754044016347 0ustar liggesusersNAME <- "diffDeparse" source(file.path('_helper', 'init.R')) # - deparse -------------------------------------------------------------------- # First one will be done in unified mode since `deparse` disregards # option(width=), second will be done side by side all.equal(as.character(diffDeparse(letters, LETTERS)), rdsf(100)) all.equal( as.character( diffDeparse(letters, LETTERS, extra=list(width.cutoff=20)) ), rdsf(200) ) diffobj/tests/test-scaling.R0000644000176200001440000000313314122754044015542 0ustar liggesusersNAME <- "scaling" source(file.path('_helper', 'init.R')) # These tests are not actually run since they require manual intervention to # check for browser rendering # These tests should be run on as many browsers as possible as well as in # RStudio, and consist of running the code and resizing the windows to see # what happens if(FALSE) { # prevent running # Text should be allowed to unfurl beyond native width diffStr(mdl1, mdl2, format="html") diffStr(mdl1, mdl2, format="html", style=list(scale=FALSE)) diffPrint(c(mdl1), c(mdl2), format="html") # Revealed problems with pixel rounding in scaling diffPrint(letters[1:6], LETTERS[1:6], format="html") diffPrint(letters[1:6], LETTERS[1:6], format="html", style=list(scale=FALSE)) # Revealed problems with gutter width computations; and scaling mx.2 <- matrix(1:100, ncol=4) mx.4 <- mx.3 <- mx.2 mx.3[15, 2] <- 111L mx.3a <- mx.3[-5, ] diffPrint(mx.2, mx.3a, format="html") # summary stuff summary(diffPrint(letters, LETTERS, format="html")) summary(diffStr(mdl1, mdl2, format="html")) summary(diffPrint(c(mdl1), c(mdl2), format="html")) # Long banners diffPrint( 1:20 + 100 + 100 + 100 + 100 + 100 + 100 + 100, 2:20 + 100 + 100 + 100 + 100 + 100 + 100 + 100, format="html", style=list(scale=FALSE) ) diffPrint( 1:20 + 100 + 100 + 100 + 100 + 100 + 100 + 100, 2:20 + 100 + 100 + 100 + 100 + 100 + 100 + 100, format="html" ) # context diffPrint( 1:20 + 100 + 100 + 100 + 100 + 100 + 100 + 100, 2:20 + 100 + 100 + 100 + 100 + 100 + 100 + 100, format="html", mode="context" ) } diffobj/tests/test-limit.Rout.save0000644000176200001440000000726114122754044016733 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "limit" > source(file.path('_helper', 'init.R')) > > # - Simple limit --------------------------------------------------------------- > > A <- B <- letters[1:5] > B[2] <- "B" > B[6] <- "F" > # diffChr(A, B) > all.equal(as.character(diffChr(A, B, line.limit=2)), rdsf(100)) [1] TRUE > all.equal(as.character(diffChr(A, B, line.limit=3)), rdsf(200)) [1] TRUE > > # - More Extensive Limits ------------------------------------------------------ > > Puromycin2 <- Puromycin > set.seed(1) > Puromycin2$conc[c(8, 15:19, 22)] <- round(runif(7), 2) > Puromycin2$state[17] <- "treated" > > all.equal( + as.character( + diffPrint(Puromycin, Puromycin2, line.limit=15, mode="sidebyside") + ), + rdsf(300) + ) [1] TRUE > > # # Not working right > # diffPrint(Puromycin, Puromycin2, line.limit=15, mode="context") > all.equal( + as.character( + diffPrint(Puromycin, Puromycin2, line.limit=15, mode="unified") + ), + rdsf(500) + ) [1] TRUE > > all.equal( + as.character( + diffPrint(Puromycin, Puromycin2, line.limit=5, mode="sidebyside") + ), + rdsf(600) + ) [1] TRUE > all.equal( + as.character( + diffPrint(Puromycin, Puromycin2, line.limit=5, mode="context") + ), + rdsf(700) + ) [1] TRUE > all.equal( + as.character( + diffPrint(Puromycin, Puromycin2, line.limit=5, mode="unified") + ), + rdsf(800) + ) [1] TRUE > > Puromycin3 <- Puromycin2 > names(Puromycin3)[3L] <- "blargh" > all.equal( + as.character( + diffPrint(Puromycin, Puromycin3, line.limit=7, mode="sidebyside") + ), + rdsf(900) + ) [1] TRUE > all.equal( + as.character( + diffPrint(Puromycin, Puromycin3, line.limit=6, mode="context") + ), + rdsf(1000) + ) [1] TRUE > # - Dual limit values ---------------------------------------------------------- > > A <- letters[1:10] > B <- LETTERS[1:10] > all.equal( + as.character(diffChr(A, B, line.limit=c(10, 3))), rdsf(1100) + ) [1] TRUE > all.equal( + as.character(diffChr(A, B, line.limit=c(13, 3))), rdsf(1200) + ) [1] TRUE > try(diffChr(A, B, line.limit=c(3, 13))) # "larger than or" Error in diffChr(target = A, current = B, line.limit = c(3, 13)) : Argument `line.limit` must be an integer vector of length 1 or 2 and if length 2, with the first value larger than or equal to the second, or "auto" or the result of calling `auto_line_limit` > > # - Cause errors --------------------------------------------------------------- > > try(diffChr(letters, LETTERS, line.limit=1:3)) # "vector of length" Error in diffChr(target = letters, current = LETTERS, line.limit = 1:3) : Argument `line.limit` must be an integer vector of length 1 or 2 and if length 2, with the first value larger than or equal to the second, or "auto" or the result of calling `auto_line_limit` > > # - Vanishing header ----------------------------------------------------------- > > # issue 64 > all.equal( + as.character( + diffChr( + letters, letters[-13], context=auto_context(0, 10), line.limit=1L, + pager="off" + ) ), + rdsf(1300) + ) [1] TRUE > > > proc.time() user system elapsed 2.005 0.211 2.256 diffobj/tests/test-pager.Rout.save0000644000176200001440000003420314122754044016707 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "pager" > source(file.path('_helper', 'init.R')) > source(file.path('_helper', 'tools.R')) > > # void pager, doesn't do anything, just to test side effect of writing to file > > void <- function(x) NULL > > # - Specifying pager ----------------------------------------------------------- > > style <- gdo("diffobj.style") > if(is.null(style)) style <- StyleAnsi8NeutralYb() > style@pager@file.ext <- "xyz" # make pager identifiable > all.equal( + diffChr( + letters, LETTERS, style=style, pager="auto", interactive=TRUE + )@etc@style@pager@file.ext, + "xyz" + ) [1] TRUE > all.equal( + diffChr( + letters, LETTERS, style=style, pager="off", interactive=TRUE + )@etc@style@pager, + PagerOff() + ) [1] TRUE > identical( + diffChr( + letters, LETTERS, style=style, pager="auto", interactive=FALSE + )@etc@style@pager, + PagerOff() + ) [1] TRUE > > # - System Pagers -------------------------------------------------------------- > > less.orig <- Sys.getenv("LESS") > pager_mock <- function(...) { + warning(Sys.getenv("LESS")) + 42 + } > is(PagerSystem(), "PagerSystem") [1] TRUE > is( + pg.less <- PagerSystemLess(pager=pager_mock, flags="VWF"), + "PagerSystemLess" + ) [1] TRUE > res <- pg.less@pager() # warning: "VWF$" Warning message: In pager.old(x) : -VWF > all.equal(res, 42) [1] TRUE > all.equal(less.orig, Sys.getenv("LESS")) [1] TRUE > all.equal(PagerSystemLess(pager=pager_mock)@flags, "R") [1] TRUE > > try(PagerSystemLess(pager=pager_mock, flags=letters)) Error in initialize(value, ...) : Argument `flags` must be character(1L) and not NA > > # - use_pager ------------------------------------------------------------------ > > local({ + suppressMessages(mock(diffobj:::console_lines, 10L)) + on.exit(suppressMessages(untrace(diffobj:::console_lines))) + c( + isTRUE(diffobj:::use_pager(PagerSystem(threshold=0L), 1L)), + identical(diffobj:::use_pager(PagerSystem(threshold=50L), 25L), FALSE), + isTRUE(diffobj:::use_pager(PagerSystem(threshold=-1L), 25L)) + ) + }) [1] TRUE TRUE TRUE > > # - Setting LESS var ----------------------------------------------------------- > > local({ + less.orig <- Sys.getenv("LESS", unset=NA) + old.opt <- options(crayon.enabled=FALSE) # problems with crayon and LESS + on.exit({ + diffobj:::reset_less_var(less.orig) # should be tested..., but super simple + options(old.opt) + }) + + # Here we change the LESS variable even though we're mocking getenv + + Sys.unsetenv("LESS") + a0 <- isTRUE(is.na(diffobj:::set_less_var("XF"))) + a <- all.equal(Sys.getenv("LESS"), "-XF") + Sys.setenv(LESS="-X -F") + b <- all.equal(diffobj:::set_less_var("VP"), "-X -F") + c <- all.equal(Sys.getenv("LESS"), "-X -FVP") + diffobj:::reset_less_var("-XF") + d <- all.equal(Sys.getenv("LESS"), "-XF") + diffobj:::reset_less_var(NA_character_) + e <- all.equal(Sys.getenv("LESS"), "") + Sys.setenv(LESS="-XF") + f <- all.equal(diffobj:::set_less_var("V"), "-XF") + g <- all.equal(Sys.getenv("LESS"), "-XFV") + c(a0, a, b, c, d, e, f, g) + }) [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > # - viewer vs browser ---------------------------------------------------------- > > local({ + viewer <- function(x) "viewer" + old.external <- options(viewer=viewer, browser=function(url) "browser") + on.exit(options(old.external)) + suppressMessages(mock(diffobj::make_blocking, quote(fun))) + on.exit(suppressMessages(untrace(diffobj::make_blocking)), add=TRUE) + pager <- PagerBrowser() + a <- all.equal(pager@pager("blah"), "viewer") + options(viewer=NULL) + b <- all.equal(pager@pager("blah"), "browser") + options(viewer=function(x) stop("viewer error")) + res <- pager@pager("blah") # warning: "IDE viewer" + c <- all.equal(res, "browser") + c(a, b, c) + }) [1] TRUE TRUE TRUE Warning message: In pager@pager("blah") : IDE viewer failed with error viewer error; falling back to `browseURL` > > # - blocking ------------------------------------------------------------------- > > # Note that readline just proceeds in non-interactive mode, which is why we > # need the mock here > > local({ + suppressMessages(mock(diffobj:::interactive, FALSE)) + on.exit(suppressMessages(untrace(diffobj:::interactive))) + suppressMessages(mock(diffobj:::readline, quote(warning("readline")))) + on.exit(suppressMessages(untrace(diffobj:::readline)), add=TRUE) + try(make_blocking("hello")) # "must be a function" + try(make_blocking(identity, letters)) # "must be character\\(1L") + try(make_blocking(identity, "a", "a")) # "must be TRUE" + + res <- make_blocking(sum)(1:10) # warn: "readline" + a <- all.equal(sum(1:10), res) + b <- isTRUE( + withVisible( + suppressWarnings(make_blocking(sum, invisible=FALSE)(1:10)) + )[['visible']] + ) + c(a, b) + }) Error in make_blocking("hello") : Argument `fun` must be a function Error in make_blocking(identity, letters) : Argument `msg` must be character(1L) and not NA Error in make_blocking(identity, "a", "a") : Argument `invisible.res` must be TRUE or FALSE [1] TRUE TRUE Warning message: In readline(msg) : readline > local({ + suppressMessages(mock(diffobj:::interactive, TRUE)) + on.exit(suppressMessages(untrace(diffobj:::interactive))) + suppressMessages(mock(diffobj:::readline, quote(warning("readline")))) + on.exit(suppressMessages(untrace(diffobj:::readline)), add=TRUE) + show( # warn "readline" + diffChr( + "a", "b", format='raw', + pager=list(pager=void, make.blocking=TRUE, threshold=0) + ) + ) + show( # warn "readline" + diffChr( + "a", "b", format='html', + pager=list(pager=void, make.blocking=NA, threshold=0) + ) ) + show(diffChr("a", "b", format='html', pager=list(pager=void))) + }) Warning messages: 1: In readline(msg) : readline 2: In readline(msg) : readline 3: In readline(msg) : readline > # There should be no warnings in this lot > > local({ + suppressMessages(mock(diffobj:::interactive, TRUE)) + on.exit(suppressMessages(untrace(diffobj:::interactive))) + suppressMessages(mock(diffobj:::readline, quote(warning("readline")))) + on.exit(suppressMessages(untrace(diffobj:::readline)), add=TRUE) + f <- tempfile() + on.exit(unlink(f), add=TRUE) + show( # no warning + diffChr( + "a", "b", format='html', + pager=list(pager=void, make.blocking=NA, file.path=f) + ) ) + show( # no warning + diffChr( + "a", "b", format='html', + pager=list(pager=void, make.blocking=FALSE, file.path=f) + ) ) + show( # no warning + diffChr("a", "b", format='html', pager=list(pager=void, file.path=f)) + ) + }) > > # - html page output ----------------------------------------------------------- > > pager <- PagerBrowser( + pager=function(x) cat(readLines(x), sep="\n"), make.blocking=FALSE + ) > all.equal( + capture.output(show(diffChr("A", "B", pager=pager, style=StyleRaw()))), + c("< \"A\" > \"B\" ", "@@ 1 @@ @@ 1 @@ ", "< A > B ") + ) [1] TRUE > pager.warn <- PagerBrowser( + pager=function(x) cat(readLines(x), sep="\n"), make.blocking=FALSE + ) > try( # "Unable to instantiate `Style` object: Argument `js` .* is not a file" + diffChr( + "A", "B", pager=pager.warn, format="html", style=list(js="notafile") + ) ) Error in diffChr(target = "A", current = "B", pager = pager.warn, format = "html", : Unable to instantiate `Style` object: Argument `js` ("notafile") is not a file > try( # "Unable to instantiate `Style` object: Argument `css` .* is not a file" + diffChr( + "A", "B", pager=pager.warn, format="html", style=list(css="notafile") + ) + ) Error in diffChr(target = "A", current = "B", pager = pager.warn, format = "html", : Unable to instantiate `Style` object: Argument `css` ("notafile") is not a file > # Create objects that bypass the validation > > style.obj.1 <- style.obj.2 <- StyleHtmlLightYb() > style.obj.1@css <- "notafile" > style.obj.2@js <- "notafile" > > invisible( + capture.output( # warn: "Unable to read provided css file" + show(diffChr("A", "B", pager=pager.warn, style=style.obj.1)) + ) ) Warning messages: 1: In file(con, "r") : cannot open file 'notafile': No such file or directory 2: In .local(x, ...) : Unable to read provided css file "notafile" (error: cannot open the connection). > invisible( + capture.output( # "Unable to read provided js file" + show(diffChr("A", "B", pager=pager.warn, style=style.obj.2)) + ) ) Warning messages: 1: In file(con, "r") : cannot open file 'notafile': No such file or directory 2: In .local(x, ...) : Unable to read provided js file "notafile" (error: cannot open the connection). > # - pager_is_less -------------------------------------------------------------- > > is.less <- pager_is_less() > isTRUE(diffobj:::is.TF(is.less)) [1] TRUE > > less <- tryCatch( + system2("which", "less", stdout=TRUE, stderr=TRUE), + error=function(e) NULL, warning=function(e) NULL + ) > sys.cat <- tryCatch( + system2("which", "cat", stdout=TRUE, stderr=TRUE), + error=function(e) NULL, warning=function(e) NULL + ) > if(diffobj:::is.chr.1L(less) && file_test("-x", less)) { + local({ + old.opt <- options(pager=less) + on.exit(options(old.opt)) + + # has to be stopifnot as we can't return TRUE for systems that don't + # meet these requirements + stopifnot( + identical(diffobj:::pager_opt_default(), FALSE), + isTRUE(pager_is_less()) + ) + }) + } > if(diffobj:::is.chr.1L(sys.cat) && file_test("-x", sys.cat)) { + local({ + old.opt <- options(pager=sys.cat) + on.exit(options(old.opt)) + + # has to be stopifnot as we can't return TRUE for systems that don't + # meet these requirements + stopifnot( + identical(diffobj:::pager_opt_default(), FALSE), + identical(pager_is_less(), FALSE) + ) + }) + } > ## force some checks > > local({ + old.opt <- options(pager=NULL) + on.exit(options(old.opt)) + identical(pager_is_less(), FALSE) + }) [1] TRUE > identical(diffobj:::file_is_less(tempfile()), FALSE) [1] TRUE > > # - file.path ------------------------------------------------------------------ > > f <- tempfile() > show( + diffChr( + "A", "B", format='raw', + pager=list(pager=void, file.path=f, threshold=0L) + ) ) > all.equal( + readLines(f), + c("< \"A\" > \"B\" ", "@@ 1 @@ @@ 1 @@ ", + "< A > B ") + ) [1] TRUE > show( # No error on this one + diffChr( + "A", "B", format='raw', + pager=list(pager=void, file.path=NA, threshold=0L) + ) ) > try(Pager(file.path=letters)) # "must be length 1" Error in initialize(value, ...) : Argument `file.path` must be length 1. > try(Pager(file.path=1)) # "must be character" Error in initialize(value, ...) : Argument `file.path` must be character. > > # - basic pager ---------------------------------------------------------------- > > local({ + f <- tempfile() + on.exit(unlink(f)) + c( + all.equal( + capture.output( + show( + diffChr( + 1, 2, pager=Pager(file.path=f, threshold=0L), + format='raw' + ) + ) ), + txtf(100) + ), + all.equal(txtf(100), readLines(f)) + ) + }) [1] TRUE TRUE > > # - format-pager interaction --------------------------------------------------- > > local({ + old.opt <- options(crayon.colors=7) + crayon::num_colors(TRUE) + on.exit({ + options(old.opt) + crayon::num_colors(TRUE) + }) + c( + is( + diffChr(1, 2, format='auto', pager="on", interactive=TRUE)@etc@style, + "StyleHtml" + ), + is( + diffChr(1, 2, format='auto', pager="on", interactive=FALSE)@etc@style, + "StyleRaw" + ), + is( + diffChr( + 1, 2, format='auto', pager=PagerBrowser(), interactive=FALSE + )@etc@style, + "StyleHtml" + ) + ) + }) [1] TRUE TRUE TRUE > # - format-pager interaction 2 ------------------------------------------------- > > local({ + old.rs <- Sys.getenv('RSTUDIO', unset=NA) + old.rsterm <- Sys.getenv('RSTUDIO_TERM', unset=NA) + on.exit({ + if(is.na(old.rs)) { + Sys.unsetenv('RSTUDIO') + } else Sys.setenv('RSTUDIO'=old.rs) + + if(is.na(old.rsterm)) { + Sys.unsetenv('RSTUDIO_TERM') + } else Sys.setenv('RSTUDIO_TERM'=old.rsterm) + }) + Sys.unsetenv('RSTUDIO') + Sys.unsetenv('RSTUDIO_TERM') + old.opt <- options(crayon.colors=8) + crayon::num_colors(TRUE) + on.exit({options(old.opt); crayon::num_colors(TRUE)}, add=TRUE) + + Sys.setenv(RSTUDIO='1') + + a <- c( + is( + diffChr(1, 2, format='auto', pager='on', interactive=TRUE)@etc@style, + "StyleHtml" + ), + is( + diffChr(1, 2, format='auto', interactive=FALSE)@etc@style, + "StyleAnsi" + ) ) + Sys.setenv(RSTUDIO_TERM='HELLO') + crayon::num_colors(TRUE) + + c( + a, + is( + diffChr(1, 2, format='auto', pager='on', interactive=TRUE)@etc@style, + "StyleAnsi" + ) ) + }) [1] TRUE TRUE TRUE > > # - format-pager interaction 3 ------------------------------------------------- > > is( + diffPrint(1:3, 3:1, format='auto', interactive=FALSE, term.colors=1)@etc@style, + "StyleRaw" + ) [1] TRUE > is( + diffPrint(1:3, 3:1, format='auto', interactive=FALSE, term.colors=8)@etc@style, + "StyleAnsi" + ) [1] TRUE > > # - Default pager writes to screen --------------------------------------------- > > # issue132 thanks Bill Dunlap > > local({ + f <- tempfile() + on.exit(unlink(f)) + writeLines("hello world", f) + + all.equal(capture.output(new("Pager")@pager(f)), "hello world") + }) [1] TRUE > > > proc.time() user system elapsed 1.638 0.199 1.873 diffobj/tests/test-summary.R0000644000176200001440000000444014122754044015621 0ustar liggesusersNAME <- "summary" source(file.path('_helper', 'init.R')) # Note, atomic prints happen in different test file # - Any ------------------------------------------------------------------------ identical(any(diffPrint(iris.s, iris.s)), FALSE) res <- any(diffPrint(iris.s, iris.c)) # warn: "objects are NOT" identical(res, FALSE) isTRUE(any(diffPrint(iris.s, iris.4))) # - Small Summary -------------------------------------------------------------- all.equal( as.character(summary(diffPrint(iris.s, iris.4))), rdsf(100) ) all.equal( as.character(summary(diffPrint(iris.s, iris.2))), rdsf(200) ) all.equal( as.character(summary(diffPrint(iris.s, iris.3))), rdsf(300) ) all.equal( as.character(summary(diffPrint(iris.s, iris.c))), rdsf(400) ) # All equal all.equal( as.character(summary(diffChr(letters, letters))), rdsf(450) ) # - Big Summary ---------------------------------------------------------------- # Make sure we test summary reduction, wrapping all.equal( as.character(summary(diffChr(chr.7, chr.8))), rdsf(500) ) all.equal( as.character(summary(diffChr(chr.7, chr.8), scale.threshold=1)), rdsf(600) ) all.equal( as.character(summary(diffChr(chr.7, chr.8), scale.threshold=0)), rdsf(700) ) # Force truncation of summary all.equal( as.character( summary(diffChr(chr.7, chr.8), scale.threshold=0, max.lines=2) ), rdsf(800) ) # - Show ----------------------------------------------------------------------- isTRUE( paste0(capture.output(summary(diffChr(chr.7, chr.8))), collapse="\n") == as.character(summary(diffChr(chr.7, chr.8))) ) # - HTML summary --------------------------------------------------------------- all.equal( as.character( summary( diffPrint( iris.s, iris.4, format="html", style=list(html.output="page") ) ) ), rdsf(900) ) # - errors --------------------------------------------------------------------- diff <- diffChr("hello green world", "hello red world") try(summary(diff, max.lines=0)) # "strictly positive" try(summary(diff, width=1:3)) # "integer\\(1L\\)" try(summary(diff, scale.threshold=5)) # "between 0 and 1" # - width wrap ----------------------------------------------------------------- diff <- diffChr("hello green world", "hello red world", format='raw') all.equal(capture.output(show(summary(diff, width=5))), txtf(100)) diffobj/tests/test-atomic.Rout.save0000644000176200001440000001436714122754044017076 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin17.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "atomic" > source(file.path('_helper', 'init.R')) > > # - Basic Tests > > all.equal(as.character(diffPrint(chr.1, chr.2)), rdsf(100)) [1] TRUE > all.equal( + as.character(diffPrint(chr.1, chr.2, mode="unified")), rdsf(200) + ) [1] TRUE > all.equal( + as.character(diffPrint(chr.1, chr.2, mode="context")), rdsf(400) + ) [1] TRUE > all.equal( + as.character(diffPrint(chr.1[2:3], chr.2[2], mode="sidebyside")), rdsf(500) + ) [1] TRUE > # Check that `extra` works > > all.equal( + as.character( + diffPrint(chr.1, chr.2, mode="unified", extra=list(quote=FALSE)) + ), + rdsf(600) + ) [1] TRUE > # make sure blanks line up correctly > > all.equal( + as.character(diffPrint(chr.3, chr.4)), rdsf(700) + ) [1] TRUE > all.equal( + as.character(diffPrint(chr.3, chr.4, mode="unified")), rdsf(800) + ) [1] TRUE > > # - Word wrap in atomic > > A <- A.1 <- B <- c(letters, LETTERS) > B[15] <- "Alabama" > A.1[5] <- "Ee" > C <- A[-15] > D <- C > E <- B[-45] > > # Test simple changes to vectors; at 80 columns removing 1:8 corresponds to > # row deletion > > all.equal(as.character(diffPrint(A[-(1:8)], A)), rdsf(900)) [1] TRUE > all.equal(as.character(diffPrint(A, A[-(1:8)])), rdsf(1000)) [1] TRUE > > all.equal(as.character(diffPrint(A[-1], A[-2])), rdsf(1100)) [1] TRUE > > # Replace single word > > all.equal(as.character(diffPrint(A, B)), rdsf(1200)) [1] TRUE > all.equal(as.character(diffPrint(B, A)), rdsf(1250)) [1] TRUE > > # Make sure turning off word.diff also turns of unwrapping, but that we can > # turn off unwrapping without turning off word diff > > all.equal( + as.character(diffPrint(A, B, word.diff=FALSE)), rdsf(1300) + ) [1] TRUE > all.equal( + as.character(diffPrint(A, B, unwrap.atomic=FALSE)), rdsf(1400) + ) [1] TRUE > # Different wrap frequency and removed words that span lines > > all.equal( + as.character(diffPrint(A, A.1[-(13:18)])), rdsf(1425) + ) [1] TRUE > # Removing words > > all.equal(as.character(diffPrint(C, B)), rdsf(1450)) [1] TRUE > > # Two hunks > > all.equal(as.character(diffPrint(D, E)), rdsf(1500)) [1] TRUE > all.equal(as.character(diffPrint(E, D)), rdsf(1600)) [1] TRUE > > # Vignette example > > state.abb.2 <- state.abb > state.abb.2[38] <- "Pennsylvania" > > all.equal( + as.character(diffPrint(state.abb, state.abb.2)), rdsf(1700) + ) [1] TRUE > # Number corner cases > > all.equal(as.character(diffPrint(1:100, 2:101)), rdsf(1800)) [1] TRUE > all.equal(as.character(diffPrint(2:101, 1:100)), rdsf(1900)) [1] TRUE > all.equal( + as.character(diffPrint(2:101, (1:100)[-9])), rdsf(2000) + ) [1] TRUE > all.equal( + as.character(diffPrint((2:101)[-98], (1:100)[-9])), rdsf(2100) + ) [1] TRUE > # This is one of those that a better in-hunk align algorithm would benefit > > int.1 <- int.2 <- 1:100 > int.2[c(8, 20, 60)] <- 99 > int.2 <- c(50:1, int.2) > all.equal(as.character(diffPrint(int.1, int.2)), rdsf(2200)) [1] TRUE > > # - with names > rand.chrs <- do.call(paste0, expand.grid(LETTERS, LETTERS)) > F <- F1 <- F2 <- (2:105)[-98] > G <- G2 <- G3 <- G4 <- G5 <- (1:100)[-9] > nm.1 <- rand.chrs[seq_along(F)] > nm.2 <- rand.chrs[seq_along(G)] > names(F1) <- names(F2) <- nm.1 > names(G3) <- names(G2) <- names(G3) <- names(G4) <- names(G5) <- nm.2 > names(G3)[c(5, 25, 60)] <- c("XXXXX", rand.chrs[c(300, 350)]) > names(G4)[c(5, 25, 60)] <- names(G5)[c(5, 25, 60)] <- + c("XX", rand.chrs[c(300, 350)]) > attr(F2, "blah") <- 1:5 > attr(G5, "blah") <- 3:8 > > all.equal(as.character(diffPrint(F, G)), rdsf(2300)) [1] TRUE > all.equal(as.character(diffPrint(F1, G2)), rdsf(2400)) [1] TRUE > > # Challenging case b/c the names wrap with values, and you have to pick one or > # the other to match when the wrap frequencies are different > > all.equal(as.character(diffPrint(F1, G3)), rdsf(2500)) [1] TRUE > all.equal(as.character(diffPrint(F1, G4)), rdsf(2520)) [1] TRUE > > # Attributes > > all.equal(as.character(diffPrint(F2, G5)), rdsf(2530)) [1] TRUE > all.equal(as.character(diffPrint(F1, G5)), rdsf(2540)) [1] TRUE > > # - Original tests > set.seed(2) > w1 <- sample( + c( + "carrot", "cat", "cake", "eat", "rabbit", "holes", "the", "a", "pasta", + "boom", "noon", "sky", "hat", "blah", "paris", "dog", "snake" + ), 25, replace=TRUE + ) > w4 <- w3 <- w2 <- w1 > w2[sample(seq_along(w1), 5)] <- LETTERS[1:5] > w3 <- w1[8:15] > w4 <- c(w1[1:5], toupper(w1[1:5]), w1[6:15], toupper(w1[1:5])) > > all.equal(as.character(diffPrint(w1, w2)), rdsf(2600)) [1] TRUE > all.equal(as.character(diffPrint(w1, w3)), rdsf(2700)) [1] TRUE > all.equal(as.character(diffPrint(w1, w4)), rdsf(2800)) [1] TRUE > > # - Simple word diffs > a <- c("a", "b", "c", "d") > b <- c("b", "c", "d", "e") > all.equal(as.character(diffPrint(a, b)), rdsf(2900)) [1] TRUE > > a <- c("x", "a", "b", "c", "d", "z") > b <- c("x", "b", "c", "d", "e", "z") > all.equal(as.character(diffPrint(a, b)), rdsf(3000)) [1] TRUE > > a <- c("x", "a", "b", "c", "d", "z") > b <- c("z", "b", "c", "d", "e", "x") > all.equal(as.character(diffPrint(a, b)), rdsf(3100)) [1] TRUE > > # - Alignment edge cases > all.equal( + as.character(diffPrint(20:50, 30:62)), rdsf(3200) + ) [1] TRUE > # below is off; should be aligning matching context line, part of the problem > # might be that we're doing the realignment without thinking about what the > # other hunk has. > # > # Possible encode each line as hunk#:diff/mix/cont > > # all.equal( > # as.character(diffPrint(20:50, 35:62)), rdsf(3300) > # ) > > # another interesting example where the existing algo seems to lead to a > # reasonable outcome > > all.equal( + as.character(diffPrint(c(1:24,35:45), c(1:8, 17:45))), rdsf(3400) + ) [1] TRUE > > proc.time() user system elapsed 3.515 0.411 4.070 diffobj/MD50000644000176200001440000005204215001401012012150 0ustar liggesusers3ba65258b3dae94744c804f7e5a0f5e4 *DESCRIPTION 8ebc8bbb2dbb0fd5a14b0559163a46e9 *NAMESPACE 3d922da541c9f555c0af33ebeabfac35 *NEWS.md 49d3d45d7f8fbd5039931dec5e0a75ad *R/capt.R 15c25fba7f29c1ca25339d50c9db24e3 *R/check.R bf5c59ca0690d04818f1dc08e4f125ae *R/core.R 983cfc54fdc9993a715c4f861df1da2f *R/diff.R dcce37378f0cff4d10f9a4c132bc2898 *R/finalizer.R f62077eb26090bdbb0003aee5b405a24 *R/get.R b8bf43023e234425503bfa0e8dc9adc8 *R/guides.R 984ed8bdef48847c20f7d41939984bf9 *R/html.R 3866a281d271757572686dcd4323e1e9 *R/hunks.R e7a548158b6bd4ef3079e2157a7f50eb *R/layout.R 9710803489104a33ba502ef4ee11d8e1 *R/misc.R 0a6b2d346328ee8c55e0cea53a36db3b *R/myerssimple.R d37d716569d95a7d8b1f1eff73f24ad2 *R/options.R d68f12ce557d21e1c0ed46c6f232d420 *R/pager.R dc315dbe26fbcf9af0c746df1cc7c0d5 *R/rdiff.R 1019d8520b1b2f8367f77341aaf0f1c4 *R/rds.R 201159662ccb306e427391315f5f2517 *R/s4.R ef478064e67522a8627d4c390149235b *R/set.R 323789973b388f35b29cfbb5d397d44b *R/styles.R 140c8b32cf27466641ba6073c206a69c *R/subset.R d264d7fd94ee63fc5ba90458cafc19c9 *R/summmary.R 6e41c09de0c77f265ab80103e8eda1bc *R/system.R 69f27658f5dad96c2b6dffac87c8b845 *R/text.R 14dce32be9ed0a23b2e8d8437c925357 *R/tochar.R c3a42436e52a82143d6a23fc35e94b67 *R/trim.R 91bf02bacd231e90d1d8c8a5130d679a *R/word.R 9be6c5e5c5466dfa120e6057b382c150 *README.md e11a7832f8cad61ff143640ead779f18 *build/vignette.rds 320fc37b423b0e309fedfde4061bc906 *inst/COPYRIGHTS 4522b9ebe26e4d989bc7a27f933e3d21 *inst/css/diffobj.css e26109a8656bcfcbb0160c0c62e84463 *inst/doc/diffobj.R 4ad69236446ba4c6e985d4c6a85ef782 *inst/doc/diffobj.Rmd 9f9da0cf82b77ce7e97345b6f97eeb05 *inst/doc/diffobj.html 33486a30d4e535c0861113752be75879 *inst/doc/embed.R 9e93047aa59973c6475724b83fc6c321 *inst/doc/embed.Rmd 7796018ae7a4976db234fea02a5c8d67 *inst/doc/embed.html 58457afa03757c75394dfb619876db3b *inst/script/diffobj.js 31419b3dc6ce97ed3345f193b7656d50 *man/AlignThreshold-class.Rd 93b232974dcc5131b6d2d3614b5e90bc *man/Diff-class.Rd 45e765d94003da598c35f61278cea156 *man/Extract_PaletteOfStyles.Rd f2e40c1436601fc5c57e0d2fd58405cf *man/Pager.Rd 70f6f6c53819b288f32221a9037ccdd8 *man/PaletteOfStyles-class.Rd 44122be6966715471ea1071ab79f9a8d *man/Rdiff_chr.Rd dc65bc321349383369bb285cafe8f377 *man/Style.Rd 7432f4de3d7eeac72497bdebce78fa99 *man/StyleFuns.Rd 2c94216969caf6341d74b9ffe80188b7 *man/StyleSummary.Rd 31afdced631cfa0ea225ea80e52f97bb *man/StyleText.Rd acccbbfbe4b351a6ec2abf0214622580 *man/any-Diff-method.Rd c6e0d308a833f0f506c82db170574449 *man/as.character-DiffSummary-method.Rd 5520ff92ad10370c9d2e8eaa23ee7301 *man/as.character-MyersMbaSes-method.Rd 9b1924f6d3ed312ae91c66dcaa12c867 *man/auto_context.Rd 42e7cd6e2e963cf61fde825fd0c48b53 *man/console_lines.Rd 3cc3a3a8d727b5fc298c26661a6dfdb0 *man/diffChr.Rd 08526bb359903552fb012c039212859c *man/diffCsv.Rd ce38cb7bd87bc685548fb26d61ffc55a *man/diffDeparse.Rd 77dc21f04d0c429ea156f9376204cf2c *man/diffFile.Rd 29916b9909caccb09b666d6a32acbb0c *man/diffObj.Rd 6144ffc9eba2ea21c079e28aff66a180 *man/diffPrint.Rd 9459e5a5a2177176b86a10eb3317cf63 *man/diffStr.Rd ebb62a0537328a03b7ee468fe1ade5c2 *man/diff_myers.Rd a6d00e875bd0d2078acc523d9cb0f3bd *man/diffobj-package.Rd e90329bfecacee1de20b87230e5bb8cc *man/diffobj_s4method_doc.Rd 168591e0c6d3f6c40061e5fa5819f724 *man/diffobj_set_def_opts.Rd 504f92f3aa46bf96b5d7ceb9ced1cf39 *man/dimnames-PaletteOfStyles-method.Rd 7925b4c3808f54355ce4a7e27151351b *man/extract-Diff-method.Rd 0152556a38f12fec9826e2486c1b5503 *man/finalizeHtml.Rd 65da419e2049850113c0c5fe2915824c *man/gdo.Rd ed1a56df12ea7f95cd3d1a3401b1b761 *man/guides.Rd e6fe3aeab53db02d9e281856a1895df8 *man/has_Rdiff.Rd 930d757bba96a859bbd528ba95d5056e *man/make_blocking.Rd 00ba016bdea25ea334451371bd616d3c *man/nchar_html.Rd 4f2341110f17057d5df37855d560c188 *man/pager_is_less.Rd 641f6695b008ea98b037ba7542b653f6 *man/par_frame.Rd 5684beb11ea28a26d9dd3fbe1d2559bb *man/ses.Rd 577dda8d444116bc3d5cd9c76b6dc0b1 *man/show-DiffSummary-method.Rd 6b3cf207b00a94134d319f5bbc1624eb *man/show-PaletteOfStyles-method.Rd 8686528d8af3c214b50ccd8383932e94 *man/show-Style-method.Rd f6aec61ea0385eb48029f21361b4b36d *man/strip_hz_control.Rd 15e607283f82470ad098506338e6a56e *man/summary-Diff-method.Rd 7b3535e656b8011ff8298db338be16e9 *man/summary-MyersMbaSes-method.Rd f79eb2ea6757ef2babf636c6222040f6 *man/summary-PaletteOfStyles-method.Rd 089e12b412655819fbd17fba92e02a2c *man/tag_f.Rd 9b8d5ebf572029a14064136e48907d4b *man/trim.Rd 9443671b9841375f6c005b55963aa2fc *man/view_or_browse.Rd 9dd8095f89982d2d197f849c9af145d6 *man/webfiles.Rd 4be9e7afc0e49598c44931d45eb41e66 *src/diff.c 2305ce0fbfec00b881bd460e956388d2 *src/diff.h eea2cb88f3d7f5ab081b4396715c447c *src/diffobj.c 3a4d96a207313f8d062a150984b5b280 *src/diffobj.h 5b752a841b887c1ad5c862eb6679d9f6 *src/init.c a7b2148e0e6c112c8724679fea3e80e4 *tests/_helper/breakdown.R fc5f397522504e0bce404a5c2a5246e6 *tests/_helper/check.R 93a11280184e036685a9cd4c24d0ed78 *tests/_helper/commonobjects.R 168a72d71281bdb4c60a4546213dcd1a *tests/_helper/init.R a45701a8a943fee86e2f7bfea68c554e *tests/_helper/objs/atomic/100.rds dc3f364393561bd18b20d84286c3b7c7 *tests/_helper/objs/atomic/1000.rds 44c2381df681c732977077f5a46bd25c *tests/_helper/objs/atomic/1100.rds 69f4fa668d1680ac1dccebb25e315e99 *tests/_helper/objs/atomic/1200.rds 0734eca1d4d03680354c5612b93aed88 *tests/_helper/objs/atomic/1250.rds 37c577a82c7968d7997aebe1d3109ca5 *tests/_helper/objs/atomic/1300.rds 34a356139062b436b647f889e3a26a0a *tests/_helper/objs/atomic/1400.rds e05e4ac9e2ac21a5be7ccf5ba4901412 *tests/_helper/objs/atomic/1425.rds 2432d32ed1495f36c39af5fa71db6a64 *tests/_helper/objs/atomic/1450.rds ea6141ad68328e262fb39675bebc751b *tests/_helper/objs/atomic/1500.rds c140a1be8612c04236c9741e044e7f8a *tests/_helper/objs/atomic/1600.rds b6dc4bc12e54f95aa91224f02ee32bb8 *tests/_helper/objs/atomic/1700.rds 764f2019d89135c633fb547ed4e1a2b0 *tests/_helper/objs/atomic/1800.rds 221588368f319815137723249d330fe7 *tests/_helper/objs/atomic/1900.rds c2a2f40ec2fb74e3732c84602b3f88f0 *tests/_helper/objs/atomic/200.rds a74e6e21b9c01c44385949f20db6a701 *tests/_helper/objs/atomic/2000.rds 101109fd4be9f6920e256fa7f4902d42 *tests/_helper/objs/atomic/2100.rds 41fd3b188451f69fd9e1fecb6ca7647d *tests/_helper/objs/atomic/2200.rds f23316310a5b9a7fc25895065a64c1da *tests/_helper/objs/atomic/2300.rds 2f5942ee3eedc6d18123ffcff4756ce7 *tests/_helper/objs/atomic/2400.rds f0e8bb15dd4921aec2d0c224c3646234 *tests/_helper/objs/atomic/2500.rds 3f0cd800db66170eef9945861acd15aa *tests/_helper/objs/atomic/2520.rds fab134028d4d441560b2a6847cae5091 *tests/_helper/objs/atomic/2530.rds 31764b7afd942315de7c9e7436081d93 *tests/_helper/objs/atomic/2540.rds bfafd46faad18c70b7d7b2e6734ea3a3 *tests/_helper/objs/atomic/2600.rds da093f2a3ce05c9b4b76c2bb7a9353a1 *tests/_helper/objs/atomic/2700.rds f4d06103b2b62f64c2b60cfbf4ac4d36 *tests/_helper/objs/atomic/2800.rds 989d1180e3880b221aa73666b60bfd81 *tests/_helper/objs/atomic/2900.rds 7f9785d7bf351f9eee19af77fb04bac2 *tests/_helper/objs/atomic/3000.rds 5d368c9bac8fd272b810a4b15b33fc57 *tests/_helper/objs/atomic/3100.rds 91218647f129ad69cbc6ebd5c7dc172d *tests/_helper/objs/atomic/3200.rds acb225308bc51c408162ad69a43a6863 *tests/_helper/objs/atomic/3300.rds c1694e5b8fdec754a52c2b01e747ed7c *tests/_helper/objs/atomic/3400.rds 6ee314755262cba70a6fe4fd2dda4058 *tests/_helper/objs/atomic/400.rds e5d81a992cfb76c65f2b4676f4cbebf3 *tests/_helper/objs/atomic/500.rds 02e31be899289c97b3a36a6c75ab47a8 *tests/_helper/objs/atomic/600.rds 4fff8918a763c31cd2f3f98e6df53acf *tests/_helper/objs/atomic/700.rds 3e8b6358cb2aa43179319f1bd6228486 *tests/_helper/objs/atomic/800.rds 8357b4e983f364f29582a41bf12ef315 *tests/_helper/objs/atomic/900.rds 48f39fcbb69b8703b42d00c23b2defbd *tests/_helper/objs/common/aaaa.RDS f6d68e680e822b2808762d45d201b675 *tests/_helper/objs/context/100.rds 5dd71ce40c9679b4c95aaee45c565b37 *tests/_helper/objs/context/100.txt f198a0849fac7b99820ea6694ed26990 *tests/_helper/objs/context/150.rds 41dc9a5fed17f5ee9d909000195c23e6 *tests/_helper/objs/context/200.rds 54ab37eccc5b0e7fe550ebd5467da5af *tests/_helper/objs/context/200.txt f28717f7e31485ece3c0f8e2ce032b3f *tests/_helper/objs/context/300.rds ec95a408b23380dfa98dcd5d44026a0e *tests/_helper/objs/context/400.rds f00958307411ddfe90d8d45be4a6e917 *tests/_helper/objs/context/500.rds 6ea96d1d9b5da34720d14756cb5aada7 *tests/_helper/objs/diffChr/100.rds 5ea668dd799d006548506ff46c74b738 *tests/_helper/objs/diffChr/100.txt d85efe2ce8b91e2acde6a2b1363211ca *tests/_helper/objs/diffChr/1000.rds ca124f8c0b596d37f7a211162f40f018 *tests/_helper/objs/diffChr/1100.rds f2cbabe3191df5d5e8d74db247af7af3 *tests/_helper/objs/diffChr/1200.rds 805bbf7455cce2d6e79bb5868535d99e *tests/_helper/objs/diffChr/1300.rds 5728b07f03543b472c9e8afe477a4218 *tests/_helper/objs/diffChr/1400.rds 11efd2c5b63c52ebef56eddc809547be *tests/_helper/objs/diffChr/1500.rds 3094895a0ae2a02c3df392b59110131b *tests/_helper/objs/diffChr/200.rds 3f61d4788d843555c01962fe9488f224 *tests/_helper/objs/diffChr/200.txt c28135ec2ad960124c266f2d8e8f1449 *tests/_helper/objs/diffChr/225.rds b858eca5629dab83ad71a0ceb4aeaf28 *tests/_helper/objs/diffChr/250.rds 3d5584a86016db6a893cf63a896bbd3d *tests/_helper/objs/diffChr/300.rds 7eec0dc151eacdc33d6fff179ce36d70 *tests/_helper/objs/diffChr/300.txt a0a3531322d6651912d2b4bfc057fdfb *tests/_helper/objs/diffChr/400.rds 9387a8fc5bcf16bf042f6431a8f3dcc6 *tests/_helper/objs/diffChr/400.txt 14e6ba05956c075bc0dea7a806d1ce11 *tests/_helper/objs/diffChr/500.rds c20342671fef7075a835980cba0f8878 *tests/_helper/objs/diffChr/500.txt a7bff3a7d88f4be8a65fecedd1d6707b *tests/_helper/objs/diffChr/600.rds ad335e2b030a318a911f7ce5b2d81c8c *tests/_helper/objs/diffChr/800.rds da6d129bc1abde1f32243f14060437e2 *tests/_helper/objs/diffChr/900.rds a892016365e770595c37c7cfeef280c4 *tests/_helper/objs/diffDeparse/100.rds a3902e3d7357dc97b3abc4d323046096 *tests/_helper/objs/diffDeparse/200.rds cfd11512ac2c0336d5f7ae6dcd3952b4 *tests/_helper/objs/diffFile/100.rds 125b7770618cee796f75f11fe42b513f *tests/_helper/objs/diffFile/s.o.30dbe0.R 9752f5d324622b136bad0666714cc101 *tests/_helper/objs/diffFile/s.o.3f1f68.R 1483c33e014566ac7c0307b4f875a190 *tests/_helper/objs/diffObj/100.rds 79eb3fb9a4533231c16a88da7c7e67f1 *tests/_helper/objs/diffObj/200.rds 3d2afca44733f3900578b5139c80ac6e *tests/_helper/objs/diffObj/300.rds f28316a1fc903d296643e6730589f6de *tests/_helper/objs/diffObj/400.rds 37b17feb793bf07a25b90bea54db8dd5 *tests/_helper/objs/diffPrint/100.rds 85499e94ba78e61b81abb0a18c518aad *tests/_helper/objs/diffPrint/100.txt 60381bf784f270725eaf5f886df2e40f *tests/_helper/objs/diffPrint/1000.rds c963e95d93e1419329faf4b3e4af8008 *tests/_helper/objs/diffPrint/1100.rds 5e701970a746e1f48a7aabcc27a886e9 *tests/_helper/objs/diffPrint/1200.rds 8f76c594527c84f9c094c41c1e954e15 *tests/_helper/objs/diffPrint/1300.rds 9bd8920b9f7d5e05d30c60d1739e58f5 *tests/_helper/objs/diffPrint/1400.rds 36c801641f202eb148e628da26a0f8bf *tests/_helper/objs/diffPrint/150.rds 90bb138a4f05b20b723cc13de8dfbf2e *tests/_helper/objs/diffPrint/150.txt 07497bf535c796d2b6207f9f0aabb023 *tests/_helper/objs/diffPrint/1500.rds b2de18480bc61e62e2b4d7e14e00963f *tests/_helper/objs/diffPrint/1600.rds e4f1b395cb2c812e12de73aaf57eb689 *tests/_helper/objs/diffPrint/1650.rds 31bec83015b12f4212e0a406c5c69923 *tests/_helper/objs/diffPrint/1700.rds 5778a7ce44ff70aa025f16aecb98a047 *tests/_helper/objs/diffPrint/175.rds 0abeac571d16a77cd414bc57c0d528cc *tests/_helper/objs/diffPrint/175.txt fc035cf2e8ece3effb658e0919d7a9f7 *tests/_helper/objs/diffPrint/1800.rds 5dc5f7ba8f8d8fbc698dc145d0296736 *tests/_helper/objs/diffPrint/1900.rds eec6a82dfed19356cf0d4f8c6b0dcc8b *tests/_helper/objs/diffPrint/200.rds 73d3abb805eaa7da254c6e46a9369b8d *tests/_helper/objs/diffPrint/200.txt 1be79c5818539f20125ac58eba1dcc44 *tests/_helper/objs/diffPrint/2000.rds f6969b4e873c2626cba9655fa0ade92f *tests/_helper/objs/diffPrint/2100.rds f14f24f4387d9ba302727c01c8dca2e6 *tests/_helper/objs/diffPrint/2150.rds 4883764bcc9b13ca249fa1759c2eb0cf *tests/_helper/objs/diffPrint/2200.rds 7acb31232169b734d4fa644446928ab1 *tests/_helper/objs/diffPrint/2250.rds 23e50dc91187ec68ffb8417c962732d2 *tests/_helper/objs/diffPrint/2300.rds f6969b4e873c2626cba9655fa0ade92f *tests/_helper/objs/diffPrint/2350.rds fb6e3e28a0fe590afa16470e491b897d *tests/_helper/objs/diffPrint/2370.rds 90f0c8e624026ae3ee09ff6b36af0a7e *tests/_helper/objs/diffPrint/2380.rds 4a8410c083b3f64cc8fce0ff5d3709a3 *tests/_helper/objs/diffPrint/2383.rds f7adce81326a7bf1b2af4b9db98da099 *tests/_helper/objs/diffPrint/2400.rds f7adce81326a7bf1b2af4b9db98da099 *tests/_helper/objs/diffPrint/2500.rds 88f94687cb1212e341dd409fef89f60e *tests/_helper/objs/diffPrint/2600.rds 51192ba9a08d8130611189b4b7a99717 *tests/_helper/objs/diffPrint/2700.rds 1462ff7687b98218c6dd5a5d79209fc6 *tests/_helper/objs/diffPrint/2800.rds 0fcf1dbaf973aff32c38642dea659515 *tests/_helper/objs/diffPrint/2900.rds 6428bd1ff765feaf9698cc6693cf1ac0 *tests/_helper/objs/diffPrint/300.rds 7266f76fb2b5f81db8f1c18858399827 *tests/_helper/objs/diffPrint/3000.rds a35c08e11e8d7c403e3177c13a2d65f9 *tests/_helper/objs/diffPrint/3100.rds 2c958f4965b14694d30335b9f72807bd *tests/_helper/objs/diffPrint/3200.rds 86794d78ccec9b8dc582ab5a346da9b3 *tests/_helper/objs/diffPrint/3300.rds 4d0208a0b608b7d633f662b2092ed896 *tests/_helper/objs/diffPrint/3400.rds 26bb401980e8c6ddc54688448335eb75 *tests/_helper/objs/diffPrint/400.rds 8ba4fe3b4176287a49fc6ae3f6174ea7 *tests/_helper/objs/diffPrint/500.rds 207c5dd85b0c8df263deae230c68a2b2 *tests/_helper/objs/diffPrint/600.rds f6b17f580422089c84bf2c16cea8579a *tests/_helper/objs/diffPrint/700.rds cf0a10ed0b7939dfbd33366fbfe353c2 *tests/_helper/objs/diffPrint/800.rds 3732b9b1ed11bd4171627347310ee847 *tests/_helper/objs/diffPrint/900.rds e1b09bf3fffdaac6189e86f1c49594b0 *tests/_helper/objs/diffStr/100.rds 8f8c0614f6610391dd23827baa721d2b *tests/_helper/objs/diffStr/100.txt 64fc1bd339dd438d0b4dff9fb26c6dbf *tests/_helper/objs/diffStr/1000.rds d2ca22a1835e41ad7d0b60d1e0b4e252 *tests/_helper/objs/diffStr/1100.rds 0aebb54ccae30a57fa40c9e94d5a0b79 *tests/_helper/objs/diffStr/200.rds 8e82236f5a8dca6179790f610b9162e8 *tests/_helper/objs/diffStr/300.rds afc2ddbcbb06ad13195f6111d352b141 *tests/_helper/objs/diffStr/400.rds f16070308563105cd79766fcbe4731ce *tests/_helper/objs/diffStr/500.rds c3438a71e37e39840f52f78e161941d8 *tests/_helper/objs/diffStr/550.rds 3d2afca44733f3900578b5139c80ac6e *tests/_helper/objs/diffStr/600.rds 60a797bb010593ff574c99320941a5c9 *tests/_helper/objs/diffStr/700.rds e816514b74dcc98245ed28dcd05b04e6 *tests/_helper/objs/diffStr/800.rds e816514b74dcc98245ed28dcd05b04e6 *tests/_helper/objs/diffStr/900.rds 81b4d6c860927ce9fe0b389f625f07c8 *tests/_helper/objs/guides/100.rds 9dadb9e30a566f057bb3449ca2e80ea4 *tests/_helper/objs/guides/200.rds 5cc7de0903649ea072c89294f6b8cda2 *tests/_helper/objs/html/100.rds 8b2d8f29e9b5c7e5e4315ec4bc4fa2a3 *tests/_helper/objs/html/200.rds 0143f228fcd903ce6540824af9868cd9 *tests/_helper/objs/html/300.rds e1c6fae4d07bd0a9baeb86e3fed064b1 *tests/_helper/objs/html/350.rds 9cbccce90aea834d543f4d3742e96aa9 *tests/_helper/objs/html/400.rds 0aa5e953e2838d65352d867d456376e0 *tests/_helper/objs/limit/100.rds 90b9ae355f42a20f7839b2629fa05291 *tests/_helper/objs/limit/1000.rds d1933542e8052ee44bb0b2ead7dfb387 *tests/_helper/objs/limit/1100.rds 0df077631f4d4c6b14d1479eb952aff5 *tests/_helper/objs/limit/1200.rds c880da027a5854880a5cc29bb4a0865e *tests/_helper/objs/limit/1300.rds dbe2410e259a09082784d9180d0e19cb *tests/_helper/objs/limit/200.rds a95ecffebee4e50cd16d704cf3e3908b *tests/_helper/objs/limit/300.rds 4aaadb0768c247d2e5b10da4c4c9f537 *tests/_helper/objs/limit/500.rds 602b2ac1e4d2c6b523a9b9cf72ca530d *tests/_helper/objs/limit/600.rds f939bf7d26cef1e59f088084433c10b0 *tests/_helper/objs/limit/700.rds fb49940c1563c0d7e98eaf2d8acf1655 *tests/_helper/objs/limit/800.rds df2834bd7e775c21b6c92e385e31d8f4 *tests/_helper/objs/limit/900.rds 162e195ad74eb4044591f87178a884da *tests/_helper/objs/methods/100.rds a657fc69520a33fd5d0f7a1438b54a73 *tests/_helper/objs/methods/200.rds ae0c8d3d54ce94d5ae3a529d2f07155f *tests/_helper/objs/pager/100.txt 8ee3d97210bc7915cc9b2dc52381f267 *tests/_helper/objs/pager/200.txt d41d8cd98f00b204e9800998ecf8427e *tests/_helper/objs/pager/300.txt d911852c9676e4833578c3bd5f385842 *tests/_helper/objs/style/100.rds 58d7a8816b2b516182879bf23bce19cf *tests/_helper/objs/style/200.rds b02d528d5d7449feba4d502d68963f5d *tests/_helper/objs/style/300.rds e78829dfa9acd41cc85022fbddf477f4 *tests/_helper/objs/style/400.rds 784e2b466f53d531e6bcaf9f7f834065 *tests/_helper/objs/style/500.rds 8ae83e9eaf20da0f0cca68fc184226d5 *tests/_helper/objs/summary/100.rds 98dd5589b90754b1c99677b156856280 *tests/_helper/objs/summary/100.txt 963be56fab7538f72248b353af820d9d *tests/_helper/objs/summary/200.rds 54b7fa3e99c02528b6455cf26004d424 *tests/_helper/objs/summary/300.rds 881a4f2d94f2799a11d97b2982fae9de *tests/_helper/objs/summary/400.rds b8b7c6f80f1df44b42f5be1d379a8d67 *tests/_helper/objs/summary/450.rds bfa07e2f8ba3c984ded34f47cc4f6441 *tests/_helper/objs/summary/500.rds 2022c580b6d6f555a7ed9e4d4c5d7eef *tests/_helper/objs/summary/600.rds 03683967ab30bcbeb1ab014d91d195ef *tests/_helper/objs/summary/700.rds e828109ffc70f1d2767db1fa4b40fbdf *tests/_helper/objs/summary/800.rds 466531c9c8c58319d8a123c24cfcfc65 *tests/_helper/objs/summary/900.rds bffab9bbb20319b1f24862c359640af6 *tests/_helper/objs/trim/100.rds ab2c9cb8084ef78d1a4ab576f6ef3b77 *tests/_helper/objs/trim/200.rds 720332fc5f81d72cc6cbbd4b01c00bb0 *tests/_helper/objs/trim/300.rds 24167a5223c4095addff43e415899e5d *tests/_helper/objs/trim/50.rds ef70f577c0ec4ce7513db0b6d5b78e84 *tests/_helper/string-gen.R 92e492f2f93d7e15ad4960863a1950ef *tests/_helper/tools.R 2d807b1c69afa0e80a300abe995341ad *tests/test-atomic.R 5c0756c1d64e779ef985ba6c38129cf2 *tests/test-atomic.Rout.save 2ce53858a1bd4a6affbcc1df5e570979 *tests/test-banner.R 9cdfa96b1f9db77c67bd8f664f479023 *tests/test-banner.Rout.save ef6090e6b2bfd16295bc1e845d90a288 *tests/test-capture.R f68fb6459e1b62f9f46dbcf0eade3268 *tests/test-capture.Rout.save ff8ee6e20161d2b84c58664bea28f8b6 *tests/test-check.R b052b4296bda795c96bb095752bbe502 *tests/test-check.Rout.save a0f50f1b2cfd4db3fcdd137e07086803 *tests/test-context.R 033a46f2ae9717814bfc9d0cec370741 *tests/test-context.Rout.save 73ee13c582aeb67c67fd9697ce84f3e3 *tests/test-core.R 3c48c41748b057fbdf006acb2bee7b42 *tests/test-core.Rout.save 7e999d1dfc77cca6dbd57ccf7c5799cc *tests/test-diffChr.R ce4f5f68765f0ac0239c9d31a4040afa *tests/test-diffChr.Rout.save df8289564d876b0c3544b5900aae98ba *tests/test-diffDeparse.R 1e9da1500d09c228f6f8c5a0173ebb10 *tests/test-diffDeparse.Rout.save 8eb7cb812f16635b1d9fda98d81ce596 *tests/test-diffObj.R 0623d086cf584a66a56fe2db0c41c9e8 *tests/test-diffObj.Rout.save 4dcb80e502cec9b8ebd7b6a46c027a39 *tests/test-diffPrint.R d0e9ff2ee8d3ba2e5d639fca96f91197 *tests/test-diffPrint.Rout.save 5a12fff5b0fb6fc0439da47db53fac57 *tests/test-diffStr.R a2436bf9d2e0ce7df4311931d35c6ae0 *tests/test-diffStr.Rout.save e0c634149591adda376e29362867b5b4 *tests/test-file.R af3c4263118fd5b4aecb6cdec3c41138 *tests/test-file.Rout.save 6ef0da46f74a8658f1ed61e32ff98ac3 *tests/test-guide.R dca94e0dea10450d1050a68d78cc3144 *tests/test-guide.Rout.save 57c322b182dd58a402335ab224d33357 *tests/test-html.R 58e1f53c1f5a7c7e10a20ce7d99fbefe *tests/test-html.Rout.save e798365dcb28b3eb7bce0764238c8101 *tests/test-limit.R 1c6fbd12c51b2179ac5b1af7331f58d9 *tests/test-limit.Rout.save 92ad4b7e9a893b0e7a9a47a6b9b29271 *tests/test-methods.R 4b3fd6edfdda6ab6e6ea285fa9d98d5f *tests/test-methods.Rout.save 1af2ac3b1e7da77bad705910d328f044 *tests/test-misc.R 3e647672e0516648240e095e55d17eed *tests/test-misc.Rout.save 00ac0f315eb6d3deff28ab18020d7c78 *tests/test-pager.R e7448b9e0027d9d279d9c9c6900eaccb *tests/test-pager.Rout.save 3aeae69d552f7a1e274964a36f4d3bee *tests/test-rdiff.R d0677e8a86888c95f451d94122b3c47d *tests/test-rdiff.Rout.save 08c39fb1a5cce37a44c6dc54950a550e *tests/test-s4.R 1c19f34b17256c22ff72ed6c023cb983 *tests/test-s4.Rout.save 6be2b47afa8da5a82e686f67b7804303 *tests/test-scaling.R fe59891c59b0fce386c7b8e33b032254 *tests/test-ses.R b41dfd88eb631428064a5267e0688ea0 *tests/test-ses.Rout.save 8768717a5bb91a3743a1a5a380705b78 *tests/test-style.R 01ca69030e0ccb2295c0671d3b0ef4b5 *tests/test-style.Rout.save 940afbdf7933110c7ad5ea55dd9b502b *tests/test-subset.R 3cb6f6da3d85d9e3ef229f5572fc3558 *tests/test-subset.Rout.save a9259fccca78e0fcab91f4608eb0f6f2 *tests/test-summary.R e54a8cb65318104247f4d0fecc1d80a7 *tests/test-summary.Rout.save 252573b38413d9a359a49c3d3c03bfb3 *tests/test-text.R bb8aa18d264f5091a3f505faad0e81e6 *tests/test-text.Rout.save baea5e403d5277f053053f6a5b7a187d *tests/test-trim.R dfb718afbd95a673de8a76e7f694c8ab *tests/test-trim.Rout.save c7d3d4ff89fc984b06596636fab7d469 *tests/test-warnings.R aae395c15d5d4fa004b7b836da260896 *tests/test-warnings.Rout.save 498f5f1c22d785221998c067e58cc456 *tests/valgrind/mdl-cur-all.txt 3ebdc9637d25ba9ada7fb03ea757a42e *tests/valgrind/mdl-cur.txt 190d0593d9f845f0afa81a7c23789387 *tests/valgrind/mdl-tar-all.txt 8478afde8a5625a16f8f3118ecec2219 *tests/valgrind/mdl-tar.txt ddad15fc1b4b67a5b3e6cb7e520c2860 *tests/valgrind/tests-valgrind.R b98a4202bca9af7409da6a63e0622f5d *tests/zz-test-check.R b2d7b4d93f4eab544203b2d4160e0583 *vignettes/ansi256brightness.png 4ad69236446ba4c6e985d4c6a85ef782 *vignettes/diffobj.Rmd 9e93047aa59973c6475724b83fc6c321 *vignettes/embed.Rmd 53121e5e594fc9814e2f89ebfeeccf28 *vignettes/styles.css diffobj/R/0000755000176200001440000000000015001264510012050 5ustar liggesusersdiffobj/R/set.R0000644000176200001440000000642315001242043012770 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. #' @include styles.R NULL #' Attempt to Compute Console Height in Text Lines #' #' Returns the value of the \code{LINES} system variable if it is reasonable, #' 48 otherwise. #' #' @export #' @return integer(1L) #' @examples #' console_lines() console_lines <- function() { LINES <- as.integer(Sys.getenv("LINES")) if(length(LINES) == 1L && !is.na(LINES) && LINES > 0L) LINES else 48L } #' Configure Automatic Context Calculation #' #' Helper functions to help define parameters for selecting an appropriate #' \code{context} value. #' #' @export #' @param min integer(1L), positive, set to zero to allow any context #' @param max integer(1L), set to negative to allow any context #' @return S4 object containing configuration parameters, for use as the #' \code{context} or parameter value in \code{\link[=diffPrint]{diff*}} #' methods #' @examples #' ## `pager="off"` for CRAN compliance; you may omit in normal use #' diffChr(letters, letters[-13], context=auto_context(0, 3), pager="off") #' diffChr(letters, letters[-13], context=auto_context(0, 10), pager="off") #' diffChr( #' letters, letters[-13], context=auto_context(0, 10), line.limit=3L, #' pager="off" #' ) auto_context <- function( min=getOption("diffobj.context.auto.min"), max=getOption("diffobj.context.auto.max") ){ if(!is.int.1L(min) || min < 0L) stop("Argument `min` must be integer(1L) and greater than zero") if(!is.int.1L(max)) stop("Argument `max` must be integer(1L) and not NA") new("AutoContext", min=as.integer(min), max=as.integer(max)) } # Changes the LESS system variable to make it compatible with ANSI escape # sequences # # flags is supposed to be character(1L) in form "XVF" or some such # # Returns the previous value of the variable, NA if it was not set # # Assumes `Sys.getenv('VAR')` always returns a length 1 character vector, even # though strictly this is not documented (used to handle other case but this # assumption simplifies testing now that we can't mock Sys.getenv anymore). set_less_var <- function(flags) { LESS <- Sys.getenv("LESS", unset=NA) # NA return is NA_character_ LESS.new <- NA if(is.character(LESS) && length(LESS) == 1L) { if(isTRUE(grepl("^\\s*$", LESS)) || is.na(LESS) || !nzchar(LESS)) { LESS.new <- sprintf("-%s", flags) } else if( isTRUE(grepl("^\\s*-[[:alpha:]]+(\\s+-[[:alpha:]])*\\s*$", LESS)) ) { LESS.new <- sub( "\\s*\\K(-[[:alpha:]]+)\\b$", sprintf("\\1%s", flags), LESS, perl=TRUE ) } } if(!is.na(LESS.new)) Sys.setenv(LESS=LESS.new) LESS } reset_less_var <- function(LESS.old) { if(is.na(LESS.old)) { Sys.unsetenv("LESS") } else Sys.setenv(LESS=LESS.old) } diffobj/R/pager.R0000644000176200001440000004667515001264510013313 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. #' Objects for Specifying Pager Settings #' #' Initializers for pager configuration objects that modify pager behavior. #' These objects can be used as the \code{pager} argument to the #' \code{\link[=diffPrint]{diff*}} methods, or as the \code{pager} slot for #' \code{\link{Style}} objects. In this documentation we use the \dQuote{pager} #' term loosely and intend it to refer to any device other than the terminal #' that can be used to render output. #' #' @section Default Output Behavior: #' #' \code{\link[=diffPrint]{diff*}} methods use \dQuote{pagers} to help #' manage large outputs and also to provide an alternative colored diff when the #' terminal does not support them directly. #' #' For OS X and *nix systems where \code{less} is the pager and the #' terminal supports ANSI escape sequences, output is colored with ANSI escape #' sequences. If the output exceeds one screen height in size (as estimated by #' \code{\link{console_lines}}) it is sent to the pager. #' #' If the terminal does not support ANSI escape sequences, or if the system #' pager is not \code{less} as detected by \code{\link{pager_is_less}}, then the #' output is rendered in HTML and sent to the IDE viewer #' (\code{getOption("viewer")}) if defined, or to the browser with #' \code{\link{browseURL}} if not. This behavior may seem sub-optimal for #' systems that have ANSI aware terminals and ANSI aware pagers other than #' \code{less}, but these should be rare and it is possible to configure #' \code{diffobj} to produce the correct output for them (see examples). #' #' @section Pagers and Styles: #' #' There is a close relationship between pagers and \code{\link{Style}}. The #' \code{Style} objects control whether the output is raw text, formatted #' with ANSI escape sequences, or marked up with HTML. In order for these #' different types of outputs to render properly, they need to be sent to the #' right device. For this reason \code{\link{Style}} objects come with a #' \code{Pager} configuration object pre-assigned so the output can render #' correctly. The exact \code{Pager} configuration object depends on the #' \code{\link{Style}} as well as the system configuration. #' #' In any call to the \code{\link[=diffPrint]{diff*}} methods you can always #' specify both the \code{\link{Style}} and \code{Pager} configuration object #' directly for full control of output formatting and rendering. We have tried #' to set-up sensible defaults for most likely use cases, but given the complex #' interactions involved it is possible you may need to configure things #' explicitly. Should you need to define explicit configurations you can save #' them as option values with #' \code{options(diffobj.pager=..., diffobj.style=...)} so that you do not need #' to specify them each time you use \code{diffobj}. #' #' @section Pager Configuration Objects: #' #' The \code{Pager} configuration objects allow you to specify what device to #' use as the pager and under what circumstances the pager should be used. #' Several pre-defined pager configuration objects are available via #' constructor functions: #' \itemize{ #' \item \code{Pager}: Generic pager just outputs directly to terminal; not #' useful unless the default parameters are modified. #' \item \code{PagerOff}: Turn off pager #' \item \code{PagerSystem}: Use the system pager as invoked by #' \code{\link{file.show}} #' \item \code{PagerSystemLess}: Like \code{PagerSystem}, but provides #' additional configuration options if the system pager is \code{less}. #' Note this object does not change the system pager; it only allows you to #' configure it via the \code{$LESS} environment variable which will have #' no effect unless the system pager is set to be \code{less}. #' \item \code{PagerBrowser}: Use \code{getOption("viewer")} if defined, or #' \code{\link{browseURL}} if not #' } #' The default configuration for \code{PagerSystem} and \code{PagerSystemLess} #' leads to output being sent to the pager if it exceeds the estimated window #' size, whereas \code{PagerBrowser} always sends output to the pager. This #' behavior can be configured via the \code{threshold} parameter. #' #' \code{PagerSystemLess}'s primary role is to correctly configure the #' \code{$LESS} system variable so that \code{less} renders the ANSI escape #' sequences as intended. On OS X \code{more} is a faux-alias to \code{less}, #' except it does not appear to read the \code{$LESS} system variable. #' Should you configure your system pager to be the \code{more} version of #' \code{less}, \code{\link{pager_is_less}} will be tricked into thinking you #' are using a \dQuote{normal} version of \code{less} and you will likely end up #' seeing gibberish in the pager. If this is your use case you will need to #' set-up a custom pager configuration object that sets the correct system #' variables. #' #' @section Custom Pager Configurations: #' #' In most cases the simplest way to generate new pager configurations is to use #' a list specification in the \code{\link[=diffPrint]{diff*}} call. #' Alternatively you can start with an existing \code{Pager} object and change #' the defaults. Both these cases are covered in the examples. #' #' You can change what system pager is used by \code{PagerSystem} by changing it #' with \code{options(pager=...)} or by changing the \code{$PAGER} environment #' variable. You can also explicitly set a function to act as the pager when #' you instantiate the \code{Pager} configuration object (see examples). #' #' If you wish to define your own pager object you should do so by extending the #' any of the \code{Pager} classes. If the function you use to handle the #' actual paging is non-blocking (i.e. allows R code evaluation to continue #' after it is spawned, you should set the \code{make.blocking} parameter to #' TRUE to pause execution prior to deleting the temporary file that contains #' the diff. #' #' @param pager a function that accepts at least one parameter and does not #' require a parameter other than the first parameter. This function will be #' called with a file path passed as the first argument. The referenced file #' will contain the text of the diff. By default this is a temporary file that #' will be deleted as soon as the pager function completes evaluation. #' \code{PagerSystem} and \code{PagerSystemLess} use \code{\link{file.show}} #' by default, and \code{PagerBrowser} uses #' \code{\link{view_or_browse}} for HTML output. For asynchronous pagers such #' as \code{view_or_browse} it is important to make the pager function #' blocking by setting the \code{make.blocking} parameter to TRUE, or to #' specify a pager file path explicitly with \code{file.path}. #' @param file.ext character(1L) an extension to append to file path passed to #' \code{pager}, \emph{without} the period. For example, \code{PagerBrowser} #' uses \dQuote{html} to cause \code{\link{browseURL}} to launch the web #' browser. This parameter will be overridden if \code{file.path} is used. #' @param threshold integer(1L) number of lines of output that triggers the use #' of the pager; negative values lead to using #' \code{\link{console_lines} + 1}, and zero leads to always using the pager #' irrespective of how many lines the output has. #' @param ansi TRUE or FALSE, whether the pager supports ANSI CSI SGR sequences. #' @param flags character(1L), only for \code{PagerSystemLess}, what flags to #' set with the \code{LESS} system environment variable. By default the #' \dQuote{R} flag is set to ensure ANSI escape sequences are interpreted if #' it appears your terminal supports ANSI escape sequences. If you want to #' leave the output on the screen after you exit the pager you can use #' \dQuote{RX}. You should only provide the flag letters (e.g. \dQuote{"RX"}, #' not \code{"-RX"}). The system variable is only modified for the duration #' of the evaluation and is reset / unset afterwards. \emph{Note:} you must #' specify this slot via the constructor as in the example. If you set the #' slot directly it will not have any effect. #' @param file.path character(1L), if not NA the diff will be written to this #' location, ignoring the value of \code{file.ext}. If NA_character_ #' (default), a temporary file is used and removed after the pager function #' completes evaluation. If not NA, the file is preserved. Beware that the #' file will be overwritten if it already exists. #' @param make.blocking TRUE, FALSE, or NA. Whether to wrap \code{pager} with #' \code{\link{make_blocking}} prior to calling it. This suspends R code #' execution until there is user input so that temporary diff files are not #' deleted before the pager has a chance to read them. This typically #' defaults to FALSE, except for \code{PagerBrowser} where it defaults to NA, #' which resolves to \code{is.na(file.path)} (i.e. it is TRUE if the diff is #' being written to a temporary file, and FALSE otherwise). #' @param ... additional arguments to pass on to \code{new} that are passed on #' to parent classes. #' #' @aliases PagerOff, PagerSystem, PagerSystemLess, PagerBrowser #' @importFrom utils browseURL #' @include options.R #' @rdname Pager #' @name Pager #' @seealso \code{\link{Style}}, \code{\link{pager_is_less}} #' @examples #' ## We `dontrun` these examples as they involve pagers that should only be run #' ## in interactive mode #' \dontrun{ #' ## Specify Pager parameters via list; this lets the `diff*` functions pick #' ## their preferred pager based on format and other output parameters, but #' ## allows you to modify the pager behavior. #' #' f <- tempfile() #' diffChr(1:200, 180:300, format='html', pager=list(file.path=f)) #' head(readLines(f)) # html output #' unlink(f) #' #' ## Assuming system pager is `less` and terminal supports ANSI ESC sequences #' ## Equivalent to running `less -RFX` #' #' diffChr(1:200, 180:300, pager=PagerSystemLess(flags="RFX")) #' #' ## If the auto-selected pager would be the system pager, we could #' ## equivalently use: #' #' diffChr(1:200, 180:300, pager=list(flags="RFX")) #' #' ## System pager is not less, but it supports ANSI escape sequences #' #' diffChr(1:200, 180:300, pager=PagerSystem(ansi=TRUE)) #' #' ## Use a custom pager, in this case we make up a trivial one and configure it #' ## always page (`threshold=0L`) #' #' page.fun <- function(x) cat(paste0("| ", readLines(x)), sep="\n") #' page.conf <- PagerSystem(pager=page.fun, threshold=0L) #' diffChr(1:200, 180:300, pager=page.conf, disp.width=getOption("width") - 2) #' #' ## Set-up the custom pager as the default pager #' #' options(diffobj.pager=page.conf) #' diffChr(1:200, 180:300) #' #' ## A blocking pager (this is effectively very similar to what `PagerBrowser` #' ## does); need to block b/c otherwise temp file with diff could be deleted #' ## before the device has a chance to read it since `browseURL` is not #' ## blocking itself. On OS X we need to specify the extension so the correct #' ## program opens it (in this case `TextEdit`): #' #' page.conf <- Pager(pager=browseURL, file.ext="txt", make.blocking=TRUE) #' diffChr(1:200, 180:300, pager=page.conf, format='raw') #' #' ## An alternative to a blocking pager is to disable the #' ## auto-file deletion; here we also specify a file location #' ## explicitly so we can recover the diff text. #' #' f <- paste0(tempfile(), ".html") # must specify .html #' diffChr(1:5, 2:6, format='html', pager=list(file.path=f)) #' tail(readLines(f)) #' unlink(f) #' } setClass( "Pager", slots=c( pager="function", file.ext="character", threshold="numeric", ansi="logical", file.path="character", make.blocking="logical" ), prototype=list( pager=function(x) writeLines(readLines(x)), file.ext="", threshold=0L, ansi=FALSE, file.path=NA_character_, make.blocking=FALSE ), validity=function(object) { if(!is.chr.1L(object@file.ext)) return("Invalid `file.ext` slot") if(!is.int.1L(object@threshold)) return("Invalid `threshold` slot") if(!is.TF(object@ansi)) return("Invalid `ansi` slot") if(!is.logical(object@make.blocking) || length(object@make.blocking) != 1L) return("Invalid `make.blocking` slot") if(!is.character(object@file.path) || length(object@file.path) != 1L) return("Invalid `file.path` slot") TRUE } ) setMethod("initialize", "Pager", function(.Object, ...) { dots <- list(...) if("file.path" %in% names(dots)) { file.path <- dots[['file.path']] if(length(file.path) != 1L) stop("Argument `file.path` must be length 1.") if(is.na(file.path)) file.path <- NA_character_ if(!is.character(file.path)) stop("Argument `file.path` must be character.") dots[['file.path']] <- file.path } do.call(callNextMethod, c(list(.Object), dots)) } ) #' @export #' @rdname Pager Pager <- function( pager=function(x) writeLines(readLines(x)), file.ext="", threshold=0L, ansi=FALSE, file.path=NA_character_, make.blocking=FALSE ) { new( 'Pager', pager=pager, file.ext=file.ext, threshold=threshold, file.path=file.path, make.blocking=make.blocking ) } #' @export #' @rdname Pager setClass("PagerOff", contains="Pager") #' @export #' @rdname Pager PagerOff <- function(...) new("PagerOff", ...) #' @export #' @rdname Pager setClass( "PagerSystem", contains="Pager", prototype=list(pager=file.show, threshold=-1L, file.ext="") ) #' @export #' @rdname Pager PagerSystem <- function(pager=file.show, threshold=-1L, file.ext="", ...) new("PagerSystem", pager=pager, threshold=threshold, ...) #' @export #' @rdname Pager setClass( "PagerSystemLess", contains="PagerSystem", slots=c("flags"), prototype=list(flags="R") ) #' @export #' @rdname Pager PagerSystemLess <- function( pager=file.show, threshold=-1L, flags="R", file.ext="", ansi=TRUE, ... ) new( "PagerSystemLess", pager=pager, threshold=threshold, flags=flags, ansi=ansi, file.ext=file.ext, ... ) # Must use initialize so that the pager function can access the flags slot setMethod("initialize", "PagerSystemLess", function(.Object, ...) { dots <- list(...) flags <- if("flags" %in% names(dots)) { if(!is.chr.1L(dots[['flags']])) stop("Argument `flags` must be character(1L) and not NA") dots[['flags']] } else "" pager.old <- dots[['pager']] pager <- function(x) { old.less <- set_less_var(flags) on.exit(reset_less_var(old.less), add=TRUE) pager.old(x) } dots[['flags']] <- flags dots[['pager']] <- pager do.call(callNextMethod, c(list(.Object), dots)) } ) #' Create a Blocking Version of a Function #' #' Wraps \code{fun} in a function that runs \code{fun} and then issues a #' \code{readline} prompt to prevent further R code evaluation until user #' presses a key. #' #' @export #' @param fun a function #' @param msg character(1L) a message to use as the \code{readline} prompt #' @param invisible.res whether to return the result of \code{fun} invisibly #' @return \code{fun}, wrapped in a function that does the blocking. #' @examples #' make_blocking(sum, invisible.res=FALSE)(1:10) make_blocking <- function( fun, msg="Press ENTER to continue...", invisible.res=TRUE ) { if(!is.function(fun)) stop("Argument `fun` must be a function") if(!is.chr.1L(msg)) stop("Argument `msg` must be character(1L) and not NA") if(!is.TF(invisible.res)) stop("Argument `invisible.res` must be TRUE or FALSE") res <- function(...) { res <- fun(...) readline(msg) if(invisible.res) invisible(res) else res } res } #' Invoke IDE Viewer If Available, browseURL If Not #' #' Use \code{getOption("viewer")} to view HTML output if it is available as #' per \href{https://support.posit.co/hc/en-us/articles/202133558-Extending-RStudio-with-the-Viewer-Pane}{RStudio}. Fallback to \code{\link{browseURL}} #' if not available. #' #' @export #' @param url character(1L) a location containing a file to display #' @return the return vaue of \code{getOption("viewer")} if it is a function, or #' of \code{\link{browseURL}} if the viewer is not available view_or_browse <- function(url) { viewer <- getOption("viewer") view.success <- FALSE if(is.function(viewer)) { view.try <- try(res <- viewer(url), silent=TRUE) if(inherits(view.try, "try-error")) { warning( "IDE viewer failed with error ", conditionMessage(attr(view.try, "condition")), "; falling back to `browseURL`" ) } else view.success <- TRUE } if(!view.success) { res <- utils::browseURL(url) } res } setClass( "PagerBrowser", contains="Pager", prototype=list(threshold=0L, file.ext='html', make.blocking=NA) ) #' @export #' @rdname Pager PagerBrowser <- function( pager=view_or_browse, threshold=0L, file.ext="html", make.blocking=NA, ... ) new( "PagerBrowser", pager=pager, threshold=threshold, file.ext=file.ext, make.blocking=make.blocking, ... ) # Helper function to determine whether pager will be used or not use_pager <- function(pager, len) { if(!is(pager, "Pager")) stop("Logic Error: expecting `Pager` arg; contact maintainer.") # nocov if(!is(pager, "PagerOff")) { threshold <- if(pager@threshold < 0L) { console_lines() } else pager@threshold !threshold || len > threshold } else FALSE } #' Check Whether System Has less as Pager #' #' If \code{getOption(pager)} is set to the default value, checks whether #' \code{Sys.getenv("PAGER")} appears to be \code{less} by trying to run the #' pager with the \dQuote{version} and parsing the output. If #' \code{getOption(pager)} is not the default value, then checks whether it #' points to the \code{less} program by the same mechanism. #' #' Some systems may have \code{less} pagers installed that do not respond to the #' \code{$LESS} environment variable. For example, \code{more} on at least some #' versions of OS X is \code{less}, but does not actually respond to #' \code{$LESS}. If such as pager is the system pager you will likely end up #' seeing gibberish in the pager. If this is your use case you will need to #' set-up a custom pager configuration object that sets the correct system #' variables (see \code{\link{Pager}}). #' #' @seealso \code{\link{Pager}} #' @return TRUE or FALSE #' @export #' @examples #' pager_is_less() pager_is_less <- function() { pager.opt <- getOption("pager") if(pager_opt_default(pager.opt)) { file_is_less(Sys.getenv("PAGER")) } else if (is.character(pager.opt)) { file_is_less(head(pager.opt, 1L)) } else FALSE } pager_opt_default <- function(x=getOption("pager")) { is.character(x) && !is.na(x[1L]) && normalizePath(x[1L], mustWork=FALSE) == normalizePath(file.path(R.home(), "bin", "pager"), mustWork=FALSE) } ## Helper Function to Check if a File is Likely to be less Pager file_is_less <- function(x) { if(is.chr.1L(x) && file_test("-x", x)) { res <- tryCatch( system2(x, "--version", stdout=TRUE, stderr=TRUE), warning=function(e) NULL, error=function(e) NULL ) length(res) && grepl("^less \\d+", res[1L]) } else FALSE } diffobj/R/tochar.R0000644000176200001440000005075015001242043013457 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. # @include S4.R NULL # Compute the ranges of a hunk group based on atomic hunk ids # # rng.o is a matrix where each column represents `c(tar.rng, cur.rng)` # and rng.o has the original untrimmed values (ACTUALLY, not clear this is # what we are doing currently, seems like we're passing the post context # assesment hunks) # # fill indicates which lines where fill lines and should not be picked to # represent the start or end point of a range (these are added by the atomic # word diff) find_rng <- function(ids, rng.o, fill) { # first row of rng.o is the start of the hunk with.rng <- ids[which(rng.o[1L, ids] > 0L)] rng <- if(!length(with.rng)) { # Find previous earliest originally existing item we want to insert # after; note we need to look at the non-trimmed ranges, and we include # the first context atomic hunk in the group as a potential match prev <- rng.o[ 2L, seq_len(ncol(rng.o)) <= max(ids[[1L]], 0L) & rng.o[1L, ] > 0L ] if(!length(prev)) integer(2L) else c(max(prev), 0L) } else { c(min(rng.o[1L, intersect(ids, with.rng)]), max(rng.o[2L, ids])) } } # Create a text representation of a file line range to use in the hunk header rng_as_chr <- function(range) { if(length(range) < 2L) "0" else { a <- range[[1L]] b <- if(diff(range)) paste0(",", if(range[[2L]]) diff(range) + 1L else 0) paste0(a, b) } } # Finalization function should return a list with two character vectors for # diff contents, and two factor vectors denoting the type of content for # each of the character vectors where valid data types are ins, del, mtc, hdr, # ctx; chrt is just a helper function to generate factors with those possible # values chrt <- function(...) factor( c(...), levels=c( "insert", "delete", "match", "header", "context.sep", "banner.insert", "banner.delete", "guide", "fill" ) ) hunkl <- function(col.1=NULL, col.2=NULL, type.1=NULL, type.2=NULL) c( list( if(is.null(col.1)) list(dat=character(), type=chrt()) else list(dat=col.1, type=type.1) ), if(!is.null(col.2)) list(list(dat=col.2, type=type.2)) ) # finalization functions take aligned data and juxtapose it according to # selected display mode. Note that _context must operate on all the hunks # in a hunk group, whereas the other two operate on each hunk atom. Padding # is identified in two forms: as actual A.fill and B.fill values when there # was a wrapped diff, and in side by side mode when the lengths of A and B # are not the same and end up adding NAs. Padding is really only meaningful # for side by side mode so is removed in the other modes # The A.fill and B.fill business is a bit of a mess, because ideally we woudl # want a structure parallel to the data structure instead of just vectors that # we need to line up with the data lists, but this is all a result of trying # to shoehorn new functionality in... fin_fun_context <- function(dat) { dat_wo_fill <- function(x, ind) unlist(x[[ind]])[!x[[sprintf("%s.fill", ind)]]] A.dat <- lapply(dat, dat_wo_fill, "A") B.dat <- lapply(dat, dat_wo_fill, "B") A.lens <- vapply(A.dat, function(x) length(unlist(x)), integer(1L)) B.lens <- vapply(B.dat, function(x) length(unlist(x)), integer(1L)) A.ul <- unlist(A.dat) B.ul <- unlist(B.dat) context <- vapply(dat, "[[", logical(1L), "context") guide <- vapply(dat, "[[", logical(1L), "guide") A.ctx <- rep(context, A.lens) A.guide <- rep(guide, A.lens) B.ctx <- rep(context, B.lens) B.guide <- rep(guide, B.lens) A.types <- ifelse(A.guide, "guide", ifelse(A.ctx, "match", "delete")) B.types <- ifelse(B.guide, "guide", ifelse(B.ctx, "match", "insert")) # return in list so compatible with post `lapply` return values for other # finalization functions list( hunkl( col.1=c(A.ul, if(length(B.ul)) NA, B.ul), type.1=chrt(A.types, if(length(B.ul)) "context.sep", B.types) ) ) } fin_fun_unified <- function(A, B, A.fill, B.fill, context, guide) { A.lens <- vapply(A, length, integer(1L)) B.lens <- vapply(B, length, integer(1L)) A.ord <- rep(seq_along(A.lens), A.lens)[!A.fill] B.ord <- rep(seq_along(B.lens), B.lens)[!B.fill] A <- unlist(A)[!A.fill] B <- unlist(B)[!B.fill] ord <- order(c(A.ord, B.ord)) types <- c( rep(if(guide) "guide" else if(context) "match" else "delete", sum(A.lens)), rep(if(guide) "guide" else if(context) "match" else "insert", sum(B.lens)) ) hunkl( col.1=unlist(c(A, B)[ord]), type.1=chrt(unlist(types[ord])) ) } fin_fun_sidebyside <- function(A, B, A.fill, B.fill, context, guide) { for(i in seq_along(A)) { A.ch <- A[[i]] B.ch <- B[[i]] A.l <- length(A.ch) B.l <- length(B.ch) max.l <- max(A.l, B.l) length(A.ch) <- length(B.ch) <- max.l A[[i]] <- A.ch B[[i]] <- B.ch } A.ul <- unlist(A) B.ul <- unlist(B) A.fill.u <- B.fill.u <- !logical(length(A.ul)) A.fill.u[!is.na(A.ul)] <- A.fill B.fill.u[!is.na(B.ul)] <- B.fill A.len <- length(A.ul) B.len <- length(B.ul) hunkl( col.1=ifelse(is.na(A.ul), "", A.ul), col.2=ifelse(is.na(B.ul), "", B.ul), type.1=chrt( ifelse( rep(guide, A.len), "guide", ifelse(A.fill.u, "fill", ifelse(context, "match", "delete") ) ) ), type.2=chrt( ifelse( rep(guide, B.len), "guide", ifelse(B.fill.u, "fill", ifelse(context, "match", "insert") ) ) ) ) } # Convert a hunk group into text representation hunk_atom_as_char <- function(h.a, x) { etc <- x@etc mode <- x@etc@mode if(mode=="context") { ghd.mode.1 <- "A" ghd.mode.2 <- "B" ghd.type.1 <- ghd.type.2 <- "both" } else if(mode == "unified") { ghd.mode.1 <- ghd.mode.2 <-"A" ghd.type.1 <- "pos" ghd.type.2 <- "neg" } else if(mode == "sidebyside") { ghd.mode.1 <- "A" ghd.mode.2 <- "B" ghd.type.1 <- "pos" ghd.type.2 <- "neg" } A.ind <- get_hunk_ind(h.a, mode=ghd.mode.1, ghd.type.1) B.ind <- get_hunk_ind(h.a, mode=ghd.mode.2, ghd.type.2) # Align the lines accounting for partial matching post word-diff, # each diff style has a different finalization function dat.align <- align_eq(A.ind, B.ind, x=x, context=h.a$context) list( A=dat.align$A, B=dat.align$B, A.fill=dat.align$A.fill, B.fill=dat.align$B.fill, context=h.a$context, guide=h.a$guide ) } hunk_as_char <- function(h.g, h.h, x) { stopifnot(is(x, "Diff")) etc <- x@etc mode <- etc@mode hunk.head <- if(length(h.g) && !h.g[[1L]]$completely.empty) { list( if(mode == "sidebyside") { hunkl( col.1=h.h[1L], col.2=h.h[2L], type.1=chrt("header"), type.2=chrt("header") ) } else { hunkl(col.1=h.h, type.1=chrt("header")) } ) } # Generate hunk contents in aligned form hunk.res <- lapply(h.g, hunk_atom_as_char, x=x) # Run finalization functions; context mode is different because we need to # re-order across atomic hunks fin_fun <- switch( mode, unified=fin_fun_unified, sidebyside=fin_fun_sidebyside, context=fin_fun_context ) hunk.fin <- if(mode != "context") { lapply(hunk.res, function(x) do.call(fin_fun, x)) } else { fin_fun_context(hunk.res) } # Add header and return; this a list of lists, though all sub-lists should # have same format c(hunk.head, hunk.fin) } # Helper functions for 'as.character' # Get trimmed character ranges; positives are originally from target, and # negatives from current get_hunk_ind <- function(h.a, mode, type="both") { stopifnot( mode %in% LETTERS[1:2], length(mode) == 1L, is.chr.1L(type), type %in% c("both", "pos", "neg") ) rng.raw <- c( if(type %in% c("pos", "both")) seq(h.a$tar.rng.trim[[1L]], h.a$tar.rng.trim[[2L]]), if(type %in% c("neg", "both")) -seq(h.a$cur.rng.trim[[1L]], h.a$cur.rng.trim[[2L]]) ) rng.raw[rng.raw %in% h.a[[mode]]] } #' @rdname diffobj_s4method_doc setMethod("as.character", "Diff", function(x, ...) { old.crayon.opt <- options(crayon.enabled=is(x@etc@style, "StyleAnsi")) on.exit(options(old.crayon.opt), add=TRUE) hunk.limit <- x@etc@hunk.limit line.limit <- x@etc@line.limit hunk.limit <- x@etc@hunk.limit disp.width <- x@etc@disp.width hunk.grps <- x@diffs mode <- x@etc@mode tab.stops <- x@etc@tab.stops ignore.white.space <- x@etc@ignore.white.space sgr.supported <- x@etc@sgr.supported # legacy from when we had different max diffs for different parts of diff max.diffs <- x@etc@max.diffs max.diffs.in.hunk <- x@etc@max.diffs max.diffs.wrap <- x@etc@max.diffs s <- x@etc@style # shorthand len.max <- max(length(x@tar.dat$raw), length(x@cur.dat$raw)) no.diffs <- if(!suppressWarnings(any(x))) { # This needs to account for "trim" effects msg <- "No visible differences between objects" if( ( ignore.white.space || x@etc@convert.hz.white.space || !identical(x@etc@trim, trim_identity) || x@etc@strip.sgr ) && !isTRUE(all.equal(x@tar.dat$orig, x@cur.dat$orig)) && isTRUE(all.equal(x@tar.dat$comp, x@cur.dat$comp)) ) { paste0( msg, ", but there are some differences suppressed by ", "`ignore.white.space`, `convert.hz.white.space`, `strip.sgr`, ", "and/or `trim`. Set all those arguments to FALSE to highlight ", "the differences.", collapse="" ) } else if (!isTRUE(all.eq <- all.equal(x@target, x@current))) { c( paste0( msg, ", but objects are *not* `all.equal`", if(length(all.eq)) ":" else "." ), if(length(all.eq)) paste0("- ", all.eq) ) } else paste0(msg, ".") } # Basic width computation and banner size; start by computing gutter so we # can figure out what's left gutter.dat <- x@etc@gutter # Trim hunks to the extented needed to make sure we fit in lines hunks.flat <- unlist(hunk.grps, recursive=FALSE) ranges <- vapply( hunks.flat, function(h.a) c(h.a$tar.rng.trim, h.a$cur.rng.trim), integer(4L) ) ranges.orig <- vapply( hunks.flat, function(h.a) c(h.a$tar.rng.sub, h.a$cur.rng.sub), integer(4L) ) hunk.heads <- x@hunk.heads h.h.chars <- nchar2( chr_trim( unlist(hunk.heads), x@etc@line.width, sgr.supported=sgr.supported ), sgr.supported=sgr.supported ) # Make the object banner and compute more detailed widths post trim tar.banner <- if(!is.null(x@etc@tar.banner)) x@etc@tar.banner else deparse(x@etc@tar.exp)[[1L]] cur.banner <- if(!is.null(x@etc@cur.banner)) x@etc@cur.banner else deparse(x@etc@cur.exp)[[1L]] ban.A.trim <- if(s@wrap) chr_trim(tar.banner, x@etc@text.width, sgr.supported=sgr.supported) else tar.banner ban.B.trim <- if(s@wrap) chr_trim(cur.banner, x@etc@text.width, sgr.supported=sgr.supported) else cur.banner banner.A <- s@funs@word.delete(ban.A.trim) banner.B <- s@funs@word.insert(ban.B.trim) # Trim banner doesn't currently work, so we just comment the nulling out and # updated the docs. This doesn't seem worth fixing. The banner portion # would still show up with the banners themselves NULLed. if(line.limit[[1L]] >= 0) { ll2 <- line.limit[[2L]] # if(ll2 < 2L && mode != "sidebyside") { # banner.A <- NULL # } # if(ll2 < 1L) { # banner.B <- banner.A <- NULL # } } if(mode == "sidebyside") { line.limit <- pmax(integer(2L), line.limit - 2L) } else { line.limit <- pmax(integer(2L), line.limit - 1L) } # Post trim, figure out max lines we could possibly be showing from capture # strings; careful with ranges, trim.meta <- attr(hunk.grps, "meta") if(is.null(trim.meta)) stop("Internal error: missing trim meta data, contact maintainer") # nocov lim.line <- trim.meta$lines lim.hunk <- trim.meta$hunks ll <- !!lim.line[[1L]] lh <- !!lim.hunk[[1L]] diff.count <- count_diffs(hunk.grps) str.fold.out <- if(x@capt.mode == "str" && x@diff.count.full > diff.count) { paste0( x@diff.count.full - diff.count, " differences are hidden by our use of `max.level`" ) } limit.out <- if(ll || lh) { if(!is.null(str.fold.out)) { # nocov start stop( "Internal Error: should not be str folding when limited; contact ", "maintainer." ) # nocov end } paste0( "... omitted ", if(ll) sprintf("%d/%d lines", lim.line[[1L]], lim.line[[2L]]), if(ll && lh) ", ", if(lh) sprintf("%d/%d hunks", lim.hunk[[1L]], lim.hunk[[2L]]) ) } tar.max <- max(ranges[2L, ], 0L) cur.max <- max(ranges[4L, ], 0L) # At this point we need to actually reconstitute the final output string by: # - Applying word diffs # - Reconstructing untrimmed strings # - Substitute appropriate values for empty strings f.f <- x@etc@style@funs if(x@etc@word.diff) { tar.w.c <- word_color(x@tar.dat$trim, x@tar.dat$word.ind, f.f@word.delete) cur.w.c <- word_color(x@cur.dat$trim, x@cur.dat$word.ind, f.f@word.insert) } else { tar.w.c <- x@tar.dat$trim cur.w.c <- x@cur.dat$trim } x@tar.dat$fin <- untrim(x@tar.dat, tar.w.c, x@etc) x@cur.dat$fin <- untrim(x@cur.dat, cur.w.c, x@etc) # Generate the pre-rendered hunk data as text columns; a bit complicated # as we need to unnest stuff; use rbind to make it a little easier. pre.render.raw <- unlist( Map(hunk_as_char, hunk.grps, hunk.heads, x=list(x)), recursive=FALSE ) pre.render.mx <- do.call(rbind, pre.render.raw) pre.render.mx.2 <- lapply( split(pre.render.mx, col(pre.render.mx)), do.call, what="rbind" ) pre.render <- lapply( unname(pre.render.mx.2), function(mx) list( dat=unlist(mx[, 1L]), type=unlist(mx[, 2L], recursive=FALSE) ) ) # Add the banners; banners are rendered exactly like normal text, except # for the line level functions if(mode == "sidebyside") { pre.render[[1L]]$dat <- c(banner.A, pre.render[[1L]]$dat) pre.render[[1L]]$type <- c(chrt("banner.delete"), pre.render[[1L]]$type) pre.render[[2L]]$dat <- c(banner.B, pre.render[[2L]]$dat) pre.render[[2L]]$type <- c(chrt("banner.insert"), pre.render[[2L]]$type) } else { pre.render[[1L]]$dat <- c(banner.A, banner.B, pre.render[[1L]]$dat) pre.render[[1L]]$type <- c( chrt("banner.delete", "banner.insert"), pre.render[[1L]]$type ) } # Generate wrapped version of the text; if in sidebyside, make sure that # all elements are same length pre.render.w <- if(s@wrap) { pre.render.w <- replicate( length(pre.render), vector("list", length(pre.render[[1L]]$dat)), simplify=FALSE ) for(i in seq_along(pre.render)) { hdr <- pre.render[[i]]$type == "header" pre.render.w[[i]][hdr] <- wrap( pre.render[[i]]$dat[hdr], x@etc@line.width, sgr.supported=sgr.supported ) pre.render.w[[i]][!hdr] <- wrap( pre.render[[i]]$dat[!hdr], x@etc@text.width, sgr.supported=sgr.supported ) } pre.render.w } else lapply(pre.render, function(y) as.list(y$dat)) line.lens <- lapply(pre.render.w, vapply, length, integer(1L)) types.raw <- lapply(pre.render, "[[", "type") types <- lapply( types.raw, function(y) sub("^banner\\.", "", as.character(y)) ) if(mode == "sidebyside") { line.lens.max <- replicate(2L, do.call(pmax, line.lens), simplify=FALSE) pre.render.w <- lapply( pre.render.w, function(y) { Map( function(dat, len) { length(dat) <- len dat }, y, line.lens.max[[1L]] ) } ) } else line.lens.max <- line.lens # Substitute NA elements with the appropriate values as dictated by the # styles; also record lines NA positions lines.na <- lapply(pre.render.w, lapply, is.na) pre.render.w <- lapply( pre.render.w, lapply, function(y) { res <- y res[is.na(y)] <- x@etc@style@na.sub res } ) # Compute gutter, padding, and continuations gutters <- render_gutters( types=types, lens=line.lens, lens.max=line.lens.max, etc=x@etc ) # Pad text pre.render.w.p <- if(s@pad) { Map( function(col, type) { diff.line <- type %in% c("insert", "delete", "match", "guide", "fill") col[diff.line] <- lapply( col[diff.line], rpad, x@etc@text.width, sgr.supported=sgr.supported ) col[!diff.line] <- lapply( col[!diff.line], rpad, x@etc@line.width, sgr.supported=sgr.supported ) col }, pre.render.w, types ) } else pre.render.w # Apply text level styles; make sure that all types are defined here # otherwise you'll get lines missing in output; note that fill lines were # represented by NAs originally and we indentify them within each aligned # group with `lines.na` # NOTE: any changes here need to be reflected in `make_dummy_row` # CAN WE MOVE THIS WAY EARLIER SO WE CAN GET THE CORRECT TEXT WIDTHS? # SEE #65 es <- x@etc@style funs.ts <- list( insert=function(x) es@funs@text(es@funs@text.insert(x)), delete=function(x) es@funs@text(es@funs@text.delete(x)), match=function(x) es@funs@text(es@funs@text.match(x)), guide=function(x) es@funs@text(es@funs@text.guide(x)), fill=function(x) es@funs@text(es@funs@text.fill(x)), context.sep=function(x) es@funs@text(es@funs@context.sep(es@text@context.sep)), header=es@funs@header ) pre.render.s <- Map( function(dat, type, l.na) { res <- vector("list", length(dat)) for(i in names(funs.ts)) # really need to loop through all? res[type == i] <- Map( function(y, l.na.i) { res.s <- y if(any(l.na.i)) res.s[l.na.i] <- funs.ts$fill(y[l.na.i]) res.s[!l.na.i | i == "context.sep"] <- funs.ts[[i]](y[!l.na.i]) res.s }, dat[type == i], l.na[type == i] ) res }, pre.render.w.p, types, lines.na ) # Reconstruct 'types.raw' with the appropriate lenghts, and replacing # types with 'fill' if elements were extended due to wrap types.raw.x <- Map( function(y, z) { Map( function(y.s, z.s) { res <- rep(y.s, length(z.s)) res[z.s] <- "fill" res }, y, z ) }, types.raw, lines.na ) # Render columns; note here we use 'types.raw' to distinguish banner lines cols <- render_cols( cols=pre.render.s, gutters=gutters, types=types.raw.x, etc=x@etc ) # Render rows rows <- render_rows(cols, etc=x@etc) # Collect all the pieces, and for the meta pieces wrap, pad, and format pre.fin.l <- list(no.diffs, rows, limit.out, str.fold.out) meta.elem <- c(1L, 3:4) pre.fin.l[meta.elem] <- lapply( pre.fin.l[meta.elem], # meta should not have any csi, so plain strwrap is okay function(m) es@funs@meta(strwrap(m, width=disp.width)) ) pre.fin <- unlist(pre.fin.l) # Apply subsetting as needed ind <- seq_along(pre.fin) ind <- if(length(x@sub.index)) ind[x@sub.index] else ind if(length(x@sub.head)) ind <- head(ind, x@sub.head) if(length(x@sub.tail)) ind <- tail(ind, x@sub.tail) # Do the finalization pre.fin <- pre.fin[ind] res.len <- length(pre.fin) finalize(es@funs@container(pre.fin), x, res.len) } ) # Finalizing fun used by both Diff and DiffSummary as.character methods finalize <- function(txt, obj, len) { style <- obj@etc@style pager <- style@pager obj@etc@style@pager <- if(use_pager(pager, len)) pager else PagerOff() fin <- style@finalizer(obj, txt) attr(fin, "len") <- len fin } diffobj/R/hunks.R0000644000176200001440000005745215001242043013335 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. # Convert ses data into raw hunks that include both match hunks as well as # actual hunks # # These hunks are then processed into hunk groups in a separate step # (see `group_hunks`). # # @return a list of atomic hunks, each containing integer vectors A and B where # positive numbers reference character lines from target and negative ones # from current. For "context" and "sidebyside" mode the A vector will contain # the lines from target, and the B vector the lines from current. For # "unified" only the A vector is populated. In addition to the A and B # vectors some other meta data is tracked, such as the range of the hunks is # also stored as tar.rng and cur.rng; mostly inferrable from the actual data # in the hunks, except that in unified mode we no longer have the actual # context strings from the `current` vector. # # starting to have second thoughts about removing all the non index data from # hunks, particularly because it makes the line length calc a pita. setGeneric("as.hunks", function(x, etc, ...) standardGeneric("as.hunks")) setMethod("as.hunks", c("MyersMbaSes", "Settings"), function( x, etc, ... ) { # Split our data into sections that have either deletes/inserts or matches dat <- as.matrix(x) sects <- unique(dat[, "section"]) j <- 0L res.l <- if(!nrow(dat)) { # Minimum one empty hunk if nothing; make this a context hunk to indicate # that there are no differences. This used to be a non-context hunk list( list( id=1L, A=integer(0L), B=integer(0L), context=TRUE, guide=FALSE, tar.rng=integer(2L), cur.rng=integer(2L), tar.rng.sub=integer(2L), cur.rng.sub=integer(2L), tar.rng.trim=integer(2L), cur.rng.trim=integer(2L), completely.empty=TRUE ) ) } else { lapply( seq_along(sects), function(i) { s <- sects[i] d <- dat[which(dat[, "section"] == s), , drop=FALSE] d.del <- d[which(.edit.map[d[, "type"]] == "Delete"), ,drop=FALSE] d.ins <- d[which(.edit.map[d[, "type"]] == "Insert"), ,drop=FALSE] d.mtc <- d[which(.edit.map[d[, "type"]] == "Match"), ,drop=FALSE] # R 3.3.3 had sum(integer(0)) == 1! del.len <- if(nrow(d.del)) sum(d.del[, "len"]) else 0L ins.len <- if(nrow(d.ins)) sum(d.ins[, "len"]) else 0L mtc.len <- if(nrow(d.mtc)) sum(d.mtc[, "len"]) else 0L tar.len <- del.len + mtc.len cur.len <- ins.len + mtc.len # atomic hunks may only be del/ins or match, not both if((del.len || ins.len) && mtc.len || !(del.len + ins.len + mtc.len)) stop("Logic Error: unknown edit types; contact maintainer.") # nocov # Figure out where previous hunk left off del.last <- if(nrow(d.del)) d.del[1L, "last.a"] else d[1L, "last.a"] ins.last <- if(nrow(d.ins)) d.ins[1L, "last.b"] else d[1L, "last.b"] A.start <- unname(del.last) B.start <- unname(ins.last) # record `cur` indices as negatives tar <- seq_len(tar.len) + A.start cur <- -(seq_len(cur.len) + B.start) context <- !!mtc.len A <- switch( etc@mode, context=tar, unified=c(tar, if(!context) cur), sidebyside=tar, stop("Logic Error: unknown mode; contact maintainer.") ) B <- switch( etc@mode, context=cur, unified=integer(), sidebyside=cur, stop("Logic Error: unknown mode; contact maintainer.") ) # compute ranges tar.rng <- cur.rng <- integer(2L) if(tar.len) tar.rng <- c(A.start + 1L, A.start + tar.len) if(cur.len) cur.rng <- c(B.start + 1L, B.start + cur.len) list( id=i, A=A, B=B, context=context, guide=FALSE, tar.rng=tar.rng, cur.rng=cur.rng, tar.rng.sub=tar.rng, cur.rng.sub=cur.rng, tar.rng.trim=tar.rng, cur.rng.trim=cur.rng, completely.empty=FALSE ) } ) } res.l } ) # Group hunks together based on context, in "auto" mode we find the context # that maximizes lines displayed while adhering to line and hunk limits # Definitely not very efficient since we re-run code multiple times we # probably don't need to. # # Important: context atomic hunks are duplicated anytime there is enough # context that we only show part of the context hunk. # # @return a list containing lists of atomic hunks. Each of these sub-lists # of atomic hunks is treated as a "hunk", but is really a combination of # context and hunks which we will refer to as "hunk group". In each hunk # group, There may be as little as one hunk with no context, or many hunks and # context if the context between hunks is not sufficient to meet the requested # context, in which case the hunks bleed together forming these hunk groups. group_hunks <- function(hunks, etc, tar.capt, cur.capt) { context <- etc@context line.limit <- etc@line.limit ctx.val <- if(is(context, "AutoContext")) { len <- diff_line_len( p_and_t_hunks(hunks, ctx.val=context@max, etc=etc), etc=etc, tar.capt=tar.capt, cur.capt=cur.capt ) len.min <- diff_line_len( p_and_t_hunks(hunks, ctx.val=context@min, etc=etc), etc=etc, tar.capt=tar.capt, cur.capt=cur.capt ) if(line.limit[[1L]] < 0L) { context@max } else if(len.min > line.limit[[1L]]) { context@min } else { ctx.max <- ctx.hi <- ctx <- context@max ctx.lo <- context@min safety <- 0L repeat { if((safety <- safety + 1L) > ctx.max) # nocov start stop( "Logic Error: stuck trying to find auto-context; contact ", "maintainer." ) # nocov end if(len > line.limit[[1L]] && ctx - ctx.lo > 1L) { ctx.hi <- ctx ctx <- as.integer((ctx - ctx.lo) / 2) } else if (len < line.limit[[1L]] && ctx.hi - ctx > 1L) { ctx.lo <- ctx ctx <- ctx + as.integer(ceiling(ctx.hi - ctx) / 2) } else if (len > line.limit[[1L]]) { # unable to get something small enough, but we know min context # works from inital test ctx <- context@min break } else if (len <= line.limit[[1L]]) { break } len <- diff_line_len( p_and_t_hunks(hunks, ctx.val=ctx, etc=etc), etc=etc, tar.capt=tar.capt, cur.capt=cur.capt ) } ctx } } else context res <- process_hunks(hunks, ctx.val=ctx.val, etc=etc) res } # process the hunks and also drop off groups that exceed limit # # used exclusively when we are trying to auto-calculate context p_and_t_hunks <- function(hunks.raw, ctx.val, etc) { c.all <- process_hunks(hunks.raw, ctx.val, etc) hunk.limit <- etc@hunk.limit if(hunk.limit[[1L]] >= 0L && length(c.all) > hunk.limit[[1L]]) c.all <- c.all[seq_along(hunk.limit[[2L]])] c.all } # Subset hunks; should only ever be subsetting context hunks hunk_sub <- function(hunk, op, n) { stopifnot( op %in% c("head", "tail"), hunk$context, all(hunk$tar.rng.sub), length(hunk$tar.rng.sub) == length(hunk$cur.rng.sub), diff(hunk$tar.rng.sub) == diff(hunk$cur.rng.sub), length(hunk$tar.rng.sub) == 2L ) hunk.len <- diff(hunk$tar.rng.sub) + 1L len.diff <- hunk.len - n if(len.diff >= 0) { nm <- c("A", "B", "A.tok.ratio", "B.tok.ratio") hunk[nm] <- lapply(hunk[nm], op, n) # Need to recompute ranges if(n) { if(op == "tail") { hunk$tar.rng.trim[[1L]] <- hunk$tar.rng.sub[[1L]] <- hunk$tar.rng.sub[[1L]] + len.diff hunk$cur.rng.trim[[1L]] <- hunk$cur.rng.sub[[1L]] <- hunk$cur.rng.sub[[1L]] + len.diff } else { hunk$tar.rng.trim[[2L]] <- hunk$tar.rng.sub[[2L]] <- hunk$tar.rng.sub[[2L]] - len.diff hunk$cur.rng.trim[[2L]] <- hunk$cur.rng.sub[[2L]] <- hunk$cur.rng.sub[[2L]] - len.diff } } else { hunk$tar.rng.trim <- hunk$cur.rng.trim <- hunk$tar.rng.sub <- hunk$cur.rng.sub <- integer(2L) } } hunk } # Figure Out Context for Each Chunk # # If a hunk bleeds into another due to context then it becomes part of the # other hunk. # # This will group atomic hunks into hunk groups with matching line in excess of # context removed. process_hunks <- function(x, ctx.val, etc) { context <- ctx.val ctx.vec <- vapply(x, "[[", logical(1L), "context") if(!all(abs(diff(ctx.vec)) == 1L)) # nocov start stop( "Logic Error: atomic hunks not interspersing context; contact maintainer." ) # nocov end hunk.len <- length(x) # Special cases, including only one hunk or forcing only one hunk group, or # no differences if(context < 0L || hunk.len < 2L || !any(ctx.vec)) { res.l <- list(x) } else { # Normal cases; allocate maximum possible number of elements, may need fewer # if hunks bleed into each other res.l <- vector("list", sum(!ctx.vec)) # Jump through every second value as those are the mismatch hunks, though # first figure out if first hunk is mismatching, and merge hunks. This # is likely not super efficient as we keep growing a list, though the only # thing we are actually re-allocating is the list index really, at least if # R is being smart about not copying the list contents (which as of 3.1 I # think it is...) i <- if(ctx.vec[[1L]]) 2L else 1L j <- 1L while(i <= hunk.len) { # Merge left res.l[[j]] <- if(i - 1L) list(hunk_sub(x[[i - 1L]], "tail", context), x[[i]]) else x[i] # Merge right if(i < hunk.len) { # Hunks bleed into next hunk due to context; note that i + 1L will always # be a context hunk, so $A is fully representative while( i < hunk.len && length(x[[i + 1L]]$A) <= context * 2 && i + 1L < length(x) ) { res.l[[j]] <- append(res.l[[j]], x[i + 1L]) if(i < hunk.len - 1L) res.l[[j]] <- append(res.l[[j]], x[i + 2L]) i <- i + 2L } # Context enough to cause a break if(i < hunk.len) { res.l[[j]] <- append( res.l[[j]], list(hunk_sub(x[[i + 1L]], "head", context)) ) } } j <- j + 1L i <- i + 2L } length(res.l) <- j - 1L } # Add back the guide hunks if needed they didn't make it in as part of the # context or differences. It should be the case that the only spot that could # have missing hunk guides is the first hunk in a hunk group if it is a # context hunk # First, determine which guides if any need to be added back; need to do it # first because it is possible that a guide is present at the end context # of the prior hunk group # Helper fun to pull out indices of guide.lines get_guides <- function(hunk, rows, mode) { stopifnot(hunk$context) rng <- hunk[[sprintf("%s.rng", mode)]] rng.sub <- hunk[[sprintf("%s.rng.sub", mode)]] h.rows <- rows[which(!rows %bw% rng.sub & rows %bw% rng)] # If context hunk already contains guide row and there is a non guide at # beginning of hunk, then we don't need to return a guide row if(any(rows %bw% rng.sub) && !rng.sub[[1L]] %in% rows) { integer(0L) } else { # special case where the first row in the subbed hunk is a context row; # note we need to look at the first non-blank row; since this has to be # a context hunk we can just look at A.chr first.is.guide <- FALSE if(rng.sub[[1L]] %in% rows) { first.is.guide <- TRUE h.rows <- c(h.rows, rng.sub[[1L]]) } # we want all guide.lines that abut the last matched guide row if(length(h.rows)) { h.fin <- h.rows[seq(to=max(h.rows), length.out=length(h.rows)) == h.rows] if(first.is.guide) h.fin <- head(h.fin, -1L) # convert back to indeces relative to hunk h.fin - rng[[1L]] + 1L } else integer(0L) } } for(k in seq_along(res.l)) { if(length(res.l[[k]]) && res.l[[k]][[1L]]$context) { h <- res.l[[k]][[1L]] h.o <- x[[res.l[[k]][[1L]]$id]] # retrieve original untrimmed hunk if(! identical( h$tar.rng.sub, h$cur.rng.sub - h$cur.rng.sub[1L] + h$tar.rng.sub[1L] ) ) stop("Logic Error: unequal context hunks; contact mainainer") # nocov # since in a context hunk, everything in tar and cur is the same, so # we just need to recompute the `cur` guidelines relative to tar indices # since the guidelines need not be the same (e.g., in lists that are # mostly the same, but deeper in one object, guideline will be deepest # index entry, which will be different. tar.cand.guides <- intersect( etc@guide.lines@target, seq(h$tar.rng[1L], h$tar.rng[2L], by=1L) ) cur.cand.guides <- intersect( etc@guide.lines@current, seq(h$cur.rng[1L], h$cur.rng[2L], by=1L) ) - h$cur.rng[1L] + h$tar.rng[1L] h.guides <- get_guides( h, unique(c(tar.cand.guides, cur.cand.guides)), "tar" ) if(length(h.guides)) { h.h <- hunk_sub(h.o, "head", max(h.guides)) tail.ind <- if(length(h.guides) == 1L) 1L else diff(range(h.guides)) + 1L h.fin <- hunk_sub(h.h, "tail", tail.ind) h.fin$guide <- TRUE res.l[[k]] <- c(list(h.fin), res.l[[k]]) } } } # Finalize, including sizing correctly, and setting the ids to the right # values since we potentially duplicated some context hunks res.fin <- res.l k <- 1L for(i in seq_along(res.fin)) { for(j in seq_along(res.fin[[i]])) { res.fin[[i]][[j]][["id"]] <- k k <- k + 1L } } res.fin } # Account for overhead / side by sideness in width calculations # Internal funs hunk_len <- function(hunk.id, hunks, tar.capt, cur.capt, etc) { disp.width <- etc@disp.width mode <- etc@mode hunk <- hunks[[hunk.id]] A.lines <- nlines(get_dat_raw(hunk$A, tar.capt, cur.capt), disp.width, mode, etc) B.lines <- nlines(get_dat_raw(hunk$B, tar.capt, cur.capt), disp.width, mode, etc) # Depending on each mode, figure out how to set up the lines; # straightforward except for context where we need to account for the # fact that all the A of a hunk group are shown first, and then all # the B are shown lines.out <- switch( mode, context=c(A.lines, if(!hunk$guide) -B.lines), unified=c(A.lines), sidebyside={ max.len <- max(length(A.lines), length(B.lines)) length(A.lines) <- length(B.lines) <- max.len c(pmax(A.lines, B.lines, na.rm=TRUE)) }, stop("Logic Error: unknown mode '", mode, "' contact maintainer") ) # Make sure that line.id refers to the position of the line in either # original A or B vector l.o.len <- length(lines.out) line.id <- integer(l.o.len) l.gt.z <- lines.out > 0L l.gt.z.w <- which(l.gt.z) line.id[l.gt.z.w] <- seq_along(l.gt.z.w) l.lt.z.w <- which(!l.gt.z) line.id[l.lt.z.w] <- seq_along(l.lt.z.w) cbind( hunk.id=if(length(lines.out)) hunk.id else integer(), line.id=unname(line.id), len=lines.out ) } hunk_grp_len <- function( hunk.grp.id, hunk.grps, etc, tar.capt, cur.capt ) { mode <- etc@mode hunks <- hunk.grps[[hunk.grp.id]] hunks.proc <- lapply( seq_along(hunks), hunk_len, hunks=hunks, etc=etc, tar.capt=tar.capt, cur.capt=cur.capt ) res.tmp <- do.call(rbind, hunks.proc) res <- cbind(grp.id=if(nrow(res.tmp)) hunk.grp.id else integer(0L), res.tmp) # Need to make sure all positives are first, and all negatives second, if # there are negatives (context mode); also, if the first hunk in a hunk # group, add a line for the hunk header, though hunk header itself is added # later extra <- if(length(hunks)) 1L else 0L if(identical(mode, "context")) res <- res[order(res[, "len"] < 0L), , drop=FALSE] if( identical(mode, "context") && length(negs <- which(res[, "len"] < 0L)) && length(poss <- which(res[, "len"] > 0L)) ) { # Add one for hunk header, one for context separator; remember, that lengths # in the B hunk are counted negatively res[1L, "len"] <- res[1L, "len"] + extra res[negs[[1L]], "len"] <- res[negs[[1L]], "len"] - extra } else if(nrow(res)) { res[1L, "len"] <- res[1L, "len"] + extra } res } # Compute how many lines the display version of the diff will take, meta # lines (used for hunk guides) are denoted by negatives # # count lines for each remaining hunk and figure out if we need to cut some # hunks off; note that "negative" lengths indicate the lines being counted # originated from the B hunk in context mode get_hunk_chr_lens <- function(hunk.grps, etc, tar.capt, cur.capt) { mode <- etc@mode disp.width <- etc@disp.width # Generate a matrix with hunk group id, hunk id, and wrapped length of each # line that we can use to figure out what to show do.call( rbind, lapply( seq_along(hunk.grps), hunk_grp_len, etc=etc, tar.capt=tar.capt, cur.capt=cur.capt, hunk.grps=hunk.grps ) ) } # Compute total diff length in lines diff_line_len <- function(hunk.grps, etc, tar.capt, cur.capt) { max( 0L, cumsum( get_hunk_chr_lens( hunk.grps, etc=etc, tar.capt=tar.capt, cur.capt=cur.capt )[, "len"] ) ) + banner_len(etc@mode) } # completely.empty used to highlight difference between hunks that technically # contain a header and no data vs those that can't even contain a header; # unfortunately a legacy of poor design choice in how headers are handled empty_hunk_grp <- function(h.g) { for(j in seq_along(h.g)) { h.g[[j]][c("tar.rng.trim", "cur.rng.trim")] <- list(integer(2L), integer(2L)) h.g[[j]]$completely.empty <- TRUE } h.g } # Remove hunk groups and atomic hunks that exceed the line limit # # Return value is a hunk group list, with an attribute indicating how many # hunks and lines were trimmed trim_hunk <- function(hunk, type, line.id) { stopifnot(type %in% c("tar", "cur")) rng.idx <- sprintf("%s.rng.trim", type) hunk[[rng.idx]] <- if(!line.id) integer(2L) else { if(all(hunk[[rng.idx]])) { c( hunk[[rng.idx]][[1L]], min(hunk[[rng.idx]][[1L]] + line.id - 1L, hunk[[rng.idx]][[2L]]) ) } else integer(2L) } hunk } trim_hunks <- function(hunk.grps, etc, tar.raw, cur.raw) { stopifnot(is(etc, "Settings")) mode <- etc@mode disp.width <- etc@disp.width hunk.limit <- etc@hunk.limit line.limit <- etc@line.limit diffs.orig <- count_diffs(hunk.grps) hunk.grps.count <- length(hunk.grps) if(hunk.limit[[1L]] < 0L) hunk.limit <- rep(hunk.grps.count, 2L) hunk.limit.act <- if(hunk.grps.count > hunk.limit[[1L]]) hunk.limit[[2L]] hunk.grps.omitted <- max(0L, hunk.grps.count - hunk.limit.act) hunk.grps.used <- min(hunk.grps.count, hunk.limit.act) hunk.grps <- hunk.grps[seq_len(hunk.grps.used)] lines <- get_hunk_chr_lens( hunk.grps, etc=etc, tar.capt=tar.raw, cur.capt=cur.raw ) cum.len <- cumsum(abs(lines[, "len"])) cut.off <- -1L lines.omitted <- 0L lines.total <- max(0L, tail(cum.len, 1L)) if(line.limit[[1L]] < 0L) { cut.off <- max(0L, cum.len) } else if(any(cum.len > line.limit[[1L]])) { cut.off <- max(0L, cum.len[cum.len <= line.limit[[2L]]]) } if(cut.off > 0) { lines.omitted <- lines.total - cut.off cut.dat <- lines[max(which(cum.len <= cut.off)), ] grp.cut <- cut.dat[["grp.id"]] hunk.cut <- cut.dat[["hunk.id"]] line.cut <- cut.dat[["line.id"]] line.neg <- cut.dat[["len"]] < 0 # completely trim hunks that will not be shown grps.to.cut <- setdiff(seq_along(hunk.grps), seq_len(grp.cut)) for(i in grps.to.cut) hunk.grps[[i]] <- empty_hunk_grp(hunk.grps[[i]]) hunk.grps.used <- grp.cut hunk.grps.omitted <- max(0L, hunk.grps.count - grp.cut) # Remove excess lines from the atomic hunks based on the limits; we don't # update the ranges as those should still indicate what the original # untrimmed range was # special case for first hunk in group since we need to account for hunk # header that takes up a line; this is not ideal, hunk header should be # made part of hunks eventually if(mode == "context") { # Context tricky because every atomic hunk B data is displayed after all # the A data for(i in seq_along(hunk.grps[[grp.cut]])) { hunk.atom <- hunk.grps[[grp.cut]][[i]] if(!line.neg) { # means all B blocks must be dropped hunk.atom <- trim_hunk(hunk.atom, "cur", 0L) if(i > hunk.cut) { hunk.atom <- trim_hunk(hunk.atom, "tar", 0L) } else if (i == hunk.cut) { hunk.atom <- trim_hunk(hunk.atom, "tar", line.cut) } } else { if(i > hunk.cut) { hunk.atom <- trim_hunk(hunk.atom, "cur", 0L) } else if (i == hunk.cut) { hunk.atom <- trim_hunk(hunk.atom, "cur", line.cut) } } hunk.grps[[grp.cut]][[i]] <- hunk.atom } } else { hunk.atom <- hunk.grps[[grp.cut]][[hunk.cut]] hunk.atom <- trim_hunk(hunk.atom, "tar", line.cut) if(mode == "unified") { # Need to share lines between tar and cur in unified mode line.cut <- max( 0L, line.cut - if(any(hunk.atom$tar.rng)) diff(hunk.atom$tar.rng) + 1L else 0L ) } hunk.atom <- trim_hunk(hunk.atom, "cur", line.cut) hunk.grps[[grp.cut]][[hunk.cut]] <- hunk.atom null.hunks <- seq_len(length(hunk.grps[[grp.cut]]) - hunk.cut) + hunk.cut hunk.grps[[grp.cut]][null.hunks] <- lapply( hunk.grps[[grp.cut]][null.hunks], function(h.a) { h.a <- trim_hunk(h.a, "cur", 0L) h.a <- trim_hunk(h.a, "tar", 0L) h.a } ) } } else if (!cut.off && length(cum.len)) { lines.omitted <- lines.total hunk.grps.omitted <- hunk.grps.count for(i in seq_along(hunk.grps)) hunk.grps[[i]] <- empty_hunk_grp(hunk.grps[[i]]) } diffs.trim <- count_diffs(hunk.grps) attr(hunk.grps, "meta") <- list( lines=as.integer(c(lines.omitted, lines.total)), hunks=as.integer(c(hunk.grps.omitted, hunk.grps.count)), diffs=as.integer(c(diffs.orig - diffs.trim, diffs.orig)) ) hunk.grps } # Helper fun line_count <- function(rng) if(rng[[1L]]) rng[[2L]] - rng[[1L]] + 1L else 0L # Count how many "lines" of differences there are in the hunks # # Counts original diff lines, not lines left after trim. This is because # we are checking for 'str' folding, and 'str' folding should only happen # if the folded results fits fully within limit. # # param x should be a hunk group list count_diffs <- function(x) { sum( vapply( unlist(x, recursive=FALSE), function(y) if(y$context) 0L else line_count(y$tar.rng) + line_count(y$cur.rng), integer(1L) ) ) } # More detailed counting of differences; note that context counting is messed # up b/c context's are duplicated around each hunk. This is primarily used for # the summary method count_diffs_detail <- function(x) { x.flat <- unlist(x, recursive=FALSE) guides <- vapply(x.flat, "[[", logical(1L), "guide") vapply( x.flat[!guides], function(y) if(y$context) c(match=line_count(y$tar.rng), delete=0L, add=0L) else c(match=0L, delete=line_count(y$tar.rng), add=line_count(y$cur.rng)), integer(3L) ) } count_diff_hunks <- function(x) sum(!vapply(unlist(x, recursive=FALSE), "[[", logical(1L), "context")) diffobj/R/options.R0000644000176200001440000000506515001242043013671 0ustar liggesusers# Default options; beware of defining default options that may have different # values during package install, which is when this list is contructed, and # function runtime .default.opts <- list( diffobj.context=2L, diffobj.context.auto.min=1L, diffobj.context.auto.max=10L, diffobj.ignore.white.space=TRUE, diffobj.convert.hz.white.space=TRUE, diffobj.strip.sgr=NULL, diffobj.line.limit=-1L, diffobj.pager="auto", diffobj.pager.mode="threshold", diffobj.pager.threshold=-1L, diffobj.pager.file.keep=FALSE, diffobj.pager.file.path=NA_character_, diffobj.less.flags="R", diffobj.word.diff=TRUE, diffobj.unwrap.atomic=TRUE, diffobj.rds=TRUE, diffobj.hunk.limit=-1L, diffobj.mode="auto", diffobj.silent=FALSE, diffobj.warn=TRUE, diffobj.max.diffs=50000L, diffobj.align=NULL, # NULL == AlignThreshold() diffobj.align.threshold=0.25, diffobj.align.min.chars=3L, diffobj.align.count.alnum.only=TRUE, diffobj.style="auto", diffobj.format="auto", diffobj.interactive=NULL, # NULL == interactive() diffobj.color.mode="yb", diffobj.term.colors=NULL, diffobj.brightness="neutral", diffobj.tab.stops=8L, diffobj.disp.width=0L, # 0L == use style width, see param docs diffobj.palette=NULL, # NULL == PaletteOfStyles() diffobj.guides=TRUE, diffobj.trim=TRUE, diffobj.html.escape.html.entities=TRUE, diffobj.html.js=NULL, # NULL == diffobj_js() diffobj.html.css=NULL, # NULL == diffobj_css() diffobj.sgr.supported=NULL, # These next two also have defaults set in the `getOption` call in styles.R # because of problems with R 3.1 where initialize methods are called on # install diffobj.html.scale=TRUE, diffobj.html.output="auto" ) #' Set All diffobj Options to Defaults #' #' Used primarily for testing to ensure all options are set to default values. #' #' @export #' @return list for use with \code{options} that contains values of #' \code{diffob} options before they were forced to defaults #' @examples #' \dontrun{ #' diffobj_set_def_opts() #' } diffobj_set_def_opts <- function() options(.default.opts) #' Shorthand Function for Accessing diffobj Options #' #' \code{gdo(x)} is equivalent to \code{getOption(sprintf("diffobj.\%s", x))}, #' falling back to \pkg{diffobj}'s internal default value if the option is #' not set. #' #' @export #' @param x character(1L) name off \code{diffobj} option to retrieve, without #' the \dQuote{diffobj.} prefix #' @examples #' gdo("format") gdo <- function(x) { opt <- sprintf("diffobj.%s", x) getOption(opt, .default.opts[[opt]]) } diffobj/R/misc.R0000644000176200001440000003006715001242043013131 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. # Used so that `with_mock` will work since these are primitives, for testing interactive <- function() base::interactive() readline <- function(...) if(interactive()) base::readline(...) # nocov # Returns the indices of the original rle object that correspond to the # ind rle values rle_sub <- function(rle, ind) { ind <- if(is.numeric(ind)) { as.integer(ind) } else if(is.logical(ind)) { which(ind) } else stop("Internal Error: unexpected `ind` input") # nocov if(!all(ind) > 0 || !all(diff(ind) > 0)) stop("Internal Error: `ind` should be monotonically increasing") # nocov len.cum <- cumsum(rle$lengths) all.ind <- Map( seq, from=c(1L, head(len.cum, -1L) + 1L), to=len.cum, by=1L ) all.ind[ind] } # concatenate method for factors c.factor <- function(..., recursive=FALSE) { dots <- list(...) dots.n.n <- dots[!vapply(dots, is.null, logical(1L))] if(!length(dots)) factor(character()) else { if( !all(vapply(dots.n.n, is, logical(1L), "factor")) || length(unique(lapply(dots.n.n, levels))) != 1L ) { NextMethod() } else { int.f <- unlist(lapply(dots.n.n, as.integer)) lvl <- levels(dots[[1L]]) factor(lvl[int.f], levels=lvl) } } } # Pull out the names of the functions in a sys.call stack stack_funs <- function(s.c) { if(!length(s.c)) stop("Internal Error: call stack empty; contact maintainer.") #nocov vapply( s.c, function(call) paste0(deparse(call), collapse="\n"), character(1L) ) } .internal.call <- quote(.local(target, current, ...)) # Pull out the first call reading back from sys.calls that is likely to be # be the top level call to the diff* methods. This is somewhat fragile # unfortunately, but there doesn't seem to be a systematic way to figure this # out which_top <- function(s.c) { if(!length(s.c)) # nocov start stop("Internal Error: stack should have at least one call, contact maintainer") # nocov end funs <- stack_funs(s.c) fun.ref <- stack_funs(list(.internal.call)) # find .local call fun.ref.loc <- match(fun.ref, funs, nomatch=0L) f.rle <- rle(funs) val.calls <- f.rle$lengths == 2 # default if failed to find a value is last call on stack res <- length(s.c) if(any(val.calls) && fun.ref.loc) { # return first index of last pairs of identical calls in the call stack # that is followed by a correct .internal call, and also that are not # calls to `eval`. rle.elig <- rle_sub(f.rle, which(val.calls)) rle.elig.max <- vapply(rle.elig, max, integer(1L)) rle.followed <- which( rle.elig.max < max(fun.ref.loc) & !grepl("eval\\(", funs[rle.elig.max]) ) if(length(rle.followed)) { # can't find correct one res <- rle.elig[[max(rle.followed)]][1L] } } res } get_fun <- function(name, env) { get.fun <- if(is.name(name) || (is.character(name) && length(name) == 1L)) { try(get(as.character(name), envir=env), silent=TRUE) } else if( is.call(name) && ( identical(as.character(name[[1L]]), "::") || identical(as.character(name[[1L]]), ":::") ) && length(name) == 3L ) { get.fun <- try(eval(name, env)) } else function(...) NULL if(is.function(get.fun)) get.fun else { warning( "Unable to find function `", deparse(name), "` to ", "match call with." ) NULL } } extract_call <- function(s.c, par.env) { idx <- which_top(s.c) found.call <- s.c[[idx]] no.match <- list(call=NULL, tar=NULL, cur=NULL) get.fun <- get_fun(found.call[[1L]], env=par.env) res <- no.match if(is.function(get.fun)) { found.call.m <- try( # this creates an environment where `...` is available so we don't # get a "... used in a situation it does not exist error" (issue 134) (function(...) { match.call(definition=get.fun, call=found.call, envir=environment()) })() ) if(!inherits(found.call.m, "try-error")) { if(length(found.call.m) < 3L) { found.call.ml <- as.list(found.call.m) length(found.call.ml) <- 3L # found.call.ml[[3L]] <- quote(list(x=))[[2L]] found.call.m <- as.call(found.call.ml) } res <- list(call=found.call.m, tar=found.call.m[[2L]], cur=found.call.m[[3L]]) } else { # nocov start # not sure if it's possible to get here, seems like not, maybe we can # get rid of try, but don't want to risk breaking stuff that used to work warning( "Failed trying to recover tar/cur expressions for display, see ", "previous errors." ) # nocov end } } res } #' Get Parent Frame of S4 Call Stack #' #' Implementation of the \code{function(x=parent.frame()) ...} pattern for the #' \code{\link[=diffPrint]{diff*}} methods since the normal pattern does not #' work with S4 methods. Works by looking through the call stack and #' identifying what call likely initiated the S4 dispatch. #' #' The function is not exported and intended only for use as the default value #' for the \code{frame} argument for the \code{\link[=diffPrint]{diff*}} #' methods. #' #' Matching is done purely by looking for the last repeated call followed #' by \code{.local(target, current, ...)} that is not a call to \code{eval}. #' This pattern seems to match the correct call most of the time. #' Since methods can be renamed by the user we make no attempt to verify method #' names. This method could potentially be tricked if you implement custom #' \code{\link[=diffPrint]{diff*}} methods that somehow #' issue two identical sequential calls before calling \code{callNextMethod}. #' Failure in this case means the wrong \code{frame} will be returned. #' #' @return an environment par_frame <- function() { s.c <- head(sys.calls(), -1L) top <- which_top(s.c) par <- head(sys.parents(), -1L)[top] if(par) { head(sys.frames(), -1L)[[par]] } else .GlobalEnv # can't figure out how to cause this branch } # check whether running in knitr # in_knitr <- function() isTRUE(getOption('knitr.in.progress')) make_err_fun <- function(call) function(...) stop(simpleError(do.call(paste0, list(...)), call=call)) make_warn_fun <- function(call) function(...) warning(simpleWarning(do.call(paste0, list(...)), call=call)) # Function used to match against `str` calls since the existing function # does not actually define `max.level`; note it never is actually called # nocov start str_tpl <- function(object, max.level, comp.str, indent.str, ...) NULL # nocov end # utility fun to deparse into chr1L dep <- function(x) paste0(deparse(x, width.cutoff=500L), collapse="") # Reports how many levels deep each line of a `str` screen output is str_levels <- function(str.txt, wrap=FALSE) { if(length(str.txt) < 2L) { integer(length(str.txt)) } else { # annoying `wrap` kills leading whitespace, so we need separate patterns sub.pat <- if(wrap) { "^(\\.\\. )*\\.\\.[@$\\-]" } else { "^ ( \\.\\.)*[@$\\-]" } tl.pat <- if(wrap) "^(\\$|-)" else "^ (\\$|-)" subs <- character(length(str.txt)) subs.rg <- regexpr(sub.pat, str.txt, perl=TRUE) subs[subs.rg > 0] <- regmatches(str.txt, subs.rg) subs.fin <- regmatches(subs, gregexpr("\\.\\.", subs, perl=TRUE)) level <- vapply(subs.fin, length, integer(1L)) top.level <- grepl(tl.pat, str.txt) level[!!level & !top.level] <- level[!!level & !top.level] + 1L level[1L] <- 0L level[top.level] <- 1L # handle potential wrapping; need to detect which sections of the text # are at level 0, and if they are, give them the depth of the previous # section if(wrap) { sects <- c( 0L, cumsum(xor(head(level, -1L) == 0L, tail(level, -1L) == 0L)) ) level.s <- split(level, sects) if(length(level.s) > 1L) { for(i in 2L:length(level.s)){ if(!any(level.s[[i]])) level.s[[i]][] <- tail(level.s[[i - 1L]], 1L) } # could just unlist since sections are supposed to be monotonic in vec level <- unsplit(level.s, sects) } } level } } # Calculate how many lines the banner will take up banner_len <- function(mode) if(mode == "sidebyside") 1L else 2L # Compute display width in characters # # Note this does not account for the padding required .pad <- list(context=2L, sidebyside=2L, unified=2L) .min.width <- 6L calc_width <- function(width, mode) { # stopifnot( # is.numeric(width), length(width) == 1L, !is.na(width), is.finite(width), # width >= 0L, # is.character(mode), mode %in% c("context", "unified", "sidebyside") # ) width <- as.integer(width) width.tmp <- if(mode == "sidebyside") as.integer(floor((width - 2)/ 2)) else width as.integer(max(.min.width, width.tmp)) } calc_width_pad <- function(width, mode) { # stopifnot( # is.character(mode), mode %in% c("context", "unified", "sidebyside") # ) width.tmp <- calc_width(width, mode) width.tmp - .pad[[mode]] } # Helper function to retrieve a palette parameter get_pal_par <- function(format, param) { if(is.chr.1L(param) && is.null(names(param))) { param } else if(format %in% names(param)) { param[format] } else if (wild.match <- match("", names(param), nomatch=0L)) { param[wild.match] } else # nocov start stop("Internal Error: malformed palette parameter; contact maintainer.") # nocov end } # check whether argument list contains non-default formals has_non_def_formals <- function(arg.list) { stopifnot(is.pairlist(arg.list) || is.list(arg.list)) any( vapply( arg.list, function(x) is.name(x) && !nzchar(as.character(x)), logical(1L) ) ) } # Between `%bw%` <- function(x, y) { stopifnot(length(y) == 2L) if(y[[1L]] < y[[2L]]) { low <- y[[1L]] hi <- y[[2L]] } else { hi <- y[[1L]] low <- y[[2L]] } x >= low & x <= hi } flatten_list <- function(l) if(is.list(l) && !is.object(l) && length(l)) do.call(c, lapply(l, flatten_list)) else list(l) trimws2 <- function(x, which=c("both", "left", "right")) { if( !is.character(which) || !isTRUE(which[[1]] %in% c("both", "left", "right")) ) stop("Argument which is wrong") switch(which[[1]], both=gsub("^[ \t\r\n]*|[ \t\r\n]*$", "", x), left=gsub("^[ \t\r\n]*", "", x), right=gsub("[ \t\r\n]*$", "", x) ) } # this gets overwritten in .onLoad if needed (i.e. R version < 3.2) trimws <- NULL # Placeholders until we are able to use fansi versions substr2 <- function(x, start, stop, sgr.supported) { len.x <- length(x) if( (length(start) != 1L && length(start) != len.x) || (length(stop) != 1L && length(stop) != len.x) ) stop("`start` and `stop` must be length 1 or the same length as `x`.") res <- substr(x, start, stop) if(sgr.supported) { has.ansi <- grep("\033[", x, fixed=TRUE) if(length(has.ansi)) { res[has.ansi] <- crayon::col_substr( x[has.ansi], if(length(start) != 1L) start[has.ansi] else start, if(length(stop) != 1L) stop[has.ansi] else stop ) } } res } strsplit2 <- function(x, ..., sgr.supported) { res <- strsplit(x, ...) if(sgr.supported) { has.ansi <- grep("\033[", x, fixed=TRUE) if(length(has.ansi)) res[has.ansi] <- crayon::col_strsplit(x[has.ansi], ...) } res } nchar2 <- function(x, ..., sgr.supported) { if(sgr.supported) crayon::col_nchar(x, ...) else nchar(x, ...) } # These are internal methods for testing #' @export print.diffobj_ogewlhgiadfl <- function(x, ...) stop('failure') #' @export as.character.diffobj_ogewlhgiadfl2 <- function(x, ...) stop('failure2') #' @export as.character.diffobj_ogewlhgiadfl3 <- function(x, ...) x diffobj/R/myerssimple.R0000644000176200001440000001367015001242043014550 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. # These are deprecated legacy functions from before we incorporated the # libmba versions of the myers algo # Alternate implementation of Myers algorithm in R, without linear space # modification. Included here mostly for reference purposes and not intended # for use since the MBA myers implemenation should be far superior myers_simple <- function(target, current) { path <- myers_simple_int(target, current) diff_path_to_diff(path, target, current) } myers_simple_int <- function(A, B) { N <- length(A) M <- length(B) MAX <- M + N + 1L OFF <- MAX + 1L # offset to adjust to R indexing Vl <- vector("list", MAX) for(D in seq_len(MAX) - 1L) { Vl[[D + 1L]] <- if(!D) integer(2L * MAX + 1L) else Vl[[D]] for(k in seq(-D, D, by=2L)) { # not sure of precendence for || vs && # k == -D means x == 0 V <- Vl[[D + 1L]] if(k == -D || (k != D && V[k - 1L + OFF] < V[k + 1L + OFF])) { x <- V[k + 1L + OFF] } else { x <- V[k - 1L + OFF] + 1L } y <- x - k # Move on diagonal while (x < N && y < M && A[x + 1L] == B[y + 1L]) { x <- x + 1L y <- y + 1L } # Record last match or end; if a mismatch no longer increment Vl[[D + 1L]][k + OFF] <- x if(x >= N && y >= M) { # Create matrix to hold entire result path; should be longest of # A and B plus recorded differences path.len <- D + max(N, M) res <- matrix(integer(1L), nrow=path.len, ncol=2) res[path.len, ] <- c(x, y) path.len <- path.len - 1L for(d in rev(seq_len(D))) { Vp <- Vl[[d]] break.out <- FALSE repeat { # can't match to zero since that is the initialized value shift.up <- Vp[k + 1L + OFF] == x && x shift.left <- Vp[k - 1L + OFF] == x - 1L && x > 1L if(x <= 0L && y <= 0L) { break } else if(!shift.up && !shift.left) { # must be on snake or about to hit 0,0 x <- max(x - 1L, 0L) y <- max(y - 1L, 0L) } else { if(shift.up) { y <- y - 1L k <- k + 1L } else { x <- x - 1L k <- k - 1L } break.out <- TRUE } res[path.len, ] <- c(x, y) path.len <- path.len - 1L if(break.out) break } } if(any(res < 0L)) { # nocov start stop( "Logic Error: diff generated illegal coords; contact maintainer." ) # nocov end } return(res) } } } stop("Logic Error, should not get here") # nocov } # Translates a diff path produced by the simple Myers Algorithm into the # standard format we use in the rest of the package diff_path_to_diff <- function(path, target, current) { stopifnot( is.character(target), is.character(current), is.matrix(path), is.integer(path), ncol(path) == 2, all(path[, 1L] %in% c(0L, seq_along(target))), all(path[, 2L] %in% c(0L, seq_along(current))) ) # Path specifies 0s as well as duplicate coordinates, which we don't use # in our other formats. For dupes, find first value for each index that is # lined up with a real value in the other column get_dupe <- function(x) { base <- !logical(length(x)) if(!length(y <- which(x != 0L))) base[[1L]] <- FALSE else base[[min(y)]] <- FALSE base } cur.dup <- as.logical(ave(path[, 1L], path[, 2L], FUN=get_dupe)) tar.dup <- as.logical(ave(path[, 2L], path[, 1L], FUN=get_dupe)) path[!path] <- NA_integer_ path[tar.dup, 1L] <- NA_integer_ path[cur.dup, 2L] <- NA_integer_ # Now create the character equivalents of the path matrix tar.path <- target[path[, 1L]] cur.path <- current[path[, 2L]] # Mark the equalities in the path matrix by setting them negative path[which(tar.path == cur.path), ] <- -path[which(tar.path == cur.path), ] # Remaining numbers are the mismatches which we will arbitrarily assign to # each other; to do so we first split our data into groups of matches and # mismatches and do the mapping there-in. We also get rid of non-matching # entries. matched <- ifelse(!is.na(path[, 1]) & path[, 1] < 0L, 1L, 0L) splits <- cumsum(abs(diff(c(0, matched)))) chunks <- split.data.frame(path, splits) res.tar <- res.cur <- vector("list", length(chunks)) mm.count <- 0L # for tracking matched mismatches for(i in seq_along(chunks)) { x <- chunks[[i]] if((neg <- any(x < 0L, na.rm=TRUE)) && !all(x < 0L, na.rm=TRUE)) stop("Internal Error: match group error; contact maintainer") # nocov if(neg) { # Matches, so equal length and set to zero res.tar[[i]] <- res.cur[[i]] <- integer(nrow(x)) } else { # Mismatches tar.mm <- Filter(Negate(is.na), x[, 1L]) cur.mm <- Filter(Negate(is.na), x[, 2L]) x.min.len <- min(length(tar.mm), length(cur.mm)) res.tar[[i]] <- res.cur[[i]] <- seq_len(x.min.len) + mm.count mm.count <- x.min.len + mm.count length(res.tar[[i]]) <- length(tar.mm) length(res.cur[[i]]) <- length(cur.mm) } } if(!length(res.tar)) res.tar <- integer() if(!length(res.cur)) res.cur <- integer() return(list(target=unlist(res.tar), current=unlist(res.cur))) } diffobj/R/finalizer.R0000644000176200001440000000604615001242043014161 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. #' @include s4.R NULL #' Finalizing Methods for HTML Output #' #' Used as the \code{finalizer} slot to \code{\link{StyleHtml}} objects to wrap #' character output prior to output to device. Used primarily by styles that #' output to HTML to properly configure HTML page structure, including injecting #' JS, CSS, etc.. #' #' @param x object to finalize #' @param x.chr character text representation of \code{x}, typically generated #' with the \code{as.character} method for \code{x} #' @param js character javascript code to append to HTML representation #' @param ... arguments to pass on to methods #' @export setGeneric( "finalizeHtml", function(x, ...) standardGeneric("finalizeHtml") # nocov ) #' @rdname finalizeHtml setMethod("finalizeHtml", c("ANY"), function(x, x.chr, js, ...) { if(!is.character(x.chr)) stop("Argument `x.chr` must be character") if(!is.chr.1L(js)) stop("Argument `js` must be character(1L) and not NA.") style <- x@etc@style html.output <- style@html.output pager <- style@pager if(html.output == "auto") { html.output <- if(is(pager, "PagerBrowser")) "page" else "diff.only" } if(html.output %in% c("diff.w.style", "page")) { css.txt <- try(paste0(readLines(style@css), collapse="\n"), silent=TRUE) if(inherits(css.txt, "try-error")) { cond <- attr(css.txt, "condition") warning( "Unable to read provided css file \"", style@css, "\" (error: ", paste0(conditionMessage(cond), collapse=""), ")." ) css <- "" } else { css <- sprintf("", css.txt) } } if(html.output == "diff.w.style") { tpl <- "%s%s" } else if (html.output == "page") { x.chr <- enc2utf8(x.chr) charset <- '' tpl <- sprintf(" %s\n %%s\n
\n%%s\n
", charset, js ) } else if (html.output == "diff.only") { css <- "" tpl <- "%s%s" } else stop("Internal Error: unexpected html.output; contact maintainer.")# nocov sprintf(tpl, css, paste0(x.chr, collapse="")) } ) diffobj/R/s4.R0000644000176200001440000004307315001242043012525 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. #' @include misc.R #' @include styles.R #' @include pager.R NULL # S4 class definitions setClassUnion("charOrNULL", c("character", "NULL")) #' Dummy Doc File for S4 Methods with Existing Generics #' #' @keywords internal #' @name diffobj_s4method_doc #' @rdname diffobj_s4method_doc NULL #' Controls How Lines Within a Diff Hunk Are Aligned #' #' @slot threshold numeric(1L) between 0 and 1, what proportion of words #' in the lines must match in order to align them. Set to 1 to effectively #' turn aligning off. Defaults to 0.25. #' @slot min.chars integer(1L) positive, minimum number of characters that must #' match across lines in order to align them. This requirement is in addition #' to \code{threshold} and helps minimize spurious alignments. Defaults to #' 3. #' @slot count.alnum.only logical(1L) modifier for \code{min.chars}, whether to #' count alpha numeric characters only. Helps reduce spurious alignment #' caused by meta character sequences such as \dQuote{[[1]]} that would #' otherwise meet the \code{min.chars} limit #' @export AlignThreshold #' @exportClass AlignThreshold #' @examples #' a1 <- AlignThreshold(threshold=0) #' a2 <- AlignThreshold(threshold=1) #' a3 <- AlignThreshold(threshold=0, min.chars=2) #' ## Note how "e f g" is aligned #' diffChr(c("a b c e", "d e f g"), "D e f g", align=a1, pager="off") #' ## But now it is not #' diffChr(c("a b c e", "d e f g"), "D e f g", align=a2, pager="off") #' ## "e f" are not enough chars to align #' diffChr(c("a b c", "d e f"), "D e f", align=a1, pager="off") #' ## Override with min.chars, so now they align #' diffChr(c("a b c", "d e f"), "D e f", align=a3, pager="off") AlignThreshold <- setClass("AlignThreshold", slots=c( threshold="numeric", min.chars="integer", count.alnum.only="logical" ), validity=function(object) { if( length(object@threshold) != 1L || is.na(object@threshold) || !object@threshold %bw% c(0, 1) ) return("Slot `threhold` must be numeric(1L) between 0 and 1") if(!is.int.1L(object@min.chars) || object@min.chars < 0L) return("Slot `min.chars` must be integer(1L) and positive") if(!is.TF(object@count.alnum.only)) return("Slot `count.alnum.only` must be TRUE or FALSE") } ) setMethod( "initialize", "AlignThreshold", function( .Object, threshold=gdo("align.threshold"), min.chars=gdo("align.min.chars"), count.alnum.only=gdo("align.count.alnum.only"), ... ) { if(is.numeric(min.chars)) min.chars <- as.integer(min.chars) callNextMethod( .Object, threshold=threshold, min.chars=min.chars, count.alnum.only=count.alnum.only, ... ) } ) setClass("AutoContext", slots=c( min="integer", max="integer" ), validity=function(object) { if(!is.int.1L(object@max) || object@min < 0L) return("Slot `max` must be integer(1L), positive, and not NA") if(!is.int.1L(object@max)) return("Slot `max` must be integer(1L), and not NA") if(object@max > 0L && object@min > object@max) return("Slot `max` must be negative, or greater than slot `min`") TRUE } ) setClassUnion("doAutoCOrInt", c("AutoContext", "integer")) # pre-computed gutter data GuideLines <- setClass( "GuideLines", slots=c(target="integer", current="integer"), validity=function(object) { vals <- c(object@target, object@current) if(anyNA(vals) || any(vals < 1L)) return("Object may only contain strictly positive integer values") TRUE } ) setClass("StripRowHead", slots=c(target="ANY", current="ANY"), validity=function(object) { if(!isTRUE(err <- is.one.arg.fun(object@target))) return(err) if(!isTRUE(err <- is.one.arg.fun(object@current))) return(err) TRUE } ) setClass("Gutter", slots= c( insert="character", insert.ctd="character", delete="character", delete.ctd="character", match="character", match.ctd="character", guide="character", guide.ctd="character", fill="character", fill.ctd="character", context.sep="character", context.sep.ctd="character", pad="character", width="integer" ) ) setClass("Settings", slots=c( mode="character", # diff output mode context="doAutoCOrInt", line.limit="integer", style="Style", hunk.limit="integer", max.diffs="integer", word.diff="logical", unwrap.atomic="logical", align="AlignThreshold", ignore.white.space="logical", convert.hz.white.space="logical", strip.sgr="logical", sgr.supported="logical", frame="environment", tab.stops="integer", tar.exp="ANY", cur.exp="ANY", tar.banner="charOrNULL", cur.banner="charOrNULL", guides="ANY", guide.lines="GuideLines", trim="ANY", strip.row.head="StripRowHead", disp.width="integer", line.width="integer", text.width="integer", line.width.half="integer", text.width.half="integer", gutter="Gutter", err="function", warn="function" ), prototype=list( disp.width=0L, text.width=0L, line.width=0L, text.width.half=0L, line.width.half=0L, guides=function(obj, obj.as.chr) integer(0L), trim=function(obj, obj.as.chr) cbind(1L, nchar(obj.as.chr)), ignore.white.space=TRUE, convert.hz.white.space=TRUE, word.diff=TRUE, unwrap.atomic=TRUE, strip.sgr=TRUE, sgr.supported=TRUE, err=stop, warn=warning ), validity=function(object){ int.1L.and.pos <- c( "disp.width", "line.width", "text.width", "line.width.half", "text.width.half" ) for(i in int.1L.and.pos) if(!is.int.1L(slot(object, i)) || slot(object, i) < 0L) return(sprintf("Slot `%s` must be integer(1L) and positive", i)) TF <- c( "ignore.white.space", "convert.hz.white.space", "word.diff", "unwrap.atomic", "strip.sgr" ) for(i in TF) if(!is.TF(slot(object, i)) || slot(object, i) < 0L) return(sprintf("Slot `%s` must be TRUE or FALSE", i)) if(!is.TF(object@guides) && !is.function(object@guides)) return("Slot `guides` must be TRUE, FALSE, or a function") if( is.function(object@guides) && !isTRUE(v.g <- is.two.arg.fun(object@guides)) ) return(sprintf("Slot `guides` is not a valid guide function (%s)", v.g)) if(!is.TF(object@trim) && !is.function(object@trim)) return("Slot `trim` must be TRUE, FALSE, or a function") if( is.function(object@trim) && !isTRUE(v.t <- is.two.arg.fun(object@trim)) ) return(sprintf("Slot `trim` is not a valid trim function (%s)", v.t)) TRUE } ) setMethod("initialize", "Settings", function(.Object, ...) { if(is.numeric(.Object@disp.width)) .Object@disp.width <- as.integer(.Object@disp.width) return(callNextMethod(.Object, ...)) } ) setGeneric("sideBySide", function(x, ...) standardGeneric("sideBySide")) setMethod("sideBySide", "Settings", function(x, ...) { x@mode <- "sidebyside" x@text.width <- x@text.width.half x@line.width <- x@line.width.half x } ) .diff.dat.cols <- c( "orig", "raw", "trim", "trim.ind.start", "trim.ind.end", "comp", "eq", "fin", "fill", "word.ind", "tok.rat" ) # Validate the *.dat slots of the Diff objects # # We stopped using this one because it was too expensive computationally. # Saving the code just in case. # valid_dat <- function(x) { # char.cols <- c("orig", "raw", "trim", "eq", "comp", "fin") # list.cols <- c("word.ind") # zerotoone.cols <- "tok.rat" # integer.cols <- c("trim.ind.start", "trim.ind.end") # # if(!is.list(x)) { # "should be a list" # } else if(!identical(names(x), .diff.dat.cols)) { # paste0("should have names ", dep(.diff.dat.cols)) # } else if( # length( # unique( # vapply( # x[c(char.cols, list.cols, zerotoone.cols, integer.cols)], # length, integer(1L) # ) # ) ) != 1L # ) { # "should have equal length components" # } else { # if( # length( # not.char <- which(!vapply(x[char.cols], is.character, logical(1L))) # ) # ){ # sprintf("element `%s` should be character", char.cols[not.char][[1L]]) # } else if ( # length( # not.int <- which(!vapply(x[integer.cols], is.integer, logical(1L))) # ) # ) { # sprintf("element `%s` should be integer", integer.cols[not.int][[1L]]) # } else if ( # length( # not.list <- which(!vapply(x[list.cols], is.list, logical(1L))) # ) # ) { # sprintf("element `%s` should be list", list.cols[not.list][[1L]]) # } else if ( # !all( # vapply( # x$word.ind, # function(y) # is.integer(y) && is.integer(attr(y, "match.length")) && # length(y) == length(attr(y, "match.length")), # logical(1L) # ) ) # ) { # "element `word.ind` is not in expected format" # } else if ( # !is.numeric(x$tok.rat) || anyNA(x$tok.rat) || !all(x$tok.rat %bw% c(0, 1)) # ) { # "element `tok.rat` should be numeric with all values between 0 and 1" # } else if (!is.logical(x$fill) || anyNA(x$fill)) { # "element `fill` should be logical and not contain NAs" # } # else TRUE # } # } #' Diff Result Object #' #' Return value for the \code{\link[=diffPrint]{diff*}} methods. Has #' \code{show}, \code{as.character}, \code{summmary}, \code{[}, \code{head}, #' \code{tail}, and \code{any} methods. #' #' @export setClass("Diff", slots=c( target="ANY", # Actual object tar.dat="list", # see line_diff() for details current="ANY", cur.dat="list", diffs="list", trim.dat="list", # result of trimmaxg sub.index="integer", sub.head="integer", sub.tail="integer", capt.mode="character", # whether in print or str mode hit.diffs.max="logical", diff.count.full="integer", # only really used by diffStr when folding hunk.heads="list", etc="Settings" ), prototype=list( capt.mode="print", trim.dat=list(lines=integer(2L), hunks=integer(2L), diffs=integer(2L)), hit.diffs.max=FALSE, diff.count.full=-1L ), validity=function(object) { # Most of the validation is done by `check_args` if( !is.chr.1L(object@capt.mode) || ! object@capt.mode %in% c("print", "str", "chr", "deparse", "file") ) return("slot `capt.mode` must be either \"print\" or \"str\"") not.list.3 <- !is.list(object@trim.dat) || length(object@trim.dat) != 3L not.names <- !identical(names(object@trim.dat), c("lines", "hunks", "diffs")) not.comp.1 <- !all(vapply(object@trim.dat, is.integer, logical(1L))) not.comp.2 <- !all(vapply(object@trim.dat, length, integer(1L)) == 2L) if(not.list.3) return( paste0( "slot `trim.dat` is not a length 3 list (", typeof(object@trim.dat), ", ", length(object@trim.dat) ) ) if(not.names) return( paste0( "slot `trim.dat` has wrong names", deparse(names(object@trim.dat))[1] ) ) if(not.comp.1) return( paste0( "slot `trim.dat` has non-integer components ", deparse(vapply(object@trim.dat, typeof, character(1L)))[1] ) ) if(not.comp.2) return("slot `trim.dat` has components of length != 2") ## too expensive computationally # if(!isTRUE(tar.dat.val <- valid_dat(object@tar.dat))) # return(paste0("slot `tar.dat` not valid: ", tar.dat.val)) # if(!isTRUE(cur.dat.val <- valid_dat(object@cur.dat))) # return(paste0("slot `cur.dat` not valid: ", cur.dat.val)) if(!is.TF(object@hit.diffs.max)) return("slot `hit.diffs.max` must be TRUE or FALSE") TRUE } ) #' @rdname finalizeHtml setMethod("finalizeHtml", c("Diff"), function(x, x.chr, ...) { style <- x@etc@style html.output <- style@html.output if(html.output == "auto") { html.output <- if(is(style@pager, "PagerBrowser")) "page" else "diff.only" } if(html.output == "page") { x.chr <- c( make_dummy_row(x), sprintf("
%s
", x.chr), sprintf( " ", if(style@scale) "true" else "false" ) ) rez.fun <- if(style@scale) "resize_diff_out_scale" else "resize_diff_out_no_scale" js <- try(readLines(style@js), silent=TRUE) if(inherits(js, "try-error")) { cond <- attr(js, "condition") warning( "Unable to read provided js file \"", style@js, "\" (error: ", paste0(conditionMessage(cond), collapse=""), ")." ) js <- "" } else { js <- paste0( c( js, sprintf( "window.addEventListener('resize', %s, true);\n %s();", rez.fun, rez.fun ) ), collapse="\n" ) } } else js <- "" callNextMethod(x, x.chr, js=js, ...) } ) # Helper fun used by `show` for Diff and DiffSummary objects show_w_pager <- function(txt, pager) { use.pager <- use_pager(pager, attr(txt, "len")) file.keep <- !is.na(pager@file.path) # Finalize and output if(use.pager) { disp.f <- if(!is.na(pager@file.path)) pager@file.path else paste0(tempfile(), ".", pager@file.ext) if(!file.keep) on.exit(add=TRUE, unlink(disp.f)) writeLines(txt, disp.f) if( isTRUE(pager@make.blocking) || (is.na(pager@make.blocking) && !file.keep) ) make_blocking(pager@pager)(disp.f) else pager@pager(disp.f) } else { cat(txt, sep="\n") } } setMethod("show", "Diff", function(object) { txt <- as.character(object) show_w_pager(txt, object@etc@style@pager) invisible(NULL) } ) # Compute what fraction of the lines in target and current actually end up # in the diff; some of the complexity is driven by repeated context hunks setGeneric("lineCoverage", function(x) standardGeneric("lineCoverage")) setMethod("lineCoverage", "Diff", function(x) { lines_in_hunk <- function(z, ind) if(z[[ind]][[1L]]) z[[ind]][[1L]]:z[[ind]][[2L]] hunks.f <- unlist(x@diffs, recursive=FALSE) lines.tar <- length( unique(unlist(lapply(hunks.f, lines_in_hunk, "tar.rng.sub"))) ) lines.cur <- length( unique(unlist(lapply(hunks.f, lines_in_hunk, "cur.rng.sub"))) ) min( 1, (lines.tar + lines.cur) / ( length(x@tar.dat$raw) + length(x@cur.dat$raw)) ) } ) #' Determine if Diff Object Has Differences #' #' @param x a \code{Diff} object #' @param ... unused, for compatibility with generic #' @param na.rm unused, for compatibility with generic #' @return TRUE if there are differences, FALSE if not, FALSE with warning if #' there are no differences but objects are not \code{\link{all.equal}} #' @examples #' any(diffChr(letters, letters)) #' any(diffChr(letters, letters[-c(1, 5, 8)])) setMethod("any", "Diff", function(x, ..., na.rm = FALSE) { dots <- list(...) if(length(dots)) stop("`any` method for `Diff` supports only one argument", call. = FALSE) res <- any( which( !vapply( unlist(x@diffs, recursive=FALSE), "[[", logical(1L), "context" ) ) ) if(!res && !isTRUE(all.equal(x@target, x@current))) warning( "No visible differences, but objects are NOT `all.equal`.", call.=FALSE ) res } ) # See diff_myers for explanation of slots setClass( "MyersMbaSes", slots=c( a="character", b="character", type="factor", length="integer", offset="integer", diffs="integer" ), prototype=list( type=factor(character(), levels=c("Match", "Insert", "Delete")) ), validity=function(object) { if(!identical(levels(object@type), c("Match", "Insert", "Delete"))) return("Slot `type` levels incorrect") if(any(is.na(c(object@a, object@b)))) return("Slots `a` and `b` may not contain NA values") if(any(is.na(c(object@type, object@length, object@offset)))) return("Slots `type`, `length`, or `offset` may not contain NA values") if(any(c(object@type, object@length, object@offset)) < 0) return( paste0( "Slots `type`, `length`, and `offset` must have values greater ", "than zero" ) ) if(!is.int.1L(object@diffs)) return("Slot `diffs` must be integer(1L) and not NA") TRUE } ) # Run validity on S4 objects # # Intended for use within check_args; unfortunately can't use complete=TRUE # because we are using ANY slots with S3 objects there-in, which causes # the complete check to freak out with "trying to get slot 'package' from..." # # @param x object to test # @param err.tpl a string used with sprintf, must contain two \dQuote{%s} for # respectively \code{arg.name} and the class name # @param arg.name argument the object is supposed to come from # @param err error reporting function valid_object <- function( x, arg.name, err, err.tpl="Argument `%s` is an invalid `%s` object because:" ) { if(isS4(x)) { if(!isTRUE(test <- validObject(x, test=TRUE))) { err( paste( sprintf(err.tpl, arg.name, class(x)[[1L]]), strwrap(test, initial="- ", prefix=" "), collapse="\n" ) ) } } } diffobj/R/text.R0000644000176200001440000003520615001242043013162 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. # borrowed from crayon, will lobby to get it exported ansi_regex <- paste0("(?:(?:\\x{001b}\\[)|\\x{009b})", "(?:(?:[0-9]{1,3})?(?:(?:;[0-9]{0,3})*)?[A-M|f-m])", "|\\x{001b}[A-M]") # Function to split a character vector by newlines; handles some special cases split_new_line <- function(x, sgr.supported) { y <- x y[!nzchar(x)] <- "\n" unlist(strsplit2(y, "\n", sgr.supported=sgr.supported)) } html_ent_sub <- function(x, style) { if(is(style, "StyleHtml") && style@escape.html.entities) { x <- gsub("&", "&", x, fixed=TRUE) x <- gsub("<", "<", x, fixed=TRUE) x <- gsub(">", ">", x, fixed=TRUE) x <- gsub("\n", "
", x, fixed=TRUE) # x <- gsub(" ", " ", x, fixed=TRUE) } x } # Helper function for align_eq; splits up a vector into matched elements and # interstitial elements, including possibly empty interstitial elements when # two matches are abutting align_split <- function(v, m) { match.len <- sum(!!m) res.len <- match.len * 2L + 1L splits <- cumsum( c( if(length(m)) 1L, (!!diff(m) < 0L & !tail(m, -1L)) | (head(m, -1L) & tail(m, -1L)) ) ) m.all <- match(m, sort(unique(m[!!m])), nomatch=0L) # normalize m.all[!m.all] <- -ave(m.all, splits, FUN=max)[!m.all] m.all[!m.all] <- -match.len - 1L # trailing zeros m.fin <- ifelse(m.all < 0, -m.all * 2 - 1, m.all * 2) if(any(diff(m.fin) < 0L)) stop("Logic Error: non monotonic alignments; contact maintainer") # nocov res <- replicate(res.len, character(0L), simplify=FALSE) res[unique(m.fin)] <- unname(split(v, m.fin)) res } # Align lists based on equalities on other vectors # # This is used for hunks that are word diffed. Once the word differences are # accounted for, the remaining strings (A.eq/B.eq) are compared to try to align # them with a naive algorithm on a line basis. This works best when lines as a # whole are equal except for a few differences. There can be funny situations # where matched words are on one line in e.g. A, but spread over multiple lines # in B. This isn't really handled well currently. # # See issue #37. # # The A/B vecs will be split up into matchd elements, and non-matched elements. # Each matching element will be surrounding by (possibly empty) non-matching # elements. # # Need to reconcile the padding that happens as a result of alignment as well # as the padding that happens with atomic vectors align_eq <- function(A, B, x, context) { stopifnot( is.integer(A), is.integer(B), !anyNA(c(A, B)), is(x, "Diff") ) A.fill <- get_dat(x, A, "fill") B.fill <- get_dat(x, B, "fill") A.fin <- get_dat(x, A, "fin") B.fin <- get_dat(x, B, "fin") if(context) { # Nothing to align if this is context hunk A.chunks <- list(A.fin) B.chunks <- list(B.fin) } else { etc <- x@etc A.eq <- get_dat(x, A, "eq") B.eq <- get_dat(x, B, "eq") # Cleanup so only relevant stuff is allowed to match A.tok.ratio <- get_dat(x, A, "tok.rat") B.tok.ratio <- get_dat(x, B, "tok.rat") if(etc@align@count.alnum.only) { A.eq.trim <- gsub("[^[:alnum:]]", "", A.eq, perl=TRUE) B.eq.trim <- gsub("[^[:alnum:]]", "", B.eq, perl=TRUE) } else { A.eq.trim <- A.eq B.eq.trim <- B.eq } # TBD whether nchar here should be ansi-aware; probably if in alnum only # mode... A.valid <- which( nchar2(A.eq.trim, sgr.supported=etc@sgr.supported) >= etc@align@min.chars & A.tok.ratio >= etc@align@threshold ) B.valid <- which( nchar2(B.eq.trim, sgr.supported=etc@sgr.supported) >= etc@align@min.chars & B.tok.ratio >= etc@align@threshold ) B.eq.seq <- seq_along(B.eq.trim) align <- integer(length(A.eq)) min.match <- 0L # Need to match each element in A.eq to B.eq, though each match consumes the # match so we can't use `match`; unfortunately this is slow; for context # hunks the match is one to one for each line; also, this whole matching # needs to be improved (see issue #37) if(length(A.valid) & length(B.valid)) { B.max <- length(B.valid) B.eq.val <- B.eq.trim[B.valid] for(i in A.valid) { if(min.match >= B.max) break B.match <- which( A.eq.trim[[i]] == if(min.match) tail(B.eq.val, -min.match) else B.eq.val ) if(length(B.match)) { align[[i]] <- B.valid[B.match[[1L]] + min.match] min.match <- B.match[[1L]] + min.match } } } # Group elements together. We number the interstitial buckest as the # negative of the next match. There are always matches together, split # by possibly empty interstitial elements align.b <- seq_along(B.eq) align.b[!align.b %in% align] <- 0L A.chunks <- align_split(A.fin, align) B.chunks <- align_split(B.fin, align.b) } if(length(A.chunks) != length(B.chunks)) # nocov start stop("Logic Error: aligned chunks unequal length; contact maintainer.") # nocov end list(A=A.chunks, B=B.chunks, A.fill=A.fill, B.fill=B.fill) } # Calculate how many lines of screen space are taken up by the diff hunks # # `disp.width` should be the available display width, this function computes # the net real estate account for mode, padding, etc. nlines <- function(txt, disp.width, mode, etc) { # stopifnot(is.character(txt), all(!is.na(txt))) capt.width <- calc_width_pad(disp.width, mode) pmax( 1L, as.integer( ceiling( nchar2(txt, sgr.supported=etc@sgr.supported ) / capt.width ) ) ) } # Gets rid of tabs and carriage returns # # Assumes each line is one screen line # @param stops may be a single positive integer value, or a vector of values # whereby the last value will be repeated as many times as necessary strip_hz_c_int <- function(txt, stops, sgr.supported) { # remove trailing and leading CRs (need to record if trailing remains to add # back at end? no, not really since by structure next thing must be a newline w.chr <- nzchar(txt) # corner case with strsplit and zero length strings txt <- gsub("^\r+|\r+$", "", txt) has.tabs <- grep("\t", txt, fixed=TRUE) has.crs <- grep("\r", txt, fixed=TRUE) txt.s <- as.list(txt) txt.s[has.crs] <- if(!any(has.crs)) list() else strsplit2(txt[has.crs], "\r+", sgr.supported=sgr.supported) # Assume \r resets tab stops as it would on a type writer; so now need to # generate the set maximum set of possible tab stops; approximate here by # using largest stop if(length(has.tabs)) { max.stop <- max(stops) width.w.tabs <- max( vapply( txt.s[has.tabs], function(x) { # add number of chars and number of tabs times max tab length sum( nchar2(x, sgr.supported=sgr.supported) + ( vapply( strsplit2(x, "\t", sgr.supported=sgr.supported), length, integer(1L) ) + grepl("\t$", x) - 1L ) * max.stop ) }, integer(1L) ) ) extra.chars <- width.w.tabs - sum(stops) extra.stops <- ceiling(extra.chars / tail(stops, 1L)) stop.vec <- cumsum(c(stops, rep(tail(stops, 1L), extra.stops))) # For each line, assess effects of tabs txt.s[has.tabs] <- lapply(txt.s[has.tabs], function(x) { if(length(h.t <- grep("\t", x, fixed=T))) { # workaround for strsplit dropping trailing tabs x.t <- sub("\t$", "\t\t", x[h.t]) x.s <- strsplit2(x.t, "\t", sgr.supported=sgr.supported) # Now cycle through each line with tabs and replace them with # spaces res <- vapply(x.s, function(y) { topad <- head(y, -1L) rest <- tail(y, 1L) chrs <- nchar2(topad, sgr.supported=sgr.supported) pads <- character(length(topad)) txt.len <- 0L for(i in seq_along(topad)) { txt.len <- chrs[i] + txt.len tab.stop <- head(which(stop.vec > txt.len), 1L) if(!length(tab.stop)) # nocov start stop( "Logic Error: failed trying to find tab stop; contact ", "maintainer" ) # nocov end tab.len <- stop.vec[tab.stop] pads[i] <- paste0(rep(" ", tab.len - txt.len), collapse="") txt.len <- tab.len } paste0(paste0(topad, pads, collapse=""), rest) }, character(1L) ) x[h.t] <- res } x } ) } # Simulate the effect of \r by collapsing every \r separated element on top # of each other with some special handling for ansi escape seqs txt.fin <- txt.s txt.fin[has.crs] <- vapply( txt.s[has.crs], function(x) { if(length(x) > 1L) { chrs <- nchar2(x, sgr.supported=sgr.supported) max.disp <- c(tail(rev(cummax(rev(chrs))), -1L), 0L) res <- paste0( rev( substr2(x, max.disp + 1L, chrs, sgr.supported=sgr.supported) ), collapse="" ) # add back every ANSI esc sequence from last line to very end # to ensure that we leave in correct ANSI escaped state if(grepl(ansi_regex, res, perl=TRUE)) { res <- paste0( res, gsub(paste0(".*", ansi_regex, ".*"), "\\1", tail(x, 1L), perl=TRUE) ) } res } else x # nocov has.cr elements can't have length zero after split... }, character(1L) ) # txt.fin should only have one long char vectors as elements if(!length(txt.fin)) txt else { # handle strsplit corner case where splitting empty string txt.fin[!nzchar(txt)] <- "" unlist(txt.fin) } } #' Replace Horizontal Spacing Control Characters #' #' Removes tabs, newlines, and manipulates the text so that #' it looks the same as it did with those horizontal control #' characters embedded. Currently carriage returns are also processed, but #' in the future they no longer will be. This function is used when the #' \code{convert.hz.white.space} parameter to the #' \code{\link[=diffPrint]{diff*}} methods is active. The term \dQuote{strip} #' is a misnomer that remains for legacy reasons and lazyness. #' #' This is an internal function with exposed documentation because it is #' referenced in an external function's documentation. #' #' @keywords internal #' @param txt character to covert #' @param stops integer, what tab stops to use #' @param sgr.supported logical whether the current display device supports #' ANSI CSI SGR. See \code{\link[=diffPrint]{diff*}}'s \code{sgr.supported} #' parameter. #' @return character, `txt` with horizontal control sequences #' replaced. strip_hz_control <- function(txt, stops=8L, sgr.supported) { # stopifnot( # is.character(txt), !anyNA(txt), # is.integer(stops), length(stops) >= 1L, !anyNA(stops), all(stops > 0L) # ) # for speed in case no special chars, just skip; obviously this adds a penalty # for other cases but it is small if(!any(grepl("\n|\t|\r", txt, perl=TRUE))) { txt } else { if(length(has.n <- grep("\n", txt, fixed=TRUE))) { txt.l <- as.list(txt) txt.l.n <- strsplit2(txt[has.n], "\n", sgr.supported=sgr.supported) txt.l[has.n] <- txt.l.n txt <- unlist(txt.l) } has.ansi <- grepl(ansi_regex, txt, perl=TRUE) w.ansi <- which(has.ansi) wo.ansi <- which(!has.ansi) # since for the time being the crayon funs are a bit slow, only us them on # strings that are known to have ansi escape sequences strip_hz_c_int(txt, stops, sgr.supported=sgr.supported) } } # Normalize strings so whitespace differences don't show up as differences normalize_whitespace <- function(txt) gsub(" ([[:punct:]])", "\\1", gsub("(\t| )+", " ", trimws(txt))) # Simple text manip functions chr_trim <- function(text, width, sgr.supported) { stopifnot(all(width > 2L)) ifelse( nchar2(text, sgr.supported=sgr.supported) > width, paste0(substr2(text, 1L, width - 2L, sgr.supported=sgr.supported), ".."), text ) } rpad <- function(text, width, pad.chr=" ", sgr.supported) { stopifnot(is.character(pad.chr), length(pad.chr) == 1L, nchar(pad.chr) == 1L) pad.count <- width - nchar2(text, sgr.supported=sgr.supported) pad.count[pad.count < 0L] <- 0L pad.chrs <- vapply( pad.count, function(x) paste0(rep(pad.chr, x), collapse=""), character(1L) ) paste0(text, pad.chrs) } # Breaks long character vectors into vectors of length width # # Right pads them to full length if requested. Only attempt to wrap if # longer than width since wrapping is pretty expensive # # Returns a list of split vectors wrap_int <- function(txt, width, sgr.supported) { nchars <- nchar2(txt, sgr.supported=sgr.supported) res <- as.list(txt) too.wide <- which(nchars > width) res[too.wide] <- lapply( too.wide, function(i) { split.end <- seq( from=width, by=width, length.out=ceiling(nchars[[i]] / width) ) split.start <- split.end - width + 1L substr2( rep(txt[[i]], length(split.start)), split.start, split.end, sgr.supported=sgr.supported ) } ) res } wrap <- function(txt, width, pad=FALSE, sgr.supported) { if(length(grep("\n", txt, fixed=TRUE))) # nocov start stop("Logic error: wrap input contains newlines; contact maintainer.") # nocov end # If there are ansi escape sequences, account for them; either way, create # a vector of character positions after which we should split our character # vector has.na <- is.na(txt) has.chars <- nchar2(txt, sgr.supported=sgr.supported) & !has.na w.chars <- which(has.chars) wo.chars <- which(!has.chars & !has.na) txt.sub <- txt[has.chars] # Wrap differently depending on whether contains ansi or not, exclude zero # length char elements res.l <- vector("list", length(txt)) res.l[has.na] <- NA_character_ res.l[wo.chars] <- "" res.l[w.chars] <- wrap_int(txt.sub, width, sgr.supported=sgr.supported) # pad if requested if(pad) res.l[!has.na] <- lapply(res.l[!has.na], rpad, width=width, sgr.supported=sgr.supported) res.l } diffobj/R/core.R0000644000176200001440000006761215001264365013147 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. #' @include s4.R NULL #' Generate a character representation of Shortest Edit Sequence #' #' @keywords internal #' @seealso \code{\link{ses}} #' @param x S4 object of class \code{MyersMbaSes} #' @param ... unused #' @return character vector setMethod("as.character", "MyersMbaSes", function(x, ...) { dat <- as.data.frame(x) # Split our data into sections that have either deletes or inserts and get # rid of the matches dat <- dat[dat$type != "Match", ] d.s <- split(dat, dat$section) # For each section, compute whether we should display, change, insert, # delete, or both, and based on that append to the ses string ses_rng <- function(off, len) paste0(off, if(len > 1L) paste0(",", off + len - 1L)) vapply( unname(d.s), function(d) { del <- sum(d$len[d$type == "Delete"]) ins <- sum(d$len[d$type == "Insert"]) if(del) { del.first <- which(d$type == "Delete")[[1L]] del.off <- d$off[del.first] } if(ins) { ins.first <- which(d$type == "Insert")[[1L]] ins.off <- d$off[ins.first] } if(del && ins) { paste0(ses_rng(del.off, del), "c", ses_rng(ins.off, ins)) } else if (del) { paste0(ses_rng(del.off, del), "d", d$last.b[[1L]]) } else if (ins) { paste0(d$last.a[[1L]], "a", ses_rng(ins.off, ins)) } else { stop("Logic Error: unexpected edit type; contact maintainer.") # nocov } }, character(1L) ) } ) # Used for mapping edit actions to numbers so we can use numeric matrices # absolutely must be used to create the @type factor in the MBA object. # # DO NOT CHANGE LIGHTLY; SOME CODE MIGHT RELY ON THE UNDERLYING INTEGER POSITIONS .edit.map <- c("Match", "Insert", "Delete") setMethod("as.matrix", "MyersMbaSes", function(x, row.names=NULL, optional=FALSE, ...) { # map del/ins/match to numbers len <- length(x@type) matches <- x@type == "Match" section <- cumsum(matches + c(0L, head(matches, -1L))) # Track what the max offset observed so far for elements of the `a` string # so that if we have an insert command we can get the insert position in # `a` last.a <- c( if(len) 0L, head( cummax( ifelse(x@type != "Insert", x@offset + x@length, 1L) ) - 1L, -1L ) ) # Do same thing with `b`, complicated because the matching entries are all # in terms of `a` last.b <- c( if(len) 0L, head(cumsum(ifelse(x@type != "Delete", x@length, 0L)), -1L) ) cbind( type=as.integer(x@type), len=x@length, off=x@offset, section=section, last.a=last.a, last.b = last.b ) } ) setMethod("as.data.frame", "MyersMbaSes", function(x, row.names=NULL, optional=FALSE, ...) { len <- length(x@type) mod <- c("Insert", "Delete") dat <- data.frame(type=x@type, len=x@length, off=x@offset) matches <- dat$type == "Match" dat$section <- cumsum(matches + c(0L, head(matches, -1L))) # Track what the max offset observed so far for elements of the `a` string # so that if we have an insert command we can get the insert position in # `a` dat$last.a <- c( if(nrow(dat)) 0L, head( cummax(ifelse(dat$type != "Insert", dat$off + dat$len, 1L)) - 1L, -1L ) ) # Do same thing with `b`, complicated because the matching entries are all # in terms of `a` dat$last.b <- c( if(nrow(dat)) 0L, head(cumsum(ifelse(dat$type != "Delete", dat$len, 0L)), -1L) ) dat } ) #' Shortest Edit Script #' #' Computes shortest edit script to convert \code{a} into \code{b} by removing #' elements from \code{a} and adding elements from \code{b}. Intended primarily #' for debugging or for other applications that understand that particular #' format. See \href{http://www.gnu.org/software/diffutils/manual/diffutils.html#Detailed-Normal}{GNU diff docs} #' for how to interpret the symbols. #' #' \code{ses} will be much faster than any of the #' \code{\link[=diffPrint]{diff*}} methods, particularly for large inputs with #' limited numbers of differences. #' #' NAs are treated as the string \dQuote{NA}. Non-character inputs are coerced #' to character. #' #' \code{ses_dat} provides a semi-processed \dQuote{machine-readable} version of #' precursor data to \code{ses} that may be useful for those desiring to use the #' raw diff data and not the printed output of \code{diffobj}, but do not wish #' to manually parse the \code{ses} output. Whether it is faster than #' \code{ses} or not depends on the ratio of matching to non-matching values as #' \code{ses_dat} includes matching values whereas \code{ses} does not. #' \code{ses_dat} objects have a print method that makes it easy to interpret #' the diff, but are actually data.frames. You can see the underlying data by #' using \code{as.data.frame}, removing the "ses_dat" class, etc.. #' #' @export #' @param a character #' @param b character #' @param extra TRUE (default) or FALSE, whether to also return the indices in #' \code{a} and \code{b} the diff values are taken from. Set to FALSE for a #' small performance gain. #' @inheritParams diffPrint #' @param warn TRUE (default) or FALSE whether to warn if we hit #' \code{max.diffs}. #' @return character shortest edit script, or a machine readable version of it #' as a \code{ses_dat} object, which is a \code{data.frame} with columns #' \code{op} (factor, values \dQuote{Match}, \dQuote{Insert}, or #' \dQuote{Delete}), \code{val} character corresponding to the value taken #' from either \code{a} or \code{b}, and if \code{extra} is TRUE, integer #' columns \code{id.a} and \code{id.b} corresponding to the indices in #' \code{a} or \code{b} that \code{val} was taken from. See Details. #' @examples #' a <- letters[1:6] #' b <- c('b', 'CC', 'DD', 'd', 'f') #' ses(a, b) #' (dat <- ses_dat(a, b)) #' str(dat) # data.frame with a print method #' #' ## use `ses_dat` output to construct a minimal diff #' ## color with ANSI CSI SGR #' diff <- dat[['val']] #' del <- dat[['op']] == 'Delete' #' ins <- dat[['op']] == 'Insert' #' if(any(del)) #' diff[del] <- paste0("\033[33m- ", diff[del], "\033[m") #' if(any(ins)) #' diff[ins] <- paste0("\033[34m+ ", diff[ins], "\033[m") #' if(any(!ins & !del)) #' diff[!ins & !del] <- paste0(" ", diff[!ins & !del]) #' writeLines(diff) #' #' ## We can recover `a` and `b` from the data #' identical(subset(dat, op != 'Insert', val)[[1]], a) #' identical(subset(dat, op != 'Delete', val)[[1]], b) ses <- function(a, b, max.diffs=gdo("max.diffs"), warn=gdo("warn")) { args <- ses_prep(a=a, b=b, max.diffs=max.diffs, warn=warn) as.character( diff_myers( args[['a']], args[['b']], max.diffs=args[['max.diffs']], warn=args[['warn']] ) ) } #' @export #' @rdname ses ses_dat <- function( a, b, extra=TRUE, max.diffs=gdo("max.diffs"), warn=gdo("warn") ) { args <- ses_prep(a=a, b=b, max.diffs=max.diffs, warn=warn) if(!is.TF(extra)) stop("Argument `extra` must be TRUE or FALSE.") mba <- diff_myers( args[['a']], args[['b']], max.diffs=args[['max.diffs']], warn=args[['warn']] ) # reorder so that deletes are before (lack of foresight in setting factor # levels...) inserts in each section sec <- cumsum(mba@type == 'Match') o <- order(sec, c(1L,3L,2L)[as.integer(mba@type)]) type <- mba@type[o] len <- mba@length[o] off <- mba@offset[o] # offsets are indices in `a` for 'Match' and 'Delete', and in `b` for insert # see `diff_myers` for details id <- rep(seq_along(type), len) type2 <- type[id] off2 <- off[id] id2 <- sequence(len) + off2 - 1L use.a <- type2 %in% c('Match', 'Delete') use.b <- !use.a values <- character(length(id)) values[use.a] <- a[id2[use.a]] values[use.b] <- b[id2[use.b]] res <- if(extra) { id.a <- id.b <- rep(NA_integer_, length(values)) id.a[use.a] <- id2[use.a] id.b[use.b] <- id2[use.b] data.frame( op=type2, val=values, id.a=id.a, id.b=id.b, stringsAsFactors=FALSE ) } else { data.frame(op=type2, val=values, stringsAsFactors=FALSE) } structure(res, class=c('ses_dat', class(res))) } #' @export print.ses_dat <- function(x, quote=FALSE, ...) { op <- x[['op']] diff <- matrix( "", 3, nrow(x), dimnames=list(c('D:', 'M:', 'I:'), character(nrow(x))) ) d <- op == 'Delete' m <- op == 'Match' i <- op == 'Insert' diff[1, d] <- x[['val']][d] diff[2, m] <- x[['val']][m] diff[3, i] <- x[['val']][i] writeLines( sprintf( "\"ses_dat\" object (Match: %d, Delete: %d, Insert: %d):", sum(m), sum(d), sum(i) ) ) print(diff, quote=quote, ...) invisible(x) } # Internal validation fun for ses_* ses_prep <- function(a, b, max.diffs, warn) { if(!is.character(a)) { a <- try(as.character(a)) if(inherits(a, "try-error")) stop("Argument `a` is not character and could not be coerced to such") } if(!is.character(b)) { b <- try(as.character(b)) if(inherits(b, "try-error")) stop("Argument `b` is not character and could not be coerced to such") } if(is.numeric(max.diffs)) max.diffs <- as.integer(max.diffs) if(!is.int.1L(max.diffs)) stop("Argument `max.diffs` must be scalar integer.") if(!is.TF(warn)) stop("Argument `warn` must be TRUE or FALSE.") if(anyNA(a)) a[is.na(a)] <- "NA" if(anyNA(b)) b[is.na(b)] <- "NA" list(a=a, b=b, max.diffs=max.diffs, warn=warn) } #' Diff two character vectors #' #' Implementation of Myer's Diff algorithm with linear space refinement #' originally implemented by Mike B. Allen as part of #' \href{https://www.ioplex.com/~miallen/libmba/}{libmba} #' version 0.9.1. This implementation is a heavily modified version of the #' original C code and is not compatible with the \code{libmba} library. #' The C code is simplified by using fixed size arrays instead of variable #' ones for tracking the longest reaching paths and for recording the shortest #' edit scripts. Additionally all error handling and memory allocation calls #' have been moved to the internal R functions designed to handle those things. #' A failover result is provided in the case where max diffs allowed is #' exceeded. Ability to provide custom comparison functions is removed. #' #' The result format indicates operations required to convert \code{a} into #' \code{b} in a precursor format to the GNU diff shortest edit script. The #' operations are \dQuote{Match} (do nothing), \dQuote{Insert} (insert one or #' more values of \code{b} into \code{a}), and \dQuote{Delete} (remove one or #' more values from \code{a}). The \code{length} slot dictates how #' many values to advance along, insert into, or delete from \code{a}. The #' \code{offset} slot changes meaning depending on the operation. For #' \dQuote{Match} and \dQuote{Delete}, it is the starting index of that #' operation in \code{a}. For \dQuote{Insert}, it is the starting index in #' \code{b} of the values to insert into \code{a}; the index in \code{a} to #' insert at is implicit in previous operations. #' #' @keywords internal #' @param a character #' @param b character #' @param max.diffs integer(1L) how many differences before giving up; set to #' -1 to allow as many as there are up to the maximum allowed (~INT_MAX/4). #' @param warn TRUE or FALSE, whether to warn if we hit `max.diffs`. #' @return MyersMbaSes object #' @useDynLib diffobj, .registration=TRUE, .fixes="DIFFOBJ_" diff_myers <- function(a, b, max.diffs=-1L, warn=FALSE) { stopifnot( is.character(a), is.character(b), all(!is.na(c(a, b))), is.int.1L(max.diffs), is.TF(warn) ) a <- enc2utf8(a) b <- enc2utf8(b) res <- .Call(DIFFOBJ_diffobj, a, b, max.diffs) res <- setNames(res, c("type", "length", "offset", "diffs")) types <- .edit.map # silly that we have to generate a factor when we have the integer vector and # levels... Two unncessary hashes. res$type <- factor(types[res$type], levels=types) res$offset <- res$offset + 1L # C 0-indexing originally res.s4 <- try(do.call("new", c(list("MyersMbaSes", a=a, b=b), res))) if(inherits(res.s4, "try-error")) # nocov start stop( "Logic Error: unable to instantiate shortest edit script object; contact ", "maintainer." ) # nocov end if(isTRUE(warn) && res$diffs < 0) { warning( "Exceeded `max.diffs`: ", abs(res$diffs), " vs ", max.diffs, " allowed. ", "Diff is probably suboptimal." ) } res.s4 } # Print Method for Shortest Edit Path # # Bare bones display of shortest edit path using GNU diff conventions # # @param object object to display # @return character the shortest edit path character representation, invisibly # @rdname diffobj_s4method_doc #' @rdname diffobj_s4method_doc setMethod("show", "MyersMbaSes", function(object) { res <- as.character(object) cat(res, sep="\n") invisible(res) } ) #' Summary Method for Shortest Edit Path #' #' Displays the data required to generate the shortest edit path for comparison #' between two strings. #' #' @export #' @keywords internal #' @param object the \code{diff_myers} object to display #' @param with.match logical(1L) whether to show what text the edit command #' refers to #' @param ... forwarded to the data frame print method used to actually display #' the data #' @return whatever the data frame print method returns setMethod("summary", "MyersMbaSes", function(object, with.match=FALSE, ...) { what <- vapply( seq_along(object@type), function(y) { t <- object@type[[y]] o <- object@offset[[y]] l <- object@length[[y]] vec <- if(t == "Insert") object@b else object@a paste0(vec[o:(o + l - 1L)], collapse="") }, character(1L) ) res <- data.frame( type=object@type, string=what, len=object@length, offset=object@offset, stringsAsFactors=FALSE ) if(!with.match) res <- res[-2L] print(res, ...) } ) # mode is display mode (sidebyside, etc.) # diff.mode is whether we are doing the first pass line diff, or doing the # in-hunk or word-wrap versions # warn is to allow us to suppress warnings after first hunk warning char_diff <- function(x, y, context=-1L, etc, diff.mode, warn) { stopifnot( diff.mode %in% c("line", "hunk", "wrap"), isTRUE(warn) || identical(warn, FALSE) ) max.diffs <- etc@max.diffs # probably shouldn't generate S4, but easier... diff <- diff_myers(x, y, max.diffs, warn=FALSE) hunks <- as.hunks(diff, etc=etc) hit.diffs.max <- FALSE if(diff@diffs < 0L) { hit.diffs.max <- TRUE diff@diffs <- -diff@diffs diff.msg <- c( line="overall", hunk="in-hunk word", wrap="atomic wrap-word" ) if(warn) warning( "Exceeded diff limit during diff computation (", diff@diffs, " vs. ", max.diffs, " allowed); ", diff.msg[diff.mode], " diff is likely not optimal", call.=FALSE ) } # used to be a `DiffDiffs` object, but too slow list(hunks=hunks, hit.diffs.max=hit.diffs.max) } # Compute the character representation of a hunk header make_hh <- function(h.g, mode, tar.dat, cur.dat, ranges.orig) { h.ids <- vapply(h.g, "[[", integer(1L), "id") h.head <- vapply(h.g, "[[", logical(1L), "guide") # exclude header hunks from contributing to range, and adjust ranges for # possible fill lines added to the data h.ids.nh <- h.ids[!h.head] tar.rng <- find_rng(h.ids.nh, ranges.orig[1:2, , drop=FALSE], tar.dat$fill) tar.rng.f <- cumsum(!tar.dat$fill)[tar.rng] cur.rng <- find_rng(h.ids.nh, ranges.orig[3:4, , drop=FALSE], cur.dat$fill) cur.rng.f <- cumsum(!cur.dat$fill)[cur.rng] hh.a <- paste0(rng_as_chr(tar.rng.f)) hh.b <- paste0(rng_as_chr(cur.rng.f)) if(mode == "sidebyside") sprintf("@@ %s @@", c(hh.a, hh.b)) else { sprintf("@@ %s / %s @@", hh.a, hh.b) } } # Do not allow `useBytes=TRUE` if there are any matches with `useBytes=FALSE` # # Clean up word.ind to avoid issues where we have mixed UTF-8 and non # UTF-8 strings in different hunks, and gregexpr is trying to optimize # buy using useBytes=TRUE in ASCII only strings without knowing that in a # different hunk there are UTF-8 strings fix_word_ind <- function(x) { matches <- vapply(x, function(y) length(y) > 1L || y != -1L, logical(1L)) useBytes <- vapply(x, function(y) isTRUE(attr(y, "useBytes")), logical(1L)) if(!all(useBytes[matches])) x <- lapply(x, `attr<-`, "useBytes", NULL) x } # Variation on `char_diff` used for the overall diff where we don't need # to worry about overhead from creating the `Diff` object line_diff <- function( target, current, tar.capt, cur.capt, context, etc, warn=TRUE, strip=TRUE ) { if(!is.valid.guide.fun(etc@guides)) # nocov start stop( "Logic Error: guides are not a valid guide function; contact maintainer" ) # nocov end etc@guide.lines <- make_guides(target, tar.capt, current, cur.capt, etc@guides) # Need to remove new lines as the processed captures do that anyway and we # end up with mismatched lengths if we don't if(any(nzchar(tar.capt))) tar.capt <- split_new_line(tar.capt, sgr.supported=etc@sgr.supported) if(any(nzchar(cur.capt))) cur.capt <- split_new_line(cur.capt, sgr.supported=etc@sgr.supported) # Some debate as to whether we want to do this first, or last. First has # many benefits so that everything is consistent, width calcs can work fine, # etc., but only issue is that user provided trim functions might not expect # the transformation of the data; this needs to be documented with the trim # docs. tar.capt.p <- tar.capt cur.capt.p <- cur.capt if(etc@convert.hz.white.space) { tar.capt.p <- strip_hz_control( tar.capt, stops=etc@tab.stops, sgr.supported=etc@sgr.supported ) cur.capt.p <- strip_hz_control( cur.capt, stops=etc@tab.stops, sgr.supported=etc@sgr.supported ) } # Remove whitespace and CSI SGR if warranted if(etc@strip.sgr) { if(has.style.1 <- any(crayon::has_style(tar.capt.p))) tar.capt.p <- crayon::strip_style(tar.capt.p) if(has.style.2 <- any(crayon::has_style(cur.capt.p))) cur.capt.p <- crayon::strip_style(cur.capt.p) if(has.style.1 || has.style.2) etc@warn( "`target` or `current` contained ANSI CSI SGR when rendered; these ", "were stripped. Use `strip.sgr=FALSE` to preserve them in the diffs." ) } # Apply trimming to remove row heads, etc, but only if something gets trimmed # from both elements tar.trim.ind <- apply_trim(target, tar.capt.p, etc@trim) tar.trim <- do.call( substr, list(tar.capt.p, tar.trim.ind[, 1L], tar.trim.ind[, 2L]) ) cur.trim.ind <- apply_trim(current, cur.capt.p, etc@trim) cur.trim <- do.call( substr, list(cur.capt.p, cur.trim.ind[, 1L], cur.trim.ind[, 2L]) ) if(identical(tar.trim, tar.capt.p) || identical(cur.trim, cur.capt.p)) { # didn't trim in both, so go back to original tar.trim <- tar.capt.p tar.trim.ind <- cbind( rep(1L, length(tar.capt.p)), nchar(tar.capt.p) ) cur.trim <- cur.capt.p cur.trim.ind <- cbind( rep(1L, length(cur.capt.p)), nchar(cur.capt.p) ) } tar.comp <- tar.trim cur.comp <- cur.trim if(etc@ignore.white.space) { tar.comp <- normalize_whitespace(tar.comp) cur.comp <- normalize_whitespace(cur.comp) } # Word diff is done in three steps: create an empty template vector structured # as the result of a call to `gregexpr` without matches, if dealing with # compliant atomic vectors in print mode, then update with the word diff # matches, finally, update with in-hunk word diffs for hunks that don't have # any existing word diffs: # Set up data lists with all relevant info; need to pass to diff_word so it # can be modified. # - orig: the very original string # - raw: the original captured text line by line, with strip_hz applied # - trim: as above, but with row meta data removed # - trim.ind: the indices used to re-insert `trim` into `raw` # - comp: the strings that will have the line diffs run on, these can be # modified to force a particular outcome, e.g. by word_to_line_map # - eq: the portion of `trim` that is equal post word-diff # - fin: the final character string for display to user # - word.ind: for use by `regmatches<-` to re-insert colored words # - tok.rat: for use by `align_eq` when lining up lines within hunks tar.dat <- list( orig=tar.capt, raw=tar.capt.p, trim=tar.trim, trim.ind.start=tar.trim.ind[, 1L], trim.ind.end=tar.trim.ind[, 2L], comp=tar.comp, eq=tar.comp, fin=tar.capt.p, fill=logical(length(tar.capt.p)), word.ind=replicate(length(tar.capt.p), .word.diff.atom, simplify=FALSE), tok.rat=rep(1, length(tar.capt.p)) ) cur.dat <- list( orig=cur.capt, raw=cur.capt.p, trim=cur.trim, trim.ind.start=cur.trim.ind[, 1L], trim.ind.end=cur.trim.ind[, 2L], comp=cur.comp, eq=cur.comp, fin=cur.capt.p, fill=logical(length(cur.capt.p)), word.ind=replicate(length(cur.capt.p), .word.diff.atom, simplify=FALSE), tok.rat=rep(1, length(cur.capt.p)) ) # Word diffs in wrapped form is atomic; note this will potentially change # the length of the vectors. tar.wrap.diff <- integer(0L) cur.wrap.diff <- integer(0L) tar.dat.w <- tar.dat cur.dat.w <- cur.dat if( is.atomic(target) && is.atomic(current) && is.null(dim(target)) && is.null(dim(current)) && length(tar.rh <- which_atomic_cont(tar.capt.p, target)) && length(cur.rh <- which_atomic_cont(cur.capt.p, current)) && is.null(names(target)) && is.null(names(current)) && etc@unwrap.atomic && etc@word.diff ) { # For historical compatibility we allow `diffChr` to get into this step if # the text format is right, even though it is arguable whether it should be # allowed or not. if(!all(diff(tar.rh) == 1L) || !all(diff(cur.rh)) == 1L){ # nocov start stop("Logic Error, row headers must be sequential; contact maintainer.") # nocov end } # Only do this for the portion of the data that actually matches up with # the atomic row headers. diff.word <- diff_word2( tar.dat, cur.dat, tar.ind=tar.rh, cur.ind=cur.rh, diff.mode="wrap", warn=warn, etc=etc ) warn <- !diff.word$hit.diffs.max tar.dat.w <- diff.word$tar.dat cur.dat.w <- diff.word$cur.dat # Mark the lines that were wrapped diffed; necessary b/c tar/cur.rh are # defined even if other conditions to get in this loop are not, and also # because the addition of the fill lines moves everything around # (effectively tar/cur.wrap.diff are the fill-offset versions of tar/cur.rh) tar.wrap.diff <- seq_along(tar.dat.w$fill)[!tar.dat.w$fill][tar.rh] cur.wrap.diff <- seq_along(cur.dat.w$fill)[!cur.dat.w$fill][cur.rh] } # Actual line diff diffs <- char_diff( tar.dat.w$comp, cur.dat.w$comp, etc=etc, diff.mode="line", warn=warn ) warn <- !diffs$hit.diffs.max hunks.flat <- diffs$hunks # For each of those hunks, run the word diffs and store the results in the # word.diffs list; bad part here is that we keep overwriting the overall # diff data for each hunk, which might be slow tar.dat.ww <- tar.dat.w cur.dat.ww <- cur.dat.w if(etc@word.diff) { # Word diffs on hunks, excluding all values that have already been wrap # diffed as in tar.rh and cur.rh / tar.wrap.diff and cur.wrap.diff for(h.a in hunks.flat) { if(h.a$context) next h.a.ind <- c(h.a$A, h.a$B) h.a.tar.ind <- setdiff(h.a.ind[h.a.ind > 0], tar.wrap.diff) h.a.cur.ind <- setdiff(abs(h.a.ind[h.a.ind < 0]), cur.wrap.diff) h.a.w.d <- diff_word2( tar.dat.ww, cur.dat.ww, h.a.tar.ind, h.a.cur.ind, diff.mode="hunk", warn=warn, etc=etc ) tar.dat.ww <- h.a.w.d[['tar.dat']] cur.dat.ww <- h.a.w.d[['cur.dat']] warn <- warn || !h.a.w.d[['hit.diffs.max']] } # Compute the token ratios tok_ratio_compute <- function(z) vapply( z, function(y) if(is.null(wc <- attr(y, "word.count"))) 1 else max(0, (wc - length(y)) / wc), numeric(1L) ) tar.dat.ww$tok.rat <- tok_ratio_compute(tar.dat.ww$word.ind) cur.dat.ww$tok.rat <- tok_ratio_compute(cur.dat.ww$word.ind) # Deal with mixed UTF/plain strings tar.dat.ww$word.ind <- fix_word_ind(tar.dat.ww$word.ind) cur.dat.ww$word.ind <- fix_word_ind(cur.dat.ww$word.ind) # Remove different words to make equal strings tar.dat.ww$eq <- with(tar.dat.ww, `regmatches<-`(trim, word.ind, value="")) cur.dat.ww$eq <- with(cur.dat.ww, `regmatches<-`(trim, word.ind, value="")) } # Instantiate result hunk.grps.raw <- group_hunks( hunks.flat, etc=etc, tar.capt=tar.dat.ww$raw, cur.capt=cur.dat.ww$raw ) gutter.dat <- etc@gutter max.w <- etc@text.width # Recompute line limit accounting for banner len, needed for correct trim etc.group <- etc if(etc.group@line.limit[[1L]] >= 0L) { etc.group@line.limit <- pmax(integer(2L), etc@line.limit - banner_len(etc@mode)) } # Trim hunks to the extent needed to make sure we fit in lines hunk.grps <- trim_hunks(hunk.grps.raw, etc.group, tar.dat.ww$raw, cur.dat.ww$raw) hunks.flat <- unlist(hunk.grps, recursive=FALSE) # Compact to width of widest element, so retrieve all char values; also # need to generate all the hunk headers b/c we need to use them in width # computation as well; under no circumstances are hunk headers allowed to # wrap as they are always assumed to take one line. # # Note: this used to be done after trimming / subbing, which is technically # better since we might have trimmed away long rows, but we need to do it # here so that we can can record the new text width in the outgoing object; # also, logic a bit circuitous b/c this was originally done elsewhere; might # be faster to use tar.dat and cur.dat directly chr.ind <- unlist(lapply(hunks.flat, "[", c("A", "B"))) chr.dat <- get_dat_raw(chr.ind, tar.dat.ww$raw, cur.dat.ww$raw) chr.size <- integer(length(chr.dat)) ranges <- vapply( hunks.flat, function(h.a) c(h.a$tar.rng.trim, h.a$cur.rng.trim), integer(4L) ) # compute ranges excluding fill lines rng_non_fill <- function(rng, fill) { if(!rng[[1L]]) rng else { rng.seq <- seq(rng[[1L]], rng[[2L]], by=1L) seq.not.fill <- rng.seq[!rng.seq %in% fill] if(!length(seq.not.fill)) { integer(2L) } else { range(seq.not.fill) } } } ranges.orig <- vapply( hunks.flat, function(h.a) { with( h.a, c( rng_non_fill(tar.rng.sub, which(tar.dat.ww$fill)), rng_non_fill(cur.rng.sub, which(cur.dat.ww$fill)) ) ) }, integer(4L) ) # We need a version of ranges that adjust for the fill lines that are counted # in the ranges but don't represent actual lines of output. This does mean # that adjusted ranges are not necessarily contiguous hunk.heads <- lapply(hunk.grps, make_hh, etc@mode, tar.dat.ww, cur.dat.ww, ranges.orig) h.h.chars <- nchar2( chr_trim( unlist(hunk.heads), etc@line.width, sgr.supported=etc@sgr.supported ), sgr.supported=etc@sgr.supported ) chr.size <- nchar2(chr.dat, sgr.supported=etc@sgr.supported) max.col.w <- max( max(0L, chr.size, .min.width + gutter.dat@width), h.h.chars ) max.w <- if(max.col.w < max.w) max.col.w else max.w # future calculations should assume narrower display etc@text.width <- max.w etc@line.width <- max.w + gutter.dat@width new( "Diff", diffs=hunk.grps, target=target, current=current, hit.diffs.max=!warn, tar.dat=tar.dat.ww, cur.dat=cur.dat.ww, etc=etc, hunk.heads=hunk.heads, trim.dat=attr(hunk.grps, 'meta') ) } diffobj/R/check.R0000644000176200001440000004145615001242043013257 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. is.less_flags <- function(x) is.chr.1L(x) && isTRUE(grepl("^[[:alpha:]]*$", x)) # for checking the limits, if successful returns an integer(2L) vector, # otherwise a character vector to sprintf as an error #' @include pager.R check_limit <- function(limit) { if( !is.numeric(limit) || any(is.na(limit)) || !length(limit) %in% 1:2 || !all(is.finite(limit)) || any(round(limit) != limit) || (length(limit) == 2L && diff(limit) > 0) ) { return( paste0( "Argument `%s` must be an integer vector of length 1 or 2 ", "and if length 2, with the first value larger than or equal to ", "the second%s" ) ) } limit <- as.integer(limit) if(length(limit) == 1L) limit <- rep(limit, 2L) limit } # requires a value to be a scalar character and match one of the provided # options string_in <- function(x, valid.x) is.chr.1L(x) && x %in% valid.x # Simple validation functions is.int.1L <- function(x) is.numeric(x) && length(x) == 1L && !is.na(x) && all(x == round(x)) && is.finite(x) is.int.2L <- function(x) is.numeric(x) && length(x) == 2L && !anyNA(x) && all(x == round(x)) && all(is.finite(x)) is.TF <- function(x) isTRUE(x) || identical(x, FALSE) is.chr.1L <- function(x) is.character(x) && length(x) == 1L && !is.na(x) is.valid.palette.param <- function(x, param, palette) { stopifnot(is(palette, "PaletteOfStyles")) stopifnot(isTRUE(param %in% c("brightness", "color.mode"))) valid.formats <- dimnames(palette@data)$format valid.params <- dimnames(palette@data)[[param]] if(!is.character(x) || anyNA(x)) paste0("Argument `", param, "` must be character and not contain NAs") else if(!all(x %in% valid.params)) paste0( "Argument `", param, "` may only contain values in `", dep(valid.params), "`" ) else if( (length(x) > 1L && is.null(names(x))) || !all(names(x) %in% c("", valid.formats)) ) paste0( "Argument `", param, "` must have names if it has length > 1, and those ", "names must include at least an empty name `\"\"` as well as names only ", "from `", dep(valid.formats), "`." ) else if ((!is.null(names(x)) && !"" %in% names(x))) paste0( "Argument `", param, "` must include at least one empty name `\"\"` if ", "it has names." ) else TRUE } is.one.arg.fun <- function(x) { if(!is.function(x)) { "is not a function" } else if(length(formals(x)) < 1L) { "does not have at least one arguments" } else if("..." %in% names(formals(x))[1]) { "cannot have `...` as the first argument" } else { nm.forms <- vapply(formals(x), is.name, logical(1L)) forms.chr <- character(length(nm.forms)) forms.chr[nm.forms] <- as.character(formals(x)[nm.forms]) forms.names <- names(formals(x)) if(any(tail(!nzchar(forms.chr) & nm.forms & forms.names != "...", -1L))) "cannot have any non-optional arguments other than first one" else TRUE } } is.valid.guide.fun <- is.two.arg.fun <- function(x) { if(!is.function(x)) { "is not a function" } else if(length(formals(x)) < 2L) { "does not have at least two arguments" } else if("..." %in% names(formals(x))[1:2]) { "cannot have `...` as one of the first two arguments" } else { nm.forms <- vapply(formals(x), is.name, logical(1L)) forms.chr <- character(length(nm.forms)) forms.chr[nm.forms] <- as.character(formals(x)[nm.forms]) if(any(tail(!nzchar(forms.chr) & nm.forms, -2L))) "cannot have any non-optional arguments other than first two" else TRUE } } is.valid.width <- function(x) if(!is.int.1L(x) || (x != 0L && (x < 10L || x > 10000))) { "must be integer(1L) and 0, or between 10 and 10000" } else TRUE is.one.file.name <- function(x) { if(!is.chr.1L(x)) { "must be character(1L) and not NA" } else if(!file_test("-f", x)) { sprintf("(\"%s\") is not a file", x) } else TRUE } is.non.obj.style <- function(x) string_in(x, "auto") || (is.list(x) && !is.object(x)) # Things that could possibly be output by substitute is.possibly.substituted <- function(x) (is.atomic(x) && length(x) == 1L) || is.null(x) || is.name(x) || is.call(x) # Checks common arguments across functions check_args <- function( call, tar.exp, cur.exp, mode, context, line.limit, format, brightness, color.mode, pager, ignore.white.space, max.diffs, align, disp.width, hunk.limit, convert.hz.white.space, tab.stops, style, palette.of.styles, frame, tar.banner, cur.banner, guides, rds, trim, word.diff, unwrap.atomic, extra, interactive, term.colors, strip.sgr, sgr.supported, call.match ) { err <- make_err_fun(call) warn <- make_warn_fun(call) # Check for conflicting arguments formals <- tail(names(call.match), -1L) style.overrideable <- c("format", "brightness", "color.mode") if( "style" %in% formals && !is.non.obj.style(style) && any(s.ov <- style.overrideable %in% formals) ) warn( "Provided `style` argument will override the provided ", if(sum(s.ov) < 2L) { sprintf("`%s` argument", style.overrideable[s.ov]) } else { paste0( paste0( sprintf("`%s`", head(style.overrideable[s.ov], -1L)), collapse=", " ), " and `", tail(style.overrideable[s.ov], 1L), "` arguments." ) } ) # Check extra if(!is.list(extra)) err("Argument `extra` must be a list.") # Check context msg.base <- paste0( "Argument `%s` must be integer(1L) and not NA, an object produced ", "by `auto_context`, or \"auto\"." ) if( !is.int.1L(context) && !is(context,"AutoContext") && !identical(context, "auto") ) err(sprintf(msg.base, "context")) if(!is(context, "AutoContext")) { context <- if(identical(context, "auto")) auto_context() else { if(is.int.1L(context) && context < 0) { min.cont <- 0 max.cont <- -1 } else if (is.int.1L(context)) { min.cont <- max.cont <- as.integer(context) } else { err("Argument `context` must be integer(1L) and not NA.") } cont <- try(auto_context(min.cont, max.cont)) if(inherits(cont, "try-error")) # nocov start # should not be possible to get here given prior checks err( "Unable to instantiate an `AutoContext` object from provided ", "`context` argument. Value should be integer(1L) and not NA, or ", "an `AutoContext` object as generated by `auto_context()`." ) # nocov end cont } } # any 'substr' of them otherwise these checks fail val.modes <- c("auto", "unified", "context", "sidebyside") fail.mode <- FALSE if(!is.character(mode) || length(mode) != 1L || is.na(mode) || !nzchar(mode)) fail.mode <- TRUE if(!fail.mode && !any(mode.eq <- substr(val.modes, 1, nchar(mode)) == mode)) fail.mode <- TRUE if(fail.mode) err( "Argument `mode` must be character(1L) and in `", deparse(val.modes), "`." ) # Tab stops tab.stops <- as.integer(tab.stops) if( !is.integer(tab.stops) || !length(tab.stops) >= 1L || anyNA(tab.stops) || !all(tab.stops > 0L) ) err( "Argument `tab.stops` must be integer containing at least one value and ", "with all values strictly positive" ) # Limit vars hunk.limit <- check_limit(hunk.limit) if(!is.integer(hunk.limit)) err(sprintf(hunk.limit, "hunk.limit", ".")) if(!is.integer(line.limit <- check_limit(line.limit))) err( sprintf( line.limit, "line.limit", ", or \"auto\" or the result of calling `auto_line_limit`" ) ) # guides if(!is.TF(guides) && !is.function(guides)) err("Argument `guides` must be TRUE, FALSE, or a function") if(is.function(guides) && !isTRUE(g.f.err <- is.two.arg.fun(guides))) err("Argument `guides` ", g.f.err) if(!is.function(guides) && !guides) guides <- function(obj, obj.as.chr) integer(0L) if(!is.TF(trim) && !is.function(trim)) err("Argument `trim` must be TRUE, FALSE, or a function") if(is.function(trim) && !isTRUE(t.f.err <- is.two.arg.fun(trim))) err("Argument `trim` ", t.f.err) if(!is.function(trim) && !trim) trim <- trim_identity # check T F args if(is.null(interactive)) interactive <- interactive() TF.vars <- c( "ignore.white.space", "convert.hz.white.space", "rds", "word.diff", "unwrap.atomic", "interactive" ) msg.base <- "Argument `%s` must be TRUE or FALSE." for(x in TF.vars) if(!is.TF(get(x, inherits=FALSE))) err(sprintf(msg.base, x)) # int 1L vars if(is.null(term.colors)) term.colors <- crayon::num_colors() msg.base <- "Argument `%s` must be integer(1L) and not NA." int.1L.vars <- c("max.diffs", "term.colors") for(x in int.1L.vars) { if(!is.int.1L(int.val <- get(x, inherits=FALSE))) err(sprintf(msg.base, "max.diffs")) assign(x, as.integer(int.val)) } # Banners; convolution here is to accomodate `diffObj` and have it be able # to pass captured target/current expressions chr1LorNULLorLanguage.vars <- c("tar.banner", "cur.banner") msg.base <- "Argument `%s` must be atomic and length(1L), NULL, a symbol, or a call" for(x in chr1LorNULLorLanguage.vars ) { y <- get(x, inherits=FALSE) if(!is.possibly.substituted(y)) err(sprintf(msg.base, x)) } if(!is.chr.1L(tar.banner) && !is.null(tar.banner)) { tar.exp <- tar.banner tar.banner <- NULL } if(!is.chr.1L(cur.banner) && !is.null(cur.banner)) { cur.exp <- cur.banner cur.banner <- NULL } # Align threshold if(!is(align, "AlignThreshold")) { align <- if( is.numeric(align) && length(align) == 1L && !is.na(align) && align %bw% c(0, 1) ) { AlignThreshold(threshold=align) } else if(is.null(align)) { AlignThreshold() } else err( "Argument `align` must be an \"AlignThreshold\" object or numeric(1L) ", "and between 0 and 1." ) } # style valid_object(style, "style", err) if( !is(style, "Style") && !string_in(style, "auto") && !(is.list(style) && !is.object(style)) ) err("Argument `style` must be \"auto\", a `Style` object, or a list.") # pager; 'on' just means use pager already associated with style valid_object(pager, "pager", err) valid.pagers <- c("auto", "off", "on") if( !is(pager, "Pager") && !string_in(pager, valid.pagers) && !(is.list(pager) && !is.object(pager)) ) err( "Argument `pager` must be one of `", dep(valid.pagers), "`, a `Pager` object, or a list." ) pager.args <- list() if(!is(pager, "Pager")) { if(string_in(pager, "off")) { pager <- PagerOff() } else if (is.list(pager)) { pager.args <- pager pager <- "on" } } # palette and arguments that reference palette dimensions if(is.null(palette.of.styles)) palette.of.styles <- PaletteOfStyles() if(!is(palette.of.styles, "PaletteOfStyles")) err("Argument `palette.of.styles` must be a `PaletteOfStyles` object.") palette.params <- c("brightness", "color.mode") for(x in palette.params) if( !isTRUE( msg <- is.valid.palette.param( get(x, inherits=FALSE), x, palette.of.styles ) ) ) err(msg) # Figure out whether pager is allowable or not; note that "auto" pager just # means let the pager that comes built into the style be the pager if(is.character(pager)) pager <- if( (pager == "auto" && interactive) || pager == "on" ) { "on" } else PagerOff() # format; decide what format to use if( !is(style, "Style") && ( string_in(style, "auto") || (is.list(style) && !is.object(style)) ) ) { if(is.list(style)) { style.args <- style style <- "auto" } else style.args <- list() # We only want to allow ansi styles if the pager supports them too; # unfortuantely we cannot have different styles depending on whether the # output is paged or not, at least not at this time pager.could.be.ansi <- if(is(pager, "Pager")) pager@ansi else FALSE if(!is.chr.1L(format)) err("Argument `format` must be character(1L) and not NA") valid.formats <- c("auto", dimnames(palette.of.styles@data)$format) if(!format %in% valid.formats) err("Argument `format` must be one of `", dep(valid.formats) , "`.") if(format == "auto") { if(!is.int.1L(term.colors)) # nocov start err( "Logic Error: unexpected return from `crayon::num_colors()`; ", "contact maintainer." ) # nocov end # No recognized color alternatives, try to use HTML if we can format <- if( nzchar(Sys.getenv('RSTUDIO')) && !nzchar(Sys.getenv('RSTUDIO_TERM')) && interactive ) { "html" } else if( term.colors < 8 ) { if(!pager.could.be.ansi) { if( (interactive && identical(pager, "on")) || is(pager, "PagerBrowser") ) "html" else "raw" } else { if(!pager@threshold) "ansi8" else "raw" } } else if (term.colors < 256) { "ansi8" } else if (term.colors >= 256) { "ansi256" } else stop("Logic error: unhandled format; contact maintainer.") # nocov } style <- palette.of.styles[[ format, get_pal_par(format, brightness), get_pal_par(format, color.mode) ]] if(is(style, "classRepresentation")) { style <- try(do.call("new", c(list(style), style.args)), silent=TRUE) if(inherits(style, "try-error")) { msg <- conditionMessage(attr(style, "condition")) err("Unable to instantiate `Style` object: ", msg) } } else { if(length(style.args)) { warn( "Extra `style` arguments cannot be applied because selected object ", "`palette.of.styles` is a `Style` instance rather than a `Style` ", "\"classRepresentation\". See documentation for the `style` ", "parameter for details." ) } valid_object( style, "palette.of.styles", err, paste0( "Argument `%s` is an invalid `%s` because it contains and invalid ", "`Style` object:" ) ) } } else if(!is(style, "Style")) stop("Logic Error: unexpected style state; contact maintainer.") # nocov # Attach specific pager if it was requested generated; if "on" just let the # existing pager on the style be, which is done by not modifying @pager if(is(pager, "Pager")) { style@pager <- pager } else if (length(pager.args)) { ## this is a bit gnarly, and pager.s <- style@pager old.slots <- sapply(slotNames(pager.s), slot, object=pager.s, simplify=FALSE) pager.args <- c(pager.args, old.slots[setdiff(names(old.slots), names(pager.args))]) style@pager <- do.call("new", c(list(class(pager.s)), pager.args)) } else if(!identical(pager, "on")) stop("Logic Error: Unexpected pager state; contact maintainer.") # nocov # Check display width if(!isTRUE(d.w.err <- is.valid.width(disp.width))) err("Arugment `disp.width` ", d.w.err) disp.width <- as.integer(disp.width) if(disp.width) { style@disp.width <- disp.width } else if(!style@disp.width) { d.w <- getOption("width") if(!is.valid.width(d.w)) { # nocov start this should never happen warn("`getOption(\"width\") returned an invalid width, using 80L") d.w <- 80L # nocov end } style@disp.width <- d.w } disp.width <- style@disp.width # check strip.sgr if(!is.TF(strip.sgr) && !is.null(strip.sgr)) err("Argument `strip.sgr` must be TRUE, FALSE, or NULL") if(is.null(strip.sgr)) strip.sgr <- is(style, "Ansi") # check strip.sgr if(!is.TF(sgr.supported) && !is.null(sgr.supported)) err("Argument `sgr.supported` must be TRUE, FALSE, or NULL") if(is.null(sgr.supported)) sgr.supported <- is(style, "Ansi") || crayon::has_color() # instantiate settings object etc <- new( "Settings", mode=val.modes[[which(mode.eq)]], context=context, line.limit=line.limit, ignore.white.space=ignore.white.space, max.diffs=max.diffs, align=align, disp.width=disp.width, hunk.limit=hunk.limit, convert.hz.white.space=convert.hz.white.space, tab.stops=tab.stops, style=style, frame=frame, tar.exp=tar.exp, cur.exp=cur.exp, guides=guides, tar.banner=tar.banner, cur.banner=cur.banner, trim=trim, word.diff=word.diff, unwrap.atomic=unwrap.atomic, strip.sgr=strip.sgr, sgr.supported=sgr.supported, err=err, warn=warn ) etc } diffobj/R/capt.R0000644000176200001440000003331115001242043013120 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. # Capture output of print/show/str; unfortunately doesn't have superb handling # of errors during print/show call, though hopefully these are rare # # x is a quoted call to evaluate capture <- function(x, etc, err) { capt.width <- etc@text.width if(capt.width) { opt.set <- try(width.old <- options(width=capt.width), silent=TRUE) if(inherits(opt.set, "try-error")) { warning( "Unable to set desired width ", capt.width, ", (", conditionMessage(attr(opt.set, "condition")), ");", "proceeding with existing setting." ) } else on.exit(options(width.old)) } # Note, we use `tempfile` for capture as that appears much faster than normal # capture without a file capt.file <- tempfile() on.exit(unlink(capt.file), add=TRUE) res <- try({ capture.output(eval(x, etc@frame), file=capt.file) obj.out <- readLines(capt.file) }) if(inherits(res, "try-error")) err( "Failed attempting to get text representation of object: ", conditionMessage(attr(res, "condition")) ) html_ent_sub(res, etc@style) } # capture normal prints, along with default prints to make sure that if we # do try to wrap an atomic vector print it is very likely to be in a format # we are familiar with and not affected by a non-default print method capt_print <- function(target, current, etc, err, extra){ dots <- extra # What about S4? if(getRversion() >= "3.2.0") { print.match <- try( match.call( get("print", envir=etc@frame, mode='function'), as.call(c(list(quote(print), x=NULL), dots)), envir=etc@frame ) ) } else { # this may be sub-optimal, but match.call does not support the envir arg # prior to this # nocov start print.match <- try( match.call( get("print", envir=etc@frame), as.call(c(list(quote(print), x=NULL), dots)) ) ) # nocov end } if(inherits(print.match, "try-error")) err("Unable to compose `print` call") names(print.match)[[2L]] <- "" tar.call <- cur.call <- print.match if(length(dots)) { if(!is.null(etc@tar.exp)) tar.call[[2L]] <- etc@tar.exp if(!is.null(etc@cur.exp)) cur.call[[2L]] <- etc@cur.exp etc@tar.banner <- deparse(tar.call)[[1L]] etc@cur.banner <- deparse(cur.call)[[1L]] } tar.call.q <- if(is.call(target) || is.symbol(target)) call("quote", target) else target cur.call.q <- if(is.call(current) || is.symbol(current)) call("quote", current) else current if(!is.null(target)) tar.call[[2L]] <- tar.call.q if(!is.null(current)) cur.call[[2L]] <- cur.call.q # If dimensioned object, and in auto-mode, switch to side by side if stuff is # narrow enough to fit if((!is.null(dim(target)) || !is.null(dim(current)))) { cur.capt <- capture(cur.call, etc, err) tar.capt <- capture(tar.call, etc, err) etc <- set_mode(etc, tar.capt, cur.capt) } else { etc <- if(etc@mode == "auto") sideBySide(etc) else etc cur.capt <- capture(cur.call, etc, err) tar.capt <- capture(tar.call, etc, err) } if(isTRUE(etc@guides)) etc@guides <- guidesPrint if(isTRUE(etc@trim)) etc@trim <- trimPrint diff.out <- line_diff(target, current, tar.capt, cur.capt, etc=etc, warn=TRUE) diff.out@capt.mode <- "print" diff.out } # Tries various different `str` settings to get the best possible output capt_str <- function(target, current, etc, err, extra){ # Match original call and managed dots, in particular wrt to the # `max.level` arg dots <- extra frame <- etc@frame line.limit <- etc@line.limit if("object" %in% names(dots)) err("You may not specify `object` as part of `extra`") if(getRversion() < "3.2.0") { # nocov start str.match <- match.call( str_tpl, call=as.call(c(list(quote(str), object=NULL), dots)) ) # nocov end } else { str.match <- match.call( str_tpl, call=as.call(c(list(quote(str), object=NULL), dots)), envir=etc@frame ) } names(str.match)[[2L]] <- "" # Handle auto mode (side by side always for `str`) if(etc@mode == "auto") etc <- sideBySide(etc) # Utility function; defining in body so it has access to `err` eval_try <- function(match.list, index, envir) tryCatch( eval(match.list[[index]], envir=envir), error=function(e) err("Error evaluating `", index, "` arg: ", conditionMessage(e)) ) # Setup / process extra args auto.mode <- FALSE max.level.supplied <- FALSE if( max.level.pos <- match("max.level", names(str.match), nomatch=0L) ) { # max.level specified in call; check for special 'auto' case max.level.eval <- eval_try(str.match, "max.level", etc@frame) if(identical(max.level.eval, "auto")) { auto.mode <- TRUE str.match[["max.level"]] <- NA } else { max.level.supplied <- TRUE } } else { str.match[["max.level"]] <- NA auto.mode <- TRUE max.level.pos <- length(str.match) max.level.supplied <- FALSE } # Was wrap specified in strict width mode? Not sure this is correct any more; # should probably be looking at extra args. wrap <- FALSE if("strict.width" %in% names(str.match)) { res <- eval_try(str.match, "strict.width", etc@frame) wrap <- is.character(res) && length(res) == 1L && !is.na(res) && nzchar(res) && identical(res, substr("wrap", 1L, nchar(res))) } if(auto.mode) { msg <- "Specifying `%s` may cause `str` output level folding to be incorrect" if("comp.str" %in% names(str.match)) warning(sprintf(msg, "comp.str")) if("indent.str" %in% names(str.match)) warning(sprintf(msg, "indent.str")) } # don't want to evaluate target and current more than once, so can't eval # tar.exp/cur.exp, so instead run call with actual object tar.call <- cur.call <- str.match tar.call.q <- if(is.call(target) || is.symbol(target)) call("quote", target) else target cur.call.q <- if(is.call(current) || is.symbol(current)) call("quote", current) else current if(!is.null(target)) tar.call[[2L]] <- tar.call.q if(!is.null(current)) cur.call[[2L]] <- cur.call.q # Run str capt.width <- etc@text.width has.diff <- has.diff.prev <- FALSE # we used to strip_hz_control here, but shouldn't have to since handled by # line_diff tar.capt <- capture(tar.call, etc, err) tar.lvls <- str_levels(tar.capt, wrap=wrap) cur.capt <- capture(cur.call, etc, err) cur.lvls <- str_levels(cur.capt, wrap=wrap) prev.lvl.hi <- lvl <- max.depth <- max(tar.lvls, cur.lvls) prev.lvl.lo <- 0L first.loop <- TRUE safety <- 0L warn <- TRUE if(isTRUE(etc@guides)) etc@guides <- guidesStr if(isTRUE(etc@trim)) etc@trim <- trimStr tar.str <- tar.capt cur.str <- cur.capt diff.obj <- diff.obj.full <- line_diff( target, current, tar.str, cur.str, etc=etc, warn=warn ) if(!max.level.supplied) { repeat{ if((safety <- safety + 1L) > max.depth && !first.loop) # nocov start stop( "Logic Error: exceeded list depth when comparing structures; contact ", "maintainer." ) # nocov end if(!first.loop) { tar.str <- tar.capt[tar.lvls <= lvl] cur.str <- cur.capt[cur.lvls <= lvl] diff.obj <- line_diff( target, current, tar.str, cur.str, etc=etc, warn=warn ) } if(diff.obj@hit.diffs.max) warn <- FALSE has.diff <- suppressWarnings(any(diff.obj)) # If there are no differences reducing levels isn't going to help to # find one; additionally, if not in auto.mode we should not be going # through this process if(first.loop && !has.diff) break first.loop <- FALSE if(line.limit[[1L]] < 1L) break line.len <- diff_line_len( diff.obj@diffs, etc=etc, tar.capt=tar.str, cur.capt=cur.str ) # We need a higher level if we don't have diffs if(!has.diff && prev.lvl.hi - lvl > 1L) { prev.lvl.lo <- lvl lvl <- lvl + as.integer((prev.lvl.hi - lvl) / 2) tar.call[[max.level.pos]] <- lvl cur.call[[max.level.pos]] <- lvl next } else if(!has.diff) { diff.obj <- diff.obj.full lvl <- NULL break } # If we have diffs, need to check whether we should try to reduce lines # to get under line limit if(line.len <= line.limit[[1L]]) { # We fit, nothing else to do break } if(lvl - prev.lvl.lo > 1L) { prev.lvl.hi <- lvl lvl <- lvl - as.integer((lvl - prev.lvl.lo) / 2) tar.call[[max.level.pos]] <- lvl cur.call[[max.level.pos]] <- lvl next } # Couldn't get under limit, so use first run results diff.obj <- diff.obj.full lvl <- NULL break } } else { tar.str <- tar.capt[tar.lvls <= max.level.eval] cur.str <- cur.capt[cur.lvls <= max.level.eval] lvl <- max.level.eval diff.obj <- line_diff(target, current, tar.str, cur.str, etc=etc, warn=warn) } if(auto.mode && !is.null(lvl) && lvl < max.depth) { str.match[[max.level.pos]] <- lvl } else if (!max.level.supplied || is.null(lvl)) { str.match[[max.level.pos]] <- NULL } tar.call <- cur.call <- str.match if(!is.null(etc@tar.exp)) tar.call[[2L]] <- etc@tar.exp if(!is.null(etc@cur.exp)) cur.call[[2L]] <- etc@cur.exp if(is.null(etc@tar.banner)) diff.obj@etc@tar.banner <- deparse(tar.call)[[1L]] if(is.null(etc@cur.banner)) diff.obj@etc@cur.banner <- deparse(cur.call)[[1L]] # Track total differences in fully expanded view so we can report hidden # diffs when folding levels diff.obj@diff.count.full <- count_diffs(diff.obj.full@diffs) diff.obj@capt.mode <- "str" diff.obj } capt_chr <- function(target, current, etc, err, extra){ tar.capt <- if(!is.character(target)) do.call(as.character, c(list(target), extra), quote=TRUE) else target cur.capt <- if(!is.character(current)) do.call(as.character, c(list(current), extra), quote=TRUE) else current # technically possible to have a character method that doesn't return a # character object... if((tt <- typeof(tar.capt)) != 'character') stop("Coercion of `target` did not produce character object (", tt, ").") if((tc <- typeof(cur.capt)) != 'character') stop("Coercion of `current` did not produce character object (", tc, ").") # drop attributes tar.capt <- c(tar.capt) cur.capt <- c(cur.capt) if(anyNA(tar.capt)) tar.capt[is.na(tar.capt)] <- "NA" if(anyNA(cur.capt)) cur.capt[is.na(cur.capt)] <- "NA" etc <- set_mode(etc, tar.capt, cur.capt) if(isTRUE(etc@guides)) etc@guides <- guidesChr if(isTRUE(etc@trim)) etc@trim <- trimChr diff.out <- line_diff( target, current, html_ent_sub(tar.capt, etc@style), html_ent_sub(cur.capt, etc@style), etc=etc ) diff.out@capt.mode <- "chr" diff.out } capt_deparse <- function(target, current, etc, err, extra){ dep.try <- try({ tar.capt <- do.call(deparse, c(list(target), extra), quote=TRUE) cur.capt <- do.call(deparse, c(list(current), extra), quote=TRUE) }) if(inherits(dep.try, "try-error")) err("Error attempting to deparse object(s)") etc <- set_mode(etc, tar.capt, cur.capt) if(isTRUE(etc@guides)) etc@guides <- guidesDeparse if(isTRUE(etc@trim)) etc@trim <- trimDeparse diff.out <- line_diff( target, current, html_ent_sub(tar.capt, etc@style), html_ent_sub(cur.capt, etc@style), etc=etc ) diff.out@capt.mode <- "deparse" diff.out } capt_file <- function(target, current, etc, err, extra) { tar.capt <- try(do.call(readLines, c(list(target), extra), quote=TRUE)) if(inherits(tar.capt, "try-error")) err("Unable to read `target` file.") cur.capt <- try(do.call(readLines, c(list(current), extra), quote=TRUE)) if(inherits(cur.capt, "try-error")) err("Unable to read `current` file.") etc <- set_mode(etc, tar.capt, cur.capt) if(isTRUE(etc@guides)) etc@guides <- guidesFile if(isTRUE(etc@trim)) etc@trim <- trimFile diff.out <- line_diff( tar.capt, cur.capt, html_ent_sub(tar.capt, etc@style), html_ent_sub(cur.capt, etc@style), etc=etc ) diff.out@capt.mode <- "file" diff.out } capt_csv <- function(target, current, etc, err, extra){ tar.df <- try(do.call(read.csv, c(list(target), extra), quote=TRUE)) if(inherits(tar.df, "try-error")) err("Unable to read `target` file.") if(!is.data.frame(tar.df)) err("`target` file did not produce a data frame when read") # nocov cur.df <- try(do.call(read.csv, c(list(current), extra), quote=TRUE)) if(inherits(cur.df, "try-error")) err("Unable to read `current` file.") if(!is.data.frame(cur.df)) err("`current` file did not produce a data frame when read") # nocov capt_print(tar.df, cur.df, etc, err, extra) } # Sets mode to "unified" if stuff is too wide to fit side by side without # wrapping otherwise sets it in "sidebyside" set_mode <- function(etc, tar.capt, cur.capt) { stopifnot(is(etc, "Settings"), is.character(tar.capt), is.character(cur.capt)) if(etc@mode == "auto") { if( any( nchar2(cur.capt, sgr.supported=etc@sgr.supported) > etc@text.width.half ) || any( nchar2(tar.capt, sgr.supported=etc@sgr.supported) > etc@text.width.half ) ) { etc@mode <- "unified" } } if(etc@mode == "auto") etc <- sideBySide(etc) etc } diffobj/R/rdiff.R0000644000176200001440000001253515001242043013270 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. #' Run Rdiff Directly on R Objects #' #' These functions are here for reference and testing purposes. They are #' wrappers to \code{tools::Rdiff} and rely on an existing system diff utility. #' You should be using \code{\link{ses}} or \code{\link{diffChr}} instead of #' \code{Rdiff_chr} and \code{\link{diffPrint}} instead of \code{Rdiff_obj}. #' See limitations in note. #' #' \code{Rdiff_chr} runs diffs on character vectors or objects coerced to #' character vectors, where each value in the vectors is treated as a line in a #' file. \code{Rdiff_chr} always runs with the \code{useDiff} and \code{Log} #' parameters set to \code{TRUE}. #' #' \code{Rdiff_obj} runs diffs on the \code{print}ed representation of #' the provided objects. For each of \code{from}, \code{to}, will check if they #' are 1 length character vectors referencing an RDS file, and will use the #' contents of that RDS file as the object to compare. #' #' @note These functions will try to use the system \code{diff} utility. This #' will fail in systems that do not have that utility available (e.g. windows #' installation without Rtools). #' @importFrom tools Rdiff #' @export #' @seealso \code{\link{ses}}, \code{\link[=diffPrint]{diff*}} #' @param from character or object coercible to character for \code{Rdiff_chr}, #' any R object with \code{Rdiff_obj}, or a file pointing to an RDS object #' @param to character same as \code{from} #' @param nullPointers passed to \code{tools::Rdiff} #' @param silent TRUE or FALSE, whether to display output to screen #' @param minimal TRUE or FALSE, whether to exclude the lines that show the #' actual differences or only the actual edit script commands #' @return the Rdiff output, invisibly if \code{silent} is FALSE #' Rdiff_chr(letters[1:5], LETTERS[1:5]) #' Rdiff_obj(letters[1:5], LETTERS[1:5]) Rdiff_chr <- function(from, to, silent=FALSE, minimal=FALSE, nullPointers=TRUE) { A <- try(as.character(from)) if(inherits(A, "try-error")) stop("Unable to coerce `target` to character.") B <- try(as.character(to)) if(inherits(B, "try-error")) stop("Unable to coerce `current` to character.") af <- tempfile() bf <- tempfile() writeLines(A, af) writeLines(B, bf) on.exit(unlink(c(af, bf))) Rdiff_run( silent=silent, minimal=minimal, from=af, to=bf, nullPointers=nullPointers ) } #' @export #' @rdname Rdiff_chr Rdiff_obj <- function(from, to, silent=FALSE, minimal=FALSE, nullPointers=TRUE) { dummy.env <- new.env() # used b/c unique object files <- try( vapply( list(from, to), function(x) { if( is.character(x) && length(x) == 1L && !is.na(x) && file_test("-f", x) ) { rdstry <- tryCatch(readRDS(x), error=function(x) dummy.env) if(!identical(rdstry, dummy.env)) x <- rdstry } f <- tempfile() on.exit(unlink(f)) capture.output(if(isS4(x)) show(x) else print(x), file=f) on.exit() f }, character(1L) ) ) if(inherits(files, "try-error")) stop("Unable to store text representation of objects") on.exit(unlink(files)) Rdiff_run( from=files[[1L]], to=files[[2L]], silent=silent, minimal=minimal, nullPointers=nullPointers ) } # Internal use only: BEWARE, will unlink from, to Rdiff_run <- function(from, to, nullPointers, silent, minimal) { stopifnot( isTRUE(silent) || identical(silent, FALSE), isTRUE(minimal) || identical(minimal, FALSE) ) res <- tryCatch( Rdiff( from=from, to=to, useDiff=TRUE, Log=TRUE, nullPointers=nullPointers )$out, warning=function(e) stop( "`tools::Rdiff` returned a warning; this likely means you are running ", "without a `diff` utility accessible to R" ) ) if(!is.character(res)) # nocov start stop("Internal Error: Unexpected tools::Rdiff output, contact maintainer") # nocov end res <- if(minimal) res[!grepl("^[<>-]", res)] else res if(silent) res else { cat(res, sep="\n") invisible(res) } } #' Attempt to Detect Whether diff Utility is Available #' #' Checks whether \code{\link[=Rdiff]{tools::Rdiff}} issues a warning when #' running with \code{useDiff=TRUE} and if it does assumes this is because the #' diff utility is not available. Intended primarily for testing purposes. #' #' @export #' @return TRUE or FALSE #' @param test.with function to test for diff presence with, typically Rdiff #' @examples #' has_Rdiff() has_Rdiff <- function(test.with=tools::Rdiff) { f.a <- tempfile() f.b <- tempfile() on.exit(unlink(c(f.a, f.b))) writeLines(letters[1:3], f.a) writeLines(LETTERS, f.b) tryCatch( { test.with( from=f.a, to=f.b, useDiff=TRUE, Log=TRUE, nullPointers=FALSE ) TRUE }, warning=function(e) FALSE ) } diffobj/R/get.R0000644000176200001440000000314315001242043012750 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. # Retrieves data from the data elements of the Diff object based on the index # values provided in ind. Positive values draw from `tar` elements, and # negative draw from `cur` elements. # # returns a list with the elements. If type is length 1, you will probably # want to unlist the return value get_dat <- function(x, ind, type) { stopifnot( is(x, "Diff"), is.integer(ind), is.chr.1L(type) && type %in% .diff.dat.cols ) # Need to figure out what zero indices are; previously would return # NA_character_, but now since we're getting a whole bunch of different # stuff not sure what the right return value should be, or even if we produce # zero indices anymore get_dat_raw(ind, x@tar.dat[[type]], x@cur.dat[[type]]) } get_dat_raw <- function(ind, tar, cur) { template <- tar[0L] length(template) <- length(ind) template[which(ind < 0L)] <- cur[abs(ind[ind < 0L])] template[which(ind > 0L)] <- tar[abs(ind[ind > 0L])] template } diffobj/R/summmary.R0000644000176200001440000002604615001242043014052 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. #' @include s4.R NULL setClass("DiffSummary", slots=c( max.lines="integer", width="integer", etc="Settings", diffs="matrix", all.eq="character", scale.threshold="numeric" ), validity=function(object) { if( !is.integer(object@diffs) && !identical(rownames(object@diffs), c("match", "delete", "add")) ) return("Invalid diffs object") TRUE } ) #' Summary Method for Diff Objects #' #' Provides high level count of insertions, deletions, and matches, as well as a #' \dQuote{map} of where the differences are. #' #' Sequences of single operations (e.g. "DDDDD") are compressed provided that #' compressing them does not distort the relative size of the sequence relative #' to the longest such sequence in the map by more than \code{scale.threshold}. #' Since length 1 sequences cannot be further compressed \code{scale.threshold} #' does not apply to them. #' #' @param object at \code{Diff} object #' @param scale.threshold numeric(1L) between 0 and 1, how much distortion to #' allow when creating the summary map, where 0 is none and 1 is as much as #' needed to fit under \code{max.lines}, defaults to 0.1 #' @param max.lines integer(1L) how many lines to allow for the summary map, #' defaults to 50 #' @param width integer(1L) how many columns wide the output should be, defaults #' to \code{getOption("width")} #' @param ... unused, for compatibility with generic #' @return a \code{DiffSummary} object #' ## `pager="off"` for CRAN compliance; you may omit in normal use #' summary(diffChr(letters, letters[-c(5, 15)], format="raw", pager="off")) setMethod("summary", "Diff", function( object, scale.threshold=0.1, max.lines=50L, width=getOption("width"), ... ) { if(!is.int.1L(max.lines) || max.lines < 1L) stop("Argument `max.lines` must be integer(1L) and strictly positive") max.lines <- as.integer(max.lines) if(!is.int.1L(width) || width < 0L) stop("Argument `width` must be integer(1L) and positive") if(width < 10L) width <- 10L if( !is.numeric(scale.threshold) || length(scale.threshold) != 1L || is.na(scale.threshold) || !scale.threshold %bw% c(0, 1) ) stop("Argument `scale.threshold` must be numeric(1L) between 0 and 1") diffs.c <- count_diffs_detail(object@diffs) # remove context hunks that are duplicated match.seq <- rle(!!diffs.c["match", ]) match.keep <- unlist( lapply( match.seq$lengths, function(x) if(x == 2L) c(TRUE, FALSE) else TRUE ) ) diffs <- diffs.c[, match.keep, drop=FALSE] all.eq <- all.equal(object@target, object@current) new( "DiffSummary", max.lines=max.lines, width=width, etc=object@etc, diffs=diffs, all.eq=if(isTRUE(all.eq)) character(0L) else all.eq, scale.threshold=scale.threshold ) } ) #' @rdname finalizeHtml setMethod("finalizeHtml", c("DiffSummary"), function(x, x.chr, ...) { js <- "" callNextMethod(x, x.chr, js=js, ...) } ) #' Generate Character Representation of DiffSummary Object #' #' @param x a \code{DiffSummary} object #' @param ... not used, for compatibility with generic #' @return the summary as a character vector intended to be \code{cat}ed to #' terminal #' @examples #' as.character( #' summary(diffChr(letters, letters[-c(5, 15)], format="raw", pager="off")) #' ) setMethod("as.character", "DiffSummary", function(x, ...) { etc <- x@etc style <- etc@style hunks <- sum(!x@diffs["match", ]) res <- c(apply(x@diffs, 1L, sum)) scale.threshold <- x@scale.threshold # something seems wrong with next condition res <- if(!hunks || !sum(x@diffs[c("delete", "add"), ])) { style@summary@body( if(length(x@all.eq)) { eq.txt <- paste0("- ", x@all.eq) paste0( c( "No visible differences, but objects are not `all.equal`:", eq.txt ), collapse=style@text@line.break ) } else { "Objects are `all.equal`" } ) } else { pad <- 2L width <- x@width - pad head <- paste0( paste0( strwrap( sprintf( "Found differences in %d hunk%s:", hunks, if(hunks != 1L) "s" else "" ), width=width ), collapse=style@text@line.break ), style@summary@detail( paste0( strwrap( sprintf( "%d insertion%s, %d deletion%s, %d match%s (lines)", res[["add"]], if(res[["add"]] == 1L) "" else "s", res[["delete"]], if(res[["delete"]] == 1L) "" else "s", res[["match"]], if(res[["match"]] == 1L) "" else "es" ), width=width ), collapse=style@text@line.break ) ), collapse="" ) # Compute character screen display max.chars <- x@max.lines * width diffs <- x@diffs scale.threshold <- x@scale.threshold # Helper fun to determine if the scale skewed our data too much scale_err <- function(orig, scaled, threshold, width) { if((width - sum(scaled)) / width > threshold) { TRUE } else { zeroes <- !orig orig.nz <- orig[!zeroes] scaled.nz <- scaled[!zeroes] orig.norm <- orig.nz / max(orig.nz) scaled.norm <- scaled.nz / max(scaled.nz) any(abs(orig.norm - scaled.norm) > threshold) } } # Scale the data down as small as possible provided we don't violate # tolerance. diffs.gz <- diffs > 1L diffs.nz <- diffs[diffs.gz] safety <- 10000L tol <- width / 4 diffs.scale <- diffs lo.bound <- lo <- length(diffs.nz) hi.bound <- hi <- sum(diffs.nz) if(sum(diffs.scale) > width) { repeat { mp <- ceiling((hi.bound - lo.bound) / 2) + lo.bound safety <- safety - 1L if(safety < 0L) # nocov start stop("Logic Error: likely infinite loop; contact maintainer.") # nocov end # Need to scale down; we know we need at least one char per value diffs.nz.s <- pmax( round(diffs.nz * (mp - lo) / (hi - lo)), 1L ) diffs.scale[diffs.gz] <- diffs.nz.s scale.err <- scale_err(diffs, diffs.scale, scale.threshold, width) break.cond <- floor(mp / width) <= floor(lo.bound / width) || mp >= hi.bound if(scale.err) { # error, keep increasing lines lo.bound <- mp } else { # no error, check if we can generate an error with a smaller value # note hi.bound is always guaranteed to not produce error if(break.cond) break hi.bound <- mp } } } diffs.fin <- diffs.scale # Compute scaling factors for display to user scale.one <- diffs.scale == 1 scale.gt.one <- diffs.scale > 1 s.o.txt <- if(any(scale.one)) { s.o.r <- unique(range(diffs[scale.one])) if(length(s.o.r) == 1L) sprintf("%d:1 for single chars", s.o.r) else sprintf("%d-%d:1 for single chars", s.o.r[1L], s.o.r[2L]) } s.gt.o.txt <- if(any(scale.gt.one)) { s.gt.o.r <- unique( range(round(diffs[scale.gt.one] / diffs.scale[scale.gt.one])) ) if(length(s.gt.o.r) == 1L) sprintf("%d:1 for char seqs", s.gt.o.r) else sprintf("%d-%d:1 for char seqs", s.gt.o.r[1L], s.gt.o.r[2L]) } map.txt <- sprintf( "Diff map (line:char scale is %s%s%s):", if(!is.null(s.o.txt)) s.o.txt else "", if(is.null(s.o.txt) && !is.null(s.gt.o.txt)) "" else ", ", if(!is.null(s.gt.o.txt)) s.gt.o.txt else "" ) body <- if(style@wrap) strwrap(map.txt, width=x@width) else map.txt # Render actual map diffs.txt <- character(length(diffs.fin)) attributes(diffs.txt) <- attributes(diffs.fin) symb <- c(match=".", add="I", delete="D") use.ansi <- FALSE for(i in names(symb)) { test <- diffs.txt[i, ] <- vapply( diffs.fin[i, ], function(x) paste0(rep(symb[[i]], x), collapse=""), character(1L) ) } # Trim text down to what is displayable in the allowed lines txt <- do.call(paste0, as.list(c(diffs.txt))) txt <- substr2(txt, 1, max.chars, sgr.supported=etc@sgr.supported) txt.w <- unlist( if(style@wrap) wrap(txt, width, sgr.supported=etc@sgr.supported) else txt ) # Apply ansi styles if warranted if(is(style, "StyleAnsi")) { old.crayon.opt <- options(crayon.enabled=TRUE) on.exit(options(old.crayon.opt), add=TRUE) } s.f <- style@funs txt.w <- gsub( symb[["add"]], s.f@word.insert(symb[["add"]]), gsub( symb[["delete"]], s.f@word.delete(symb[["delete"]]), txt.w, fixed=TRUE ), fixed=TRUE ) extra <- if(sum(diffs.fin) > max.chars) { diffs.omitted <- diffs.fin diffs.under <- cumsum(diffs.omitted) <= max.chars diffs.omitted[diffs.under] <- 0L res.om <- apply(diffs.omitted, 1L, sum) sprintf( paste0( "omitting %d deletion%s, %d insertion%s, and %d matche%s; ", "increase `max.lines` to %d to show full map" ), res.om[["delete"]], if(res.om[["delete"]] != 1L) "s" else "", res.om[["add"]], if(res.om[["add"]] != 1L) "s" else "", res.om[["match"]], if(res.om[["match"]] != 1L) "s" else "", ceiling(sum(diffs.scale) / width) ) } else character(0L) map <- txt.w if(length(extra) && style@wrap) extra <- strwrap(extra, width=width) c( style@summary@body( paste0( c(head, body), collapse=style@text@line.break ) ), style@summary@map(c(map, extra)) ) } fin <- style@funs@container(style@summary@container(res)) finalize( fin, x, length(unlist(gregexpr(style@text@line.break, fin, fixed=TRUE))) + length(fin) ) } ) #' Display DiffSummary Objects #' #' @param object a \code{DiffSummary} object #' @return NULL, invisbly #' show( #' summary(diffChr(letters, letters[-c(5, 15)], format="raw", pager="off")) #' ) setMethod("show", "DiffSummary", function(object) { show_w_pager(as.character(object), object@etc@style@pager) invisible(NULL) } ) diffobj/R/html.R0000644000176200001440000001037315001242043013140 0ustar liggesusers# Copyright (C) 2021 Brodie Gaslam # # This file is part of "diffobj - Diffs for R Objects" # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # Go to for a copy of the license. #' @include misc.R NULL #' Make Functions That Wrap Text in HTML Tags #' #' Helper functions to generate functions to use as slots for the #' \code{StyleHtml@funs} classes. These are functions that return #' \emph{functions}. #' #' \code{tag_f} and related functions (\code{div_f}, \code{span_f}) produce #' functions that are vectorized and will apply opening and closing tags to #' each element of a character vector. \code{container_f} on the other hand #' produces a function will collapse a character vector into length 1, and only #' then applies the tags. Additionally, \code{container_f} already comes with #' the \dQuote{diffobj-container} class specified. #' #' @note inputs are assumed to be valid class names or CSS styles. #' #' @export #' @param tag character(1L) a name of an HTML tag #' @param class character the CSS class(es) #' @param style named character inline styles, where the name is the CSS #' property and the value the value. #' @return a function that accepts a character parameter. If applied, each #' element in the character vector will be wrapped in the div tags #' @aliases div_f, span_f, cont_f #' @examples #' ## Assuming class 'ex1' has CSS styles defined elsewhere #' tag_f("div", "ex1")(LETTERS[1:5]) #' ## Use convenience function, and add some inline styles #' div_f("ex2", c(color="green", `font-family`="arial"))(LETTERS[1:5]) #' ## Notice how this is a div with pre-specifed class, #' ## and only one div is created around the entire data #' cont_f()(LETTERS[1:5]) tag_f <- function(tag, class=character(), style=character()) { stopifnot(is.chr.1L(tag), is.character(class), is.character(style)) function(x) { if(!is.character(x)) stop("Argument `x` must be character.") if(!length(x)) character(0L) else paste0( "<", tag, if(length(class)) paste0(" class='", paste0(class, collapse=" "), "'"), if(length(style)) paste0( " style='", paste(names(style), style, sep=": ", collapse="; "), ";'" ), ">", x, "" ) } } #' @export #' @rdname tag_f div_f <- function(class=character(), style=character()) tag_f("div", class, style) #' @export #' @rdname tag_f span_f <- function(class=character(), style=character()) tag_f("span", class, style) #' @export #' @rdname tag_f cont_f <- function(class=character()) { stopifnot(is.character(class)) function(x) { if(!is.character(x)) stop("Argument `x` must be character.") sprintf( paste0( "
",
        "%s
" ), if(length(class)) paste0(" ", class, collapse="") else "", paste0(x, collapse="") ) } } #' Count Text Characters in HTML #' #' Very simple implementation that will fail if there are any \dQuote{>} in the #' HTML that are not closing tags, and assumes that HTML entities are all one #' character wide. Also, spaces are counted as one width each because the #' HTML output is intended to be displayed inside \code{
} tags.
#'
#' @export
#' @param x character
#' @param ... unused for compatibility with internal use
#' @return integer(length(x)) with number of characters of each element
#' @examples
#' nchar_html("hello")

nchar_html <- function(x, ...) {
  stopifnot(is.character(x) && !anyNA(x))
  tag.less <- gsub("<[^>]*>", "", x) 
  # Thanks ridgerunner for html entity removal regex
  # http://stackoverflow.com/users/433790/ridgerunner
  # http://stackoverflow.com/a/8806462/2725969
  ent.less <-
    gsub("&(?:[a-z\\d]+|#\\d+|#x[a-f\\d]+);", "X", tag.less, perl=TRUE)
  nchar(ent.less)
}
diffobj/R/system.R0000644000176200001440000000211415001242043013512 0ustar  liggesusers# Copyright (C) 2021 Brodie Gaslam
#
# This file is part of "diffobj - Diffs for R Objects"
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# Go to  for a copy of the license.

#' @include styles.R

NULL


# nocov start
.onLoad <- function(libname, pkgname) {
  # Scheme defaults are fairly complex...

  existing.opts <- options()
  options(.default.opts[setdiff(names(.default.opts), names(existing.opts))])
  trimws <<- if(getRversion() < "3.2.0") trimws2 else base::trimws
}
# Remove DLLs when package is unloaded

.onUnload <- function(libpath) {
  library.dynam.unload("diffobj", libpath)
}
# nocov end

diffobj/R/layout.R0000644000176200001440000001345615001242043013516 0ustar  liggesusers# Copyright (C) 2021 Brodie Gaslam
#
# This file is part of "diffobj - Diffs for R Objects"
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# Go to  for a copy of the license.

# Compute all the different gutter components and report max width

gutter_dat <- function(etc) {
  stopifnot(is(etc, "Settings"))
  old.opt <- options(crayon.enabled=TRUE)
  on.exit(options(old.opt))
  funs <- etc@style@funs
  text <- etc@style@text

  # get every slot except the pad slot; we'll then augment them so they have
  # all the same number of characters if the style class inherits from
  # Raw, which should be the case for raw, ansi8 and ansi255.  Finally apply
  # functions; note we assume the provided gutter characters don't contain
  # ANSI escapes.  We're a bit sloppy here with how we pull the relevant stuff

  slot.nm <- slotNames(text)
  slots <- slot.nm[grepl("^gutter\\.", slot.nm) & slot.nm != "gutter.pad"]
  gutt.txt <- vapply(slots, slot, character(1L), object=text)
  gutt.dat <- if(is(etc@style, "Raw")) format(gutt.txt) else gutt.txt

  gutt.format.try <- try({
    gutt.dat.format <- vapply(
      slots,
      function(x) slot(funs, sprintf("%s", x))(gutt.dat[x]),
      character(1L)
    )
    gutt.dat.format.pad <-
      funs@gutter(paste0(gutt.dat.format, funs@gutter.pad(text@gutter.pad)))
  })
  if(inherits(gutt.format.try, "try-error"))
    stop(
      "Failed attempting to apply gutter formatting functions; if you did not ",
      "customize them, contact maintainer.  See `?StyleFuns`."
    )

  names(gutt.dat.format.pad) <- sub("^gutter\\.", "", names(gutt.dat.format))
  gutt.max.w <- max(
    etc@style@nchar.fun(gutt.dat.format.pad, sgr.supported=etc@sgr.supported)
  )
  gutt.args <- c(
    list("Gutter"), as.list(gutt.dat.format.pad),
    list(width=gutt.max.w)
  )
  do.call("new", gutt.args)
}
# Based on the type of each row in a column, render the correct gutter

render_gutters <- function(types, lens, lens.max, etc) {
  gutter.dat <- etc@gutter
  Map(
    function(dat, lens, lens.max) {
      Map(
        function(type, len, len.max) {
          if(
            type %in% c(
              "insert", "delete", "match", "guide", "fill", "context.sep"
            )
          ) {
            c(
              if(len) slot(gutter.dat, as.character(type)),
              rep(
                slot(gutter.dat, paste0(type, ".", "ctd")), max(len - 1L, 0L)
              ),
              rep(slot(gutter.dat, "fill"), max(len.max - len, 0L))
            )
          } else character(len)
        },
        dat, lens, lens.max
      )
    },
    types, lens, lens.max
  )
}

render_col <- function(gutter, col, type, etc) {
  lens <- vapply(col, length, integer(1L))
  gutt.ul <- unlist(gutter)
  col.txt <- paste0(gutt.ul, unlist(col))
  type.ul <- unlist(type)
  es <- etc@style@funs

  # line formats

  col.txt[type.ul == "banner.insert"] <-
    es@banner(es@banner.insert(col.txt[type.ul == "banner.insert"]))
  col.txt[type.ul == "banner.delete"] <-
    es@banner(es@banner.delete(col.txt[type.ul == "banner.delete"]))
  col.txt[type.ul == "insert"] <-
    es@line(es@line.insert(col.txt[type.ul == "insert"]))
  col.txt[type.ul == "delete"] <-
    es@line(es@line.delete(col.txt[type.ul == "delete"]))
  col.txt[type.ul == "match"] <-
    es@line(es@line.match(col.txt[type.ul == "match"]))
  col.txt[type.ul == "guide"] <-
    es@line(es@line.guide(col.txt[type.ul == "guide"]))
  col.txt[type.ul == "fill"] <-
    es@line(es@line.fill(col.txt[type.ul == "fill"]))
  col.txt[type.ul == "context.sep"] <-
    es@line(es@context.sep(col.txt[type.ul == "context.sep"]))
  col.txt[type.ul == "header"] <- es@line(col.txt[type.ul == "header"])
  col.txt
}
render_cols <- function(cols, gutters, types, etc) {
  Map(render_col, gutters, cols, types, MoreArgs=list(etc=etc))
}
render_rows <- function(cols, etc) {
  col.txt <- do.call(paste, c(cols, list(sep=etc@style@text@pad.col)))
  etc@style@funs@row(col.txt)
}

# Create a dummy row so we can compute display width for scaling display in
# HTML mode
#
# @param x a `Diff` object

make_dummy_line <- function(x, dummy.text, type) {
  stopifnot(is.chr.1L(type) && type %in% c("line", "banner"))

  fns <- x@etc@style@funs
  txt <- x@etc@style@text

  line_fun <- slot(fns, type)
  line_ins_fun <- slot(fns, sprintf("%s.insert", type))
  line_del_fun <- slot(fns, sprintf("%s.delete", type))

  if(x@etc@mode == "sidebyside") {
    sprintf(
      "%s%s%s",
      line_fun(
        line_del_fun(
          sprintf(
            "%s%s", x@etc@gutter@delete, fns@text(fns@text.delete(dummy.text))
      ) ) ),
      txt@pad.col,
      line_fun(
        line_ins_fun(
          sprintf(
            "%s%s", x@etc@gutter@insert, fns@text(fns@text.insert(dummy.text))
    ) ) ) )
  } else {
    line_fun(
      line_del_fun(
        sprintf(
          "%s%s", x@etc@gutter@delete, fns@text(fns@text.delete(dummy.text))
    ) ) )
  }
}
make_dummy_row <- function(x) {
  cont.meta <-
    make_dummy_line(x, paste0(rep("a", x@etc@text.width), collapse=""), "line")
  banner.meta <- make_dummy_line(x, x@etc@style@blank.sub, "banner")
  fns <- x@etc@style@funs
  sprintf(
    "

      
%s

      
%s

     
",
    "display: none; position: absolute; top: 0px; z-index: -1;",
    fns@container(fns@row(banner.meta)),
    fns@container(fns@row(cont.meta))
  )
}
diffobj/R/subset.R0000644000176200001440000000565715001242043013512 0ustar  liggesusers# Copyright (C) 2021 Brodie Gaslam
#
# This file is part of "diffobj - Diffs for R Objects"
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# Go to  for a copy of the license.

#' @include s4.R

NULL

#' Subsetting Methods for Diff Objects
#'
#' Methods to subset the character representation of the diff output.  The
#' subsetting bears no link to the line numbers in the diffs, only to the actual
#' displayed diff.
#'
#' \code{[} only supports numeric indices, and returns without error if you
#' specify out of bound indices.  If you apply multiple subsetting methods they
#' will be applied in the following order irrespective of what order you
#' actually specify them in: \code{[}, then \code{head}, then \code{tail}.
#' If you use the same subsetting method multiple times on the same object,
#' the last call will define the outcome.
#'
#' These methods are implemented by storing the chosen indices in the
#' \code{Diff} object and using them to subset the \code{as.character} output.
#' This mechanism explains the seemingly odd behavior documented above.
#'
#' @export
#' @rdname extract-Diff-method
#' @param x \code{Diff} object
#' @param i subsetting index, must be numeric
#' @param n integer(1L), the size for the resulting object
#' @param ... unused, for compatibility with generics
#' @return \code{Diff} object with subsetting indices recorded for use by
#'   \code{show}
#' ## `pager="off"` for CRAN compliance; you may omit in normal use
#' diff <- diffChr(letters, LETTERS, format="raw", pager="off")
#' diff[5:15]
#' head(diff, 5)
#' tail(diff, 5)
#' head(head(diff, 5), 8)  ## note not 'typical' behavior

setMethod(
  "[", signature(x="Diff", i="numeric", j="missing", drop="missing"),
  function(x, i) {
    if(anyNA(i) || (any(i < 0) && any(i > 0)))
      stop("`i` may not contain NAs or both positive and negative indices")
    x@sub.index <- as.integer(i)
    x
} )

#' @export
#' @rdname extract-Diff-method

setMethod("head", "Diff",
  function(x, n, ...) {
    if(length(list(...)))
      stop("This method does not support arguments other than `x` or `n`")
    if(!is.int.1L(n)) stop("`n` must be integer(1L) and not NA")
    x@sub.head <- as.integer(n)
    x
} )
#' @export
#' @rdname extract-Diff-method

setMethod("tail", "Diff",
  function(x, n, ...) {
    if(length(list(...)))
      stop("This method does not support arguments other than `x` or `n`")
    if(!is.int.1L(n)) stop("`n` must be integer(1L) and not NA")
    x@sub.tail <- as.integer(n)
    x
} )
diffobj/R/word.R0000644000176200001440000006147015001242043013153 0ustar  liggesusers# Copyright (C) 2021 Brodie Gaslam
#
# This file is part of "diffobj - Diffs for R Objects"
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# Go to  for a copy of the license.

# Used to initialize the word difference index lists; represents a non matching
# result for use with `regmatches`

.word.diff.atom <- -1L
attr(.word.diff.atom, "match.length") <- -1L

# Matches syntactically valid R variable names

.reg.r.ident <- "(?:\\.[[:alpha:]]|[[:alpha:]])[[:alnum:]_.]*"

# Helper function when lining up word in a word diff to the lines they came from
#
# This one used to be simple but grew out of control as we discovered corner
# cases; would be good to see if there is a better collapse algorithm that
# naturally handles the corner cases (note: we added general handling of the
# situation where many hunks share the same line, but have not yet removed
# specific handling for corner cases generated by that issue so there is
# redundant code in here).
#
# lines: is a list of what lines are in each hunk,
# cont: is a logical vector of same length as lines denoting whether a
#   particular value in lines is context or diff
# hunk.diff: logical vector denoting if for the other object the hunk contains
#   only differences (seemingly not used in the most recent algorithm)
#
# What do we do about lines that are fully context?  These are flexible in as
# much as we can put them anyplace between the two diff hunks.  We are trying to
# maximize overlapping context elements.

reassign_lines2 <- function(lines, cont, hunk.diff) {
  # Find out what lines show up as duplicated

  hunk.count <- length(cont)
  hunk.len <- vapply(lines, length, integer(1L))
  hunk.n <- seq_along(cont)
  nums <- unlist(lines)
  nums.l <- unlist(
    lapply(seq_along(lines), function(x) rep(x, length(lines[[x]])))
  )
  nums.d <- unique(nums[duplicated(nums)])

  # For each duplicated number, find range of hunks that contain it and remove
  # it from inappropriate hunks / add it to proper ones

  lines.p <- lines

  for(n in nums.d) {
    n.r <- range(nums.l[nums == n])

    # If any of the non-empty hunks are diff hunks, remove line reference from
    # every hunk except the first non-empty diff hunk, otherwise remove the
    # reference from everything except the first non-empty matching hunk

    b.w <- hunk.n >= n.r[[1L]] & hunk.n <= n.r[[2L]]
    min.diff.h <- head(which(!cont & b.w & hunk.len), 1L)
    min.mtch.h <- head(which(cont & b.w & hunk.len), 1L)

    keep.h <- if(length(min.diff.h)) min.diff.h else min.mtch.h

    if(length(keep.h))
      for(i in n.r[[1L]]:n.r[[2L]])
        if(i != keep.h) lines.p[[i]] <- lines.p[[i]][lines.p[[i]] != n]
  }
  lines.p
}
## Helper Function for Mapping Word Diffs to Lines
##
## Used when we're doing a wrapped diff for atomic vectors.  We expect to
## receive `tar/cur.dat` with any meta data lines (e.g. factor levels, time
## series meta data) removed already.  The challenge is we need to then be able
## to re-map back each word back to the line it was on originally before
## unwrapping.  This may include adding padding line blanks in the case one hunk
## displays across more lines than another.
#
## This function does two things: inserts padding lines when hunks in one object
## end up longer than in the other and similar lines don't align, and computes
## mock character strings that will be used by to force alignments. We
## manufacture unique strings that either match or don't match across the two
## objects depending on the word contents of each line, and then pass those
## back as the `comp` component of the `tar.dat` and `cur.dat` returned.  The
## subsequent line diff will use `comp` and cause the relevant lines to be lined
## up.  This is inefficient and round-about, but has the huge benefit of
## allowing us to plug in the wrapped diff into our existing line diff
## infrastructure
##
## Note that in "word" mode the returned values may be longer than the input ones
## as it may be necessary to add lines to get things to match-up.  Added lines
## are indicated by TRUE values in the `fill` component of the `*.dat` return
## values
##
## We have been through several iterations trying to get the most intuitive
## behavior and the result is a fairly non-intuitive and likely inefficient
## algorithm.  It works for the most part, so we leave it as is, but is long,
## messy, and should be replaced by a more elegant solution.
##
## @param tar.ends and cur.ends are the indices of the last elements in each
## line of the vector
## @param tar.dat and cur.dat are the data, see `line_diff` body for detailed
##   description of them (about 100 lines in).  Note that the data has been
##   subset to just the portion of it that has row headers (e.g. excluding
##   factor levels, etc.)
## @param tar/cur.ends the position in the unwrapped vector of the last "word"
##   in each line.

word_to_line_map <- function(
  hunks, tar.dat, cur.dat, tar.ends, cur.ends
) {
  # Once we've done all the replication and disambiguation, we need to make sure
  # diff hunks have the same number of lines.  Start mix lines or start/end mix
  # lines should go at beginning (this includes full "context" lines where there
  # is an insertion or deletion in middle. End mix lines should go at end.
  #
  # For each hunk, we need to identify what lines it contains, and whether the
  # lines are contained in full or not
  #
  # If a diff hunk is empty for tar/cur, and the corresponding cur/tar hunk
  # does not begin/end at beginning of line, then must add lines containing
  # adjoining elements to the diff

  find_word_line <- function(h.i, pos, ends.a, ends.b, hunks) {
    inds_pos <- function(h) c(h$A, h$B)[c(h$A, h$B) > 0L]
    inds_neg <- function(h) abs(c(h$A, h$B)[c(h$A, h$B) < 0L])

    h <- hunks[[h.i]]
    h.prev <- if(h.i > 1L) hunks[[h.i - 1L]]
    h.next <- if(h.i < length(hunks)) hunks[[h.i + 1L]]

    inds.a <- if(pos) inds_pos(h) else inds_neg(h)
    inds.b <- if(pos) inds_neg(h) else inds_pos(h)

    ints.a <- c(1L, head(ends.a, -1L) + 1L)
    ints.b <- c(1L, head(ends.b, -1L) + 1L)
    ends.b.m <- max(ends.b)

    # If a diff hunk and empty, but the matching hunk isn't empty, then add
    # the last element of prior hunk and first element of next hunk

    if(!h$context && !length(inds.a) && length(inds.b)) {
      inds.prev <- if(h.i > 1L) if(pos) inds_pos(h.prev) else inds_neg(h.prev)
      inds.next <- if(h.i < length(hunks))
        if(pos) inds_pos(h.next) else inds_neg(h.next)
      ind.b.min <- min(inds.b)
      ind.b.max <- max(inds.b)
      add.left <- if(!ind.b.min %in% ints.b) max(inds.prev)
      add.right <- if(!ind.b.max %in% ends.b) min(inds.next)
      inds.a <- if(length(add.left) && length(add.right))
        seq(from=add.left, to=add.right, by=1L) else c(add.left, add.right)
    }
    sort(unique(findInterval(inds.a, ints.a)))
  }
  find_full_diff_line <- function(dat, ends, diffs) {
    w.t <- vapply(
      dat$word.ind,
      function(x) if(is.null(a.val <- attr(x, "word.count"))) -1L else a.val,
      integer(1L)
    )
    inds.d.l <- findInterval(diffs, c(1L, head(ends, -1L) + 1L))
    inds.tab <- tabulate(inds.d.l, length(ends))
    diff.full <- which(inds.tab == w.t & inds.tab)
  }
  h.seq <- seq_along(hunks)
  tar.lines <- lapply(h.seq, find_word_line, TRUE, tar.ends, cur.ends, hunks)
  cur.lines <- lapply(h.seq, find_word_line, FALSE, cur.ends, tar.ends, hunks)

  # which hunks are context hunks?

  h.cont <- vapply(hunks, "[[", logical(1L), "context")

  # Compute what indices are in each lines; we are going to use this to
  # categorize what type of line this is; some of this might be duplicative with
  # what we did earlier, but that was so long ago I don't want to get back into
  # it.

  tar.idx <- Map(seq, c(1L, head(tar.ends, -1L) + 1L), tar.ends, by=1L)
  cur.idx <- Map(seq, c(1L, head(cur.ends, -1L) + 1L), cur.ends, by=1L)

  tar.diff <- unlist(
    lapply(hunks[!h.cont], function(x) with(x, abs(c(A, B))[c(A, B) > 0]))
  )
  cur.diff <- unlist(
    lapply(hunks[!h.cont], function(x) with(x, abs(c(A, B))[c(A, B) < 0]))
  )
  # identify whether a line starts with context, ends with context, neither, or
  # both

  context_type <- function(idx, diffs) {
    idx.in <- idx %in% diffs
    if(!length(idx)) {  # arbitrarily assign this case to both
      "both"
    } else {
      if(head(idx.in, 1L) && tail(idx.in, 1L)) {
        "neither"
      } else if(head(idx.in, 1L)) {
        "ends"
      } else if(tail(idx.in, 1L)) {
        "starts"
      } else {
        "both"
      }
    }
  }
  tar.end.mix <- vapply(tar.idx, context_type, character(1L), diffs=tar.diff)
  cur.end.mix <- vapply(cur.idx, context_type, character(1L), diffs=cur.diff)

  # Handle cases where line is shared by multiple hunks; also need to know which
  # hunks contain only lines that are fully different (and by extension, are
  # themselves fully different) as these don't need to have a line from the
  # opposite object brought in for alignment

  diff.inds <- unlist(lapply(hunks[!h.cont], "[",  c("A", "B")))
  if(is.null(diff.inds)) diff.inds <- integer()
  tar.inds.d <- diff.inds[diff.inds > 0]
  cur.inds.d <- abs(diff.inds[diff.inds < 0])

  tar.tot.diff.l <- find_full_diff_line(tar.dat, tar.ends, tar.inds.d)
  cur.tot.diff.l <- find_full_diff_line(cur.dat, cur.ends, cur.inds.d)

  # Remove duplicated line references

  tar.lines.u <- reassign_lines2(tar.lines, h.cont)
  cur.lines.u <- reassign_lines2(cur.lines, h.cont)

  # Search for aligned matching hunks that are empty, and if both those have
  # adjacent empty diff hunks, remove the matched and diff hunks from both
  # NOTE: this changes the number of hunks in the word diff!

  len.orig <- length(tar.lines.u)
  tar.lines.p <- tar.lines.u
  cur.lines.p <- cur.lines.u
  j <- if(h.cont[[1L]]) 1L else 2L
  l.cont <- as.list(h.cont)
  k <- 0

  while(j < length(tar.lines.p)) {
    if((k <- k + 1L) > len.orig) {
      # nocov start
      stop("Logic Error: infine loop in atomic hunk align; contact maintainer.")
      # nocov end
    }
    if(!length(tar.lines.p[[j]]) && !length(cur.lines.p[[j]])) {
      if(j > 1L) {
        tar.lo <- !length(tar.lines.p[[j - 1L]])
        cur.lo <- !length(cur.lines.p[[j - 1L]])
      } else tar.lo <- cur.lo <- FALSE
      tar.hi <- !length(tar.lines.p[[j + 1L]])
      cur.hi <- !length(cur.lines.p[[j + 1L]])

      # Need to remove paired empty match and diff; since we are shortening the
      # list we don't need to increment J (note possible memory inefficiency
      # here)
      if((tar.lo || tar.hi) && (cur.lo || cur.hi))  {
        if(tar.lo) tar.lines.p[(j - 1L):j] <- NULL else
          tar.lines.p[j:(j + 1L)] <- NULL
        if(cur.lo) cur.lines.p[(j - 1L):j] <- NULL else
          cur.lines.p[j:(j + 1L)] <- NULL
        l.cont[j:(j + 1L)] <- NULL
      } else {
        j <- j + 1L
      }
    } else j <- j + 1L
  }
  # Update our context vector since we have now possibly removed hunks

  h.cont <- unlist(l.cont)

  # If necessary, populate empty diff hunks with matching lines; this happens
  # if one of tar/cur has differences but the other doesn't

  steal_matching_line <- function(lines, i) {
    lines.p <- lines
    l.len <- length(lines)
    if(l.len > i && length(lines[[i + 1L]])) {
      lines.p[[i]] <- head(lines.p[[i + 1L]], 1L)
      lines.p[[i + 1L]] <- tail(lines.p[[i + 1L]], -1L)
    } else if (i > 1L && length(lines[[i - 1L]])) {
      lines.p[[i]] <- tail(lines.p[[i - 1L]], 1L)
      lines.p[[i - 1L]] <- head(lines.p[[i - 1L]], -1L)
    }
    lines.p
  }
  tar.lines.f <- tar.lines.p
  cur.lines.f <- cur.lines.p

  # lines that are all diffs

  hunk_diff <- function(vec, tot.diffs) length(vec) && all(vec %in% tot.diffs)
  tar.tot.diff.h <- vapply(tar.lines, hunk_diff, logical(1L), tar.tot.diff.l)
  cur.tot.diff.h <- vapply(cur.lines, hunk_diff, logical(1L), cur.tot.diff.l)

  for(i in seq_along(h.cont)) {
    if(!h.cont[[i]]) {
      t.i <- tar.lines.f[[i]]
      c.i <- cur.lines.f[[i]]
      if(!length(t.i) && length(c.i) && !cur.tot.diff.h[[i]]) {
        tar.lines.f <- steal_matching_line(tar.lines.f, i)
      } else if (!length(c.i) && length(t.i) && !tar.tot.diff.h[[i]]) {
        cur.lines.f <- steal_matching_line(cur.lines.f, i)
      }
    }
  }
  # We now need to make sure that every hunk is the same length

  if(
    length(tar.lines.f) != length(cur.lines.f) ||
    length(tar.lines.f) != length(h.cont)
  )
    # nocov start
    stop(
      "Logic error: mismatched hunk sizes when aligning words to lines; ",
      "contact maintainer."
    )
    # nocov end

  tar.lines.f2 <- tar.lines.f
  cur.lines.f2 <- cur.lines.f

  # add padding vector as close to middle of input vector as possible, except
  # in special cases (only one short line, or first or last hunks)

  pad_in_middle <- function(vec, pad)
    c(
      head(vec, ceiling(length(vec) / 2)),
      pad,
      tail(vec, floor(length(vec) / 2))
    )

  for(i in seq_along(tar.lines.f)) {
    if(length(tar.lines.f[[i]]) != length(cur.lines.f[[i]])) {
      tar.long <- length(tar.lines.f[[i]]) > length(cur.lines.f[[i]])
      long <- if(tar.long) tar.lines.f[[i]] else cur.lines.f[[i]]
      short <- if(!tar.long) tar.lines.f[[i]] else cur.lines.f[[i]]
      long.type <- if(tar.long) tar.end.mix[long] else cur.end.mix[long]
      short.type <- if(!tar.long) tar.end.mix[short] else cur.end.mix[short]

      pad <- rep(NA, length(long) - length(short))

      short.pad <- if(i == 1L && length(tar.lines.f) > 1L) {
        c(pad, short)
      } else if (i == length(tar.lines.f)) {
        c(short, pad)
      } else if(h.cont[[i]] || length(short) != 1L) {
        pad_in_middle(short, pad)
      } else {
        if(
          short.type == "ends" && (long.type[[1L]] %in% c("ends", "neither"))
        ) {
          c(pad, short)
        } else c(short, pad)
      }
      if(tar.long) cur.lines.f2[[i]] <- short.pad
      else tar.lines.f2[[i]] <- short.pad
  } }
  # Augment the input vectors by the blanks we added; these blanks are
  # represented by NAs in our index vector.

  augment <- function(dat, lines) {
    lines.u <- unlist(lines)
    lines.len <- length(lines.u)
    for(i in names(dat)) {
      i.vec <- vector(typeof(dat[[i]]), length(lines.u))
      i.vec[!is.na(lines.u)] <- dat[[i]]
      if(i == "word.ind") {
        i.vec[is.na(lines.u)] <- list(.word.diff.atom)
      } else if (i == "fill") {
        # warning: this is also used/subverted for augmenting the original
        # indices so think before you change it
        i.vec[is.na(lines.u)] <- TRUE
      }
      dat[[i]] <- i.vec
    }
    dat
  }
  tar.dat.aug <- augment(tar.dat, tar.lines.f2)
  cur.dat.aug <- augment(cur.dat, cur.lines.f2)

  # Generate the final vectors to do the diffs on; these should be unique
  # and matching for the matches, and unique and mismatching for the
  # mismatches

  hunk_match <- function(i, l) rep(h.cont[i], length(l[[i]]))
  tar.match <- unlist(lapply(seq_along(h.cont), hunk_match, l=tar.lines.f2))
  cur.match <- unlist(lapply(seq_along(h.cont), hunk_match, l=cur.lines.f2))

  pos.nums <- sum(tar.match)
  if(pos.nums != length(unlist(cur.lines.f2[h.cont]))) {
    # nocov start
    stop("Logic Error: pos nums incorrect; contact maintainer")
    # nocov end
  }
  neg.nums <- sum(!tar.match, !cur.match)

  strings <- make_unique_strings(
    pos.nums + neg.nums, c(tar.dat.aug$raw, cur.dat.aug$raw)
  )
  strings.pos <- strings[seq.int(pos.nums)]
  strings.neg <- tail(strings, neg.nums)
  if(neg.nums + pos.nums != length(strings)) {
    # nocov start
    stop("Logic Error: num-string maping failed; contact maintainer")
    # nocov end
  }

  tar.dat.aug$comp[tar.match] <- strings.pos
  cur.dat.aug$comp[cur.match] <- strings.pos
  tar.dat.aug$comp[!tar.match] <- head(strings.neg, sum(!tar.match))
  cur.dat.aug$comp[!cur.match] <- tail(strings.neg, sum(!cur.match))
  list(tar.dat=tar.dat.aug, cur.dat=cur.dat.aug)
}
# Pull out mismatching words from the word regexec; helper functions

reg_pull <- function(ind, reg) {
  reg.out <- reg[ind]
  attr(reg.out, "match.length") <- attr(reg, "match.length")[ind]
  attr(reg.out, "useBytes") <- attr(reg, "useBytes")
  attr(reg.out, "word.count") <- length(reg)
  reg.out
}
# Generate the indices in each row and apply the pulling functions
# - reg list produced by `gregexpr` and such
# - ends length of each line in words
# - mismatch index of mismatching words
#

reg_apply <- function(reg, ends, mismatch) {
  if(!length(reg)) {
    reg
  } else {
    use.bytes <- attr(reg[[1L]], "useBytes") # assume useBytes value unchanging
    regs.fin <- reg
    buckets <- head(c(0L, ends) + 1L, -1L)
    mism.lines <- findInterval(mismatch, buckets)
    mism.lines.u <- unique(mism.lines)
    mtch.lines.u <- which(!seq_along(ends) %in% mism.lines.u )
    # These don't have any mismatches
    attr(.word.diff.atom, "useBytes") <- use.bytes
    regs.fin[mtch.lines.u] <-
      replicate(length(mtch.lines.u), .word.diff.atom, simplify=FALSE)
    # These do have mismatches, we need to split them up in list elements and
    # substract the starting index to identify position within each sub-list

    if(length(mism.lines.u)) {
      inds.msm <- Map(
        "-", unname(split(mismatch, mism.lines)), buckets[mism.lines.u] - 1L
      )
      regs.fin[mism.lines.u] <- Map(reg_pull, inds.msm, reg[mism.lines.u])
    }
    regs.fin
  }
}
# Modify `tar.dat` and `cur.dat` by generating `regmatches` indices for the
# words that are different
#
# If `diff.mode` is "wrap", then wrapped atomic vector output is unwrapped and
# the diff is carried out in the unwrapped form, and then re-assembled.  See
# `word_to_line_map` for details in how its done.  Return values may be longer
# than input in this mode.
#
# `match.quotes` will make "words" starting and ending with quotes; it should
# only be used with atomic character vectors or possibly deparsed objects.

diff_word2 <- function(
  tar.dat, cur.dat, tar.ind, cur.ind, etc, match.quotes=FALSE, diff.mode,
  warn=TRUE
) {
  stopifnot(
    is.TF(match.quotes), is.TF(warn)
    # isTRUE(valid_dat(tar.dat)), isTRUE(valid_dat(cur.dat)) # too expensive
  )
  # Compute the char by char diffs for each line

  reg <- paste0(
    # grab leading spaces for each word; these will be stripped before actual
    # word diff, but we want them to be part of mismatch so they are removed
    # when we construct the equal strings as that allows better matching b/w
    # strings with differences removed; could do trailing spaces instead
    "\\s*(?:",
    # Some attempt at matching R identifiers; note we explicitly chose not to
    # match `.` or `..`, etc, since those could easily be punctuation
    sprintf("%s|", .reg.r.ident),
    # Not whitespaces that doesn't include quotes
    "[^ \"]+|",
    # Quoted phrases as structured in atomic character vectors
    if(match.quotes) "(?:(?<= )|(?<=^))\"(?:[^\"]|\\\")*?\"(?:(?= )|(?=$))|",
    # Other quoted phrases we might see in expressions or deparsed chr vecs,
    # this is a bit lazy currently b/c we're not forcing precise matching b/w
    # starting and ending delimiters
    "(?:(?<=[ ([,{])|(?<=^))\"(?:[^\"]|\\\"|\"(?=[^ ]))*?",
    "\"(?:(?=[ ,)\\]}])|(?=$))|",
    # Other otherwise 'illegal' quotes that couldn't be matched to one of the
    # known valid quote structures
    "\")"
  )
  tar.chr <- tar.dat$trim[tar.ind]
  cur.chr <- cur.dat$trim[cur.ind]
  tar.reg <- gregexpr(reg, tar.chr, perl=TRUE)
  cur.reg <- gregexpr(reg, cur.chr, perl=TRUE)

  tar.split <- regmatches(tar.chr, tar.reg)
  cur.split <- regmatches(cur.chr, cur.reg)

  # Collapse into one line if to do the diff across lines, but record
  # item counts so we can reconstitute the lines at the end

  tar.lens <- vapply(tar.split, length, integer(1L))
  cur.lens <- vapply(cur.split, length, integer(1L))

  tar.unsplit <- unlist(tar.split)
  cur.unsplit <- unlist(cur.split)
  if(is.null(tar.unsplit)) tar.unsplit <- character(0L)
  if(is.null(cur.unsplit)) cur.unsplit <- character(0L)

  # Remove the leading spaces we grabbed for each word

  tar.unsplit <- trimws(tar.unsplit, "left")
  cur.unsplit <- trimws(cur.unsplit, "left")

  # Run the word diff as a line diff configured in a manner compatible for the
  # word diff

  etc@line.limit <- etc@hunk.limit <- etc@context <- -1L
  etc@mode <- "context"

  diffs <- char_diff(
    tar.unsplit, cur.unsplit, etc=etc, diff.mode=diff.mode, warn=warn
  )
  # Need to figure out which elements match, and which ones do not

  hunks.flat <- diffs$hunks
  tar.mism <- unlist(
    lapply(hunks.flat, function(x) if(!x$context) x$A else integer(0L))
  )
  cur.mism <- abs(
    unlist(lapply(hunks.flat, function(x) if(!x$context) x$B else integer(0L)))
  )
  # Figure out which line each of these elements came from, and what index
  # in each of those lines they are; we use the recorded lengths in words of
  # each line to reconstruct this; also record original line length so we
  # can compute token ratios

  tar.ends <- cumsum(tar.lens)
  cur.ends <- cumsum(cur.lens)

  tar.dat$word.ind[tar.ind] <- reg_apply(tar.reg, tar.ends, tar.mism)
  cur.dat$word.ind[cur.ind] <- reg_apply(cur.reg, cur.ends, cur.mism)

  # If in wrap mode (which is really atomic mode), generate a spoofed
  # `comp` vector (see word_to_line_map)
  #
  # Note that we're only operating on a subset of the data via tar.ind and
  # cur.ind, these are supposed to be the contiguous block of lines that have
  # row headers.

  tar.dat.fin <- tar.dat
  cur.dat.fin <- cur.dat
  if(diff.mode == "wrap") {
    tar.dat.ind <- lapply(tar.dat, '[', tar.ind)
    cur.dat.ind <- lapply(cur.dat, '[', cur.ind)
    word.line.mapped <- word_to_line_map(
      hunks.flat, tar.dat.ind, cur.dat.ind, tar.ends, cur.ends
    )
    # Merge back the mapped data, need to account for possiblity of padding
    # lines being added.

    tar.len.old <- length(tar.dat[[1L]])
    cur.len.old <- length(cur.dat[[1L]])

    tar.ind.lo <- seq_len(head(tar.ind, 1L) - 1L)
    tar.ind.hi <- seq_len(tar.len.old - tail(tar.ind, 1L)) + tail(tar.ind, 1L)
    cur.ind.lo <- seq_len(head(cur.ind, 1L) - 1L)
    cur.ind.hi <- seq_len(cur.len.old - tail(cur.ind, 1L)) + tail(cur.ind, 1L)

    interleave <- function(idx, new, old, lo, hi)
      c(old[[idx]][lo], new[[idx]], old[[idx]][hi])

    tar.dat.fin <- setNames(
      lapply(
        seq_along(tar.dat), interleave,
        new=word.line.mapped[['tar.dat']], old=tar.dat,
        lo=tar.ind.lo, hi=tar.ind.hi
      ),
      names(tar.dat)
    )
    cur.dat.fin <- setNames(
      lapply(
        seq_along(cur.dat), interleave,
        new=word.line.mapped[['cur.dat']], old=cur.dat,
        lo=cur.ind.lo, hi=cur.ind.hi
      ),
      names(cur.dat)
    )
  }
  list(
    tar.dat=tar.dat.fin, cur.dat=cur.dat.fin, hit.diffs.max=diffs$hit.diffs.max
  )
}
# Make unique strings
#
# Makes gibberish strings that are 16 characters long, are unique, and don't
# overlap with `invalid`.  This allows us to generate strings we can use to
# cause a specific diff outcome.
#
# n: how long the character vector should be
# invalid: what values cannot be contained in the returned values

make_unique_strings <- function(n, invalid) {
  pool <- c(
    letters, LETTERS, 0:9, "_", ".", "*", "+", "-", "=", "(", ")", "{",
    "}", "~", "`", "!", "@", "#", "$", "%", "^", "&", ";", ":", "<", ">", "?",
    ",", "/"
  )
  cols <- 16 # use 16 character samples, should be more than big enough
  dat <- matrix("", ncol=16, nrow=n)
  rows <- 1:n
  safety <- 0
  repeat {
    dat[rows, ] <-
      matrix(sample(pool, cols * length(rows), replace=TRUE), ncol=cols)
    dat.chr <- do.call(paste0, split(dat, col(dat)))
    rows <- which(duplicated(dat.chr) | dat.chr %in% invalid)
    if(!length(rows)) break
    # nocov start
    if(safety <- safety + 1 > 100)
      stop(
        "Logic Error: unable to generate unique strings; this should be ",
        "incredibly rare as we are sampling from 10^31 elements, so try ",
        "again and if it happens again contact maintainer"
      )
    # nocov end
  }
  dat.chr
}
# Add word diff highlighting

word_color <- function(txt, inds, fun) {
  word.list <- regmatches(txt, inds)
  word.lens <- vapply(word.list, length, integer(1L))

  # remove leading space before coloring
  words.u <- if(length(word.list)) unlist(word.list) else character(0L)
  words.u.trim.ind <- regexpr("\\S.*", words.u)
  words.u.trim <- regmatches(words.u, words.u.trim.ind)

  # color and re-insert back into space
  words.c.trim <- fun(words.u.trim)
  regmatches(words.u, words.u.trim.ind) <- words.c.trim

  # split back into original lines
  words.res <- vector("list", length(word.list))
  words.res[!!word.lens] <- split(
    words.u, rep(seq_along(word.lens), times=word.lens)
  )
  words.res[!word.lens] <- list(character(0L))
  regmatches(txt, inds) <- words.res
  txt
}
diffobj/R/rds.R0000644000176200001440000000171715001242043012766 0ustar  liggesusers# Copyright (C) 2021 Brodie Gaslam
#
# This file is part of "diffobj - Diffs for R Objects"
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# Go to  for a copy of the license.

# Check Whether Input Could Be Reference to RDS File and Load if it Is

get_rds <- function(x) {
  tryCatch(
    if(
      (is.chr.1L(x) && Encoding(x) != "bytes" && file_test("-f", x)) ||
      inherits(x, "connection")
    ) {
      suppressWarnings(readRDS(x))
    } else x,
    error=function(e) x
  )
}
diffobj/R/styles.R0000644000176200001440000015456115001242043013527 0ustar  liggesusers# Copyright (C) 2021 Brodie Gaslam
#
# This file is part of "diffobj - Diffs for R Objects"
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# Go to  for a copy of the license.

#' @include html.R
#' @include finalizer.R
#' @include pager.R

NULL

# maybe this shouldn't be an S4 class since the function slot doesn't work
# for classed functions (e.g. the ones produced by crayon)

#' Functions Used for Styling Diff Components
#'
#' Except for \code{container} every function specified here should be
#' vectorized and apply formatting to each element in a character vectors.  The
#' functions must accept at least one argument and require no more than one
#' argument.  The text to be formatted will be passed as a character vector
#' as the first argument to each function.
#'
#' These functions are applied in post processing steps.  The \code{diff*}
#' methods do not do any of the formatting.  Instead, the formatting is done
#' only if the user requests to \code{show} the object.  Internally, \code{show}
#' first converts the object to a character vector using \code{as.character},
#' which applies every formatting function defined here except for
#' \code{container}.  Then \code{show} applies \code{container} before
#' forwarding the result to the screen or pager.
#'
#' @note the slots are set to class \dQuote{ANY} to allow classed functions
#'   such as those defined in the \code{crayon} package.  Despite this seemingly
#'   permissive slot definition, only functions are allowed in the slots by
#'   the validation functions.
#' @param container function used primarily by HTML styles to generate an
#'   outermost \code{DIV} that allows for CSS targeting of its contents
#'   (see \code{\link{cont_f}} for a function generator appropriate for use
#'   here)
#' @param line function
#' @param line.insert function
#' @param line.delete function
#' @param line.match function
#' @param line.guide function formats guide lines (see \code{\link{guides}})
#' @param text function
#' @param text.insert function
#' @param text.delete function
#' @param text.match function
#' @param text.guide function formats guide lines (see \code{\link{guides}})
#' @param gutter function
#' @param gutter.insert function
#' @param gutter.delete function
#' @param gutter.match function
#' @param gutter.guide function
#' @param gutter.pad function
#' @param header function to format each hunk header with
#' @param banner function to format entire banner
#' @param banner.insert function to format insertion banner
#' @param banner.delete function to format deletion banner
#' @param meta function format meta information lines
#' @param context.sep function to format the separator used to visually
#'   distinguish the A and B hunks in \dQuote{context} \code{mode}
#' @return a StyleFuns S4 object
#' @seealso \code{\link{Style}}
#' @rdname StyleFuns
#' @export StyleFuns
#' @exportClass StyleFuns

StyleFuns <- setClass(
  "StyleFuns",
  slots=c(
    container="ANY", row="ANY",
    line="ANY", line.insert="ANY", line.delete="ANY", line.match="ANY",
    line.guide="ANY", line.fill="ANY",
    text="ANY", text.insert="ANY", text.delete="ANY", text.match="ANY",
    text.guide="ANY", text.fill="ANY",
    banner="ANY", banner.insert="ANY", banner.delete="ANY",
    gutter="ANY",
    gutter.insert="ANY", gutter.insert.ctd="ANY",
    gutter.delete="ANY", gutter.delete.ctd="ANY",
    gutter.match="ANY", gutter.match.ctd="ANY",
    gutter.guide="ANY", gutter.guide.ctd="ANY",
    gutter.fill="ANY", gutter.fill.ctd="ANY",
    gutter.context.sep="ANY", gutter.context.sep.ctd="ANY",
    gutter.pad="ANY",
    word.insert="ANY", word.delete="ANY",
    context.sep="ANY", header="ANY", meta="ANY", trim="ANY"
  ),
  prototype=list(
    container=identity, row=identity,
    banner=identity, banner.insert=identity, banner.delete=identity,
    line=identity, line.insert=identity, line.delete=identity,
    line.match=identity, line.guide=identity, line.fill=identity,
    text=identity, text.insert=identity, text.delete=identity,
    text.match=identity, text.guide=identity, text.fill=identity,
    gutter=identity, gutter.pad=identity,
    gutter.insert=identity, gutter.insert.ctd=identity,
    gutter.delete=identity, gutter.delete.ctd=identity,
    gutter.match=identity, gutter.match.ctd=identity,
    gutter.guide=identity, gutter.guide.ctd=identity,
    gutter.fill=identity, gutter.fill.ctd=identity,
    gutter.context.sep=identity, gutter.context.sep.ctd=identity,
    word.insert=identity, word.delete=identity,
    header=identity,
    context.sep=identity,
    meta=identity,
    trim=identity
  ),
  validity=function(object){
    for(i in slotNames(object)) {
      if(!is.function(slot(object, i)))
        return(paste0("Argument `", i, "` should be a function."))
      if(has_non_def_formals(tail(formals(slot(object, i)), -1L)))
        return(
          paste0(
            "Argument `", i,
            "` may not have non-default formals argument after the first."
          ) )
    }
    TRUE
  }
)
StyleFunsAnsi <- setClass(
  "StyleFunsAnsi", contains="StyleFuns",
  prototype=list(
    word.insert=crayon::green, word.delete=crayon::red,
    gutter.insert=crayon::green, gutter.insert.ctd=crayon::green,
    gutter.delete=crayon::red, gutter.delete.ctd=crayon::red,
    gutter.guide=crayon::silver, gutter.guide.ctd=crayon::silver,
    gutter.fill=crayon::silver, gutter.fill.ctd=crayon::silver,
    gutter.context.sep=crayon::silver, gutter.context.sep.ctd=crayon::silver,
    header=crayon::cyan,
    meta=crayon::silver,
    line.guide=crayon::silver,
    context.sep=crayon::silver,
    trim=crayon::silver
  )
)
#' Character Tokens Used in Diffs
#'
#' Various character tokens are used throughout diffs to provide visual cues.
#' For example, gutters will contain characters that denote deletions and
#' insertions (\code{<} and \code{>} by default).
#'
#' @param gutter.insert character(1L) text to use as visual cue to indicate
#'   whether a diff line is an insertion, defaults to \dQuote{> }
#' @param gutter.insert.ctd character(1L) if a diff line is wrapped, the
#'   visual cue shifts to this character to indicate wrapping occured
#' @param gutter.delete character(1L) see \code{gutter.insert} above
#' @param gutter.delete.ctd character(1L) see \code{gutter.insert.ctd} above
#' @param gutter.match character(1L) see \code{gutter.insert} above
#' @param gutter.match.ctd character(1L) see \code{gutter.insert.ctd} above
#' @param gutter.guide character(1L) see \code{gutter.insert} above
#' @param gutter.guide.ctd character(1L) see \code{gutter.insert.ctd} above
#' @param gutter.fill character(1L) see \code{gutter.insert} above
#' @param gutter.fill.ctd character(1L) see \code{gutter.insert.ctd} above
#' @param gutter.pad character(1L) separator between gutter characters and the
#'   rest of a line in a diff
#' @param pad.col character(1L) separator between columns in side by side mode
#' @return a StyleText S4 object
#' @seealso \code{\link{Style}}
#' @rdname StyleText
#' @export StyleText
#' @exportClass StyleText

StyleText <- setClass(
  "StyleText",
  slots=c(
    gutter.insert="character", gutter.insert.ctd="character",
    gutter.delete="character", gutter.delete.ctd="character",
    gutter.match="character", gutter.match.ctd="character",
    gutter.guide="character", gutter.guide.ctd="character",
    gutter.fill="character", gutter.fill.ctd="character",
    gutter.context.sep="character", gutter.context.sep.ctd="character",
    gutter.pad="character",
    context.sep="character",
    pad.col="character",
    line.break="character"
  ),
  prototype=list(
    gutter.insert=">", gutter.insert.ctd=":",
    gutter.delete="<", gutter.delete.ctd=":",
    gutter.match=" ", gutter.match.ctd=" ",
    gutter.guide="~", gutter.guide.ctd="~",
    gutter.fill="~", gutter.fill.ctd="~",
    gutter.context.sep="~", gutter.context.sep.ctd="~",
    gutter.pad=" ", context.sep="----------",
    pad.col="  ",
    line.break="\n"
  ),
  validity=function(object){
    for(i in slotNames(object)) if(!is.chr.1L(slot(object, i)))
      return(paste0("Argument `", i, "` must be character(1L) and not NA."))
    TRUE
  }
)
#' Styling Information for Summaries
#'
#' @export
#' @rdname StyleSummary
#' @slot container function applied to entire summary
#' @slot body function applied to everything except the actual map portion of
#'   the summary
#' @slot detail function applied to section showing how many deletions /
#'   insertions, etc. occurred
#' @slot map function applied to the map portion of the summary

StyleSummary <- setClass("StyleSummary",
  slots=c(container="ANY", body="ANY", map="ANY", detail="ANY"),
  prototype=list(
    container=function(x) sprintf("\n%s\n", paste0(x, collapse="")),
    body=identity,
    detail=function(x) sprintf("\n%s\n", paste0("  ", x, collapse="")),
    map=function(x) sprintf("\n%s", paste0("  ", x, collapse="\n"))
  ),
  validity=function(object) {
    fun.slots <- c("container", "body", "map", "detail")
    for(i in fun.slots) {
      if(!isTRUE(is.one.arg.fun(slot(object, i))))
        return(
          "Slot ", i, " must contain a function that accepts at least one ",
          "argument and requires no more than one argument."
        )
    }
    TRUE
  }
)
#' @rdname StyleSummary
#' @export

StyleSummaryHtml <- setClass("StyleSummaryHtml", contains="StyleSummary",
  prototype=list(
    container=function(x) div_f("diffobj-summary")(paste0(x, collapse="")),
    body=div_f("body"),
    detail=div_f("detail"),
    map=div_f("map")
) )
#' Customize Appearance of Diff
#'
#' S4 objects that expose the formatting controls for \code{Diff}
#' objects.  Many predefined formats are defined as classes that extend the
#' base \code{Style} class.  You may fine tune styles by either extending
#' the pre-defined classes, or modifying an instance thereof.
#'
#' @section Pre-defined Classes:
#'
#' Pre-defined classes are used to populate the \code{\link{PaletteOfStyles}}
#' object, which in turn allows the \code{diff*} methods to pick the
#' appropriate \code{Style} for each combination of the \code{format},
#' \code{color.mode}, and \code{brightness} parameters when the \code{style}
#' parameter is set to \dQuote{auto}.  The following classes are pre-defined:
#'
#' \itemize{
#'   \item \code{StyleRaw}: No styles applied
#'   \item \code{StyleAnsi8NeutralRgb}
#'   \item \code{StyleAnsi8NeutralYb}
#'   \item \code{StyleAnsi256LightRgb}
#'   \item \code{StyleAnsi256LightYb}
#'   \item \code{StyleAnsi256DarkRgb}
#'   \item \code{StyleAnsi256DarkYb}
#'   \item \code{StyleHtmlLightRgb}
#'   \item \code{StyleHtmlLightYb}
#' }
#' Each of these classes has an associated constructor function with the
#' same name (see examples).  Objects instantiated from these classes
#' may also be used directly as the value for the \code{style} parameter to the
#' \code{diff*} methods. This will override the automatic selection process
#' that uses \code{\link{PaletteOfStyles}}.  If you wish to tweak an
#' auto-selected style rather than explicitly specify one, pass a parameter
#' list instead of a \code{Style} objects as the \code{style} parameter to the
#' \code{diff*} methods (see examples).
#'
#' There are predefined classes for most combinations of
#' \code{format/color.mode/brightness}, but not all.  For example, there are
#' only \dQuote{light} \code{brightness} defined for the \dQuote{html}
#' \code{format}, and those classes are re-used for all possible
#' \code{brightness} values, and the 8 color ANSI neutral classes are used
#' for the 256 color neutral selections as well.
#'
#' To get a preview of what a style looks like just instantiate
#' an object; the \code{show} method will output a trivial diff to screen with
#' styles applied.  Note that for ANSI styles of the dark and light variety
#' the show method colors the terminal background and foregrounds in compatible
#' colors.  In normal usage the terminal background and foreground colors are
#' left untouched so you should not expect light styles to look good on dark
#' background and vice versa even if they render correctly when showing the
#' style object.
#'
#' @section Style Structure:
#'
#' Most of the customization is done by specifying functions that operate on
#' character vectors and return a modified character vector of the same length.
#' The intended use case is to pass \code{crayon} functions such as
#' \code{crayon::red}, although you may pass any function of your liking
#' that behaves as described.  Formatting functions are expected to return their
#' inputs formatted in such a way that their \emph{display} width is unchanged.
#' If your formatting functions change display width output may not render
#' properly, particularly when using \code{mode="sidebyside"}.
#'
#' The visual representation of the diff has many nested components.  The
#' functions you specify here will be applied starting with the innermost ones.
#' A schematic of the various component that represent an inserted line follows
#' (note \dQuote{insert} abbreviated to \dQuote{ins}, and \dQuote{gutter}
#' abbreviated to \dQuote{gtr}):
#' \preformatted{+- line ---------------------------------------------------+
#' |+- line.ins ---------------------------------------------+|
#' ||+- gtr ------------------------++- text ---------------+||
#' |||+- gtr.ins ---++- gtr.pad ---+||+- text.ins ---------+|||
#' ||||             ||             ||||      +- word.ins -+||||
#' |||| gtr.ins.txt || gtr.pad.txt |||| DIFF | TEXT HERE  |||||
#' ||||             ||             ||||      +------------+||||
#' |||+-------------++-------------+||+--------------------+|||
#' ||+------------------------------++----------------------+||
#' |+--------------------------------------------------------+|
#' +----------------------------------------------------------+
#' }
#' A similar model applies to deleted and matching lines.  The boxes represent
#' functions.  \code{gutter.insert.txt} represents the text to use in the gutter
#' and is not a function. \code{DIFF TEXT HERE} is text from the objects being
#' diffed, with the portion that has different words inside the
#' \code{word.insert}.  \code{gutter.pad} and \code{gutter.pad.txt} are used to
#' separate the gutter from the text and usually end up resolving to a space.
#'
#' Most of the functions defined here default to \code{\link{identity}}, but
#' you are given the flexibility to fully format the diff.  See
#' \code{\link{StyleFuns}} and \code{\link{StyleText}} for a full listing of
#' the adjustable elements.
#'
#' In side-by-side mode there are two \dQuote{lines} per screen line, each with
#' the structure described here.
#'
#' The structure described here may change in the future.
#'
#' @section HTML Styles:
#'
#' If you use a \code{Style} that inherits from \code{StyleHtml} the
#' diff will be wrapped in HTML tags, styled with CSS, and output to
#' \code{getOption("viewer")} if your IDE supports it (e.g. Rstudio), or
#' directly to the browser otherwise, assuming that the default
#' \code{\link{Pager}} or a correctly configured pager that inherits from
#' \code{\link{PagerBrowser}} is in effect.  Otherwise, the raw HTML will be
#' output to your terminal.
#'
#' By default HTML output sent to the viewer/browser is a full stand-alone
#' webpage with CSS styles to format and color the diff, and JS code to
#' handle scaling.  The CSS and JS is read from the
#' \link[=webfiles]{default files} and injected into the HTML to simplify
#' packaging of the output.  You can customize the CSS and JS by using the
#' \code{css} and \code{js} arguments respectively, but read the rest of this
#' documentation section if you plan on doing so.
#'
#' Should you want to capture the HTML output for use elsewhere, you can do
#' so by using \code{as.character} on the return value of the \code{diff*}
#' methods.  If you want the raw HTML without any of the headers, CSS, and
#' JS use \code{html.ouput="diff.only"} when you instantiate the
#' \code{StyleHtml} object (see examples), or disable the \code{\link{Pager}}.
#' Another option is \code{html.output="diff.w.style"} which will add
#' \code{
























diffobj - Diffs for R Objects


Brodie Gaslam








Introduction


diffobj uses the same comparison mechanism used by
git diff and diff to highlight differences
between rendered R objects:


a <- b <- matrix(1:100, ncol=2)
a <- a[-20,]
b <- b[-45,]
b[c(18, 44)] <- 999
diffPrint(target=a, current=b)




@@ 17,6 @@
@@ 17,7 @@
~
 
      [,1] [,2]
~
 
      [,1] [,2]
 
 
[16,]   16   66
 
 
[16,]   16   66
 
 
[17,]   17   67
 
 
[17,]   17   67
<
 
[18,]   18   68
>
 
[18,]  999   68
 
 
[19,]   19   69
 
 
[19,]   19   69
~
 
>
 
[20,]   20   70
 
 
[20,]   21   71
 
 
[21,]   21   71
 
 
[21,]   22   72
 
 
[22,]   22   72
@@ 42,6 @@
@@ 43,5 @@
 
 
[41,]   42   92
 
 
[42,]   42   92
 
 
[42,]   43   93
 
 
[43,]   43   93
<
 
[43,]   44   94
>
 
[44,]  999   94
<
 
[44,]   45   95
~
 
 
 
[45,]   46   96
 
 
[45,]   46   96
 
 
[46,]   47   97
 
 
[46,]   47   97




diffobj comparisons work best when objects have some
similarities, or when they are relatively small. The package was
originally developed to help diagnose failed unit tests by comparing
test results to reference objects in a human-friendly manner.


If your terminal supports formatting through ANSI escape sequences,
diffobj will output colored diffs to the terminal. If not,
it will output colored diffs to your IDE viewport if it is supported, or
to your browser otherwise.






Interpreting Diffs




Shortest Edit Script


The output from diffobj is a visual representation of
the Shortest Edit Script (SES). An SES is the shortest set of deletion
and insertion instructions for converting one sequence of elements into
another. In our case, the elements are lines of text. We encode the
instructions to convert a to b by deleting
lines from a (in yellow) and inserting new ones from
b (in blue).






Diff Structure


The first line of our diff output acts as a legend to the diff by
associating the colors and symbols used to represent differences present
in each object with the name of the object:








After the legend come the hunks, which are portions of the objects
that have differences with nearby matching lines provided for
context:




@@ 17,6 @@
@@ 17,7 @@
~
 
      [,1] [,2]
~
 
      [,1] [,2]
 
 
[16,]   16   66
 
 
[16,]   16   66
 
 
[17,]   17   67
 
 
[17,]   17   67
<
 
[18,]   18   68
>
 
[18,]  999   68
 
 
[19,]   19   69
 
 
[19,]   19   69
~
 
>
 
[20,]   20   70
 
 
[20,]   21   71
 
 
[21,]   21   71
 
 
[21,]   22   72
 
 
[22,]   22   72




At the top of the hunk is the hunk header: this tells us that the
first displayed hunk (including context lines), starts at line 17 and
spans 6 lines for a and 7 for b. These are
display lines, not object row indices, which is why the first row shown
of the matrix is row 16. You might have also noticed that the line after
the hunk header is out of place:




~
 
      [,1] [,2]
~
 
      [,1] [,2]




This is a special context line that is not technically part of the
hunk, but is shown nonetheless because it is useful in helping
understand the data. The line is styled differently to highlight that it
is not part of the hunk. Since it is not part of the hunk, it is not
accounted for in the hunk header. See ?guideLines for more
details.


The actual mismatched lines are highlighted in the colors of the
legend, with additional visual cues in the gutters:




<
 
[18,]   18   68
>
 
[18,]  999   68
 
 
[19,]   19   69
 
 
[19,]   19   69
~
 
>
 
[20,]   20   70
 
 
[20,]   21   71
 
 
[21,]   21   71




diffobj uses a line by line diff to identify which
portions of each of the objects are mismatches, so even if only part of
a line mismatches it will be considered different. diffobj
then runs a word diff within the hunks and further highlights
mismatching words.


Let’s examine the last two lines from the previous hunk more
closely:




~
 
>
 
[20,]   20   70
 
 
[20,]   21   71
 
 
[21,]   21   71




Here b has an extra line so diffobj adds an
empty line to a to maintain the alignment for subsequent
matching lines. This additional line is marked with a tilde in the
gutter and is shown in a different color to indicate it is not part of
the original text.


If you look closely at the next matching line you will notice that
the a and b values are not exactly the same.
The row indices are different, but diffobj excludes row
indices from the diff so that rows that are identical otherwise are
shown as matching. diffobj indicates this is happening by
showing the portions of a line that are ignored in the diff in grey.


See ?guides and ?trim for details and
limitations on guideline detection and unsemantic meta data
trimming.






Atomic Vectors


Since R can display multiple elements in an atomic vector on the same
line, and diffPrint is fundamentally a line diff, we use
specialized logic when diffing atomic vectors. Consider:


state.abb2 <- state.abb[-16]
state.abb2[37] <- "Pennsylvania"
diffPrint(state.abb, state.abb2)




@@ 1,5 @@
@@ 6,5 @@
 
 
 [1] "AL" "AK" "AZ" "AR" "CA" "CO"
 
 
[11] "HI"           "ID"          
 
 
 [7] "CT" "DE" "FL" "GA" "HI" "ID"
 
 
[13] "IL"           "IN"          
<
 
[13] "IL" "IN" "IA" "KS" "KY" "LA"
>
 
[15] "IA"           "KY"          
 
 
[19] "ME" "MD" "MA" "MI" "MN" "MS"
 
 
[17] "LA"           "ME"          
 
 
[25] "MO" "MT" "NE" "NV" "NH" "NJ"
 
 
[19] "MD"           "MA"          
@@ 6,4 @@
@@ 17,5 @@
~
 
 
 
 
[33] "ND"           "OH"          
 
 
[31] "NM" "NY" "NC" "ND" "OH" "OK"
 
 
[35] "OK"           "OR"          
<
 
[37] "OR" "PA" "RI" "SC" "SD" "TN"
>
 
[37] "Pennsylvania" "RI"          
 
 
[43] "TX" "UT" "VT" "VA" "WA" "WV"
 
 
[39] "SC"           "SD"          
 
 
[49] "WI" "WY"
 
 
[41] "TN"           "TX"          




Due to the different wrapping frequency no line in the text display
of our two vectors matches. Despite this, diffPrint only
highlights the lines that actually contain differences. The side effect
is that lines that only contain matching elements are shown as matching
even though the actual lines may be different. You can turn off this
behavior in favor of a normal line diff with the
unwrap.atomic argument to diffPrint.


Currently this only works for unnamed vectors, and even for
them some inputs may produce sub-optimal results. Nested vectors inside
lists will not be unwrapped. You can also use diffChr (see
below) to do a direct element by element comparison.








Other Diff Functions




Method Overview


diffobj defines several S4 generics and default methods
to go along with them. Each of them uses a different text representation
of the inputs:


    

  • diffPrint: use the print/show
output and is the one used in the examples so far
    • 

  • diffStr: use the output of str
    • 

  • diffObj: picks between
print/show and str depending on
which provides the “best” overview of differences
    • 

  • diffChr: coerces the inputs to atomic character vectors
with as.character, and runs the diff on the character
vector
    • 

  • diffFile: compares the text content of two files
    • 

  • diffCsv: loads two CSV files into data frames and
compares the data frames with diffPrint
    • 

  • diffDeparse: deparses and compares the character
vectors produced by the deparsing
    • 

  • ses: computes the element by element shortest edit
script on two character vectors
    • 



Note the diff* functions use lowerCamelCase in keeping
with S4 method name convention, whereas the package name itself is all
lower case.






Compare Structure with diffStr


For complex objects it is often useful to compare structures:


mdl1 <- lm(Sepal.Length ~ Sepal.Width, iris)
mdl2 <- lm(Sepal.Length ~ Sepal.Width + Species, iris)
diffStr(mdl1$qr, mdl2$qr, line.limit=15)




@@ 1,9 @@
@@ 1,10 @@
 
 
List of 5
 
 
List of 5
<
 
 $ qr   : num [1:150, 1:2] -12.2474 0.0816 0.0816 0.0816 0.0816 ...
>
 
 $ qr   : num [1:150, 1:4] -12.2474 0.0816 0.0816 0.0816 0.0816 ...
 
 
  ..- attr(*, "dimnames")=List of 2
 
 
  ..- attr(*, "dimnames")=List of 2
<
 
  ..- attr(*, "assign")= int [1:2] 0 1
>
 
  ..- attr(*, "assign")= int [1:4] 0 1 2 2
~
 
>
 
  ..- attr(*, "contrasts")=List of 1
<
 
 $ qraux: num [1:2] 1.08 1.02
>
 
 $ qraux: num [1:4] 1.08 1.02 1.05 1.11
<
 
 $ pivot: int [1:2] 1 2
>
 
 $ pivot: int [1:4] 1 2 3 4
 
 
 $ tol  : num 1e-07
 
 
 $ tol  : num 1e-07
<
 
 $ rank : int 2
>
 
 $ rank : int 4
 
 
 - attr(*, "class")= chr "qr"
 
 
 - attr(*, "class")= chr "qr"
3 differences are hidden by our use of `max.level`




If you specify a line.limit with diffStr it
will fold nested levels in order to fit under line.limit so
long as there remain visible differences. If you prefer to see all the
differences you can leave line.limit unspecified.






Compare Vectors Elements with diffChr


Sometimes it is useful to do a direct element by element
comparison:


diffChr(letters[1:3], c("a", "B", "c"))




@@ 1,3 @@
@@ 1,3 @@
 
 
a
 
 
a
<
 
b
>
 
B
 
 
c
 
 
c




Notice how we are comparing the contents of the vectors with one line
per element.






Why S4?


The diff* functions are defined as S4 generics with
default methods (signature c("ANY", "ANY")) so that users
can customize behavior for their own objects. For example, a custom
method could set many of the default parameters to values more suitable
for a particular object. If the objects in question are S3 objects the
S3 class will have to be registered with setOldClass.






Return Value


All the diff* methods return a Diff S4
object. It has a show method which is responsible for
rendering the Diff and displaying it to the screen. Because
of this you can compute and render diffs in two steps:


x <- diffPrint(letters, LETTERS)
x   # or equivalently: `show(x)`


This may cause the diff to render funny if you change screen widths,
etc., between the two steps.


There are also summary, any, and
as.character methods. The summary method
provides a high level overview of where the differences are, which can
be helpful for large diffs:


summary(diffStr(mdl1, mdl2))




Found differences in 12 hunks:
45 insertions, 39 deletions, 18 matches (lines)

Diff map (line:char scale is 1:1 for single chars, 1-2:1 for char seqs):
DDDIII.DDDIII.DI.DI..DDDIIIII.DI.DDDDDIIIIIII.DDDIII..DDDIII..DDIII.DDDIII..DDII.




any returns TRUE if there are differences, and
as.character returns the character representation of the
diff.








Controlling Diffs and Their Appearance




Parameters


The diff* family of methods has an extensive set of
parameters that allow you to fine tune how the diff is applied and
displayed. We will review some of the major ones in this section. For a
full description see ?diffPrint.


While the parameter list is extensive, only the objects being
compared are required. All the other parameters have default values, and
most of them are for advanced use only. The defaults can all be adjusted
via the diffobj.* options.






Display Mode


There are three built-in display modes that are similar to those
found in GNU diff: “sidebyside”, “unified”, and “context”.
For example, by varying the mode parameter with:


x <- y <- letters[24:26]
y[2] <- "GREMLINS"
diffChr(x, y)


we get:






mode=“sidebyside”

mode=“unified”

mode=“context”






@@ 1,3 @@
@@ 1,3 @@
 
 
x
 
 
x
<
 
y
>
 
GREMLINS
 
 
z
 
 
z







@@ 1,3 / 1,3 @@
 
 
x
<
 
y
>
 
GREMLINS
 
 
z







@@ 1,3 / 1,3 @@
 
 
x
<
 
y
 
 
z
~
 
----------
 
 
x
>
 
GREMLINS
 
 
z






By default diffobj will try to use
mode="sidebyside" if reasonable given display width, and
otherwise will switch to mode="unified". You can always
force a particular display style by specifying it with the
mode argument.






Color Mode


The default color mode uses yellow and blue to symbolize deletions
and insertions for accessibility to dichromats. If you prefer the more
traditional color mode you can specify color.mode="rgb" in
the parameter list, or use
options(diffobj.color.mode="rgb"):


diffChr(x, y, color.mode="rgb")




@@ 1,3 @@
@@ 1,3 @@
 
 
x
 
 
x
<
 
y
>
 
GREMLINS
 
 
z
 
 
z








Output Formats


If your terminal supports it diffobj will format the
output with ANSI escape sequences. diffobj uses Gábor
Csárdi’s crayon package
to detect ANSI support and to apply ANSI based formatting. If you are
using RStudio or another IDE that supports
getOption("viewer"), diffobj will output an
HTML/CSS formatted diff to the viewport. In other terminals that do not
support ANSI colors, diffobj will attempt to output to an
HTML/CSS formatted diff to your browser using
browseURL.


You can explicitly specify the output format with the
format parameter:


    

  • format="raw" for unformatted diffs
    • 

  • format="ansi8" for standard ANSI 8 color
formatting
    • 

  • format="ansi256" for ANSI 256 color formatting
    • 

  • format="html" for HTML/CSS output and styling
    • 



See Pagers for more details.






Brightness


The brightness parameter allows you to pick a color
scheme compatible with the background color of your terminal. The
options are:


    

  • “light”: for use with light tone terminals
    • 

  • “dark”: for use with dark tone terminals
    • 

  • “neutral”: for use with either light or dark terminals
    • 



Here are examples of terminal screen renderings for both “rgb” and
“yb” color.mode for the three brightness
levels.




The examples for “light” and “dark” have the backgrounds forcefully
set to a color compatible with the scheme. In actual use the base
background and foreground colors are left unchanged, which will look bad
if you use “dark” with light colored backgrounds or vice versa. Since we
do not know of a good cross platform way of detecting terminal
background color the default brightness value is
“neutral”.


At this time the only format that is affected by this
parameter is “ansi256”. If you want to specify your own
light/dark/neutral schemes you may do so either by specifying a style directly or with Palette of
Styles.






Pagers


In interactive mode, if the diff output is very long or if your
terminal does not support ANSI colors, diff* methods will
pipe output to a pager. This is done by writing the output to a
temporary file and passing the file reference to the pager. The default
action is to invoke the pager with file.show if your
terminal supports ANSI colors and the pager is known to support ANSI
colors as well (as of this writing, only less is assumed to
support ANSI colors), or if not to use getOption("viewer")
if available (this outputs to the viewport in RStudio), or if not to use
browseURL.


You can fine tune when, how, and if a pager is used with the
pager parameter. See ?diffPrint and
?Pager for more details.






Styles


You can control almost all aspects of the diff output formatting via
the style parameter. To do so, pass an appropriately
configured Style object. See ?Style for more
details on how to do this.


The default is to auto pick a style based on the values of the
format, color.mode, and
brightness parameters. This is done by using the computed
values for each of those parameters to subset the
PaletteOfStyles object passed as the
palette.of.styles parameter. This
PaletteOfStyles object contains a Style object
for all the possible permutations of the style,
format, and color.mode parameters. See
?PaletteOfStyles.


If you specify the style parameter the values of the
format, brightness, and
color.mode parameters will be ignored.








Diff Algorithm


The primary diff algorithm is Myer’s solution to the shortest edit
script / longest common sequence problem with the Hirschberg linear
space refinement as described in:




E. Myers, “An O(ND) Difference Algorithm and Its Variations”,
Algorithmica 1, 2 (1986), 251-266.




and should be the same algorithm used by GNU diff. The implementation
used here is a heavily modified version of Michael B. Allen’s diff
program from the libmba
C library. Any and all bugs in the C code in this package
were most likely introduced by yours truly. Please note that the
resulting C code is incompatible with the original libmba
library.






Performance Considerations




Diff


The diff algorithm scales with the square of the number of
differences. For reasonably small diffs (< 10K differences),
the diff itself is unlikely to be the bottleneck.






Capture and Processing


Capture of inputs for diffPrint and
diffStr, and processing of output for all
diff* methods will account for most of the execution time
unless you have large numbers of differences. This input and output
processing scales mostly linearly with the input size.


You can improve performance somewhat by using diffChr
since that skips the capture part, and by turning off
word.diff:


v1 <- 1:5e4
v2 <- v1[-sample(v1, 100)]
diffChr(v1, v2, word.diff=FALSE)


will be ~2x as fast as:


diffPrint(v1, v2)


Note: turning off word.diff when using
diffPrint with unnamed atomic vectors can actually slow
down the diff because there may well be fewer element by element
differences than line differences as displayed. For example, when
comparing 1:1e6 to 2:1e6 there is only one
element difference, but every line as displayed is different because of
the shift. Using word.diff=TRUE (and
unwrap.atomic=TRUE) allows diffPrint to
compare element by element rather than line by line.
diffChr always compares element by element.






Minimal Diff


If you are looking for the fastest possible diff you can use
ses and completely bypass most input and output processing.
Inputs will be coerced to character if they are not character.


ses(letters[1:5], letters[c(2:3, 5)])


## [1] "1d0" "4d2"


This will be 10-20x faster than diffChr, at the cost of
less useful output.
















diffobj/inst/doc/embed.R0000644000176200001440000000362215001306424014574 0ustar  liggesusers## ----echo=FALSE---------------------------------------------------------------
library(diffobj)

## ----results='asis'-----------------------------------------------------------
cat(
  as.character(
    diffPrint(
      1:5, 2:6,
      format="html",
      style=list(html.output="diff.w.style")
) ) )

## ----results='asis'-----------------------------------------------------------
cat(
  as.character(
    diffPrint(
      1:5, 2:6,
      format="html",
      style=list(html.output="diff.only")   # notice this changed
) ) )

## ----eval=FALSE---------------------------------------------------------------
# options(
#   diffobj.format="html",
#   diffobj.style=list(html.output="diff.only")
# )

## ----echo=FALSE---------------------------------------------------------------
old.opts <- options(
  diffobj.format="html",
  diffobj.style=list(html.output="diff.only")
)

## ----results='asis'-----------------------------------------------------------
cat(as.character(diffPrint(1:5, 2:6)))

## ----echo=FALSE---------------------------------------------------------------
options(old.opts)

## ----eval=FALSE---------------------------------------------------------------
# library(shiny)
# shinyApp(
#   ui=fluidPage(htmlOutput('diffobj_element')),
#   server=function(input, output) {
#     output$diffobj_element <- renderUI({
#       HTML(
#         as.character(
#           diffPrint(
#             1:5, 2:6,
#             format="html",
#             style=list(html.output="diff.w.style")
# ) ) )}) } )

## ----eval=FALSE---------------------------------------------------------------
# options(
#   diffobj.format="html",
#   diffobj.style=list(html.output="diff.only")
# )
# shinyApp(
#   ui=fluidPage(
#     includeCSS(diffobj_css()),
#     htmlOutput('diffobj_element')
#   ),
#   server=function(input, output) {
#     output$diffobj_element <- renderUI({
#       HTML(as.character(diffPrint(1:5, 2:6,)))
# }) } )

diffobj/inst/doc/embed.html0000644000176200001440000007730315001306424015346 0ustar  liggesusers














Embed Diffs in R Markdown Or Shiny




























Embed Diffs in R Markdown Or Shiny


Brodie Gaslam








Rmarkdown




Basic Requirements


Any R chunks that produce diffs should include the
results='asis' option, e.g.:


```{r, comment="", results="asis"}
# R code here
```






Embedded CSS


This is what a basic code block should look like:


```{r, comment="", results="asis"}
cat(                                 # output to screen
  as.character(                      # convert to diff to character vector
    diffPrint(                       # run diff
      1:5, 2:6,
      format="html",                 # specify html output
      style=list(
        html.output="diff.w.style"   # configure html style
      )
) ) )
```


Here we use this same code as an actual markdown R code block:


cat(
  as.character(
    diffPrint(
      1:5, 2:6,
      format="html",
      style=list(html.output="diff.w.style")
) ) )





@@ 1 @@
@@ 1 @@
<
 
[1] 1 2 3 4 5
>
 
[1] 2 3 4 5 6




This is an ugly implementation because it produces illegal HTML. The
styles are directly embedded in the body of the document, outside of the
HEAD tags. Although this is illegal HTML, it seems to work in most
browsers. Another problem is that every diff you use in your document
will inject the same CSS code over and over.






External CSS


A better option is to provide the CSS directly by modifying the
output portion of the YAML
header:


---
output:
    rmarkdown::html_vignette:
        toc: true
        css: !expr diffobj::diffobj_css()
---


In reality you will probably want to specify multiple CSS files,
including the original rmarkdown one:


---
output:
    rmarkdown::html_vignette:
        toc: true
        css:
          - !expr diffobj::diffobj_css()
          - !expr system.file("rmarkdown", "templates", "html_vignette", "resources", "vignette.css", package = "rmarkdown")
---


Once you set this up then you can use:


cat(
  as.character(
    diffPrint(
      1:5, 2:6,
      format="html",
      style=list(html.output="diff.only")   # notice this changed
) ) )




@@ 1 @@
@@ 1 @@
<
 
[1] 1 2 3 4 5
>
 
[1] 2 3 4 5 6




This will omit the CSS, but since we include it via the YAML
everything should work as expected.






Use Options


Almost all diffobj parameters can be specified via
options:


options(
  diffobj.format="html",
  diffobj.style=list(html.output="diff.only")
)


Then you can just run the diff as normal:


cat(as.character(diffPrint(1:5, 2:6)))




@@ 1 @@
@@ 1 @@
<
 
[1] 1 2 3 4 5
>
 
[1] 2 3 4 5 6










Shiny


Shiny usage is very similar to rmarkdown. In both cases
we want to get diffobj to produce HTML output to embed in
our document. If we are willing to embed the CSS with each diff, we can
use:


library(shiny)
shinyApp(
  ui=fluidPage(htmlOutput('diffobj_element')),
  server=function(input, output) {
    output$diffobj_element <- renderUI({
      HTML(
        as.character(
          diffPrint(
            1:5, 2:6,
            format="html",
            style=list(html.output="diff.w.style")
) ) )}) } )


If we have many diffs, it may be preferable to use options and
external style sheet:


options(
  diffobj.format="html",
  diffobj.style=list(html.output="diff.only")
)
shinyApp(
  ui=fluidPage(
    includeCSS(diffobj_css()),
    htmlOutput('diffobj_element')
  ),
  server=function(input, output) {
    output$diffobj_element <- renderUI({
      HTML(as.character(diffPrint(1:5, 2:6,)))
}) } )


Unlike with our rmarkdown example, this
CSS is included in the body of the HTML document instead of in the
header, so it is technically illegal like in our embedded css example.














diffobj/inst/doc/embed.Rmd0000644000176200001440000001013214122754044015117 0ustar  liggesusers---
title: "Embed Diffs in R Markdown Or Shiny"
author: "Brodie Gaslam"
output:
    rmarkdown::html_vignette:
        toc: true
        css:
          - !expr diffobj::diffobj_css()
          - styles.css
vignette: >
  %\VignetteIndexEntry{Embed Diffs in R Markdown Or Shiny}
  %\VignetteEngine{knitr::rmarkdown}
  \usepackage[utf8]{inputenc}

---

```{r echo=FALSE}
library(diffobj)
```

## Rmarkdown

### Basic Requirements

Any R chunks that produce diffs should include the `results='asis'` option,
e.g.:

````
```{r, comment="", results="asis"}`r ''`
# R code here
```
````

### Embedded CSS

This is what a basic code block should look like:

````
```{r, comment="", results="asis"}`r ''`
cat(                                 # output to screen
  as.character(                      # convert to diff to character vector
    diffPrint(                       # run diff
      1:5, 2:6,
      format="html",                 # specify html output
      style=list(
        html.output="diff.w.style"   # configure html style
      )
) ) )
```
````

Here we use this same code as an actual markdown R code block:

```{r results='asis'}
cat(
  as.character(
    diffPrint(
      1:5, 2:6,
      format="html",
      style=list(html.output="diff.w.style")
) ) )
```

This is an ugly implementation because it produces illegal HTML.  The styles are
directly embedded in the body of the document, outside of the HEAD tags.
Although this is illegal HTML, it seems to work in most browsers.  Another
problem is that every diff you use in your document will inject the same CSS
code over and over.

### External CSS

A better option is to provide the CSS directly by modifying the `output`
portion of the [YAML
header](https://bookdown.org/yihui/rmarkdown/r-package-vignette.html):

```
---
output:
    rmarkdown::html_vignette:
        toc: true
        css: !expr diffobj::diffobj_css()
---
```

In reality you will probably want to specify multiple CSS files, including the
original `rmarkdown` one:

```
---
output:
    rmarkdown::html_vignette:
        toc: true
        css:
          - !expr diffobj::diffobj_css()
          - !expr system.file("rmarkdown", "templates", "html_vignette", "resources", "vignette.css", package = "rmarkdown")
---
```

Once you set this up then you can use:

```{r results='asis'}
cat(
  as.character(
    diffPrint(
      1:5, 2:6,
      format="html",
      style=list(html.output="diff.only")   # notice this changed
) ) )
```

This will omit the CSS, but since we include it via the YAML everything should
work as expected.

### Use Options

Almost all `diffobj` parameters can be specified via options:

```{r eval=FALSE}
options(
  diffobj.format="html",
  diffobj.style=list(html.output="diff.only")
)
```
```{r echo=FALSE}
old.opts <- options(
  diffobj.format="html",
  diffobj.style=list(html.output="diff.only")
)
```
Then you can just run the diff as normal:
```{r results='asis'}
cat(as.character(diffPrint(1:5, 2:6)))
```
```{r echo=FALSE}
options(old.opts)
```

## Shiny

Shiny usage is very similar to `rmarkdown`.  In both cases we want to get
`diffobj` to produce HTML output to embed in our document.  If we are willing to
embed the CSS with each diff, we can use:

```{r, eval=FALSE}
library(shiny)
shinyApp(
  ui=fluidPage(htmlOutput('diffobj_element')),
  server=function(input, output) {
    output$diffobj_element <- renderUI({
      HTML(
        as.character(
          diffPrint(
            1:5, 2:6,
            format="html",
            style=list(html.output="diff.w.style")
) ) )}) } )
```

If we have many diffs, it may be preferable to use options and external
style sheet:

```{r, eval=FALSE}
options(
  diffobj.format="html",
  diffobj.style=list(html.output="diff.only")
)
shinyApp(
  ui=fluidPage(
    includeCSS(diffobj_css()),
    htmlOutput('diffobj_element')
  ),
  server=function(input, output) {
    output$diffobj_element <- renderUI({
      HTML(as.character(diffPrint(1:5, 2:6,)))
}) } )
```

Unlike with our [rmarkdown example](#external-css), this CSS is included
in the body of the HTML document instead of in the header, so it is technically
illegal like in our [embedded css example](#embedded-css).

diffobj/inst/doc/diffobj.R0000644000176200001440000000562415001306423015126 0ustar  liggesusers## ----echo=FALSE---------------------------------------------------------------
library(diffobj)
old.opt <- options(
  diffobj.disp.width=80, diffobj.pager="off", diffobj.format="html"
)

## ----results="asis"-----------------------------------------------------------
a <- b <- matrix(1:100, ncol=2)
a <- a[-20,]
b <- b[-45,]
b[c(18, 44)] <- 999
diffPrint(target=a, current=b)

## ----results="asis", echo=FALSE-----------------------------------------------
diffPrint(target=a, current=b)[1]

## ----results="asis", echo=FALSE-----------------------------------------------
diffPrint(target=a, current=b)[2:10]

## ----results="asis", echo=FALSE-----------------------------------------------
diffPrint(target=a, current=b)[3]

## ----results="asis", echo=FALSE-----------------------------------------------
diffPrint(target=a, current=b)[6:9]

## ----results="asis", echo=FALSE-----------------------------------------------
diffPrint(target=a, current=b)[8:9]

## ----results="asis"-----------------------------------------------------------
state.abb2 <- state.abb[-16]
state.abb2[37] <- "Pennsylvania"
diffPrint(state.abb, state.abb2)

## ----results="asis"-----------------------------------------------------------
mdl1 <- lm(Sepal.Length ~ Sepal.Width, iris)
mdl2 <- lm(Sepal.Length ~ Sepal.Width + Species, iris)
diffStr(mdl1$qr, mdl2$qr, line.limit=15)

## ----results="asis"-----------------------------------------------------------
diffChr(letters[1:3], c("a", "B", "c"))

## ----eval=FALSE---------------------------------------------------------------
# x <- diffPrint(letters, LETTERS)
# x   # or equivalently: `show(x)`

## ----results="asis"-----------------------------------------------------------
summary(diffStr(mdl1, mdl2))

## ----results="asis", eval=FALSE-----------------------------------------------
# x <- y <- letters[24:26]
# y[2] <- "GREMLINS"
# diffChr(x, y)

## ----results="asis", echo=FALSE-----------------------------------------------
x <- y <- letters[24:26]
y[2] <- "GREMLINS"
diffChr(x, y, mode="sidebyside")

## ----results="asis", echo=FALSE-----------------------------------------------
x <- y <- letters[24:26]
y[2] <- "GREMLINS"
diffChr(x, y, mode="unified")

## ----results="asis", echo=FALSE-----------------------------------------------
x <- y <- letters[24:26]
y[2] <- "GREMLINS"
diffChr(x, y, mode="context")

## ----results="asis"-----------------------------------------------------------
diffChr(x, y, color.mode="rgb")

## ----eval=FALSE---------------------------------------------------------------
# v1 <- 1:5e4
# v2 <- v1[-sample(v1, 100)]
# diffChr(v1, v2, word.diff=FALSE)

## ----eval=FALSE---------------------------------------------------------------
# diffPrint(v1, v2)

## -----------------------------------------------------------------------------
ses(letters[1:5], letters[c(2:3, 5)])

## ----echo=FALSE---------------------------------------------------------------
options(old.opt)

diffobj/inst/script/0000755000176200001440000000000014122754044014141 5ustar  liggesusersdiffobj/inst/script/diffobj.js0000644000176200001440000001322314122754044016103 0ustar  liggesusers// diffobj - Compare R Objects with a Diff
// Copyright (C) 2021 Brodie Gaslam
//
// This program is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 3 of the License, or
// (at your option) any later version.
//
// This program is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU General Public License for more details.
//
// Go to  for a copy of the license.

/*
 * Resizes diff by changing font-size using a hidden row of sample output as
 * a reference
 *
 * NOTE: this code is intended to be loaded after the HTML has been rendered
 * and is assumed to be the only JS on the page.  It should only be included
 * as part of output when in "page" mode and should not be embedded in other
 * content.  For that, use the HTML/CSS only outputs.
 */

var meta = document.getElementById("diffobj_meta");
var meta_cont = document.getElementById("diffobj_content_meta");
var meta_banner = document.getElementById("diffobj_banner_meta");
var content = document.getElementById("diffobj_content");
var outer = document.getElementById("diffobj_outer");

if(
  meta == null || content == null || outer == null ||
  meta_cont == null || meta_banner == null
)
  throw new Error("Unable to find meta and content; contact maintainer.");

var row = meta_cont.getElementsByClassName("row");

if(row.length != 1)
  throw new Error("Unexpected row struct in meta block; contact maintainer.");

var lines = meta_cont.getElementsByClassName("line");

if(lines.length != 1 && lines.length != 2)
  throw new Error("Unexpected lines in meta block; contact maintainer.");

var meta_bnr_gutter =
  document.querySelector("#diffobj_banner_meta .line .gutter");
var meta_bnr_delete =
  document.querySelector("#diffobj_banner_meta .line .text>.delete");
var meta_bnr_text =
  document.querySelector("#diffobj_banner_meta .line .text");

var bnr_gutters =
  document.querySelectorAll("#diffobj_content .line.banner .gutter");
var bnr_text_div =
  document.querySelectorAll("#diffobj_content .line.banner .text>DIV");

if(
    meta_bnr_gutter == null || meta_bnr_delete == null ||
    bnr_gutters.length != 2 || bnr_text_div.length != 2
  )
  throw new Error("Unable to get meta banner objects")

// Set the banners to 'fixed'; need to be in auto by default

for(i = 0; i < 2; i++) bnr_text_div[i].style.tableLayout = "fixed";

// - Set Min Width -------------------------------------------------------------

// Makes sure that we don't wrap under "native" width
// Note we need to pad because scrollWidth appears to truncate floats to int

meta.style.display = "block";
var min_width = 0;
for(i = 0; i < lines.length; i++) min_width += lines[i].scrollWidth + 1;
meta.style.display = "none";

content.style.minWidth = min_width + "px";

function resize_diff_out(scale) {

  // - Get object refs ---------------------------------------------------------


  // - Get Sizes ---------------------------------------------------------------

  meta.style.display = "block";

  // The getComputedStyle business won't work on IE9 or lower; need to detect
  // and implement work-around

  var b_t, b_d_w, b_d_o, b_g;
  b_g = parseFloat(window.getComputedStyle(meta_bnr_gutter).width);
  b_d_o = meta_bnr_delete.offsetWidth;
  b_d_w = parseFloat(window.getComputedStyle(meta_bnr_delete).width);
  b_t = parseFloat(window.getComputedStyle(meta_bnr_text).width);

  meta.style.display = "none";

  // - Set Sizes ---------------------------------------------------------------

  for(i = 0; i < 2; i++) {
    bnr_gutters[i].style.width = b_g + "px";
    // for some reason table fixed width computation doesn't properly account
    // for padding and lines
    bnr_text_div[i].style.width = b_t - b_d_o + b_d_w + "px";
  }
  var w = document.body.clientWidth;
  var scale_size = w / min_width;

  if(scale_size < 1) {

    if(scale) {
      content.style.transform = "scale(" + scale_size + ")";
      content.style.transformOrigin = "top left";
      content.style.webkitTransform = "scale(" + scale_size + ")";
      content.style.webkitTransformOrigin = "top left";
      content.style.msTransform = "scale(" + scale_size + ")";
      content.style.msTransformOrigin = "top left";
      content.style.MozTransform = "scale(" + scale_size + ")";
      content.style.MozTransformOrigin = "top left";
      content.style.oTransform = "scale(" + scale_size + ")";
      content.style.oTransformOrigin = "top left";

      var cont_rec_h = content.getBoundingClientRect().height;

      if(cont_rec_h) {
        outer.style.height = cont_rec_h + "px";
      }
    }
    var cont_rec_w = content.getBoundingClientRect().width;
    if(cont_rec_w) {
      outer.style.width = cont_rec_w + "px";
    }
  } else {
    content.style.transform = "none";
    content.style.MozTransform = "none";
    content.style.webkitTransform = "none";
    content.style.msTransform = "none";
    content.style.oTransform = "none";
    outer.style.height = "auto";
    outer.style.width = "auto";
  }
};
/*
 * Manage resize timeout based on how large the object is
 */

var out_rows = content.getElementsByClassName("row").length;
var timeout_time;
if(out_rows < 100) {
  timeout_time = 25;
} else {
  timeout_time = Math.min(25 + (out_rows - 100) / 4, 500)
}

var timeout;
function resize_window(f, scale) {
  clearTimeout(timeout);
  timeout = setTimeout(f, timeout_time, scale);
}

function resize_diff_out_scale() {resize_window(resize_diff_out, true);}
function resize_diff_out_no_scale() {resize_window(resize_diff_out, false);}
diffobj/inst/COPYRIGHTS0000644000176200001440000000127314122754044014256 0ustar  liggesusersThe C implementation of the Myers' Diff Algorithm with Linear Space Refinement was originally written by Michael B. Allen with the following license and copyright:

  diff - compute a shortest edit script (SES) given two sequences
  Copyright (C) 2004 Michael B. Allen 
  License: MIT

The original source code is available at:

  http://www.ioplex.com/~miallen/libmba/dl/libmba-0.9.1.tar.gz

The adapted and heavily modified code is available in src/diff.c, src/diff.h.  See those files for additional details.

This package is released under the GPL (>= 2) or greater license:

  diffobj - Compare R Objects with a Diff
  Copyright (C) 2021 Brodie Gaslam
  License: GPL (>= 2)
diffobj/README.md0000644000176200001440000001041215001306403013122 0ustar  liggesusers# diffobj - Diffs for R Objects

[![R build
status](https://github.com/brodieG/diffobj/workflows/R-CMD-check/badge.svg)](https://github.com/brodieG/diffobj/actions)
[![](https://codecov.io/github/brodieG/diffobj/coverage.svg?branch=rc)](https://app.codecov.io/gh/brodieG/diffobj?branch=rc)

Generate a colorized diff of two R objects for an intuitive visualization of their differences.

> See the [introductory vignette for details][1].

## Output

If your terminal supports formatting through ANSI escape sequences, `diffobj` will output colored diffs to the terminal.  Otherwise, output will be colored with HTML/CSS and sent to the IDE viewport or to your browser.  `diffobj` comes with several built-in color schemes that can be further customized.  Some examples:

![Output Examples](https://raw.githubusercontent.com/brodieG/diffobj/master/cliandrstudio.png)

## Installation

This package is available on [CRAN](https://cran.r-project.org/package=diffobj).

```
install.packages("diffobj")
browseVignettes("diffobj")
```

## Related Software

* [tools::Rdiff][2].
* [Daff](https://cran.r-project.org/package=daff) diff, patch and merge for
  data.frames.
* [GNU diff](https://www.gnu.org/software/diffutils/).
* [waldo](https://cran.r-project.org/package=waldo), which internally uses
  `diffobj` for diffs but takes a more hands-on approach to detailing object
  differences.

## Acknowledgements

* R Core for developing and maintaining such a wonderful language.
* CRAN maintainers, for patiently shepherding packages onto CRAN and maintaining
  the repository, and Uwe Ligges in particular for maintaining
  [Winbuilder](https://win-builder.r-project.org/).
* The users who have reported bugs and possible fixes, and/or made feature
  requests (see NEWS.md).
* [Gábor Csárdi](https://github.com/gaborcsardi) for
  [crayon](https://github.com/r-lib/crayon).
* [Jim Hester](https://github.com/jimhester) for
  [covr](https://cran.r-project.org/package=covr), and with Rstudio for
  [r-lib/actions](https://github.com/r-lib/actions).
* [Dirk Eddelbuettel](https://github.com/eddelbuettel) and [Carl
  Boettiger](https://github.com/cboettig) for the
  [rocker](https://github.com/rocker-org/rocker) project, and [Gábor
  Csárdi](https://github.com/gaborcsardi) and the
  [R-consortium](https://r-consortium.org/) for
  [Rhub](https://github.com/r-hub), without which testing bugs on R-devel and
  other platforms would be a nightmare.
* [Hadley Wickham](https://github.com/hadley/) and [Peter
  Danenberg](https://github.com/klutometis) for
  [roxygen2](https://cran.r-project.org/package=roxygen2).
* [Yihui Xie](https://github.com/yihui) for
  [knitr](https://cran.r-project.org/package=knitr) and  [J.J.
  Allaire](https://github.com/jjallaire) etal for
  [rmarkdown](https://cran.r-project.org/package=rmarkdown), and by extension
  John MacFarlane for [pandoc](https://pandoc.org/).
* Olaf Mersmann for
  [microbenchmark](https://cran.r-project.org/package=microbenchmark), because
  microsecond matter, and [Joshua Ulrich](https://github.com/joshuaulrich) for
  making it lightweight and maintaining it.
* [Tomas Kalibera](https://github.com/kalibera) for
  [rchk](https://github.com/kalibera/rchk) and the accompanying vagrant image,
  and rcnst to help detect errors in compiled code.
* [Winston Chang](https://github.com/wch) for the
  [r-debug](https://hub.docker.com/r/wch1/r-debug/) docker container, in
  particular because of the valgrind level 2 instrumented version of R.
* [Gábor Csárdi](https://github.com/gaborcsardi), the
  [R-consortium](https://r-consortium.org/), etal for
  [revdepcheck](https://github.com/r-lib/revdepcheck) to simplify reverse
  dependency checks.
* All open source developers out there that make their work freely available
  for others to use.
* [Github](https://github.com/), [Codecov](https://about.codecov.io/),
  [Vagrant](https://www.vagrantup.com/), [Docker](https://www.docker.com/),
  [Ubuntu](https://ubuntu.com/), [Brew](https://brew.sh/) for providing
  infrastructure that greatly simplifies open source development.
* [Free Software Foundation](https://www.fsf.org/) for developing the GPL
  license and promotion of the free software movement.

[1]: https://cran.r-project.org/package=diffobj/vignettes/diffobj.html
[2]: https://stat.ethz.ch/R-manual/R-devel/library/tools/html/Rdiff.html
diffobj/build/0000755000176200001440000000000015001306424012747 5ustar  liggesusersdiffobj/build/vignette.rds0000644000176200001440000000037215001306424015310 0ustar  liggesusersuϊ0ƣU<5}*,Ѥm%oi;)VC&3f;>=H9!YIIhqDȎנRh~;Y,j9n73WEݝ-gzM꠵`F!׺FO^_(CJ	ҶWZ#X^huP`tc,N)˝#C,P=LVdiffobj/man/0000755000176200001440000000000015001246431012424 5ustar  liggesusersdiffobj/man/gdo.Rd0000644000176200001440000000077015001246431013470 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/options.R
\name{gdo}
\alias{gdo}
\title{Shorthand Function for Accessing diffobj Options}
\usage{
gdo(x)
}
\arguments{
\item{x}{character(1L) name off \code{diffobj} option to retrieve, without
the \dQuote{diffobj.} prefix}
}
\description{
\code{gdo(x)} is equivalent to \code{getOption(sprintf("diffobj.\%s", x))},
falling back to \pkg{diffobj}'s internal default value if the option is
not set.
}
\examples{
gdo("format")
}
diffobj/man/diffObj.Rd0000644000176200001440000000262514122754044014272 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/diff.R
\name{diffObj}
\alias{diffObj}
\title{Diff Objects}
\usage{
diffObj(target, current, ...)
}
\arguments{
\item{target}{the reference object}

\item{current}{the object being compared to \code{target}}

\item{...}{unused, for compatibility of methods with generics}
}
\value{
a \code{Diff} object; see \code{\link{diffPrint}}.
}
\description{
Compare either the \code{print}ed or \code{str} screen representation of
R objects depending on which is estimated to produce the most useful
diff.  The selection process tries to minimize screen lines while maximizing
differences shown subject to display constraints.  The decision algorithm is
likely to evolve over time, so do not rely on this function making
a particular selection under specific circumstances.  Instead, use
\code{\link{diffPrint}} or \code{\link{diffStr}} if you require one or the
other output.
}
\examples{
## `pager="off"` for CRAN compliance; you may omit in normal use
diffObj(letters, c(letters[1:10], LETTERS[11:26]), pager="off")
with(mtcars, diffObj(lm(mpg ~ hp)$qr, lm(mpg ~ disp)$qr, pager="off"))
}
\seealso{
\code{\link{diffPrint}} for details on the \code{diff*} methods,
  \code{\link{diffStr}},
  \code{\link{diffChr}} to compare character vectors directly
  \code{\link{diffDeparse}} to compare deparsed objects,
  \code{\link{ses}} for a minimal and fast diff
}
diffobj/man/trim.Rd0000644000176200001440000000710414122754044013677 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/trim.R
\name{trim}
\alias{trim}
\alias{trimPrint,}
\alias{trimStr,}
\alias{trimChr,}
\alias{trimDeparse,}
\alias{trimFile}
\alias{trimPrint}
\alias{trimPrint,ANY,character-method}
\alias{trimStr}
\alias{trimStr,ANY,character-method}
\alias{trimChr}
\alias{trimChr,ANY,character-method}
\alias{trimDeparse}
\alias{trimDeparse,ANY,character-method}
\alias{trimFile,ANY,character-method}
\title{Methods to Remove Unsemantic Text Prior to Diff}
\usage{
trimPrint(obj, obj.as.chr)

\S4method{trimPrint}{ANY,character}(obj, obj.as.chr)

trimStr(obj, obj.as.chr)

\S4method{trimStr}{ANY,character}(obj, obj.as.chr)

trimChr(obj, obj.as.chr)

\S4method{trimChr}{ANY,character}(obj, obj.as.chr)

trimDeparse(obj, obj.as.chr)

\S4method{trimDeparse}{ANY,character}(obj, obj.as.chr)

trimFile(obj, obj.as.chr)

\S4method{trimFile}{ANY,character}(obj, obj.as.chr)
}
\arguments{
\item{obj}{the object}

\item{obj.as.chr}{character the \code{print}ed representation of the object}
}
\value{
a \code{length(obj.as.chr)} row and 2 column integer matrix with the
  start (first column) and end (second column) character positions of the sub
  string to run diffs on.
}
\description{
\code{\link[=diffPrint]{diff*}} methods, in particular \code{diffPrint},
modify the text representation of an object prior to running the diff to
reduce the incidence of spurious mismatches caused by unsemantic differences.
For example, we look to remove matrix row indices and atomic vector indices
(i.e. the \samp{[1,]} or \samp{[1]} strings at the beginning of each display
line).
}
\details{
Consider: \preformatted{
> matrix(10:12)
     [,1]
[1,]   10
[2,]   11
[3,]   12
> matrix(11:12)
     [,1]
[1,]   11
[2,]   12
}
In this case, the line by line diff would find all rows of the matrix to
be mismatched because where the data matches (rows containing
11 and 12) the indices do not.  By trimming out the row indices before
the diff, the diff can recognize that row 2 and 3  from the first matrix
should be matched to row 1 and 2 of the second.

These methods follow a similar interface as the \code{\link[=guides]{guide*}}
methods, with one available for each \code{diff*} method except for
\code{diffCsv} since that one uses \code{diffPrint} internally.  The
unsemantic differences are added back after the diff for display purposes,
and are colored in grey to indicate they are ignored in the diff.

Currently only \code{trimPrint} and \code{trimStr} do anything meaningful.
\code{trimPrint} removes row index headers provided that they are of the
default un-named variety.  If you add row names, or if numeric row indices
are not ascending from 1, they will not be stripped as those have meaning.
\code{trimStr} removes the \samp{..$}, \samp{..-}, and \samp{..@} tokens
to minimize spurious matches.

You can modify how text is trimmed by providing your own functions to the
\code{trim} argument of the \code{diff*} methods, or by defining
\code{trim*} methods for your objects.  Note that the return value for these
functions is the start and end columns of the text that should be
\emph{kept} and used in the diff.

As with guides, trimming is on a best efforts basis and may fail with
\dQuote{pathological} display representations.  Since the diff still works
even with failed trimming this is considered an acceptable compromise.
Trimming is more likely to fail with nested recursive structures.
}
\note{
\code{obj.as.chr} will be as processed by
  \code{\link{strip_hz_control}} and as such will not be identical to the
  captured output if it contains tabs, newlines, or carriage returns.
}
diffobj/man/par_frame.Rd0000644000176200001440000000230414122754044014655 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/misc.R
\name{par_frame}
\alias{par_frame}
\title{Get Parent Frame of S4 Call Stack}
\usage{
par_frame()
}
\value{
an environment
}
\description{
Implementation of the \code{function(x=parent.frame()) ...} pattern for the
\code{\link[=diffPrint]{diff*}} methods since the normal pattern does not
work with S4 methods.  Works by looking through the call stack and
identifying what call likely initiated the S4 dispatch.
}
\details{
The function is not exported and intended only for use as the default value
for the \code{frame} argument for the \code{\link[=diffPrint]{diff*}}
methods.

Matching is done purely by looking for the last repeated call followed
by \code{.local(target, current, ...)} that is not a call to \code{eval}.
This pattern seems to match the correct call most of the time.
Since methods can be renamed by the user we make no attempt to verify method
names.  This method could potentially be tricked if you implement custom
\code{\link[=diffPrint]{diff*}} methods that somehow
issue two identical sequential calls before calling \code{callNextMethod}.
Failure in this case means the wrong \code{frame} will be returned.
}
diffobj/man/has_Rdiff.Rd0000644000176200001440000000113214122754044014604 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/rdiff.R
\name{has_Rdiff}
\alias{has_Rdiff}
\title{Attempt to Detect Whether diff Utility is Available}
\usage{
has_Rdiff(test.with = tools::Rdiff)
}
\arguments{
\item{test.with}{function to test for diff presence with, typically Rdiff}
}
\value{
TRUE or FALSE
}
\description{
Checks whether \code{\link[=Rdiff]{tools::Rdiff}} issues a warning when
running with \code{useDiff=TRUE} and if it does assumes this is because the
diff utility is not available.  Intended primarily for testing purposes.
}
\examples{
has_Rdiff()
}
diffobj/man/ses.Rd0000644000176200001440000000647415001246431013520 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/core.R
\name{ses}
\alias{ses}
\alias{ses_dat}
\title{Shortest Edit Script}
\usage{
ses(a, b, max.diffs = gdo("max.diffs"), warn = gdo("warn"))

ses_dat(a, b, extra = TRUE, max.diffs = gdo("max.diffs"), warn = gdo("warn"))
}
\arguments{
\item{a}{character}

\item{b}{character}

\item{max.diffs}{integer(1L), number of \emph{differences} (default 50000L)
after which we abandon the \code{O(n^2)} diff algorithm in favor of a naive
\code{O(n)} one. Set to \code{-1L} to stick to the original algorithm up to
the maximum allowed (~INT_MAX/4).}

\item{warn}{TRUE (default) or FALSE whether to warn if we hit
\code{max.diffs}.}

\item{extra}{TRUE (default) or FALSE, whether to also return the indices in
\code{a} and \code{b} the diff values are taken from.  Set to FALSE for a
small performance gain.}
}
\value{
character shortest edit script, or a machine readable version of it
  as a \code{ses_dat} object, which is a \code{data.frame} with columns
  \code{op} (factor, values \dQuote{Match}, \dQuote{Insert}, or
  \dQuote{Delete}), \code{val} character corresponding to the value taken
  from either \code{a} or \code{b}, and if \code{extra} is TRUE, integer
  columns \code{id.a} and \code{id.b} corresponding to the indices in
  \code{a} or \code{b} that \code{val} was taken from.  See Details.
}
\description{
Computes shortest edit script to convert \code{a} into \code{b} by removing
elements from \code{a} and adding elements from \code{b}.  Intended primarily
for debugging or for other applications that understand that particular
format.  See \href{http://www.gnu.org/software/diffutils/manual/diffutils.html#Detailed-Normal}{GNU diff docs}
for how to interpret the symbols.
}
\details{
\code{ses} will be much faster than any of the
\code{\link[=diffPrint]{diff*}} methods, particularly for large inputs with
limited numbers of differences.

NAs are treated as the string \dQuote{NA}.  Non-character inputs are coerced
to character.

\code{ses_dat} provides a semi-processed \dQuote{machine-readable} version of
precursor data to \code{ses} that may be useful for those desiring to use the
raw diff data and not the printed output of \code{diffobj}, but do not wish
to manually parse the \code{ses} output.  Whether it is faster than
\code{ses} or not depends on the ratio of matching to non-matching values as
\code{ses_dat} includes matching values whereas \code{ses} does not.
\code{ses_dat} objects have a print method that makes it easy to interpret
the diff, but are actually data.frames.  You can see the underlying data by
using \code{as.data.frame}, removing the "ses_dat" class, etc..
}
\examples{
a <- letters[1:6]
b <- c('b', 'CC', 'DD', 'd', 'f')
ses(a, b)
(dat <- ses_dat(a, b))
str(dat)                 # data.frame with a print method

## use `ses_dat` output to construct a minimal diff
## color with ANSI CSI SGR
diff <- dat[['val']]
del <- dat[['op']] == 'Delete'
ins <- dat[['op']] == 'Insert'
if(any(del))
  diff[del] <- paste0("\033[33m- ", diff[del], "\033[m")
if(any(ins))
  diff[ins] <- paste0("\033[34m+ ", diff[ins], "\033[m")
if(any(!ins & !del))
  diff[!ins & !del] <- paste0("  ", diff[!ins & !del])
writeLines(diff)

## We can recover `a` and `b` from the data
identical(subset(dat, op != 'Insert', val)[[1]], a)
identical(subset(dat, op != 'Delete', val)[[1]], b)
}
diffobj/man/Pager.Rd0000644000176200001440000002666214122754044013774 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/pager.R
\docType{class}
\name{Pager}
\alias{Pager}
\alias{PagerOff,}
\alias{PagerSystem,}
\alias{PagerSystemLess,}
\alias{PagerBrowser}
\alias{PagerOff-class}
\alias{PagerOff}
\alias{PagerSystem-class}
\alias{PagerSystem}
\alias{PagerSystemLess-class}
\alias{PagerSystemLess}
\title{Objects for Specifying Pager Settings}
\usage{
Pager(
  pager = function(x) writeLines(readLines(x)),
  file.ext = "",
  threshold = 0L,
  ansi = FALSE,
  file.path = NA_character_,
  make.blocking = FALSE
)

PagerOff(...)

PagerSystem(pager = file.show, threshold = -1L, file.ext = "", ...)

PagerSystemLess(
  pager = file.show,
  threshold = -1L,
  flags = "R",
  file.ext = "",
  ansi = TRUE,
  ...
)

PagerBrowser(
  pager = view_or_browse,
  threshold = 0L,
  file.ext = "html",
  make.blocking = NA,
  ...
)
}
\arguments{
\item{pager}{a function that accepts at least one parameter and does not
require a parameter other than the first parameter.  This function will be
called with a file path passed as the first argument.  The referenced file
will contain the text of the diff.  By default this is a temporary file that
will be deleted as soon as the pager function completes evaluation.
\code{PagerSystem} and \code{PagerSystemLess} use \code{\link{file.show}}
by default, and \code{PagerBrowser} uses
\code{\link{view_or_browse}} for HTML output.  For asynchronous pagers such
as \code{view_or_browse} it is important to make the pager function
blocking by setting the \code{make.blocking} parameter to TRUE, or to
specify a pager file path explicitly with \code{file.path}.}

\item{file.ext}{character(1L) an extension to append to file path passed to
\code{pager}, \emph{without} the period.  For example, \code{PagerBrowser}
uses \dQuote{html} to cause \code{\link{browseURL}} to launch the web
browser.  This parameter will be overridden if \code{file.path} is used.}

\item{threshold}{integer(1L) number of lines of output that triggers the use
of the pager; negative values lead to using
\code{\link{console_lines} + 1}, and zero leads to always using the pager
irrespective of how many lines the output has.}

\item{ansi}{TRUE or FALSE, whether the pager supports ANSI CSI SGR sequences.}

\item{file.path}{character(1L), if not NA the diff will be written to this
location, ignoring the value of \code{file.ext}.  If NA_character_
(default), a temporary file is used and removed after the pager function
completes evaluation.  If not NA, the file is preserved.  Beware that the
file will be overwritten if it already exists.}

\item{make.blocking}{TRUE, FALSE, or NA. Whether to wrap \code{pager} with
\code{\link{make_blocking}} prior to calling it.  This suspends R code
execution until there is user input so that temporary diff files are not
deleted before the pager has a chance to read them.  This typically
defaults to FALSE, except for \code{PagerBrowser} where it defaults to NA,
which resolves to \code{is.na(file.path)} (i.e. it is TRUE if the diff is
being written to a temporary file, and FALSE otherwise).}

\item{...}{additional arguments to pass on to \code{new} that are passed on
to parent classes.}

\item{flags}{character(1L), only for \code{PagerSystemLess}, what flags to
set with the \code{LESS} system environment variable.  By default the
\dQuote{R} flag is set to ensure ANSI escape sequences are interpreted if
it appears your terminal supports ANSI escape sequences.  If you want to
leave the output on the screen after you exit the pager you can use
\dQuote{RX}.  You should only provide the flag letters (e.g. \dQuote{"RX"},
not \code{"-RX"}).  The system variable is only modified for the duration
of the evaluation and is reset / unset afterwards. \emph{Note:} you must
specify this slot via the constructor as in the example.  If you set the
slot directly it will not have any effect.}
}
\description{
Initializers for pager configuration objects that modify pager behavior.
These objects can be used as the \code{pager} argument to the
\code{\link[=diffPrint]{diff*}} methods, or as the \code{pager} slot for
\code{\link{Style}} objects.  In this documentation we use the \dQuote{pager}
term loosely and intend it to refer to any device other than the terminal
that can be used to render output.
}
\section{Default Output Behavior}{


\code{\link[=diffPrint]{diff*}} methods use \dQuote{pagers} to help
manage large outputs and also to provide an alternative colored diff when the
terminal does not support them directly.

For OS X and *nix systems where \code{less} is the pager and the
terminal supports ANSI escape sequences, output is colored with ANSI escape
sequences.  If the output exceeds one screen height in size (as estimated by
\code{\link{console_lines}}) it is sent to the pager.

If the terminal does not support ANSI escape sequences, or if the system
pager is not \code{less} as detected by \code{\link{pager_is_less}}, then the
output is rendered in HTML and sent to the IDE viewer
(\code{getOption("viewer")}) if defined, or to the browser with
\code{\link{browseURL}} if not.  This behavior may seem sub-optimal for
systems that have ANSI aware terminals and ANSI aware pagers other than
\code{less}, but these should be rare and it is possible to configure
\code{diffobj} to produce the correct output for them (see examples).
}

\section{Pagers and Styles}{


There is a close relationship between pagers and \code{\link{Style}}.  The
\code{Style} objects control whether the output is raw text, formatted
with ANSI escape sequences, or marked up with HTML.  In order for these
different types of outputs to render properly, they need to be sent to the
right device.  For this reason \code{\link{Style}} objects come with a
\code{Pager} configuration object pre-assigned so the output can render
correctly.  The exact \code{Pager} configuration object depends on the
\code{\link{Style}} as well as the system configuration.

In any call to the \code{\link[=diffPrint]{diff*}} methods you can always
specify both the \code{\link{Style}} and \code{Pager} configuration object
directly for full control of output formatting and rendering.  We have tried
to set-up sensible defaults for most likely use cases, but given the complex
interactions involved it is possible you may need to configure things
explicitly.  Should you need to define explicit configurations you can save
them as option values with
\code{options(diffobj.pager=..., diffobj.style=...)} so that you do not need
to specify them each time you use \code{diffobj}.
}

\section{Pager Configuration Objects}{


The \code{Pager} configuration objects allow you to specify what device to
use as the pager and under what circumstances the pager should be used.
Several pre-defined pager configuration objects are available via
constructor functions:
\itemize{
  \item \code{Pager}: Generic pager just outputs directly to terminal; not
    useful unless the default parameters are modified.
  \item \code{PagerOff}: Turn off pager
  \item \code{PagerSystem}: Use the system pager as invoked by
     \code{\link{file.show}}
  \item \code{PagerSystemLess}: Like \code{PagerSystem}, but provides
     additional configuration options if the system pager is \code{less}.
     Note this object does not change the system pager; it only allows you to
     configure it via the \code{$LESS} environment variable which will have
     no effect unless the system pager is set to be \code{less}.
  \item \code{PagerBrowser}: Use \code{getOption("viewer")} if defined, or
    \code{\link{browseURL}} if not
}
The default configuration for \code{PagerSystem} and \code{PagerSystemLess}
leads to output being sent to the pager if it exceeds the estimated window
size, whereas \code{PagerBrowser} always sends output to the pager.  This
behavior can be configured via the \code{threshold} parameter.

\code{PagerSystemLess}'s primary role is to correctly configure the
\code{$LESS} system variable so that \code{less} renders the ANSI escape
sequences as intended.  On OS X \code{more} is a faux-alias to \code{less},
except it does not appear to read the \code{$LESS} system variable.
Should you configure your system pager to be the \code{more} version of
\code{less}, \code{\link{pager_is_less}} will be tricked into thinking you
are using a \dQuote{normal} version of \code{less} and you will likely end up
seeing gibberish in the pager.  If this is your use case you will need to
set-up a custom pager configuration object that sets the correct system
variables.
}

\section{Custom Pager Configurations}{


In most cases the simplest way to generate new pager configurations is to use
a list specification in the \code{\link[=diffPrint]{diff*}} call.
Alternatively you can start with an existing \code{Pager} object and change
the defaults.  Both these cases are covered in the examples.

You can change what system pager is used by \code{PagerSystem} by changing it
with \code{options(pager=...)} or by changing the \code{$PAGER} environment
variable.  You can also explicitly set a function to act as the pager when
you instantiate the \code{Pager} configuration object (see examples).

If you wish to define your own pager object you should do so by extending the
any of the \code{Pager} classes.  If the function you use to handle the
actual paging is non-blocking (i.e. allows R code evaluation to continue
after it is spawned, you should set the \code{make.blocking} parameter to
TRUE to pause execution prior to deleting the temporary file that contains
the diff.
}

\examples{
## We `dontrun` these examples as they involve pagers that should only be run
## in interactive mode
\dontrun{
## Specify Pager parameters via list; this lets the `diff*` functions pick
## their preferred pager based on format and other output parameters, but
## allows you to modify the pager behavior.

f <- tempfile()
diffChr(1:200, 180:300, format='html', pager=list(file.path=f))
head(readLines(f))  # html output
unlink(f)

## Assuming system pager is `less` and terminal supports ANSI ESC sequences
## Equivalent to running `less -RFX`

diffChr(1:200, 180:300, pager=PagerSystemLess(flags="RFX"))

## If the auto-selected pager would be the system pager, we could
## equivalently use:

diffChr(1:200, 180:300, pager=list(flags="RFX"))

## System pager is not less, but it supports ANSI escape sequences

diffChr(1:200, 180:300, pager=PagerSystem(ansi=TRUE))

## Use a custom pager, in this case we make up a trivial one and configure it
## always page (`threshold=0L`)

page.fun <- function(x) cat(paste0("| ", readLines(x)), sep="\n")
page.conf <- PagerSystem(pager=page.fun, threshold=0L)
diffChr(1:200, 180:300, pager=page.conf, disp.width=getOption("width") - 2)

## Set-up the custom pager as the default pager

options(diffobj.pager=page.conf)
diffChr(1:200, 180:300)

## A blocking pager (this is effectively very similar to what `PagerBrowser`
## does); need to block b/c otherwise temp file with diff could be deleted
## before the device has a chance to read it since `browseURL` is not
## blocking itself.  On OS X we need to specify the extension so the correct
## program opens it (in this case `TextEdit`):

page.conf <- Pager(pager=browseURL, file.ext="txt", make.blocking=TRUE)
diffChr(1:200, 180:300, pager=page.conf, format='raw')

## An alternative to a blocking pager is to disable the
## auto-file deletion; here we also specify a file location
## explicitly so we can recover the diff text.

f <- paste0(tempfile(), ".html")  # must specify .html
diffChr(1:5, 2:6, format='html', pager=list(file.path=f))
tail(readLines(f))
unlink(f)
}
}
\seealso{
\code{\link{Style}}, \code{\link{pager_is_less}}
}
diffobj/man/StyleText.Rd0000644000176200001440000000275314122754044014676 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/styles.R
\docType{class}
\name{StyleText-class}
\alias{StyleText-class}
\alias{StyleText}
\title{Character Tokens Used in Diffs}
\arguments{
\item{gutter.insert}{character(1L) text to use as visual cue to indicate
whether a diff line is an insertion, defaults to \dQuote{> }}

\item{gutter.insert.ctd}{character(1L) if a diff line is wrapped, the
visual cue shifts to this character to indicate wrapping occured}

\item{gutter.delete}{character(1L) see \code{gutter.insert} above}

\item{gutter.delete.ctd}{character(1L) see \code{gutter.insert.ctd} above}

\item{gutter.match}{character(1L) see \code{gutter.insert} above}

\item{gutter.match.ctd}{character(1L) see \code{gutter.insert.ctd} above}

\item{gutter.guide}{character(1L) see \code{gutter.insert} above}

\item{gutter.guide.ctd}{character(1L) see \code{gutter.insert.ctd} above}

\item{gutter.fill}{character(1L) see \code{gutter.insert} above}

\item{gutter.fill.ctd}{character(1L) see \code{gutter.insert.ctd} above}

\item{gutter.pad}{character(1L) separator between gutter characters and the
rest of a line in a diff}

\item{pad.col}{character(1L) separator between columns in side by side mode}
}
\value{
a StyleText S4 object
}
\description{
Various character tokens are used throughout diffs to provide visual cues.
For example, gutters will contain characters that denote deletions and
insertions (\code{<} and \code{>} by default).
}
\seealso{
\code{\link{Style}}
}
diffobj/man/guides.Rd0000644000176200001440000001166314122754044014211 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/guides.R
\name{guides}
\alias{guides}
\alias{guidesPrint,}
\alias{guidesStr,}
\alias{guidesChr,}
\alias{guidesDeparse}
\alias{guidesPrint}
\alias{guidesPrint,ANY,character-method}
\alias{guidesStr}
\alias{guidesStr,ANY,character-method}
\alias{guidesChr}
\alias{guidesChr,ANY,character-method}
\alias{guidesDeparse,ANY,character-method}
\alias{guidesFile}
\alias{guidesFile,ANY,character-method}
\title{Generic Methods to Implement Flexible Guide Line Computations}
\usage{
guidesPrint(obj, obj.as.chr)

\S4method{guidesPrint}{ANY,character}(obj, obj.as.chr)

guidesStr(obj, obj.as.chr)

\S4method{guidesStr}{ANY,character}(obj, obj.as.chr)

guidesChr(obj, obj.as.chr)

\S4method{guidesChr}{ANY,character}(obj, obj.as.chr)

guidesDeparse(obj, obj.as.chr)

\S4method{guidesDeparse}{ANY,character}(obj, obj.as.chr)

guidesFile(obj, obj.as.chr)

\S4method{guidesFile}{ANY,character}(obj, obj.as.chr)
}
\arguments{
\item{obj}{an R object}

\item{obj.as.chr}{the character representation of \code{obj} that is used
for computing the diffs}
}
\value{
integer containing values in \code{seq_along(obj.as.chr)}
}
\description{
Guides are context lines that would normally be omitted from the
diff because they are too far from any differences, but provide particularly
useful contextual information.  Column headers are a common example.
Modifying guide finding is an advanced feature intended for package
developers that want special treatment for the display output of their
objects.
}
\details{
\code{Diff} detects these important context lines by looking for patterns in
the text of the diff, and then displays these lines in addition to the
normal diff output.  Guides are marked by a tilde in the gutter, and
are typically styled differently than normal context lines, by default in
grey.  Guides may be far from the diff hunk they are juxtaposed to.  We
eschew the device of putting the guides in the hunk header as \code{git diff}
does because often the column alignment of the guide line is meaningful.

Guides are detected by the \code{guides*} methods documented here.
Each of the \code{diff*} methods (e.g. \code{\link{diffPrint}}) has a
corresponding \code{guides*} method (e.g.
\code{\link{guidesPrint}}), with the exception of \code{\link{diffCsv}}
since that method uses \code{diffPrint} internally.  The \code{guides*}
methods expect an R object as the first parameter and the captured display
representation of the object in a character vector as the second.  The
function should then identify which elements in the character representation
should be treated as guides, and should return the numeric indices for them.

The original object is passed as the first argument so that the generic can
dispatch on it, and so the methods may adjust their guide finding behavior
to data that is easily retrievable from the object, but less so from the
character representation thereof.

The default method for \code{guidesPrint} has special handling for 2D
objects (e.g. data frames, matrices), arrays, time series, tables, lists, and
S4 objects that use the default \code{show} method.  Guide finding is on a
best efforts basis and may fail if your objects contain \dQuote{pathological}
display representations.  Since the diff will still work with failed
\code{guides} finding we consider this an acceptable compromise.  Guide
finding is more likely to fail with nested recursive structures.  A known
issue is that list-like S3 objects without print methods [reset the tag
buffers](https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17610) so the
guides become less useful for them.

\code{guidesStr} highlights top level objects.  The default methods for the
other \code{guide*} generics do not do anything and exist only as a mechanism
for providing custom guide line methods.

If you dislike the default handling you can also define your own methods for
matrices, arrays, etc., or alternatively you can pass a guide finding
function directly via the \code{guides} parameter to the \code{diff*}
methods.

If you have classed objects with special patterns you can define your own
methods for them (see examples), though if your objects are S3 you will need
to use \code{\link{setOldClass}} as the \code{guides*} generics are S4.
}
\note{
The mechanism for identifying guides will almost certainly change in
  the future to allow for better handling of nested guides, so if you do
  implement custom guideline methods do so with the understanding that they
  will likely be deprecated in one of the future releases.
}
\examples{
## Roundabout way of suppressing guides for matrices
setMethod("guidesPrint", c("matrix", "character"),
  function(obj, obj.as.chr) integer(0L)
)
## Special guides for "zulu" S3 objects that match lines
## starting in "zulu###" where ### is a nuber
setOldClass("zulu")
setMethod("guidesPrint", c("zulu", "character"),
  function(obj, obj.as.chr) {
    if(length(obj) > 20) grep("^zulu[0-9]*", obj.as.chr)
    else integer(0L)
} )
}
diffobj/man/summary-Diff-method.Rd0000644000176200001440000000270214122754044016544 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/summmary.R
\name{summary,Diff-method}
\alias{summary,Diff-method}
\title{Summary Method for Diff Objects}
\usage{
\S4method{summary}{Diff}(
  object,
  scale.threshold = 0.1,
  max.lines = 50L,
  width = getOption("width"),
  ...
)
}
\arguments{
\item{object}{at \code{Diff} object}

\item{scale.threshold}{numeric(1L) between 0 and 1, how much distortion to
allow when creating the summary map, where 0 is none and 1 is as much as
needed to fit under \code{max.lines}, defaults to 0.1}

\item{max.lines}{integer(1L) how many lines to allow for the summary map,
defaults to 50}

\item{width}{integer(1L) how many columns wide the output should be, defaults
to \code{getOption("width")}}

\item{...}{unused, for compatibility with generic}
}
\value{
a \code{DiffSummary} object
## `pager="off"` for CRAN compliance; you may omit in normal use
summary(diffChr(letters, letters[-c(5, 15)], format="raw", pager="off"))
}
\description{
Provides high level count of insertions, deletions, and matches, as well as a
\dQuote{map} of where the differences are.
}
\details{
Sequences of single operations (e.g. "DDDDD") are compressed provided that
compressing them does not distort the relative size of the sequence relative
to the longest such sequence in the map by more than \code{scale.threshold}.
Since length 1 sequences cannot be further compressed \code{scale.threshold}
does not apply to them.
}
diffobj/man/view_or_browse.Rd0000644000176200001440000000126615001264550015755 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/pager.R
\name{view_or_browse}
\alias{view_or_browse}
\title{Invoke IDE Viewer If Available, browseURL If Not}
\usage{
view_or_browse(url)
}
\arguments{
\item{url}{character(1L) a location containing a file to display}
}
\value{
the return vaue of \code{getOption("viewer")} if it is a function, or
  of \code{\link{browseURL}} if the viewer is not available
}
\description{
Use \code{getOption("viewer")} to view HTML output if it is available as
per \href{https://support.posit.co/hc/en-us/articles/202133558-Extending-RStudio-with-the-Viewer-Pane}{RStudio}. Fallback to \code{\link{browseURL}}
if not available.
}
diffobj/man/summary-MyersMbaSes-method.Rd0000644000176200001440000000130114122754044020060 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/core.R
\name{summary,MyersMbaSes-method}
\alias{summary,MyersMbaSes-method}
\title{Summary Method for Shortest Edit Path}
\usage{
\S4method{summary}{MyersMbaSes}(object, with.match = FALSE, ...)
}
\arguments{
\item{object}{the \code{diff_myers} object to display}

\item{with.match}{logical(1L) whether to show what text the edit command
refers to}

\item{...}{forwarded to the data frame print method used to actually display
the data}
}
\value{
whatever the data frame print method returns
}
\description{
Displays the data required to generate the shortest edit path for comparison
between two strings.
}
\keyword{internal}
diffobj/man/show-PaletteOfStyles-method.Rd0000644000176200001440000000057314122754044020252 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/styles.R
\name{show,PaletteOfStyles-method}
\alias{show,PaletteOfStyles-method}
\title{Display a PaletteOfStyles}
\usage{
\S4method{show}{PaletteOfStyles}(object)
}
\arguments{
\item{object}{a \code{\link{PaletteOfStyles}} object}
}
\value{
NULL, invisibly
}
\description{
Display a PaletteOfStyles
}
diffobj/man/diffStr.Rd0000644000176200001440000004520315001246431014320 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/diff.R
\name{diffStr}
\alias{diffStr}
\alias{diffStr,ANY-method}
\title{Diff Object Structures}
\usage{
diffStr(target, current, ...)

\S4method{diffStr}{ANY}(
  target,
  current,
  mode = gdo("mode"),
  context = gdo("context"),
  format = gdo("format"),
  brightness = gdo("brightness"),
  color.mode = gdo("color.mode"),
  word.diff = gdo("word.diff"),
  pager = gdo("pager"),
  guides = gdo("guides"),
  trim = gdo("trim"),
  rds = gdo("rds"),
  unwrap.atomic = gdo("unwrap.atomic"),
  max.diffs = gdo("max.diffs"),
  disp.width = gdo("disp.width"),
  ignore.white.space = gdo("ignore.white.space"),
  convert.hz.white.space = gdo("convert.hz.white.space"),
  tab.stops = gdo("tab.stops"),
  line.limit = gdo("line.limit"),
  hunk.limit = gdo("hunk.limit"),
  align = gdo("align"),
  style = gdo("style"),
  palette.of.styles = gdo("palette"),
  frame = par_frame(),
  interactive = gdo("interactive"),
  term.colors = gdo("term.colors"),
  tar.banner = NULL,
  cur.banner = NULL,
  strip.sgr = gdo("strip.sgr"),
  sgr.supported = gdo("sgr.supported"),
  extra = list()
)
}
\arguments{
\item{target}{the reference object}

\item{current}{the object being compared to \code{target}}

\item{...}{unused, for compatibility of methods with generics}

\item{mode}{character(1L), one of:
\itemize{
  \item \dQuote{unified}: diff mode used by \code{git diff}
  \item \dQuote{sidebyside}: line up the differences side by side
  \item \dQuote{context}: show the target and current hunks in their
    entirety; this mode takes up a lot of screen space but makes it easier
    to see what the objects actually look like
  \item \dQuote{auto}: default mode; pick one of the above, will favor
    \dQuote{sidebyside} unless \code{getOption("width")} is less than 80,
    or in \code{diffPrint} and objects are dimensioned and do not fit side
    by side, or in \code{diffChr}, \code{diffDeparse}, \code{diffFile} and
    output does not fit in side by side without wrapping
}}

\item{context}{integer(1L) how many lines of context are shown on either side
of differences (defaults to 2).  Set to \code{-1L} to allow as many as
there are.  Set to \dQuote{auto}  to display as many as 10 lines or as few
as 1 depending on whether total screen lines fit within the number of lines
specified in \code{line.limit}.  Alternatively pass the return value of
\code{\link{auto_context}} to fine tune the parameters of the auto context
calculation.}

\item{format}{character(1L), controls the diff output format, one of:
\itemize{
  \item \dQuote{auto}: to select output format based on terminal
    capabilities; will attempt to use one of the ANSI formats if they
    appear to be supported, and if not or if you are in the Rstudio console
    it will attempt to use HTML and browser output if in interactive mode.
  \item \dQuote{raw}: plain text
  \item \dQuote{ansi8}: color and format diffs using basic ANSI escape
    sequences
  \item \dQuote{ansi256}: like \dQuote{ansi8}, except using the full range
    of ANSI formatting options
  \item \dQuote{html}: color and format using HTML markup; the resulting
    string is processed with \code{\link{enc2utf8}} when output as a full
    web page (see docs for \code{html.output} under \code{\link{Style}}).
}
Defaults to \dQuote{auto}.  See \code{palette.of.styles} for details
on customization, \code{\link{Style}} for full control of output format.
See `pager` parameter for more discussion of Rstudio behavior.}

\item{brightness}{character, one of \dQuote{light}, \dQuote{dark},
\dQuote{neutral}, useful for adjusting color scheme to light or dark
terminals.  \dQuote{neutral} by default.  See \code{\link{PaletteOfStyles}}
for details and limitations.  Advanced: you may specify brightness as a
function of \code{format}.  For example, if you typically wish to use a
\dQuote{dark} color scheme, except for when in \dQuote{html} format when
you prefer the \dQuote{light} scheme, you may use
\code{c("dark", html="light")} as the value for this parameter.  This is
particularly useful if \code{format} is set to \dQuote{auto} or if you
want to specify a default value for this parameter via options.  Any names
you use should correspond to a \code{format}.  You must have one unnamed
value which will be used as the default for all \code{format}s that are
not explicitly specified.}

\item{color.mode}{character, one of \dQuote{rgb} or \dQuote{yb}.
Defaults to \dQuote{yb}.  \dQuote{yb} stands for \dQuote{Yellow-Blue} for
color schemes that rely primarily on those colors to style diffs.
Those colors can be easily distinguished by individuals with
limited red-green color sensitivity.  See \code{\link{PaletteOfStyles}} for
details and limitations.  Also offers the same advanced usage as the
\code{brightness} parameter.}

\item{word.diff}{TRUE (default) or FALSE, whether to run a secondary word
diff on the in-hunk differences.  For atomic vectors setting this to
FALSE could make the diff \emph{slower} (see the \code{unwrap.atomic}
parameter).  For other uses, particularly with \code{\link{diffChr}}
setting this to FALSE can substantially improve performance.}

\item{pager}{one of \dQuote{auto} (default), \dQuote{on},
  \dQuote{off}, a \code{\link{Pager}} object, or a list; controls whether and
  how a pager is used to display the diff output.  If you require a
  particular pager behavior you must use a \code{\link{Pager}}
  object, or \dQuote{off} to turn off the pager.  All other settings will
  interact with other parameters such as \code{format}, \code{style}, as well
  as with your system capabilities in order to select the pager expected to
  be most useful.

  \dQuote{auto} and \dQuote{on} are the same, except that in non-interactive
  mode \dQuote{auto} is equivalent to \dQuote{off}.  \dQuote{off} will always
  send output to the console.  If \dQuote{on}, whether the output
  actually gets routed to the pager depends on the pager \code{threshold}
  setting (see \code{\link{Pager}}).  The default behavior is to use the
  pager associated with the \code{Style} object.  The \code{Style} object is
  itself is determined by the \code{format} or \code{style} parameters.

  Depending on your system configuration different styles and corresponding
  pagers will get selected, unless you specify a \code{Pager} object
  directly.  On a system with a system pager that supports ANSI CSI SGR
  colors, the pager will only trigger if the output is taller than one
  window.  If the system pager is not known to support ANSI colors then the
  output will be sent as HTML to the IDE viewer if available or to the web
  browser if not.  Even though Rstudio now supports ANSI CSI SGR at the
  console output is still formatted as HTML and sent to the IDE viewer.
  Partly this is for continuity of behavior, but also because the default
  Rstudio pager does not support ANSI CSI SGR, at least as of this writing.

  If \code{pager} is a list, then the same as with \dQuote{on}, except that
  the \code{Pager} object associated with the selected \code{Style} object is
  re-instantiated with the union of the list elements and the existing
  settings of that \code{Pager}.  The list should contain named elements that
  correspond to the \code{\link{Pager}} instantiation parameters.  The names
  must be specified in full as partial parameter matching will not be carried
  out because the pager is re-instantiated with \code{\link{new}}.

  See \code{\link{Pager}}, \code{\link{Style}}, and
  \code{\link{PaletteOfStyles}} for more details and for instructions on how
  to modify the default behavior.}

\item{guides}{TRUE (default), FALSE, or a function that accepts at least two
arguments and requires no more than two arguments.  Guides
are additional context lines that are not strictly part of a hunk, but
provide important contextual data (e.g. column headers).  If TRUE, the
context lines are shown in addition to the normal diff output, typically
in a different color to indicate they are not part of the hunk.  If a
function, the function should accept as the first argument the object
being diffed, and the second the character representation of the object.
The function should return the indices of the elements of the
character representation that should be treated as guides.  See
\code{\link{guides}} for more details.}

\item{trim}{TRUE (default), FALSE, or a function that accepts at least two
arguments and requires no more than two arguments.  Function should compute
for each line in captured output what portion of those lines should be
diffed.  By default, this is used to remove row meta data differences
(e.g. \code{[1,]}) so they alone do not show up as differences in the
diff.  See \code{\link{trim}} for more details.}

\item{rds}{TRUE (default) or FALSE, if TRUE will check whether
\code{target} and/or \code{current} point to a file that can be read with
\code{\link{readRDS}} and if so, loads the R object contained in the file
and carries out the diff on the object instead of the original argument.
Currently there is no mechanism for specifying additional arguments to
\code{readRDS}}

\item{unwrap.atomic}{TRUE (default) or FALSE.  Relevant primarily for
\code{diffPrint}, if TRUE, and \code{word.diff} is also TRUE, and both
\code{target} and \code{current} are \emph{unnamed} one-dimension atomics ,
the vectors are unwrapped and diffed element by element, and then
re-wrapped.  Since \code{diffPrint} is fundamentally a line diff, the
re-wrapped lines are lined up in a manner that is as consistent as possible
with the unwrapped diff.  Lines that contain the location of the word
differences will be paired up.  Since the vectors may well be wrapped with
different periodicities this will result in lines that are paired up that
look like they should not be paired up, though the locations of the
differences should be.  If is entirely possible that setting this parameter
to FALSE will result in a slower diff.  This happens if two vectors are
actually fairly similar, but their line representations are not.  For
example, in comparing \code{1:100} to \code{c(100, 1:99)}, there is really
only one difference at the \dQuote{word} level, but every screen line is
different.  \code{diffChr} will also do the unwrapping if it is given a
character vector that contains output that looks like the atomic vectors
described above.  This is a bug, but as the functionality could be useful
when diffing e.g. \code{capture.output} data, we now declare it a feature.}

\item{max.diffs}{integer(1L), number of \emph{differences} (default 50000L)
after which we abandon the \code{O(n^2)} diff algorithm in favor of a naive
\code{O(n)} one. Set to \code{-1L} to stick to the original algorithm up to
the maximum allowed (~INT_MAX/4).}

\item{disp.width}{integer(1L) number of display columns to take up; note that
in \dQuote{sidebyside} \code{mode} the effective display width is half this
number (set to 0L to use default widths which are \code{getOption("width")}
for normal styles and \code{80L} for HTML styles.  Future versions of
\code{diffobj} may change this to larger values for two dimensional objects
for better diffs (see details).}

\item{ignore.white.space}{TRUE or FALSE, whether to consider differences in
horizontal whitespace (i.e. spaces and tabs) as differences (defaults to
TRUE).}

\item{convert.hz.white.space}{TRUE or FALSE, whether modify input strings
that contain tabs and carriage returns in such a way that they display as
they would \bold{with} those characters, but without using those
characters (defaults to TRUE).  The conversion assumes that tab stops are
spaced evenly eight characters apart on the terminal.  If this is not the
case you may specify the tab stops explicitly with \code{tab.stops}.}

\item{tab.stops}{integer, what tab stops to use when converting hard tabs to
spaces.  If not integer will be coerced to integer (defaults to 8L).  You
may specify more than one tab stop.  If display width exceeds that
addressable by your tab stops the last tab stop will be repeated.}

\item{line.limit}{integer(2L) or integer(1L), if length 1 how many lines of
output to show, where \code{-1} means no limit.  If length 2, the first
value indicates the threshold of screen lines to begin truncating output,
and the second the number of lines to truncate to, which should be fewer
than the threshold.  Note that this parameter is implemented on a
best-efforts basis and should not be relied on to produce the exact
number of lines requested.  In particular do not expect it to work well for
for values small enough that the banner portion of the diff would have to
be trimmed.  If you want a specific number of lines use \code{[} or
\code{head} / \code{tail}.  One advantage of \code{line.limit} over these
other options is that you can combine it with \code{context="auto"} and
auto \code{max.level} selection (the latter for \code{diffStr}), which
allows the diff to dynamically adjust to make best use of the available
display lines.  \code{[}, \code{head}, and \code{tail} just subset the text
of the output.}

\item{hunk.limit}{integer(2L) or integer (1L), how many diff hunks to show.
Behaves similarly to \code{line.limit}.  How many hunks are in a
particular diff is a function of how many differences, and also how much
\code{context} is used since context can cause two hunks to bleed into
each other and become one.}

\item{align}{numeric(1L) between 0 and 1, proportion of
words in a line of \code{target} that must be matched in a line of
\code{current} in the same hunk for those lines to be paired up when
displayed (defaults to 0.25), or an \code{\link{AlignThreshold}} object.
Set to \code{1} to turn off alignment which will cause all lines in a hunk
from \code{target} to show up first, followed by all lines from
\code{current}.  Note that in order to be aligned lines must meet the
threshold and have at least 3 matching alphanumeric characters (see
\code{\link{AlignThreshold}} for details).}

\item{style}{\dQuote{auto}, a \code{\link{Style}} object, or a list.
\dQuote{auto} by default.  If a \code{Style} object, will override the
the \code{format}, \code{brightness}, and \code{color.mode} parameters.
The \code{Style} object provides full control of diff output styling.
If a list, then the same as \dQuote{auto}, except that if the auto-selected
\code{Style} requires instantiation (see \code{\link{PaletteOfStyles}}),
then the list contents will be used as arguments when instantiating the
style object.  See \code{\link{Style}} for more details, in particular the
examples.}

\item{palette.of.styles}{\code{\link{PaletteOfStyles}} object; advanced
usage, contains all the \code{\link{Style}} objects or
\dQuote{classRepresentation} objects extending \code{\link{Style}} that are
selected by specifying the \code{format}, \code{brightness}, and
\code{color.mode} parameters.  See \code{\link{PaletteOfStyles}} for more
details.}

\item{frame}{an environment to use as the evaluation frame for the
\code{print/show/str}, calls and for \code{diffObj}, the evaluation frame
for the \code{diffPrint} / \code{diffStr} calls.  Defaults to the return
value of \code{\link{par_frame}}.}

\item{interactive}{TRUE or FALSE whether the function is being run in
interactive mode, defaults to the return value of
\code{\link{interactive}}.  If in interactive mode, pager will be used if
\code{pager} is \dQuote{auto}, and if ANSI styles are not supported and
\code{style} is \dQuote{auto}, output will be send to viewer/browser as
HTML.}

\item{term.colors}{integer(1L) how many ANSI colors are supported by the
terminal.  This variable is provided for when
\code{\link[crayon:num_colors]{crayon::num_colors}} does not properly
detect how many ANSI colors are supported by your terminal. Defaults to
return value of \code{\link[crayon:num_colors]{crayon::num_colors}} and
should be 8 or 256 to allow ANSI colors, or any other number to disallow
them.  This only impacts output format selection when \code{style} and
\code{format} are both set to \dQuote{auto}.}

\item{tar.banner}{character(1L), language, or NULL, used to generate the
text to display ahead of the diff section representing the target output.
If NULL will use the deparsed \code{target} expression, if language, will
use the language as it would the \code{target} expression, if
character(1L), will use the string with no modifications.  The language
mode is provided because \code{diffStr} modifies the expression prior to
display (e.g. by wrapping it in a call to \code{str}).  Note that it is
possible in some cases that the substituted value of \code{target} actually
is character(1L), but if you provide a character(1L) value here it will be
assumed you intend to use that value literally.}

\item{cur.banner}{character(1L) like \code{tar.banner}, but for
\code{current}}

\item{strip.sgr}{TRUE, FALSE, or NULL (default), whether to strip ANSI CSI
SGR sequences prior to comparison and for display of diff.  If NULL,
resolves to TRUE if `style` resolves to an ANSI formatted diff, and
FALSE otherwise.  The default behavior is to avoid confusing diffs where
the original SGR and the SGR added by the diff are mixed together.}

\item{sgr.supported}{TRUE, FALSE, or NULL (default), whether to assume the
standard output device supports ANSI CSI SGR sequences.  If TRUE, strings
will be manipulated accounting for the SGR sequences.  If NULL,
resolves to TRUE if `style` resolves to an ANSI formatted diff, and
to `crayon::has_color()` otherwise.  This only controls how the strings are
manipulated, not whether SGR is added to format the diff, which is
controlled by the `style` parameter.  This parameter is exposed for the
rare cases where you might wish to control string manipulation behavior
directly.}

\item{extra}{list additional arguments to pass on to the functions used to
create text representation of the objects to diff (e.g. \code{print},
\code{str}, etc.)}
}
\value{
a \code{Diff} object; see \code{\link{diffPrint}}.
}
\description{
Compares the \code{str} output of \code{target} and \code{current}.  If
the \code{max.level} parameter to \code{str} is left unspecified, will
attempt to find the largest \code{max.level} that fits within
\code{line.limit} and shows at least one difference.
}
\details{
Due to the seemingly inconsistent nature of \code{max.level} when used with
objects with nested attributes, and also due to the relative slowness of
\code{str}, this function simulates the effect of \code{max.level} by hiding
nested lines instead of repeatedly calling \code{str} with varying values of
\code{max.level}.
}
\examples{
## `pager="off"` for CRAN compliance; you may omit in normal use
with(mtcars, diffStr(lm(mpg ~ hp)$qr, lm(mpg ~ disp)$qr, pager="off"))
}
\seealso{
\code{\link{diffPrint}} for details on the \code{diff*} functions,
  \code{\link{diffObj}}, \code{\link{diffStr}},
  \code{\link{diffChr}} to compare character vectors directly,
  \code{\link{diffDeparse}} to compare deparsed objects,
  \code{\link{ses}} for a minimal and fast diff
}
diffobj/man/as.character-DiffSummary-method.Rd0000644000176200001440000000121714122754044020763 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/summmary.R
\name{as.character,DiffSummary-method}
\alias{as.character,DiffSummary-method}
\title{Generate Character Representation of DiffSummary Object}
\usage{
\S4method{as.character}{DiffSummary}(x, ...)
}
\arguments{
\item{x}{a \code{DiffSummary} object}

\item{...}{not used, for compatibility with generic}
}
\value{
the summary as a character vector intended to be \code{cat}ed to
  terminal
}
\description{
Generate Character Representation of DiffSummary Object
}
\examples{
as.character(
  summary(diffChr(letters, letters[-c(5, 15)], format="raw", pager="off"))
)
}
diffobj/man/tag_f.Rd0000644000176200001440000000341114122754044014001 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/html.R
\name{tag_f}
\alias{tag_f}
\alias{div_f,}
\alias{span_f,}
\alias{cont_f}
\alias{div_f}
\alias{span_f}
\title{Make Functions That Wrap Text in HTML Tags}
\usage{
tag_f(tag, class = character(), style = character())

div_f(class = character(), style = character())

span_f(class = character(), style = character())

cont_f(class = character())
}
\arguments{
\item{tag}{character(1L) a name of an HTML tag}

\item{class}{character the CSS class(es)}

\item{style}{named character inline styles, where the name is the CSS
property and the value the value.}
}
\value{
a function that accepts a character parameter.  If applied, each
  element in the character vector will be wrapped in the div tags
}
\description{
Helper functions to generate functions to use as slots for the
\code{StyleHtml@funs} classes.  These are functions that return
\emph{functions}.
}
\details{
\code{tag_f} and related functions (\code{div_f}, \code{span_f}) produce
functions that are  vectorized and will apply opening and closing tags to
each element of a character vector.  \code{container_f} on the other hand
produces a function will collapse a character vector into length 1, and only
then applies the tags.  Additionally, \code{container_f} already comes with
the \dQuote{diffobj-container} class specified.
}
\note{
inputs are assumed to be valid class names or CSS styles.
}
\examples{
## Assuming class 'ex1' has CSS styles defined elsewhere
tag_f("div", "ex1")(LETTERS[1:5])
## Use convenience function, and add some inline styles
div_f("ex2", c(color="green", `font-family`="arial"))(LETTERS[1:5])
## Notice how this is a div with pre-specifed class,
## and only one div is created around the entire data
cont_f()(LETTERS[1:5])
}
diffobj/man/diffPrint.Rd0000644000176200001440000005141415001246431014645 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/diff.R
\name{diffPrint}
\alias{diffPrint}
\alias{diffPrint,ANY-method}
\title{Diff \code{print}ed Objects}
\usage{
diffPrint(target, current, ...)

\S4method{diffPrint}{ANY}(
  target,
  current,
  mode = gdo("mode"),
  context = gdo("context"),
  format = gdo("format"),
  brightness = gdo("brightness"),
  color.mode = gdo("color.mode"),
  word.diff = gdo("word.diff"),
  pager = gdo("pager"),
  guides = gdo("guides"),
  trim = gdo("trim"),
  rds = gdo("rds"),
  unwrap.atomic = gdo("unwrap.atomic"),
  max.diffs = gdo("max.diffs"),
  disp.width = gdo("disp.width"),
  ignore.white.space = gdo("ignore.white.space"),
  convert.hz.white.space = gdo("convert.hz.white.space"),
  tab.stops = gdo("tab.stops"),
  line.limit = gdo("line.limit"),
  hunk.limit = gdo("hunk.limit"),
  align = gdo("align"),
  style = gdo("style"),
  palette.of.styles = gdo("palette"),
  frame = par_frame(),
  interactive = gdo("interactive"),
  term.colors = gdo("term.colors"),
  tar.banner = NULL,
  cur.banner = NULL,
  strip.sgr = gdo("strip.sgr"),
  sgr.supported = gdo("sgr.supported"),
  extra = list()
)
}
\arguments{
\item{target}{the reference object}

\item{current}{the object being compared to \code{target}}

\item{...}{unused, for compatibility of methods with generics}

\item{mode}{character(1L), one of:
\itemize{
  \item \dQuote{unified}: diff mode used by \code{git diff}
  \item \dQuote{sidebyside}: line up the differences side by side
  \item \dQuote{context}: show the target and current hunks in their
    entirety; this mode takes up a lot of screen space but makes it easier
    to see what the objects actually look like
  \item \dQuote{auto}: default mode; pick one of the above, will favor
    \dQuote{sidebyside} unless \code{getOption("width")} is less than 80,
    or in \code{diffPrint} and objects are dimensioned and do not fit side
    by side, or in \code{diffChr}, \code{diffDeparse}, \code{diffFile} and
    output does not fit in side by side without wrapping
}}

\item{context}{integer(1L) how many lines of context are shown on either side
of differences (defaults to 2).  Set to \code{-1L} to allow as many as
there are.  Set to \dQuote{auto}  to display as many as 10 lines or as few
as 1 depending on whether total screen lines fit within the number of lines
specified in \code{line.limit}.  Alternatively pass the return value of
\code{\link{auto_context}} to fine tune the parameters of the auto context
calculation.}

\item{format}{character(1L), controls the diff output format, one of:
\itemize{
  \item \dQuote{auto}: to select output format based on terminal
    capabilities; will attempt to use one of the ANSI formats if they
    appear to be supported, and if not or if you are in the Rstudio console
    it will attempt to use HTML and browser output if in interactive mode.
  \item \dQuote{raw}: plain text
  \item \dQuote{ansi8}: color and format diffs using basic ANSI escape
    sequences
  \item \dQuote{ansi256}: like \dQuote{ansi8}, except using the full range
    of ANSI formatting options
  \item \dQuote{html}: color and format using HTML markup; the resulting
    string is processed with \code{\link{enc2utf8}} when output as a full
    web page (see docs for \code{html.output} under \code{\link{Style}}).
}
Defaults to \dQuote{auto}.  See \code{palette.of.styles} for details
on customization, \code{\link{Style}} for full control of output format.
See `pager` parameter for more discussion of Rstudio behavior.}

\item{brightness}{character, one of \dQuote{light}, \dQuote{dark},
\dQuote{neutral}, useful for adjusting color scheme to light or dark
terminals.  \dQuote{neutral} by default.  See \code{\link{PaletteOfStyles}}
for details and limitations.  Advanced: you may specify brightness as a
function of \code{format}.  For example, if you typically wish to use a
\dQuote{dark} color scheme, except for when in \dQuote{html} format when
you prefer the \dQuote{light} scheme, you may use
\code{c("dark", html="light")} as the value for this parameter.  This is
particularly useful if \code{format} is set to \dQuote{auto} or if you
want to specify a default value for this parameter via options.  Any names
you use should correspond to a \code{format}.  You must have one unnamed
value which will be used as the default for all \code{format}s that are
not explicitly specified.}

\item{color.mode}{character, one of \dQuote{rgb} or \dQuote{yb}.
Defaults to \dQuote{yb}.  \dQuote{yb} stands for \dQuote{Yellow-Blue} for
color schemes that rely primarily on those colors to style diffs.
Those colors can be easily distinguished by individuals with
limited red-green color sensitivity.  See \code{\link{PaletteOfStyles}} for
details and limitations.  Also offers the same advanced usage as the
\code{brightness} parameter.}

\item{word.diff}{TRUE (default) or FALSE, whether to run a secondary word
diff on the in-hunk differences.  For atomic vectors setting this to
FALSE could make the diff \emph{slower} (see the \code{unwrap.atomic}
parameter).  For other uses, particularly with \code{\link{diffChr}}
setting this to FALSE can substantially improve performance.}

\item{pager}{one of \dQuote{auto} (default), \dQuote{on},
  \dQuote{off}, a \code{\link{Pager}} object, or a list; controls whether and
  how a pager is used to display the diff output.  If you require a
  particular pager behavior you must use a \code{\link{Pager}}
  object, or \dQuote{off} to turn off the pager.  All other settings will
  interact with other parameters such as \code{format}, \code{style}, as well
  as with your system capabilities in order to select the pager expected to
  be most useful.

  \dQuote{auto} and \dQuote{on} are the same, except that in non-interactive
  mode \dQuote{auto} is equivalent to \dQuote{off}.  \dQuote{off} will always
  send output to the console.  If \dQuote{on}, whether the output
  actually gets routed to the pager depends on the pager \code{threshold}
  setting (see \code{\link{Pager}}).  The default behavior is to use the
  pager associated with the \code{Style} object.  The \code{Style} object is
  itself is determined by the \code{format} or \code{style} parameters.

  Depending on your system configuration different styles and corresponding
  pagers will get selected, unless you specify a \code{Pager} object
  directly.  On a system with a system pager that supports ANSI CSI SGR
  colors, the pager will only trigger if the output is taller than one
  window.  If the system pager is not known to support ANSI colors then the
  output will be sent as HTML to the IDE viewer if available or to the web
  browser if not.  Even though Rstudio now supports ANSI CSI SGR at the
  console output is still formatted as HTML and sent to the IDE viewer.
  Partly this is for continuity of behavior, but also because the default
  Rstudio pager does not support ANSI CSI SGR, at least as of this writing.

  If \code{pager} is a list, then the same as with \dQuote{on}, except that
  the \code{Pager} object associated with the selected \code{Style} object is
  re-instantiated with the union of the list elements and the existing
  settings of that \code{Pager}.  The list should contain named elements that
  correspond to the \code{\link{Pager}} instantiation parameters.  The names
  must be specified in full as partial parameter matching will not be carried
  out because the pager is re-instantiated with \code{\link{new}}.

  See \code{\link{Pager}}, \code{\link{Style}}, and
  \code{\link{PaletteOfStyles}} for more details and for instructions on how
  to modify the default behavior.}

\item{guides}{TRUE (default), FALSE, or a function that accepts at least two
arguments and requires no more than two arguments.  Guides
are additional context lines that are not strictly part of a hunk, but
provide important contextual data (e.g. column headers).  If TRUE, the
context lines are shown in addition to the normal diff output, typically
in a different color to indicate they are not part of the hunk.  If a
function, the function should accept as the first argument the object
being diffed, and the second the character representation of the object.
The function should return the indices of the elements of the
character representation that should be treated as guides.  See
\code{\link{guides}} for more details.}

\item{trim}{TRUE (default), FALSE, or a function that accepts at least two
arguments and requires no more than two arguments.  Function should compute
for each line in captured output what portion of those lines should be
diffed.  By default, this is used to remove row meta data differences
(e.g. \code{[1,]}) so they alone do not show up as differences in the
diff.  See \code{\link{trim}} for more details.}

\item{rds}{TRUE (default) or FALSE, if TRUE will check whether
\code{target} and/or \code{current} point to a file that can be read with
\code{\link{readRDS}} and if so, loads the R object contained in the file
and carries out the diff on the object instead of the original argument.
Currently there is no mechanism for specifying additional arguments to
\code{readRDS}}

\item{unwrap.atomic}{TRUE (default) or FALSE.  Relevant primarily for
\code{diffPrint}, if TRUE, and \code{word.diff} is also TRUE, and both
\code{target} and \code{current} are \emph{unnamed} one-dimension atomics ,
the vectors are unwrapped and diffed element by element, and then
re-wrapped.  Since \code{diffPrint} is fundamentally a line diff, the
re-wrapped lines are lined up in a manner that is as consistent as possible
with the unwrapped diff.  Lines that contain the location of the word
differences will be paired up.  Since the vectors may well be wrapped with
different periodicities this will result in lines that are paired up that
look like they should not be paired up, though the locations of the
differences should be.  If is entirely possible that setting this parameter
to FALSE will result in a slower diff.  This happens if two vectors are
actually fairly similar, but their line representations are not.  For
example, in comparing \code{1:100} to \code{c(100, 1:99)}, there is really
only one difference at the \dQuote{word} level, but every screen line is
different.  \code{diffChr} will also do the unwrapping if it is given a
character vector that contains output that looks like the atomic vectors
described above.  This is a bug, but as the functionality could be useful
when diffing e.g. \code{capture.output} data, we now declare it a feature.}

\item{max.diffs}{integer(1L), number of \emph{differences} (default 50000L)
after which we abandon the \code{O(n^2)} diff algorithm in favor of a naive
\code{O(n)} one. Set to \code{-1L} to stick to the original algorithm up to
the maximum allowed (~INT_MAX/4).}

\item{disp.width}{integer(1L) number of display columns to take up; note that
in \dQuote{sidebyside} \code{mode} the effective display width is half this
number (set to 0L to use default widths which are \code{getOption("width")}
for normal styles and \code{80L} for HTML styles.  Future versions of
\code{diffobj} may change this to larger values for two dimensional objects
for better diffs (see details).}

\item{ignore.white.space}{TRUE or FALSE, whether to consider differences in
horizontal whitespace (i.e. spaces and tabs) as differences (defaults to
TRUE).}

\item{convert.hz.white.space}{TRUE or FALSE, whether modify input strings
that contain tabs and carriage returns in such a way that they display as
they would \bold{with} those characters, but without using those
characters (defaults to TRUE).  The conversion assumes that tab stops are
spaced evenly eight characters apart on the terminal.  If this is not the
case you may specify the tab stops explicitly with \code{tab.stops}.}

\item{tab.stops}{integer, what tab stops to use when converting hard tabs to
spaces.  If not integer will be coerced to integer (defaults to 8L).  You
may specify more than one tab stop.  If display width exceeds that
addressable by your tab stops the last tab stop will be repeated.}

\item{line.limit}{integer(2L) or integer(1L), if length 1 how many lines of
output to show, where \code{-1} means no limit.  If length 2, the first
value indicates the threshold of screen lines to begin truncating output,
and the second the number of lines to truncate to, which should be fewer
than the threshold.  Note that this parameter is implemented on a
best-efforts basis and should not be relied on to produce the exact
number of lines requested.  In particular do not expect it to work well for
for values small enough that the banner portion of the diff would have to
be trimmed.  If you want a specific number of lines use \code{[} or
\code{head} / \code{tail}.  One advantage of \code{line.limit} over these
other options is that you can combine it with \code{context="auto"} and
auto \code{max.level} selection (the latter for \code{diffStr}), which
allows the diff to dynamically adjust to make best use of the available
display lines.  \code{[}, \code{head}, and \code{tail} just subset the text
of the output.}

\item{hunk.limit}{integer(2L) or integer (1L), how many diff hunks to show.
Behaves similarly to \code{line.limit}.  How many hunks are in a
particular diff is a function of how many differences, and also how much
\code{context} is used since context can cause two hunks to bleed into
each other and become one.}

\item{align}{numeric(1L) between 0 and 1, proportion of
words in a line of \code{target} that must be matched in a line of
\code{current} in the same hunk for those lines to be paired up when
displayed (defaults to 0.25), or an \code{\link{AlignThreshold}} object.
Set to \code{1} to turn off alignment which will cause all lines in a hunk
from \code{target} to show up first, followed by all lines from
\code{current}.  Note that in order to be aligned lines must meet the
threshold and have at least 3 matching alphanumeric characters (see
\code{\link{AlignThreshold}} for details).}

\item{style}{\dQuote{auto}, a \code{\link{Style}} object, or a list.
\dQuote{auto} by default.  If a \code{Style} object, will override the
the \code{format}, \code{brightness}, and \code{color.mode} parameters.
The \code{Style} object provides full control of diff output styling.
If a list, then the same as \dQuote{auto}, except that if the auto-selected
\code{Style} requires instantiation (see \code{\link{PaletteOfStyles}}),
then the list contents will be used as arguments when instantiating the
style object.  See \code{\link{Style}} for more details, in particular the
examples.}

\item{palette.of.styles}{\code{\link{PaletteOfStyles}} object; advanced
usage, contains all the \code{\link{Style}} objects or
\dQuote{classRepresentation} objects extending \code{\link{Style}} that are
selected by specifying the \code{format}, \code{brightness}, and
\code{color.mode} parameters.  See \code{\link{PaletteOfStyles}} for more
details.}

\item{frame}{an environment to use as the evaluation frame for the
\code{print/show/str}, calls and for \code{diffObj}, the evaluation frame
for the \code{diffPrint} / \code{diffStr} calls.  Defaults to the return
value of \code{\link{par_frame}}.}

\item{interactive}{TRUE or FALSE whether the function is being run in
interactive mode, defaults to the return value of
\code{\link{interactive}}.  If in interactive mode, pager will be used if
\code{pager} is \dQuote{auto}, and if ANSI styles are not supported and
\code{style} is \dQuote{auto}, output will be send to viewer/browser as
HTML.}

\item{term.colors}{integer(1L) how many ANSI colors are supported by the
terminal.  This variable is provided for when
\code{\link[crayon:num_colors]{crayon::num_colors}} does not properly
detect how many ANSI colors are supported by your terminal. Defaults to
return value of \code{\link[crayon:num_colors]{crayon::num_colors}} and
should be 8 or 256 to allow ANSI colors, or any other number to disallow
them.  This only impacts output format selection when \code{style} and
\code{format} are both set to \dQuote{auto}.}

\item{tar.banner}{character(1L), language, or NULL, used to generate the
text to display ahead of the diff section representing the target output.
If NULL will use the deparsed \code{target} expression, if language, will
use the language as it would the \code{target} expression, if
character(1L), will use the string with no modifications.  The language
mode is provided because \code{diffStr} modifies the expression prior to
display (e.g. by wrapping it in a call to \code{str}).  Note that it is
possible in some cases that the substituted value of \code{target} actually
is character(1L), but if you provide a character(1L) value here it will be
assumed you intend to use that value literally.}

\item{cur.banner}{character(1L) like \code{tar.banner}, but for
\code{current}}

\item{strip.sgr}{TRUE, FALSE, or NULL (default), whether to strip ANSI CSI
SGR sequences prior to comparison and for display of diff.  If NULL,
resolves to TRUE if `style` resolves to an ANSI formatted diff, and
FALSE otherwise.  The default behavior is to avoid confusing diffs where
the original SGR and the SGR added by the diff are mixed together.}

\item{sgr.supported}{TRUE, FALSE, or NULL (default), whether to assume the
standard output device supports ANSI CSI SGR sequences.  If TRUE, strings
will be manipulated accounting for the SGR sequences.  If NULL,
resolves to TRUE if `style` resolves to an ANSI formatted diff, and
to `crayon::has_color()` otherwise.  This only controls how the strings are
manipulated, not whether SGR is added to format the diff, which is
controlled by the `style` parameter.  This parameter is exposed for the
rare cases where you might wish to control string manipulation behavior
directly.}

\item{extra}{list additional arguments to pass on to the functions used to
create text representation of the objects to diff (e.g. \code{print},
\code{str}, etc.)}
}
\value{
a \code{Diff} object; this object has a \code{show}
  method that will display the diff to screen or pager, as well as
  \code{summary}, \code{any}, and \code{as.character} methods.
  If you store the return value instead of displaying it to screen, and
  display it later, it is possible for the display to be thrown off if
  there are environment changes (e.g. display width changes) in between
  the time you compute the diff and the time you display it.
}
\description{
Runs the diff between the \code{print} or \code{show} output produced by
\code{target} and \code{current}.  Given the extensive parameter list, this
documentation page is intended as a reference for all the \code{diff*}
methods.  For a high level introduction see \code{vignette("diffobj")}.
}
\details{
Almost all aspects of how the diffs are computed and displayed are
controllable through the \code{diff*} methods parameters.  This results in a
lengthy parameter list, but in practice you should rarely need to adjust
anything past the \code{color.mode} parameter.  Default values are specified
as options so that users may configure diffs in a persistent manner.
\code{\link{gdo}} is a shorthand function to access \code{diffobj} options.
Examples of what you aspects of the display you can control include many of
the basic adjustment offered by traditional diff programs, color schemes,
panel headers/titles, and more.

Parameter order after \code{color.mode} is not guaranteed.  Future versions
of \code{diffobj} may add parameters and re-order existing parameters past
\code{color.mode}.

This and other \code{diff*} functions are S4 generics that dispatch on the
\code{target} and \code{current} parameters.  Methods with signature
\code{c("ANY", "ANY")} are defined and act as the default methods.  You can
use this to set up methods to pre-process or set specific parameters for
selected classes that can then \code{callNextMethod} for the actual diff.
Note that while the generics include \code{...} as an argument, none of the
methods do.

Strings are re-encoded to UTF-8 with \code{\link{enc2utf8}} prior to
comparison to avoid encoding-only differences.

The text representation of `target` and `current` should each have no more
than ~INT_MAX/4 lines.
}
\section{Matrices and Data Frames}{


While \code{diffPrint} attempts to handle the default R behavior that wraps
wide tables, the results are often sub-optimal.  A better approach is to set
the \code{disp.width} parameter to a large enough value such that wrapping is
not necessary, and a browser-based \code{pager}.  If this bothers  you see
\href{https://github.com/brodieG/diffobj/issues/109}{issue 109}.

\code{diffPrint} is not designed to work with large data frames.
}

\examples{
## `pager="off"` for CRAN compliance; you may omit in normal use
old.opt <- options(diffobj.pager='off'); on.exit(old.opt)

diffPrint(letters, letters[-5])

## Change the default banner/title
diffPrint(
  letters, letters[-5],
  tar.banner='COMPLETE', cur.banner='INCOMPLETE'
)
}
\seealso{
\code{\link{diffObj}}, \code{\link{diffStr}},
  \code{\link{diffChr}} to compare character vectors directly,
  \code{\link{diffDeparse}} to compare deparsed objects, \code{\link{ses}}
  for a minimal and fast diff @param target the reference object
}
diffobj/man/PaletteOfStyles-class.Rd0000644000176200001440000001210314122754044017111 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/styles.R
\docType{class}
\name{PaletteOfStyles-class}
\alias{PaletteOfStyles-class}
\alias{PaletteOfStyles}
\title{Class for Tracking Default Styles by Style Type}
\description{
Provides a mechanism for specifying a style based on the style properties
along dimensions of format, brightness, and color.  This allows a user to
request a style that meets a certain description (e.g. a \dQuote{light}
scheme in \dQuote{ansi256} format), without having to provide a specific
\code{\link{Style}} object.
}
\section{An Array of Styles}{


A \code{PaletteOfStyles} object is an \dQuote{array} containing either
\dQuote{classRepresentation} objects that extend \code{StyleHtml} or are
instances of objects that inherit from \code{StyleHtml}.  The \code{diff*}
methods then pick an object/class from this array based on the values of
the \code{format}, \code{brightness}, and \code{color.mode} parameters.

For the most part the distinction between actual \code{Style} objects vs
\dQuote{classRepresentation} ones is academic, except that with the latter
you can control the instantiation by providing a parameter list as the
\code{style} argument to the \code{diff*} methods. This is not an option with
already instantiated objects.  See examples.
}

\section{Dimensions}{


There are three general orthogonal dimensions of styles that can be used when
rendering diffs: the type of format, the \dQuote{brightness} of the output,
and whether the colors used are distinguishable if you assume reds and greens
are not distinguishable.  Defaults for the intersections each of these
dimensions are encoded as a three dimensional list.  This list is just an
atomic vector of type \dQuote{list} with a length 3 \code{dim} attribute.

The array/list dimensions are:
\itemize{
  \item \code{format}: the format type, one of \dQuote{raw},
    \dQuote{ansi8}, \dQuote{ansi256}, or \dQuote{html}
  \item \code{brightness}: whether the colors are bright or not, which
    allows user to chose a scheme that is compatible with their console,
    one of: \dQuote{light}, \dQuote{dark}, \dQuote{normal}
  \item \code{color.mode}: \dQuote{rgb} for full color or \dQuote{yb} for
    dichromats (yb stands for Yellow Blue).
}

Each of these dimensions can be specified directly via the corresponding
parameters to the \code{diff*} methods.
}

\section{Methods}{


\code{PaletteOfStyles} objects have The following methods implemented:
\itemize{
  \item \code{[}, \code{[<-}, \code{[[}
  \item show
  \item summary
  \item dimnames
}
}

\section{Structural Details}{


The array/list is stored in the \code{data} slot of
\code{PaletteOfStyles} objects.  Subsetting methods are provided so you
may operate directly on the S4 object as you would on a regular array.

The array/list must be fully populated with objects that are or inherit
\code{Style}, or are \dQuote{classRepresentation} objects (i.e. those of
the type returned by \code{\link{getClassDef}}) that extend \code{Style}.
By default the array is populated only with \dQuote{classRepresentation}
objects as that allows the list form of the \code{style} parameter to the
\code{diff*} methods.  If there is a particular combination of coordinates
that does not have a corresponding defined style a reasonable substitution
must be provided.  For example, this package only defines \dQuote{light}
HTML styles, so it simply uses that style for all the possible
\code{brightness} values.

There is no explicit check that the objects in the list comply with the
descriptions implied by their coordinates, although the default object
provided by the package does comply for the most part.  One check that is
carried out is that any element that has a \dQuote{html} value in the
\code{format} dimension extends \code{StyleHtml}.

While the list may only have the three dimensions described, you can add
values to the dimensions provided the values described above are the first
ones in each of their corresponding dimensions.  For example, if you wanted
to allow for styles that would render in \code{grid} graphics, you could
generate a default list with a \dQuote{"grid"} value appended to the values
of the \code{format} dimension.
}

\examples{
\dontrun{
## Look at all "ansi256" styles (assumes compatible terminal)
PaletteOfStyles()["ansi256",,]
}
## Generate the default style object palette, and replace
## the ansi256 / light / rgb style with our modified one
## which for illustrative purposes is the raw style
my.pal <- PaletteOfStyles()
my.style <- StyleRaw()   # See `?Style` for custom styles
my.style@funs@word.delete <- function(x) sprintf("--\%s--", x)
my.pal["ansi256", "light", "rgb"] <- list(my.style) # note `list()`
## Output has no format now for format/color.mode/brightness
## we modified ...
## `pager="off"` for CRAN compliance; you may omit in normal use
diffPrint(
   1:3, 2:5, format="ansi256", color.mode="rgb", brightness="light",
   palette.of.styles=my.pal, pager="off", disp.width=80
)
## If so desired, set our new style palette as the default
## one; could also pass directly as argument to `diff*` funs
\dontrun{
options(diffobj.palette=defs)
}
}
diffobj/man/Extract_PaletteOfStyles.Rd0000644000176200001440000000300614122754044017502 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/styles.R
\name{[<-,PaletteOfStyles-method}
\alias{[<-,PaletteOfStyles-method}
\alias{[,PaletteOfStyles,ANY,ANY,ANY-method}
\alias{[[,PaletteOfStyles-method}
\title{Extract/Replace a Style Class or Object from PaletteOfStyles}
\usage{
\S4method{[}{PaletteOfStyles}(x, i, j, ...) <- value

\S4method{[}{PaletteOfStyles,ANY,ANY,ANY}(x, i, j, ..., drop = FALSE)

\S4method{[[}{PaletteOfStyles}(x, i, j, ..., exact = TRUE)
}
\arguments{
\item{x}{a \code{\link{PaletteOfStyles}} object}

\item{i}{numeric, or character corresponding to a valid style \code{format}}

\item{j}{numeric, or character corresponding to a valid style
\code{brightness}}

\item{...}{pass a numeric or character corresponding to a valid
\code{color.mode}}

\item{value}{a \emph{list} of \code{\link{Style}} class or
\code{\link{Style}} objects}

\item{drop}{TRUE or FALSE, whether to drop dimensions, defaults to FALSE,
which is different than generic}

\item{exact}{passed on to generic}
}
\value{
a \code{\link{Style}} \code{ClassRepresentation} object or
   \code{\link{Style}} object for \code{[[}, and a list of the same for
   \code{[}
}
\description{
Extract/Replace a Style Class or Object from PaletteOfStyles
}
\examples{
pal <- PaletteOfStyles()
pal[["ansi256", "light", "rgb"]]
pal["ansi256", "light", ]
pal["ansi256", "light", "rgb"] <- list(StyleAnsi8NeutralRgb())
}
\seealso{
\code{\link{diffPrint}} for explanations of \code{format},
  \code{brightness}, and \code{color.mode}
}
diffobj/man/AlignThreshold-class.Rd0000644000176200001440000000302214122754044016731 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/s4.R
\docType{class}
\name{AlignThreshold-class}
\alias{AlignThreshold-class}
\alias{AlignThreshold}
\title{Controls How Lines Within a Diff Hunk Are Aligned}
\description{
Controls How Lines Within a Diff Hunk Are Aligned
}
\section{Slots}{

\describe{
\item{\code{threshold}}{numeric(1L) between 0 and 1, what proportion of words
in the lines must match in order to align them.  Set to 1 to effectively
turn aligning off.  Defaults to 0.25.}

\item{\code{min.chars}}{integer(1L) positive, minimum number of characters that must
match across lines in order to align them.  This requirement is in addition
to \code{threshold} and helps minimize spurious alignments.  Defaults to
3.}

\item{\code{count.alnum.only}}{logical(1L) modifier for \code{min.chars}, whether to
count alpha numeric characters only.  Helps reduce spurious alignment
caused by meta character sequences such as \dQuote{[[1]]} that would
otherwise meet the \code{min.chars} limit}
}}

\examples{
a1 <- AlignThreshold(threshold=0)
a2 <- AlignThreshold(threshold=1)
a3 <- AlignThreshold(threshold=0, min.chars=2)
## Note how "e f g" is aligned
diffChr(c("a b c e", "d e f g"), "D e f g", align=a1, pager="off")
## But now it is not
diffChr(c("a b c e", "d e f g"), "D e f g", align=a2, pager="off")
## "e f" are not enough chars to align
diffChr(c("a b c", "d e f"), "D e f", align=a1, pager="off")
## Override with min.chars, so now they align
diffChr(c("a b c", "d e f"), "D e f", align=a3, pager="off")
}
diffobj/man/diff_myers.Rd0000644000176200001440000000404515001264550015047 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/core.R
\name{diff_myers}
\alias{diff_myers}
\title{Diff two character vectors}
\usage{
diff_myers(a, b, max.diffs = -1L, warn = FALSE)
}
\arguments{
\item{a}{character}

\item{b}{character}

\item{max.diffs}{integer(1L) how many differences before giving up; set to
-1 to allow as many as there are up to the maximum allowed (~INT_MAX/4).}

\item{warn}{TRUE or FALSE, whether to warn if we hit `max.diffs`.}
}
\value{
MyersMbaSes object
}
\description{
Implementation of Myer's Diff algorithm with linear space refinement
originally implemented by Mike B. Allen as part of
\href{https://www.ioplex.com/~miallen/libmba/}{libmba}
version 0.9.1.  This implementation is a heavily modified version of the
original C code and is not compatible with the \code{libmba} library.
The C code is simplified by using fixed size arrays instead of variable
ones for tracking the longest reaching paths and for recording the shortest
edit scripts.  Additionally all error handling and memory allocation calls
have been moved to the internal R functions designed to handle those things.
A failover result is provided in the case where max diffs allowed is
exceeded.  Ability to provide custom comparison functions is removed.
}
\details{
The result format indicates operations required to convert \code{a} into
\code{b} in a precursor format to the GNU diff shortest edit script.  The
operations are \dQuote{Match} (do nothing), \dQuote{Insert} (insert one or
more values of \code{b} into \code{a}), and \dQuote{Delete} (remove one or
more values from \code{a}).  The \code{length} slot dictates how
many values to advance along, insert into, or delete from \code{a}.  The
\code{offset} slot changes meaning depending on the operation.  For
\dQuote{Match} and \dQuote{Delete}, it is the starting index of that
operation in \code{a}.  For \dQuote{Insert}, it is the starting index in
\code{b} of the values to insert into \code{a}; the index in \code{a} to
insert at is implicit in previous operations.
}
\keyword{internal}
diffobj/man/diffChr.Rd0000644000176200001440000004446315001246431014273 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/diff.R
\name{diffChr}
\alias{diffChr}
\alias{diffChr,ANY-method}
\title{Diff Character Vectors Element By Element}
\usage{
diffChr(target, current, ...)

\S4method{diffChr}{ANY}(
  target,
  current,
  mode = gdo("mode"),
  context = gdo("context"),
  format = gdo("format"),
  brightness = gdo("brightness"),
  color.mode = gdo("color.mode"),
  word.diff = gdo("word.diff"),
  pager = gdo("pager"),
  guides = gdo("guides"),
  trim = gdo("trim"),
  rds = gdo("rds"),
  unwrap.atomic = gdo("unwrap.atomic"),
  max.diffs = gdo("max.diffs"),
  disp.width = gdo("disp.width"),
  ignore.white.space = gdo("ignore.white.space"),
  convert.hz.white.space = gdo("convert.hz.white.space"),
  tab.stops = gdo("tab.stops"),
  line.limit = gdo("line.limit"),
  hunk.limit = gdo("hunk.limit"),
  align = gdo("align"),
  style = gdo("style"),
  palette.of.styles = gdo("palette"),
  frame = par_frame(),
  interactive = gdo("interactive"),
  term.colors = gdo("term.colors"),
  tar.banner = NULL,
  cur.banner = NULL,
  strip.sgr = gdo("strip.sgr"),
  sgr.supported = gdo("sgr.supported"),
  extra = list()
)
}
\arguments{
\item{target}{the reference object}

\item{current}{the object being compared to \code{target}}

\item{...}{unused, for compatibility of methods with generics}

\item{mode}{character(1L), one of:
\itemize{
  \item \dQuote{unified}: diff mode used by \code{git diff}
  \item \dQuote{sidebyside}: line up the differences side by side
  \item \dQuote{context}: show the target and current hunks in their
    entirety; this mode takes up a lot of screen space but makes it easier
    to see what the objects actually look like
  \item \dQuote{auto}: default mode; pick one of the above, will favor
    \dQuote{sidebyside} unless \code{getOption("width")} is less than 80,
    or in \code{diffPrint} and objects are dimensioned and do not fit side
    by side, or in \code{diffChr}, \code{diffDeparse}, \code{diffFile} and
    output does not fit in side by side without wrapping
}}

\item{context}{integer(1L) how many lines of context are shown on either side
of differences (defaults to 2).  Set to \code{-1L} to allow as many as
there are.  Set to \dQuote{auto}  to display as many as 10 lines or as few
as 1 depending on whether total screen lines fit within the number of lines
specified in \code{line.limit}.  Alternatively pass the return value of
\code{\link{auto_context}} to fine tune the parameters of the auto context
calculation.}

\item{format}{character(1L), controls the diff output format, one of:
\itemize{
  \item \dQuote{auto}: to select output format based on terminal
    capabilities; will attempt to use one of the ANSI formats if they
    appear to be supported, and if not or if you are in the Rstudio console
    it will attempt to use HTML and browser output if in interactive mode.
  \item \dQuote{raw}: plain text
  \item \dQuote{ansi8}: color and format diffs using basic ANSI escape
    sequences
  \item \dQuote{ansi256}: like \dQuote{ansi8}, except using the full range
    of ANSI formatting options
  \item \dQuote{html}: color and format using HTML markup; the resulting
    string is processed with \code{\link{enc2utf8}} when output as a full
    web page (see docs for \code{html.output} under \code{\link{Style}}).
}
Defaults to \dQuote{auto}.  See \code{palette.of.styles} for details
on customization, \code{\link{Style}} for full control of output format.
See `pager` parameter for more discussion of Rstudio behavior.}

\item{brightness}{character, one of \dQuote{light}, \dQuote{dark},
\dQuote{neutral}, useful for adjusting color scheme to light or dark
terminals.  \dQuote{neutral} by default.  See \code{\link{PaletteOfStyles}}
for details and limitations.  Advanced: you may specify brightness as a
function of \code{format}.  For example, if you typically wish to use a
\dQuote{dark} color scheme, except for when in \dQuote{html} format when
you prefer the \dQuote{light} scheme, you may use
\code{c("dark", html="light")} as the value for this parameter.  This is
particularly useful if \code{format} is set to \dQuote{auto} or if you
want to specify a default value for this parameter via options.  Any names
you use should correspond to a \code{format}.  You must have one unnamed
value which will be used as the default for all \code{format}s that are
not explicitly specified.}

\item{color.mode}{character, one of \dQuote{rgb} or \dQuote{yb}.
Defaults to \dQuote{yb}.  \dQuote{yb} stands for \dQuote{Yellow-Blue} for
color schemes that rely primarily on those colors to style diffs.
Those colors can be easily distinguished by individuals with
limited red-green color sensitivity.  See \code{\link{PaletteOfStyles}} for
details and limitations.  Also offers the same advanced usage as the
\code{brightness} parameter.}

\item{word.diff}{TRUE (default) or FALSE, whether to run a secondary word
diff on the in-hunk differences.  For atomic vectors setting this to
FALSE could make the diff \emph{slower} (see the \code{unwrap.atomic}
parameter).  For other uses, particularly with \code{\link{diffChr}}
setting this to FALSE can substantially improve performance.}

\item{pager}{one of \dQuote{auto} (default), \dQuote{on},
  \dQuote{off}, a \code{\link{Pager}} object, or a list; controls whether and
  how a pager is used to display the diff output.  If you require a
  particular pager behavior you must use a \code{\link{Pager}}
  object, or \dQuote{off} to turn off the pager.  All other settings will
  interact with other parameters such as \code{format}, \code{style}, as well
  as with your system capabilities in order to select the pager expected to
  be most useful.

  \dQuote{auto} and \dQuote{on} are the same, except that in non-interactive
  mode \dQuote{auto} is equivalent to \dQuote{off}.  \dQuote{off} will always
  send output to the console.  If \dQuote{on}, whether the output
  actually gets routed to the pager depends on the pager \code{threshold}
  setting (see \code{\link{Pager}}).  The default behavior is to use the
  pager associated with the \code{Style} object.  The \code{Style} object is
  itself is determined by the \code{format} or \code{style} parameters.

  Depending on your system configuration different styles and corresponding
  pagers will get selected, unless you specify a \code{Pager} object
  directly.  On a system with a system pager that supports ANSI CSI SGR
  colors, the pager will only trigger if the output is taller than one
  window.  If the system pager is not known to support ANSI colors then the
  output will be sent as HTML to the IDE viewer if available or to the web
  browser if not.  Even though Rstudio now supports ANSI CSI SGR at the
  console output is still formatted as HTML and sent to the IDE viewer.
  Partly this is for continuity of behavior, but also because the default
  Rstudio pager does not support ANSI CSI SGR, at least as of this writing.

  If \code{pager} is a list, then the same as with \dQuote{on}, except that
  the \code{Pager} object associated with the selected \code{Style} object is
  re-instantiated with the union of the list elements and the existing
  settings of that \code{Pager}.  The list should contain named elements that
  correspond to the \code{\link{Pager}} instantiation parameters.  The names
  must be specified in full as partial parameter matching will not be carried
  out because the pager is re-instantiated with \code{\link{new}}.

  See \code{\link{Pager}}, \code{\link{Style}}, and
  \code{\link{PaletteOfStyles}} for more details and for instructions on how
  to modify the default behavior.}

\item{guides}{TRUE (default), FALSE, or a function that accepts at least two
arguments and requires no more than two arguments.  Guides
are additional context lines that are not strictly part of a hunk, but
provide important contextual data (e.g. column headers).  If TRUE, the
context lines are shown in addition to the normal diff output, typically
in a different color to indicate they are not part of the hunk.  If a
function, the function should accept as the first argument the object
being diffed, and the second the character representation of the object.
The function should return the indices of the elements of the
character representation that should be treated as guides.  See
\code{\link{guides}} for more details.}

\item{trim}{TRUE (default), FALSE, or a function that accepts at least two
arguments and requires no more than two arguments.  Function should compute
for each line in captured output what portion of those lines should be
diffed.  By default, this is used to remove row meta data differences
(e.g. \code{[1,]}) so they alone do not show up as differences in the
diff.  See \code{\link{trim}} for more details.}

\item{rds}{TRUE (default) or FALSE, if TRUE will check whether
\code{target} and/or \code{current} point to a file that can be read with
\code{\link{readRDS}} and if so, loads the R object contained in the file
and carries out the diff on the object instead of the original argument.
Currently there is no mechanism for specifying additional arguments to
\code{readRDS}}

\item{unwrap.atomic}{TRUE (default) or FALSE.  Relevant primarily for
\code{diffPrint}, if TRUE, and \code{word.diff} is also TRUE, and both
\code{target} and \code{current} are \emph{unnamed} one-dimension atomics ,
the vectors are unwrapped and diffed element by element, and then
re-wrapped.  Since \code{diffPrint} is fundamentally a line diff, the
re-wrapped lines are lined up in a manner that is as consistent as possible
with the unwrapped diff.  Lines that contain the location of the word
differences will be paired up.  Since the vectors may well be wrapped with
different periodicities this will result in lines that are paired up that
look like they should not be paired up, though the locations of the
differences should be.  If is entirely possible that setting this parameter
to FALSE will result in a slower diff.  This happens if two vectors are
actually fairly similar, but their line representations are not.  For
example, in comparing \code{1:100} to \code{c(100, 1:99)}, there is really
only one difference at the \dQuote{word} level, but every screen line is
different.  \code{diffChr} will also do the unwrapping if it is given a
character vector that contains output that looks like the atomic vectors
described above.  This is a bug, but as the functionality could be useful
when diffing e.g. \code{capture.output} data, we now declare it a feature.}

\item{max.diffs}{integer(1L), number of \emph{differences} (default 50000L)
after which we abandon the \code{O(n^2)} diff algorithm in favor of a naive
\code{O(n)} one. Set to \code{-1L} to stick to the original algorithm up to
the maximum allowed (~INT_MAX/4).}

\item{disp.width}{integer(1L) number of display columns to take up; note that
in \dQuote{sidebyside} \code{mode} the effective display width is half this
number (set to 0L to use default widths which are \code{getOption("width")}
for normal styles and \code{80L} for HTML styles.  Future versions of
\code{diffobj} may change this to larger values for two dimensional objects
for better diffs (see details).}

\item{ignore.white.space}{TRUE or FALSE, whether to consider differences in
horizontal whitespace (i.e. spaces and tabs) as differences (defaults to
TRUE).}

\item{convert.hz.white.space}{TRUE or FALSE, whether modify input strings
that contain tabs and carriage returns in such a way that they display as
they would \bold{with} those characters, but without using those
characters (defaults to TRUE).  The conversion assumes that tab stops are
spaced evenly eight characters apart on the terminal.  If this is not the
case you may specify the tab stops explicitly with \code{tab.stops}.}

\item{tab.stops}{integer, what tab stops to use when converting hard tabs to
spaces.  If not integer will be coerced to integer (defaults to 8L).  You
may specify more than one tab stop.  If display width exceeds that
addressable by your tab stops the last tab stop will be repeated.}

\item{line.limit}{integer(2L) or integer(1L), if length 1 how many lines of
output to show, where \code{-1} means no limit.  If length 2, the first
value indicates the threshold of screen lines to begin truncating output,
and the second the number of lines to truncate to, which should be fewer
than the threshold.  Note that this parameter is implemented on a
best-efforts basis and should not be relied on to produce the exact
number of lines requested.  In particular do not expect it to work well for
for values small enough that the banner portion of the diff would have to
be trimmed.  If you want a specific number of lines use \code{[} or
\code{head} / \code{tail}.  One advantage of \code{line.limit} over these
other options is that you can combine it with \code{context="auto"} and
auto \code{max.level} selection (the latter for \code{diffStr}), which
allows the diff to dynamically adjust to make best use of the available
display lines.  \code{[}, \code{head}, and \code{tail} just subset the text
of the output.}

\item{hunk.limit}{integer(2L) or integer (1L), how many diff hunks to show.
Behaves similarly to \code{line.limit}.  How many hunks are in a
particular diff is a function of how many differences, and also how much
\code{context} is used since context can cause two hunks to bleed into
each other and become one.}

\item{align}{numeric(1L) between 0 and 1, proportion of
words in a line of \code{target} that must be matched in a line of
\code{current} in the same hunk for those lines to be paired up when
displayed (defaults to 0.25), or an \code{\link{AlignThreshold}} object.
Set to \code{1} to turn off alignment which will cause all lines in a hunk
from \code{target} to show up first, followed by all lines from
\code{current}.  Note that in order to be aligned lines must meet the
threshold and have at least 3 matching alphanumeric characters (see
\code{\link{AlignThreshold}} for details).}

\item{style}{\dQuote{auto}, a \code{\link{Style}} object, or a list.
\dQuote{auto} by default.  If a \code{Style} object, will override the
the \code{format}, \code{brightness}, and \code{color.mode} parameters.
The \code{Style} object provides full control of diff output styling.
If a list, then the same as \dQuote{auto}, except that if the auto-selected
\code{Style} requires instantiation (see \code{\link{PaletteOfStyles}}),
then the list contents will be used as arguments when instantiating the
style object.  See \code{\link{Style}} for more details, in particular the
examples.}

\item{palette.of.styles}{\code{\link{PaletteOfStyles}} object; advanced
usage, contains all the \code{\link{Style}} objects or
\dQuote{classRepresentation} objects extending \code{\link{Style}} that are
selected by specifying the \code{format}, \code{brightness}, and
\code{color.mode} parameters.  See \code{\link{PaletteOfStyles}} for more
details.}

\item{frame}{an environment to use as the evaluation frame for the
\code{print/show/str}, calls and for \code{diffObj}, the evaluation frame
for the \code{diffPrint} / \code{diffStr} calls.  Defaults to the return
value of \code{\link{par_frame}}.}

\item{interactive}{TRUE or FALSE whether the function is being run in
interactive mode, defaults to the return value of
\code{\link{interactive}}.  If in interactive mode, pager will be used if
\code{pager} is \dQuote{auto}, and if ANSI styles are not supported and
\code{style} is \dQuote{auto}, output will be send to viewer/browser as
HTML.}

\item{term.colors}{integer(1L) how many ANSI colors are supported by the
terminal.  This variable is provided for when
\code{\link[crayon:num_colors]{crayon::num_colors}} does not properly
detect how many ANSI colors are supported by your terminal. Defaults to
return value of \code{\link[crayon:num_colors]{crayon::num_colors}} and
should be 8 or 256 to allow ANSI colors, or any other number to disallow
them.  This only impacts output format selection when \code{style} and
\code{format} are both set to \dQuote{auto}.}

\item{tar.banner}{character(1L), language, or NULL, used to generate the
text to display ahead of the diff section representing the target output.
If NULL will use the deparsed \code{target} expression, if language, will
use the language as it would the \code{target} expression, if
character(1L), will use the string with no modifications.  The language
mode is provided because \code{diffStr} modifies the expression prior to
display (e.g. by wrapping it in a call to \code{str}).  Note that it is
possible in some cases that the substituted value of \code{target} actually
is character(1L), but if you provide a character(1L) value here it will be
assumed you intend to use that value literally.}

\item{cur.banner}{character(1L) like \code{tar.banner}, but for
\code{current}}

\item{strip.sgr}{TRUE, FALSE, or NULL (default), whether to strip ANSI CSI
SGR sequences prior to comparison and for display of diff.  If NULL,
resolves to TRUE if `style` resolves to an ANSI formatted diff, and
FALSE otherwise.  The default behavior is to avoid confusing diffs where
the original SGR and the SGR added by the diff are mixed together.}

\item{sgr.supported}{TRUE, FALSE, or NULL (default), whether to assume the
standard output device supports ANSI CSI SGR sequences.  If TRUE, strings
will be manipulated accounting for the SGR sequences.  If NULL,
resolves to TRUE if `style` resolves to an ANSI formatted diff, and
to `crayon::has_color()` otherwise.  This only controls how the strings are
manipulated, not whether SGR is added to format the diff, which is
controlled by the `style` parameter.  This parameter is exposed for the
rare cases where you might wish to control string manipulation behavior
directly.}

\item{extra}{list additional arguments to pass on to the functions used to
create text representation of the objects to diff (e.g. \code{print},
\code{str}, etc.)}
}
\value{
a \code{Diff} object; see \code{\link{diffPrint}}.
}
\description{
Will perform the diff on the actual string values of the character vectors
instead of capturing the printed screen output. Each vector element is
treated as a line of text.  NA elements are treated as the string
\dQuote{NA}.  Non character inputs are coerced to character and attributes
are dropped with \code{\link{c}}.
}
\examples{
## `pager="off"` for CRAN compliance; you may omit in normal use
diffChr(LETTERS[1:5], LETTERS[2:6], pager="off")
}
\seealso{
\code{\link{diffPrint}} for details on the \code{diff*} functions,
  \code{\link{diffObj}}, \code{\link{diffStr}},
  \code{\link{diffDeparse}} to compare deparsed objects,
  \code{\link{ses}} for a minimal and fast diff
}
diffobj/man/diffFile.Rd0000644000176200001440000004437115001246431014434 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/diff.R
\name{diffFile}
\alias{diffFile}
\alias{diffFile,ANY-method}
\title{Diff Files}
\usage{
diffFile(target, current, ...)

\S4method{diffFile}{ANY}(
  target,
  current,
  mode = gdo("mode"),
  context = gdo("context"),
  format = gdo("format"),
  brightness = gdo("brightness"),
  color.mode = gdo("color.mode"),
  word.diff = gdo("word.diff"),
  pager = gdo("pager"),
  guides = gdo("guides"),
  trim = gdo("trim"),
  rds = gdo("rds"),
  unwrap.atomic = gdo("unwrap.atomic"),
  max.diffs = gdo("max.diffs"),
  disp.width = gdo("disp.width"),
  ignore.white.space = gdo("ignore.white.space"),
  convert.hz.white.space = gdo("convert.hz.white.space"),
  tab.stops = gdo("tab.stops"),
  line.limit = gdo("line.limit"),
  hunk.limit = gdo("hunk.limit"),
  align = gdo("align"),
  style = gdo("style"),
  palette.of.styles = gdo("palette"),
  frame = par_frame(),
  interactive = gdo("interactive"),
  term.colors = gdo("term.colors"),
  tar.banner = NULL,
  cur.banner = NULL,
  strip.sgr = gdo("strip.sgr"),
  sgr.supported = gdo("sgr.supported"),
  extra = list()
)
}
\arguments{
\item{target}{character(1L) or file connection with read capability; if
character should point to a text file}

\item{current}{like \code{target}}

\item{...}{unused, for compatibility of methods with generics}

\item{mode}{character(1L), one of:
\itemize{
  \item \dQuote{unified}: diff mode used by \code{git diff}
  \item \dQuote{sidebyside}: line up the differences side by side
  \item \dQuote{context}: show the target and current hunks in their
    entirety; this mode takes up a lot of screen space but makes it easier
    to see what the objects actually look like
  \item \dQuote{auto}: default mode; pick one of the above, will favor
    \dQuote{sidebyside} unless \code{getOption("width")} is less than 80,
    or in \code{diffPrint} and objects are dimensioned and do not fit side
    by side, or in \code{diffChr}, \code{diffDeparse}, \code{diffFile} and
    output does not fit in side by side without wrapping
}}

\item{context}{integer(1L) how many lines of context are shown on either side
of differences (defaults to 2).  Set to \code{-1L} to allow as many as
there are.  Set to \dQuote{auto}  to display as many as 10 lines or as few
as 1 depending on whether total screen lines fit within the number of lines
specified in \code{line.limit}.  Alternatively pass the return value of
\code{\link{auto_context}} to fine tune the parameters of the auto context
calculation.}

\item{format}{character(1L), controls the diff output format, one of:
\itemize{
  \item \dQuote{auto}: to select output format based on terminal
    capabilities; will attempt to use one of the ANSI formats if they
    appear to be supported, and if not or if you are in the Rstudio console
    it will attempt to use HTML and browser output if in interactive mode.
  \item \dQuote{raw}: plain text
  \item \dQuote{ansi8}: color and format diffs using basic ANSI escape
    sequences
  \item \dQuote{ansi256}: like \dQuote{ansi8}, except using the full range
    of ANSI formatting options
  \item \dQuote{html}: color and format using HTML markup; the resulting
    string is processed with \code{\link{enc2utf8}} when output as a full
    web page (see docs for \code{html.output} under \code{\link{Style}}).
}
Defaults to \dQuote{auto}.  See \code{palette.of.styles} for details
on customization, \code{\link{Style}} for full control of output format.
See `pager` parameter for more discussion of Rstudio behavior.}

\item{brightness}{character, one of \dQuote{light}, \dQuote{dark},
\dQuote{neutral}, useful for adjusting color scheme to light or dark
terminals.  \dQuote{neutral} by default.  See \code{\link{PaletteOfStyles}}
for details and limitations.  Advanced: you may specify brightness as a
function of \code{format}.  For example, if you typically wish to use a
\dQuote{dark} color scheme, except for when in \dQuote{html} format when
you prefer the \dQuote{light} scheme, you may use
\code{c("dark", html="light")} as the value for this parameter.  This is
particularly useful if \code{format} is set to \dQuote{auto} or if you
want to specify a default value for this parameter via options.  Any names
you use should correspond to a \code{format}.  You must have one unnamed
value which will be used as the default for all \code{format}s that are
not explicitly specified.}

\item{color.mode}{character, one of \dQuote{rgb} or \dQuote{yb}.
Defaults to \dQuote{yb}.  \dQuote{yb} stands for \dQuote{Yellow-Blue} for
color schemes that rely primarily on those colors to style diffs.
Those colors can be easily distinguished by individuals with
limited red-green color sensitivity.  See \code{\link{PaletteOfStyles}} for
details and limitations.  Also offers the same advanced usage as the
\code{brightness} parameter.}

\item{word.diff}{TRUE (default) or FALSE, whether to run a secondary word
diff on the in-hunk differences.  For atomic vectors setting this to
FALSE could make the diff \emph{slower} (see the \code{unwrap.atomic}
parameter).  For other uses, particularly with \code{\link{diffChr}}
setting this to FALSE can substantially improve performance.}

\item{pager}{one of \dQuote{auto} (default), \dQuote{on},
  \dQuote{off}, a \code{\link{Pager}} object, or a list; controls whether and
  how a pager is used to display the diff output.  If you require a
  particular pager behavior you must use a \code{\link{Pager}}
  object, or \dQuote{off} to turn off the pager.  All other settings will
  interact with other parameters such as \code{format}, \code{style}, as well
  as with your system capabilities in order to select the pager expected to
  be most useful.

  \dQuote{auto} and \dQuote{on} are the same, except that in non-interactive
  mode \dQuote{auto} is equivalent to \dQuote{off}.  \dQuote{off} will always
  send output to the console.  If \dQuote{on}, whether the output
  actually gets routed to the pager depends on the pager \code{threshold}
  setting (see \code{\link{Pager}}).  The default behavior is to use the
  pager associated with the \code{Style} object.  The \code{Style} object is
  itself is determined by the \code{format} or \code{style} parameters.

  Depending on your system configuration different styles and corresponding
  pagers will get selected, unless you specify a \code{Pager} object
  directly.  On a system with a system pager that supports ANSI CSI SGR
  colors, the pager will only trigger if the output is taller than one
  window.  If the system pager is not known to support ANSI colors then the
  output will be sent as HTML to the IDE viewer if available or to the web
  browser if not.  Even though Rstudio now supports ANSI CSI SGR at the
  console output is still formatted as HTML and sent to the IDE viewer.
  Partly this is for continuity of behavior, but also because the default
  Rstudio pager does not support ANSI CSI SGR, at least as of this writing.

  If \code{pager} is a list, then the same as with \dQuote{on}, except that
  the \code{Pager} object associated with the selected \code{Style} object is
  re-instantiated with the union of the list elements and the existing
  settings of that \code{Pager}.  The list should contain named elements that
  correspond to the \code{\link{Pager}} instantiation parameters.  The names
  must be specified in full as partial parameter matching will not be carried
  out because the pager is re-instantiated with \code{\link{new}}.

  See \code{\link{Pager}}, \code{\link{Style}}, and
  \code{\link{PaletteOfStyles}} for more details and for instructions on how
  to modify the default behavior.}

\item{guides}{TRUE (default), FALSE, or a function that accepts at least two
arguments and requires no more than two arguments.  Guides
are additional context lines that are not strictly part of a hunk, but
provide important contextual data (e.g. column headers).  If TRUE, the
context lines are shown in addition to the normal diff output, typically
in a different color to indicate they are not part of the hunk.  If a
function, the function should accept as the first argument the object
being diffed, and the second the character representation of the object.
The function should return the indices of the elements of the
character representation that should be treated as guides.  See
\code{\link{guides}} for more details.}

\item{trim}{TRUE (default), FALSE, or a function that accepts at least two
arguments and requires no more than two arguments.  Function should compute
for each line in captured output what portion of those lines should be
diffed.  By default, this is used to remove row meta data differences
(e.g. \code{[1,]}) so they alone do not show up as differences in the
diff.  See \code{\link{trim}} for more details.}

\item{rds}{TRUE (default) or FALSE, if TRUE will check whether
\code{target} and/or \code{current} point to a file that can be read with
\code{\link{readRDS}} and if so, loads the R object contained in the file
and carries out the diff on the object instead of the original argument.
Currently there is no mechanism for specifying additional arguments to
\code{readRDS}}

\item{unwrap.atomic}{TRUE (default) or FALSE.  Relevant primarily for
\code{diffPrint}, if TRUE, and \code{word.diff} is also TRUE, and both
\code{target} and \code{current} are \emph{unnamed} one-dimension atomics ,
the vectors are unwrapped and diffed element by element, and then
re-wrapped.  Since \code{diffPrint} is fundamentally a line diff, the
re-wrapped lines are lined up in a manner that is as consistent as possible
with the unwrapped diff.  Lines that contain the location of the word
differences will be paired up.  Since the vectors may well be wrapped with
different periodicities this will result in lines that are paired up that
look like they should not be paired up, though the locations of the
differences should be.  If is entirely possible that setting this parameter
to FALSE will result in a slower diff.  This happens if two vectors are
actually fairly similar, but their line representations are not.  For
example, in comparing \code{1:100} to \code{c(100, 1:99)}, there is really
only one difference at the \dQuote{word} level, but every screen line is
different.  \code{diffChr} will also do the unwrapping if it is given a
character vector that contains output that looks like the atomic vectors
described above.  This is a bug, but as the functionality could be useful
when diffing e.g. \code{capture.output} data, we now declare it a feature.}

\item{max.diffs}{integer(1L), number of \emph{differences} (default 50000L)
after which we abandon the \code{O(n^2)} diff algorithm in favor of a naive
\code{O(n)} one. Set to \code{-1L} to stick to the original algorithm up to
the maximum allowed (~INT_MAX/4).}

\item{disp.width}{integer(1L) number of display columns to take up; note that
in \dQuote{sidebyside} \code{mode} the effective display width is half this
number (set to 0L to use default widths which are \code{getOption("width")}
for normal styles and \code{80L} for HTML styles.  Future versions of
\code{diffobj} may change this to larger values for two dimensional objects
for better diffs (see details).}

\item{ignore.white.space}{TRUE or FALSE, whether to consider differences in
horizontal whitespace (i.e. spaces and tabs) as differences (defaults to
TRUE).}

\item{convert.hz.white.space}{TRUE or FALSE, whether modify input strings
that contain tabs and carriage returns in such a way that they display as
they would \bold{with} those characters, but without using those
characters (defaults to TRUE).  The conversion assumes that tab stops are
spaced evenly eight characters apart on the terminal.  If this is not the
case you may specify the tab stops explicitly with \code{tab.stops}.}

\item{tab.stops}{integer, what tab stops to use when converting hard tabs to
spaces.  If not integer will be coerced to integer (defaults to 8L).  You
may specify more than one tab stop.  If display width exceeds that
addressable by your tab stops the last tab stop will be repeated.}

\item{line.limit}{integer(2L) or integer(1L), if length 1 how many lines of
output to show, where \code{-1} means no limit.  If length 2, the first
value indicates the threshold of screen lines to begin truncating output,
and the second the number of lines to truncate to, which should be fewer
than the threshold.  Note that this parameter is implemented on a
best-efforts basis and should not be relied on to produce the exact
number of lines requested.  In particular do not expect it to work well for
for values small enough that the banner portion of the diff would have to
be trimmed.  If you want a specific number of lines use \code{[} or
\code{head} / \code{tail}.  One advantage of \code{line.limit} over these
other options is that you can combine it with \code{context="auto"} and
auto \code{max.level} selection (the latter for \code{diffStr}), which
allows the diff to dynamically adjust to make best use of the available
display lines.  \code{[}, \code{head}, and \code{tail} just subset the text
of the output.}

\item{hunk.limit}{integer(2L) or integer (1L), how many diff hunks to show.
Behaves similarly to \code{line.limit}.  How many hunks are in a
particular diff is a function of how many differences, and also how much
\code{context} is used since context can cause two hunks to bleed into
each other and become one.}

\item{align}{numeric(1L) between 0 and 1, proportion of
words in a line of \code{target} that must be matched in a line of
\code{current} in the same hunk for those lines to be paired up when
displayed (defaults to 0.25), or an \code{\link{AlignThreshold}} object.
Set to \code{1} to turn off alignment which will cause all lines in a hunk
from \code{target} to show up first, followed by all lines from
\code{current}.  Note that in order to be aligned lines must meet the
threshold and have at least 3 matching alphanumeric characters (see
\code{\link{AlignThreshold}} for details).}

\item{style}{\dQuote{auto}, a \code{\link{Style}} object, or a list.
\dQuote{auto} by default.  If a \code{Style} object, will override the
the \code{format}, \code{brightness}, and \code{color.mode} parameters.
The \code{Style} object provides full control of diff output styling.
If a list, then the same as \dQuote{auto}, except that if the auto-selected
\code{Style} requires instantiation (see \code{\link{PaletteOfStyles}}),
then the list contents will be used as arguments when instantiating the
style object.  See \code{\link{Style}} for more details, in particular the
examples.}

\item{palette.of.styles}{\code{\link{PaletteOfStyles}} object; advanced
usage, contains all the \code{\link{Style}} objects or
\dQuote{classRepresentation} objects extending \code{\link{Style}} that are
selected by specifying the \code{format}, \code{brightness}, and
\code{color.mode} parameters.  See \code{\link{PaletteOfStyles}} for more
details.}

\item{frame}{an environment to use as the evaluation frame for the
\code{print/show/str}, calls and for \code{diffObj}, the evaluation frame
for the \code{diffPrint} / \code{diffStr} calls.  Defaults to the return
value of \code{\link{par_frame}}.}

\item{interactive}{TRUE or FALSE whether the function is being run in
interactive mode, defaults to the return value of
\code{\link{interactive}}.  If in interactive mode, pager will be used if
\code{pager} is \dQuote{auto}, and if ANSI styles are not supported and
\code{style} is \dQuote{auto}, output will be send to viewer/browser as
HTML.}

\item{term.colors}{integer(1L) how many ANSI colors are supported by the
terminal.  This variable is provided for when
\code{\link[crayon:num_colors]{crayon::num_colors}} does not properly
detect how many ANSI colors are supported by your terminal. Defaults to
return value of \code{\link[crayon:num_colors]{crayon::num_colors}} and
should be 8 or 256 to allow ANSI colors, or any other number to disallow
them.  This only impacts output format selection when \code{style} and
\code{format} are both set to \dQuote{auto}.}

\item{tar.banner}{character(1L), language, or NULL, used to generate the
text to display ahead of the diff section representing the target output.
If NULL will use the deparsed \code{target} expression, if language, will
use the language as it would the \code{target} expression, if
character(1L), will use the string with no modifications.  The language
mode is provided because \code{diffStr} modifies the expression prior to
display (e.g. by wrapping it in a call to \code{str}).  Note that it is
possible in some cases that the substituted value of \code{target} actually
is character(1L), but if you provide a character(1L) value here it will be
assumed you intend to use that value literally.}

\item{cur.banner}{character(1L) like \code{tar.banner}, but for
\code{current}}

\item{strip.sgr}{TRUE, FALSE, or NULL (default), whether to strip ANSI CSI
SGR sequences prior to comparison and for display of diff.  If NULL,
resolves to TRUE if `style` resolves to an ANSI formatted diff, and
FALSE otherwise.  The default behavior is to avoid confusing diffs where
the original SGR and the SGR added by the diff are mixed together.}

\item{sgr.supported}{TRUE, FALSE, or NULL (default), whether to assume the
standard output device supports ANSI CSI SGR sequences.  If TRUE, strings
will be manipulated accounting for the SGR sequences.  If NULL,
resolves to TRUE if `style` resolves to an ANSI formatted diff, and
to `crayon::has_color()` otherwise.  This only controls how the strings are
manipulated, not whether SGR is added to format the diff, which is
controlled by the `style` parameter.  This parameter is exposed for the
rare cases where you might wish to control string manipulation behavior
directly.}

\item{extra}{list additional arguments to pass on to the functions used to
create text representation of the objects to diff (e.g. \code{print},
\code{str}, etc.)}
}
\value{
a \code{Diff} object; see \code{\link{diffPrint}}.
}
\description{
Reads text files with \code{\link{readLines}} and performs a diff on the
resulting character vectors.
}
\examples{
\dontrun{
url.base <- "https://raw.githubusercontent.com/wch/r-source"
f1 <- file.path(url.base, "29f013d1570e1df5dc047fb7ee304ff57c99ea68/README")
f2 <- file.path(url.base, "daf0b5f6c728bd3dbcd0a3c976a7be9beee731d9/README")
diffFile(f1, f2)
}
}
\seealso{
\code{\link{diffPrint}} for details on the \code{diff*} functions,
  \code{\link{diffObj}}, \code{\link{diffStr}},
  \code{\link{diffChr}} to compare character vectors directly,
  \code{\link{ses}} for a minimal and fast diff
}
diffobj/man/console_lines.Rd0000644000176200001440000000055514122754044015563 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/set.R
\name{console_lines}
\alias{console_lines}
\title{Attempt to Compute Console Height in Text Lines}
\usage{
console_lines()
}
\value{
integer(1L)
}
\description{
Returns the value of the \code{LINES} system variable if it is reasonable,
48 otherwise.
}
\examples{
console_lines()
}
diffobj/man/diffobj_s4method_doc.Rd0000644000176200001440000000071614122754044016765 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/s4.R, R/core.R, R/tochar.R
\name{diffobj_s4method_doc}
\alias{diffobj_s4method_doc}
\alias{show,MyersMbaSes-method}
\alias{as.character,Diff-method}
\title{Dummy Doc File for S4 Methods with Existing Generics}
\usage{
\S4method{show}{MyersMbaSes}(object)

\S4method{as.character}{Diff}(x, ...)
}
\description{
Dummy Doc File for S4 Methods with Existing Generics
}
\keyword{internal}
diffobj/man/StyleFuns.Rd0000644000176200001440000000501114122754044014653 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/styles.R
\docType{class}
\name{StyleFuns-class}
\alias{StyleFuns-class}
\alias{StyleFuns}
\title{Functions Used for Styling Diff Components}
\arguments{
\item{container}{function used primarily by HTML styles to generate an
outermost \code{DIV} that allows for CSS targeting of its contents
(see \code{\link{cont_f}} for a function generator appropriate for use
here)}

\item{line}{function}

\item{line.insert}{function}

\item{line.delete}{function}

\item{line.match}{function}

\item{line.guide}{function formats guide lines (see \code{\link{guides}})}

\item{text}{function}

\item{text.insert}{function}

\item{text.delete}{function}

\item{text.match}{function}

\item{text.guide}{function formats guide lines (see \code{\link{guides}})}

\item{gutter}{function}

\item{gutter.insert}{function}

\item{gutter.delete}{function}

\item{gutter.match}{function}

\item{gutter.guide}{function}

\item{gutter.pad}{function}

\item{header}{function to format each hunk header with}

\item{banner}{function to format entire banner}

\item{banner.insert}{function to format insertion banner}

\item{banner.delete}{function to format deletion banner}

\item{meta}{function format meta information lines}

\item{context.sep}{function to format the separator used to visually
distinguish the A and B hunks in \dQuote{context} \code{mode}}
}
\value{
a StyleFuns S4 object
}
\description{
Except for \code{container} every function specified here should be
vectorized and apply formatting to each element in a character vectors.  The
functions must accept at least one argument and require no more than one
argument.  The text to be formatted will be passed as a character vector
as the first argument to each function.
}
\details{
These functions are applied in post processing steps.  The \code{diff*}
methods do not do any of the formatting.  Instead, the formatting is done
only if the user requests to \code{show} the object.  Internally, \code{show}
first converts the object to a character vector using \code{as.character},
which applies every formatting function defined here except for
\code{container}.  Then \code{show} applies \code{container} before
forwarding the result to the screen or pager.
}
\note{
the slots are set to class \dQuote{ANY} to allow classed functions
  such as those defined in the \code{crayon} package.  Despite this seemingly
  permissive slot definition, only functions are allowed in the slots by
  the validation functions.
}
\seealso{
\code{\link{Style}}
}
diffobj/man/make_blocking.Rd0000644000176200001440000000135614122754044015514 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/pager.R
\name{make_blocking}
\alias{make_blocking}
\title{Create a Blocking Version of a Function}
\usage{
make_blocking(fun, msg = "Press ENTER to continue...", invisible.res = TRUE)
}
\arguments{
\item{fun}{a function}

\item{msg}{character(1L) a message to use as the \code{readline} prompt}

\item{invisible.res}{whether to return the result of \code{fun} invisibly}
}
\value{
\code{fun}, wrapped in a function that does the blocking.
}
\description{
Wraps \code{fun} in a function that runs \code{fun} and then issues a
\code{readline} prompt to prevent further R code evaluation until user
presses a key.
}
\examples{
make_blocking(sum, invisible.res=FALSE)(1:10)
}
diffobj/man/Rdiff_chr.Rd0000644000176200001440000000401614122754044014611 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/rdiff.R
\name{Rdiff_chr}
\alias{Rdiff_chr}
\alias{Rdiff_obj}
\title{Run Rdiff Directly on R Objects}
\usage{
Rdiff_chr(from, to, silent = FALSE, minimal = FALSE, nullPointers = TRUE)

Rdiff_obj(from, to, silent = FALSE, minimal = FALSE, nullPointers = TRUE)
}
\arguments{
\item{from}{character or object coercible to character for \code{Rdiff_chr},
any R object with \code{Rdiff_obj}, or a file pointing to an RDS object}

\item{to}{character same as \code{from}}

\item{silent}{TRUE or FALSE, whether to display output to screen}

\item{minimal}{TRUE or FALSE, whether to exclude the lines that show the
actual differences or only the actual edit script commands}

\item{nullPointers}{passed to \code{tools::Rdiff}}
}
\value{
the Rdiff output, invisibly if \code{silent} is FALSE
Rdiff_chr(letters[1:5], LETTERS[1:5])
Rdiff_obj(letters[1:5], LETTERS[1:5])
}
\description{
These functions are here for reference and testing purposes.  They are
wrappers to \code{tools::Rdiff} and rely on an existing system diff utility.
You should be using \code{\link{ses}} or \code{\link{diffChr}} instead of
\code{Rdiff_chr} and \code{\link{diffPrint}} instead of \code{Rdiff_obj}.
See limitations in note.
}
\details{
\code{Rdiff_chr} runs diffs on character vectors or objects coerced to
character vectors, where each value in the vectors is treated as a line in a
file.  \code{Rdiff_chr} always runs with the \code{useDiff} and \code{Log}
parameters set to \code{TRUE}.

\code{Rdiff_obj} runs diffs on the \code{print}ed representation of
the provided objects.  For each of \code{from}, \code{to}, will check if they
are 1 length character vectors referencing an RDS file, and will use the
contents of that RDS file as the object to compare.
}
\note{
These functions will try to use the system \code{diff} utility. This
  will fail in systems that do not have that utility available (e.g. windows
  installation without Rtools).
}
\seealso{
\code{\link{ses}}, \code{\link[=diffPrint]{diff*}}
}
diffobj/man/any-Diff-method.Rd0000644000176200001440000000124514122754044015637 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/s4.R
\name{any,Diff-method}
\alias{any,Diff-method}
\title{Determine if Diff Object Has Differences}
\usage{
\S4method{any}{Diff}(x, ..., na.rm = FALSE)
}
\arguments{
\item{x}{a \code{Diff} object}

\item{...}{unused, for compatibility with generic}

\item{na.rm}{unused, for compatibility with generic}
}
\value{
TRUE if there are differences, FALSE if not, FALSE with warning if
  there are no differences but objects are not \code{\link{all.equal}}
}
\description{
Determine if Diff Object Has Differences
}
\examples{
any(diffChr(letters, letters))
any(diffChr(letters, letters[-c(1, 5, 8)]))
}
diffobj/man/as.character-MyersMbaSes-method.Rd0000644000176200001440000000101514122754044020723 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/core.R
\name{as.character,MyersMbaSes-method}
\alias{as.character,MyersMbaSes-method}
\title{Generate a character representation of Shortest Edit Sequence}
\usage{
\S4method{as.character}{MyersMbaSes}(x, ...)
}
\arguments{
\item{x}{S4 object of class \code{MyersMbaSes}}

\item{...}{unused}
}
\value{
character vector
}
\description{
Generate a character representation of Shortest Edit Sequence
}
\seealso{
\code{\link{ses}}
}
\keyword{internal}
diffobj/man/extract-Diff-method.Rd0000644000176200001440000000326414122754044016525 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/subset.R
\name{[,Diff,numeric,missing,missing-method}
\alias{[,Diff,numeric,missing,missing-method}
\alias{head,Diff-method}
\alias{tail,Diff-method}
\title{Subsetting Methods for Diff Objects}
\usage{
\S4method{[}{Diff,numeric,missing,missing}(x, i)

\S4method{head}{Diff}(x, n, ...)

\S4method{tail}{Diff}(x, n, ...)
}
\arguments{
\item{x}{\code{Diff} object}

\item{i}{subsetting index, must be numeric}

\item{n}{integer(1L), the size for the resulting object}

\item{...}{unused, for compatibility with generics}
}
\value{
\code{Diff} object with subsetting indices recorded for use by
  \code{show}
## `pager="off"` for CRAN compliance; you may omit in normal use
diff <- diffChr(letters, LETTERS, format="raw", pager="off")
diff[5:15]
head(diff, 5)
tail(diff, 5)
head(head(diff, 5), 8)  ## note not 'typical' behavior
}
\description{
Methods to subset the character representation of the diff output.  The
subsetting bears no link to the line numbers in the diffs, only to the actual
displayed diff.
}
\details{
\code{[} only supports numeric indices, and returns without error if you
specify out of bound indices.  If you apply multiple subsetting methods they
will be applied in the following order irrespective of what order you
actually specify them in: \code{[}, then \code{head}, then \code{tail}.
If you use the same subsetting method multiple times on the same object,
the last call will define the outcome.

These methods are implemented by storing the chosen indices in the
\code{Diff} object and using them to subset the \code{as.character} output.
This mechanism explains the seemingly odd behavior documented above.
}
diffobj/man/finalizeHtml.Rd0000644000176200001440000000200314122754044015343 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/finalizer.R, R/s4.R, R/summmary.R
\name{finalizeHtml}
\alias{finalizeHtml}
\alias{finalizeHtml,ANY-method}
\alias{finalizeHtml,Diff-method}
\alias{finalizeHtml,DiffSummary-method}
\title{Finalizing Methods for HTML Output}
\usage{
finalizeHtml(x, ...)

\S4method{finalizeHtml}{ANY}(x, x.chr, js, ...)

\S4method{finalizeHtml}{Diff}(x, x.chr, ...)

\S4method{finalizeHtml}{DiffSummary}(x, x.chr, ...)
}
\arguments{
\item{x}{object to finalize}

\item{...}{arguments to pass on to methods}

\item{x.chr}{character text representation of \code{x}, typically generated
with the \code{as.character} method for \code{x}}

\item{js}{character javascript code to append to HTML representation}
}
\description{
Used as the \code{finalizer} slot to \code{\link{StyleHtml}} objects to wrap
character output prior to output to device.  Used primarily by styles that
output to HTML to properly configure HTML page structure, including injecting
JS, CSS, etc..
}
diffobj/man/summary-PaletteOfStyles-method.Rd0000644000176200001440000000110514122754044020757 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/styles.R
\name{summary,PaletteOfStyles-method}
\alias{summary,PaletteOfStyles-method}
\title{Display a Summarized Version of a PaletteOfStyles}
\usage{
\S4method{summary}{PaletteOfStyles}(object, ...)
}
\arguments{
\item{object}{a \code{\link{PaletteOfStyles}} object}

\item{...}{unused, for compatibility with generic}
}
\value{
character representation showing classes and/or objects in
  PaletteOfStyles
summary(PaletteOfStyles())
}
\description{
Display a Summarized Version of a PaletteOfStyles
}
diffobj/man/show-Style-method.Rd0000644000176200001440000000152414122754044016260 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/styles.R
\name{show,Style-method}
\alias{show,Style-method}
\alias{show,StyleHtml-method}
\title{Show Method for Style Objects}
\usage{
\S4method{show}{Style}(object)

\S4method{show}{StyleHtml}(object)
}
\arguments{
\item{object}{a \code{Style} S4 object}
}
\value{
NULL, invisibly
}
\description{
Display a small sample diff with the Style object styles applied.  For
ANSI light and dark styles, will also temporarily set the background and
foreground colors to ensure they are compatible with the style, even though
this is not done in normal output (i.e. if you intend on using a
\dQuote{light} style, you should set your terminal background color to be
light or expect sub-optimal rendering).
}
\examples{
show(StyleAnsi256LightYb())  # assumes ANSI colors supported
}
diffobj/man/pager_is_less.Rd0000644000176200001440000000215214122754044015541 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/pager.R
\name{pager_is_less}
\alias{pager_is_less}
\title{Check Whether System Has less as Pager}
\usage{
pager_is_less()
}
\value{
TRUE or FALSE
}
\description{
If \code{getOption(pager)} is set to the default value, checks whether
\code{Sys.getenv("PAGER")} appears to be \code{less} by trying to run the
pager with the \dQuote{version} and parsing the output.  If
\code{getOption(pager)} is not the default value, then checks whether it
points to the \code{less} program by the same mechanism.
}
\details{
Some systems may have \code{less} pagers installed that do not respond to the
\code{$LESS} environment variable.  For example, \code{more} on at least some
versions of OS X is \code{less}, but does not actually respond to
\code{$LESS}.  If such as pager is the system pager you will likely end up
seeing gibberish in the pager.  If this is your use case you will need to
set-up a custom pager configuration object that sets the correct system
variables (see \code{\link{Pager}}).
}
\examples{
pager_is_less()
}
\seealso{
\code{\link{Pager}}
}
diffobj/man/nchar_html.Rd0000644000176200001440000000132314122754044015040 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/html.R
\name{nchar_html}
\alias{nchar_html}
\title{Count Text Characters in HTML}
\usage{
nchar_html(x, ...)
}
\arguments{
\item{x}{character}

\item{...}{unused for compatibility with internal use}
}
\value{
integer(length(x)) with number of characters of each element
}
\description{
Very simple implementation that will fail if there are any \dQuote{>} in the
HTML that are not closing tags, and assumes that HTML entities are all one
character wide.  Also, spaces are counted as one width each because the
HTML output is intended to be displayed inside \code{
} tags.
}
\examples{
nchar_html("hello")
}
diffobj/man/show-DiffSummary-method.Rd0000644000176200001440000000067414122754044017413 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/summmary.R
\name{show,DiffSummary-method}
\alias{show,DiffSummary-method}
\title{Display DiffSummary Objects}
\usage{
\S4method{show}{DiffSummary}(object)
}
\arguments{
\item{object}{a \code{DiffSummary} object}
}
\value{
NULL, invisbly
show(
  summary(diffChr(letters, letters[-c(5, 15)], format="raw", pager="off"))
)
}
\description{
Display DiffSummary Objects
}
diffobj/man/diffobj_set_def_opts.Rd0000644000176200001440000000075314122754044017070 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/options.R
\name{diffobj_set_def_opts}
\alias{diffobj_set_def_opts}
\title{Set All diffobj Options to Defaults}
\usage{
diffobj_set_def_opts()
}
\value{
list for use with \code{options} that contains values of
  \code{diffob} options before they were forced to defaults
}
\description{
Used primarily for testing to ensure all options are set to default values.
}
\examples{
\dontrun{
  diffobj_set_def_opts()
}
}
diffobj/man/Diff-class.Rd0000644000176200001440000000054514122754044014701 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/s4.R
\docType{class}
\name{Diff-class}
\alias{Diff-class}
\title{Diff Result Object}
\description{
Return value for the \code{\link[=diffPrint]{diff*}} methods.  Has
\code{show}, \code{as.character}, \code{summmary}, \code{[}, \code{head},
\code{tail}, and \code{any} methods.
}
diffobj/man/dimnames-PaletteOfStyles-method.Rd0000644000176200001440000000071214122754044021062 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/styles.R
\name{dimnames,PaletteOfStyles-method}
\alias{dimnames,PaletteOfStyles-method}
\title{Retrieve Dimnames for PaletteOfStyles Objects}
\usage{
\S4method{dimnames}{PaletteOfStyles}(x)
}
\arguments{
\item{x}{a \code{\link{PaletteOfStyles}} object}
}
\value{
list the dimension names
dimnames(PaletteOfStyles())
}
\description{
Retrieve Dimnames for PaletteOfStyles Objects
}
diffobj/man/strip_hz_control.Rd0000644000176200001440000000223614122754044016327 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/text.R
\name{strip_hz_control}
\alias{strip_hz_control}
\title{Replace Horizontal Spacing Control Characters}
\usage{
strip_hz_control(txt, stops = 8L, sgr.supported)
}
\arguments{
\item{txt}{character to covert}

\item{stops}{integer, what tab stops to use}

\item{sgr.supported}{logical whether the current display device supports
ANSI CSI SGR.  See \code{\link[=diffPrint]{diff*}}'s \code{sgr.supported}
parameter.}
}
\value{
character, `txt` with horizontal control sequences
  replaced.
}
\description{
Removes tabs, newlines, and manipulates the text so that
it looks the same as it did with those horizontal control
characters embedded.  Currently carriage returns are also processed, but
in the future they no longer will be.  This function is used when the
\code{convert.hz.white.space} parameter to the
\code{\link[=diffPrint]{diff*}} methods is active.  The term \dQuote{strip}
is a misnomer that remains for legacy reasons and lazyness.
}
\details{
This is an internal function with exposed documentation because it is
referenced in an external function's documentation.
}
\keyword{internal}
diffobj/man/diffobj-package.Rd0000644000176200001440000000140215001246431015704 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/diff.R
\docType{package}
\name{diffobj-package}
\alias{diffobj}
\alias{diffobj-package}
\title{Diffs for R Objects}
\description{
Generate a colorized diff of two R objects for an intuitive visualization of
their differences.  See `vignette(package="diffobj", "diffobj")` for details.
}
\seealso{
Useful links:
\itemize{
  \item \url{https://github.com/brodieG/diffobj}
  \item Report bugs at \url{https://github.com/brodieG/diffobj/issues}
}

}
\author{
\strong{Maintainer}: Brodie Gaslam \email{brodie.gaslam@yahoo.com}

Other contributors:
\itemize{
  \item Michael B. Allen \email{ioplex@gmail.com} (Original C implementation of Myers Diff Algorithm) [contributor, copyright holder]
}

}
diffobj/man/auto_context.Rd0000644000176200001440000000177114122754044015444 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/set.R
\name{auto_context}
\alias{auto_context}
\title{Configure Automatic Context Calculation}
\usage{
auto_context(
  min = getOption("diffobj.context.auto.min"),
  max = getOption("diffobj.context.auto.max")
)
}
\arguments{
\item{min}{integer(1L), positive, set to zero to allow any context}

\item{max}{integer(1L), set to negative to allow any context}
}
\value{
S4 object containing configuration parameters, for use as the
  \code{context} or parameter value in \code{\link[=diffPrint]{diff*}}
  methods
}
\description{
Helper functions to help define parameters for selecting an appropriate
\code{context} value.
}
\examples{
## `pager="off"` for CRAN compliance; you may omit in normal use
diffChr(letters, letters[-13], context=auto_context(0, 3), pager="off")
diffChr(letters, letters[-13], context=auto_context(0, 10), pager="off")
diffChr(
  letters, letters[-13], context=auto_context(0, 10), line.limit=3L,
  pager="off"
)
}
diffobj/man/StyleSummary.Rd0000644000176200001440000000126414122754044015403 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/styles.R
\docType{class}
\name{StyleSummary-class}
\alias{StyleSummary-class}
\alias{StyleSummary}
\alias{StyleSummaryHtml-class}
\alias{StyleSummaryHtml}
\title{Styling Information for Summaries}
\description{
Styling Information for Summaries
}
\section{Slots}{

\describe{
\item{\code{container}}{function applied to entire summary}

\item{\code{body}}{function applied to everything except the actual map portion of
the summary}

\item{\code{detail}}{function applied to section showing how many deletions /
insertions, etc. occurred}

\item{\code{map}}{function applied to the map portion of the summary}
}}

diffobj/man/diffCsv.Rd0000644000176200001440000004505315001246431014306 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/diff.R
\name{diffCsv}
\alias{diffCsv}
\alias{diffCsv,ANY-method}
\title{Diff CSV Files}
\usage{
diffCsv(target, current, ...)

\S4method{diffCsv}{ANY}(
  target,
  current,
  mode = gdo("mode"),
  context = gdo("context"),
  format = gdo("format"),
  brightness = gdo("brightness"),
  color.mode = gdo("color.mode"),
  word.diff = gdo("word.diff"),
  pager = gdo("pager"),
  guides = gdo("guides"),
  trim = gdo("trim"),
  rds = gdo("rds"),
  unwrap.atomic = gdo("unwrap.atomic"),
  max.diffs = gdo("max.diffs"),
  disp.width = gdo("disp.width"),
  ignore.white.space = gdo("ignore.white.space"),
  convert.hz.white.space = gdo("convert.hz.white.space"),
  tab.stops = gdo("tab.stops"),
  line.limit = gdo("line.limit"),
  hunk.limit = gdo("hunk.limit"),
  align = gdo("align"),
  style = gdo("style"),
  palette.of.styles = gdo("palette"),
  frame = par_frame(),
  interactive = gdo("interactive"),
  term.colors = gdo("term.colors"),
  tar.banner = NULL,
  cur.banner = NULL,
  strip.sgr = gdo("strip.sgr"),
  sgr.supported = gdo("sgr.supported"),
  extra = list()
)
}
\arguments{
\item{target}{character(1L) or file connection with read capability;
if character should point to a CSV file}

\item{current}{like \code{target}}

\item{...}{unused, for compatibility of methods with generics}

\item{mode}{character(1L), one of:
\itemize{
  \item \dQuote{unified}: diff mode used by \code{git diff}
  \item \dQuote{sidebyside}: line up the differences side by side
  \item \dQuote{context}: show the target and current hunks in their
    entirety; this mode takes up a lot of screen space but makes it easier
    to see what the objects actually look like
  \item \dQuote{auto}: default mode; pick one of the above, will favor
    \dQuote{sidebyside} unless \code{getOption("width")} is less than 80,
    or in \code{diffPrint} and objects are dimensioned and do not fit side
    by side, or in \code{diffChr}, \code{diffDeparse}, \code{diffFile} and
    output does not fit in side by side without wrapping
}}

\item{context}{integer(1L) how many lines of context are shown on either side
of differences (defaults to 2).  Set to \code{-1L} to allow as many as
there are.  Set to \dQuote{auto}  to display as many as 10 lines or as few
as 1 depending on whether total screen lines fit within the number of lines
specified in \code{line.limit}.  Alternatively pass the return value of
\code{\link{auto_context}} to fine tune the parameters of the auto context
calculation.}

\item{format}{character(1L), controls the diff output format, one of:
\itemize{
  \item \dQuote{auto}: to select output format based on terminal
    capabilities; will attempt to use one of the ANSI formats if they
    appear to be supported, and if not or if you are in the Rstudio console
    it will attempt to use HTML and browser output if in interactive mode.
  \item \dQuote{raw}: plain text
  \item \dQuote{ansi8}: color and format diffs using basic ANSI escape
    sequences
  \item \dQuote{ansi256}: like \dQuote{ansi8}, except using the full range
    of ANSI formatting options
  \item \dQuote{html}: color and format using HTML markup; the resulting
    string is processed with \code{\link{enc2utf8}} when output as a full
    web page (see docs for \code{html.output} under \code{\link{Style}}).
}
Defaults to \dQuote{auto}.  See \code{palette.of.styles} for details
on customization, \code{\link{Style}} for full control of output format.
See `pager` parameter for more discussion of Rstudio behavior.}

\item{brightness}{character, one of \dQuote{light}, \dQuote{dark},
\dQuote{neutral}, useful for adjusting color scheme to light or dark
terminals.  \dQuote{neutral} by default.  See \code{\link{PaletteOfStyles}}
for details and limitations.  Advanced: you may specify brightness as a
function of \code{format}.  For example, if you typically wish to use a
\dQuote{dark} color scheme, except for when in \dQuote{html} format when
you prefer the \dQuote{light} scheme, you may use
\code{c("dark", html="light")} as the value for this parameter.  This is
particularly useful if \code{format} is set to \dQuote{auto} or if you
want to specify a default value for this parameter via options.  Any names
you use should correspond to a \code{format}.  You must have one unnamed
value which will be used as the default for all \code{format}s that are
not explicitly specified.}

\item{color.mode}{character, one of \dQuote{rgb} or \dQuote{yb}.
Defaults to \dQuote{yb}.  \dQuote{yb} stands for \dQuote{Yellow-Blue} for
color schemes that rely primarily on those colors to style diffs.
Those colors can be easily distinguished by individuals with
limited red-green color sensitivity.  See \code{\link{PaletteOfStyles}} for
details and limitations.  Also offers the same advanced usage as the
\code{brightness} parameter.}

\item{word.diff}{TRUE (default) or FALSE, whether to run a secondary word
diff on the in-hunk differences.  For atomic vectors setting this to
FALSE could make the diff \emph{slower} (see the \code{unwrap.atomic}
parameter).  For other uses, particularly with \code{\link{diffChr}}
setting this to FALSE can substantially improve performance.}

\item{pager}{one of \dQuote{auto} (default), \dQuote{on},
  \dQuote{off}, a \code{\link{Pager}} object, or a list; controls whether and
  how a pager is used to display the diff output.  If you require a
  particular pager behavior you must use a \code{\link{Pager}}
  object, or \dQuote{off} to turn off the pager.  All other settings will
  interact with other parameters such as \code{format}, \code{style}, as well
  as with your system capabilities in order to select the pager expected to
  be most useful.

  \dQuote{auto} and \dQuote{on} are the same, except that in non-interactive
  mode \dQuote{auto} is equivalent to \dQuote{off}.  \dQuote{off} will always
  send output to the console.  If \dQuote{on}, whether the output
  actually gets routed to the pager depends on the pager \code{threshold}
  setting (see \code{\link{Pager}}).  The default behavior is to use the
  pager associated with the \code{Style} object.  The \code{Style} object is
  itself is determined by the \code{format} or \code{style} parameters.

  Depending on your system configuration different styles and corresponding
  pagers will get selected, unless you specify a \code{Pager} object
  directly.  On a system with a system pager that supports ANSI CSI SGR
  colors, the pager will only trigger if the output is taller than one
  window.  If the system pager is not known to support ANSI colors then the
  output will be sent as HTML to the IDE viewer if available or to the web
  browser if not.  Even though Rstudio now supports ANSI CSI SGR at the
  console output is still formatted as HTML and sent to the IDE viewer.
  Partly this is for continuity of behavior, but also because the default
  Rstudio pager does not support ANSI CSI SGR, at least as of this writing.

  If \code{pager} is a list, then the same as with \dQuote{on}, except that
  the \code{Pager} object associated with the selected \code{Style} object is
  re-instantiated with the union of the list elements and the existing
  settings of that \code{Pager}.  The list should contain named elements that
  correspond to the \code{\link{Pager}} instantiation parameters.  The names
  must be specified in full as partial parameter matching will not be carried
  out because the pager is re-instantiated with \code{\link{new}}.

  See \code{\link{Pager}}, \code{\link{Style}}, and
  \code{\link{PaletteOfStyles}} for more details and for instructions on how
  to modify the default behavior.}

\item{guides}{TRUE (default), FALSE, or a function that accepts at least two
arguments and requires no more than two arguments.  Guides
are additional context lines that are not strictly part of a hunk, but
provide important contextual data (e.g. column headers).  If TRUE, the
context lines are shown in addition to the normal diff output, typically
in a different color to indicate they are not part of the hunk.  If a
function, the function should accept as the first argument the object
being diffed, and the second the character representation of the object.
The function should return the indices of the elements of the
character representation that should be treated as guides.  See
\code{\link{guides}} for more details.}

\item{trim}{TRUE (default), FALSE, or a function that accepts at least two
arguments and requires no more than two arguments.  Function should compute
for each line in captured output what portion of those lines should be
diffed.  By default, this is used to remove row meta data differences
(e.g. \code{[1,]}) so they alone do not show up as differences in the
diff.  See \code{\link{trim}} for more details.}

\item{rds}{TRUE (default) or FALSE, if TRUE will check whether
\code{target} and/or \code{current} point to a file that can be read with
\code{\link{readRDS}} and if so, loads the R object contained in the file
and carries out the diff on the object instead of the original argument.
Currently there is no mechanism for specifying additional arguments to
\code{readRDS}}

\item{unwrap.atomic}{TRUE (default) or FALSE.  Relevant primarily for
\code{diffPrint}, if TRUE, and \code{word.diff} is also TRUE, and both
\code{target} and \code{current} are \emph{unnamed} one-dimension atomics ,
the vectors are unwrapped and diffed element by element, and then
re-wrapped.  Since \code{diffPrint} is fundamentally a line diff, the
re-wrapped lines are lined up in a manner that is as consistent as possible
with the unwrapped diff.  Lines that contain the location of the word
differences will be paired up.  Since the vectors may well be wrapped with
different periodicities this will result in lines that are paired up that
look like they should not be paired up, though the locations of the
differences should be.  If is entirely possible that setting this parameter
to FALSE will result in a slower diff.  This happens if two vectors are
actually fairly similar, but their line representations are not.  For
example, in comparing \code{1:100} to \code{c(100, 1:99)}, there is really
only one difference at the \dQuote{word} level, but every screen line is
different.  \code{diffChr} will also do the unwrapping if it is given a
character vector that contains output that looks like the atomic vectors
described above.  This is a bug, but as the functionality could be useful
when diffing e.g. \code{capture.output} data, we now declare it a feature.}

\item{max.diffs}{integer(1L), number of \emph{differences} (default 50000L)
after which we abandon the \code{O(n^2)} diff algorithm in favor of a naive
\code{O(n)} one. Set to \code{-1L} to stick to the original algorithm up to
the maximum allowed (~INT_MAX/4).}

\item{disp.width}{integer(1L) number of display columns to take up; note that
in \dQuote{sidebyside} \code{mode} the effective display width is half this
number (set to 0L to use default widths which are \code{getOption("width")}
for normal styles and \code{80L} for HTML styles.  Future versions of
\code{diffobj} may change this to larger values for two dimensional objects
for better diffs (see details).}

\item{ignore.white.space}{TRUE or FALSE, whether to consider differences in
horizontal whitespace (i.e. spaces and tabs) as differences (defaults to
TRUE).}

\item{convert.hz.white.space}{TRUE or FALSE, whether modify input strings
that contain tabs and carriage returns in such a way that they display as
they would \bold{with} those characters, but without using those
characters (defaults to TRUE).  The conversion assumes that tab stops are
spaced evenly eight characters apart on the terminal.  If this is not the
case you may specify the tab stops explicitly with \code{tab.stops}.}

\item{tab.stops}{integer, what tab stops to use when converting hard tabs to
spaces.  If not integer will be coerced to integer (defaults to 8L).  You
may specify more than one tab stop.  If display width exceeds that
addressable by your tab stops the last tab stop will be repeated.}

\item{line.limit}{integer(2L) or integer(1L), if length 1 how many lines of
output to show, where \code{-1} means no limit.  If length 2, the first
value indicates the threshold of screen lines to begin truncating output,
and the second the number of lines to truncate to, which should be fewer
than the threshold.  Note that this parameter is implemented on a
best-efforts basis and should not be relied on to produce the exact
number of lines requested.  In particular do not expect it to work well for
for values small enough that the banner portion of the diff would have to
be trimmed.  If you want a specific number of lines use \code{[} or
\code{head} / \code{tail}.  One advantage of \code{line.limit} over these
other options is that you can combine it with \code{context="auto"} and
auto \code{max.level} selection (the latter for \code{diffStr}), which
allows the diff to dynamically adjust to make best use of the available
display lines.  \code{[}, \code{head}, and \code{tail} just subset the text
of the output.}

\item{hunk.limit}{integer(2L) or integer (1L), how many diff hunks to show.
Behaves similarly to \code{line.limit}.  How many hunks are in a
particular diff is a function of how many differences, and also how much
\code{context} is used since context can cause two hunks to bleed into
each other and become one.}

\item{align}{numeric(1L) between 0 and 1, proportion of
words in a line of \code{target} that must be matched in a line of
\code{current} in the same hunk for those lines to be paired up when
displayed (defaults to 0.25), or an \code{\link{AlignThreshold}} object.
Set to \code{1} to turn off alignment which will cause all lines in a hunk
from \code{target} to show up first, followed by all lines from
\code{current}.  Note that in order to be aligned lines must meet the
threshold and have at least 3 matching alphanumeric characters (see
\code{\link{AlignThreshold}} for details).}

\item{style}{\dQuote{auto}, a \code{\link{Style}} object, or a list.
\dQuote{auto} by default.  If a \code{Style} object, will override the
the \code{format}, \code{brightness}, and \code{color.mode} parameters.
The \code{Style} object provides full control of diff output styling.
If a list, then the same as \dQuote{auto}, except that if the auto-selected
\code{Style} requires instantiation (see \code{\link{PaletteOfStyles}}),
then the list contents will be used as arguments when instantiating the
style object.  See \code{\link{Style}} for more details, in particular the
examples.}

\item{palette.of.styles}{\code{\link{PaletteOfStyles}} object; advanced
usage, contains all the \code{\link{Style}} objects or
\dQuote{classRepresentation} objects extending \code{\link{Style}} that are
selected by specifying the \code{format}, \code{brightness}, and
\code{color.mode} parameters.  See \code{\link{PaletteOfStyles}} for more
details.}

\item{frame}{an environment to use as the evaluation frame for the
\code{print/show/str}, calls and for \code{diffObj}, the evaluation frame
for the \code{diffPrint} / \code{diffStr} calls.  Defaults to the return
value of \code{\link{par_frame}}.}

\item{interactive}{TRUE or FALSE whether the function is being run in
interactive mode, defaults to the return value of
\code{\link{interactive}}.  If in interactive mode, pager will be used if
\code{pager} is \dQuote{auto}, and if ANSI styles are not supported and
\code{style} is \dQuote{auto}, output will be send to viewer/browser as
HTML.}

\item{term.colors}{integer(1L) how many ANSI colors are supported by the
terminal.  This variable is provided for when
\code{\link[crayon:num_colors]{crayon::num_colors}} does not properly
detect how many ANSI colors are supported by your terminal. Defaults to
return value of \code{\link[crayon:num_colors]{crayon::num_colors}} and
should be 8 or 256 to allow ANSI colors, or any other number to disallow
them.  This only impacts output format selection when \code{style} and
\code{format} are both set to \dQuote{auto}.}

\item{tar.banner}{character(1L), language, or NULL, used to generate the
text to display ahead of the diff section representing the target output.
If NULL will use the deparsed \code{target} expression, if language, will
use the language as it would the \code{target} expression, if
character(1L), will use the string with no modifications.  The language
mode is provided because \code{diffStr} modifies the expression prior to
display (e.g. by wrapping it in a call to \code{str}).  Note that it is
possible in some cases that the substituted value of \code{target} actually
is character(1L), but if you provide a character(1L) value here it will be
assumed you intend to use that value literally.}

\item{cur.banner}{character(1L) like \code{tar.banner}, but for
\code{current}}

\item{strip.sgr}{TRUE, FALSE, or NULL (default), whether to strip ANSI CSI
SGR sequences prior to comparison and for display of diff.  If NULL,
resolves to TRUE if `style` resolves to an ANSI formatted diff, and
FALSE otherwise.  The default behavior is to avoid confusing diffs where
the original SGR and the SGR added by the diff are mixed together.}

\item{sgr.supported}{TRUE, FALSE, or NULL (default), whether to assume the
standard output device supports ANSI CSI SGR sequences.  If TRUE, strings
will be manipulated accounting for the SGR sequences.  If NULL,
resolves to TRUE if `style` resolves to an ANSI formatted diff, and
to `crayon::has_color()` otherwise.  This only controls how the strings are
manipulated, not whether SGR is added to format the diff, which is
controlled by the `style` parameter.  This parameter is exposed for the
rare cases where you might wish to control string manipulation behavior
directly.}

\item{extra}{list additional arguments to pass on to the functions used to
create text representation of the objects to diff (e.g. \code{print},
\code{str}, etc.)}
}
\value{
a \code{Diff} object; see \code{\link{diffPrint}}.
}
\description{
Reads CSV files with \code{\link{read.csv}} and passes the resulting data
frames onto \code{\link{diffPrint}}.  \code{extra} values are passed as
arguments are passed to both \code{read.csv} and \code{print}.  To the
extent you wish to use different \code{extra} arguments for each of those
functions you will need to \code{read.csv} the files and pass them to
\code{diffPrint} yourself.
}
\examples{
iris.2 <- iris
iris.2$Sepal.Length[5] <- 99
f1 <- tempfile()
f2 <- tempfile()
write.csv(iris, f1, row.names=FALSE)
write.csv(iris.2, f2, row.names=FALSE)
## `pager="off"` for CRAN compliance; you may omit in normal use
diffCsv(f1, f2, pager="off")
unlink(c(f1, f2))
}
\seealso{
\code{\link{diffPrint}} for details on the \code{diff*} functions,
  \code{\link{diffObj}}, \code{\link{diffStr}},
  \code{\link{diffChr}} to compare character vectors directly,
  \code{\link{ses}} for a minimal and fast diff
}
diffobj/man/Style.Rd0000644000176200001440000003432314122754044014027 0ustar  liggesusers% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/styles.R
\docType{class}
\name{Style-class}
\alias{Style-class}
\alias{Style}
\alias{StyleRaw-class}
\alias{StyleRaw}
\alias{StyleAnsi-class}
\alias{StyleAnsi}
\alias{StyleAnsi8NeutralRgb-class}
\alias{StyleAnsi8NeutralRgb}
\alias{StyleAnsi8NeutralYb-class}
\alias{StyleAnsi8NeutralYb}
\alias{StyleAnsi256LightRgb-class}
\alias{StyleAnsi256LightRgb}
\alias{StyleAnsi256LightYb-class}
\alias{StyleAnsi256LightYb}
\alias{StyleAnsi256DarkRgb-class}
\alias{StyleAnsi256DarkRgb}
\alias{StyleAnsi256DarkYb-class}
\alias{StyleAnsi256DarkYb}
\alias{StyleHtml-class}
\alias{StyleHtml}
\alias{StyleHtmlLightRgb-class}
\alias{StyleHtmlLightRgb}
\alias{StyleHtmlLightYb-class}
\alias{StyleHtmlLightYb}
\title{Customize Appearance of Diff}
\arguments{
\item{funs}{a \code{\link{StyleFuns}} object that contains all the functions
represented above}

\item{text}{a \code{\link{StyleText}} object that contains the non-content
text used by the diff (e.g. \code{gutter.insert.txt})}

\item{summary}{a \code{\link{StyleSummary}} object that contains formatting
functions and other meta data for rendering summaries}

\item{pad}{TRUE or FALSE, whether text should be right padded}

\item{pager}{what type of \code{\link{Pager}} to use}

\item{nchar.fun}{function to use to count characters; intended mostly for
internal use (used only for gutters as of version 0.2.0).}

\item{wrap}{TRUE or FALSE, whether text should be hard wrapped at
\code{disp.width}}

\item{na.sub}{what character value to substitute for NA elements; NA elements
are generated when lining up side by side diffs by adding padding rows; by
default the text styles replace these with a blank character string, and
the HTML styles leave them as NA for the HTML formatting functions to deal
with}

\item{blank}{sub what character value to replace blanks with; needed in
particular for HTML rendering (uses \code{" "}) to prevent lines from
collapsing}

\item{disp.width}{how many columns the text representation of the objects to
diff is allowed to take up before it is hard wrapped (assuming \code{wrap}
is TRUE).  See param \code{disp.width} for \code{\link{diffPrint}}.}

\item{finalizer}{function that accepts at least two parameters and requires
no more than two parameters, will receive as the first parameter the
the object to render (either a \code{Diff} or a \code{DiffSummary}
object), and the text representation of that object as the second
argument.  This allows final modifications to the character output so that
it is displayed correctly by the pager.  For example, \code{StyleHtml}
objects use it to generate HTML headers if the \code{Diff} is destined to
be displayed in a browser.  The object themselves are passed along to
provide information about the paging device and other contextual data to
the function.}

\item{html.output}{(\code{StyleHtml} objects only) one of:
\itemize{
  \item \dQuote{page}: Include all HTML/CSS/JS required to create a
    stand-alone web page with the diff; in this mode the diff string will
    be re-encoded with \code{\link{enc2utf8}} and the HTML page encoding
    will be declared as UTF-8.
  \item \dQuote{diff.w.style}: The CSS and HTML, but without any of the
    outer tags that would make it a proper HTML page (i.e. no
    \code{/} tags or the like) and without the JS; note that
    technically this is illegal HTML since we have \code{