[Rd] Some "new" stuff for hist.R
Kjetil Kjernsmo
kjetil.kjernsmo@astro.uio.no
Thu, 23 Mar 2000 18:37:53 +0100 (MET)
This message is in MIME format. The first part should be readable text,
while the remaining parts are likely unreadable without MIME-aware tools.
Send mail to mime@docserver.cac.washington.edu for more info.
--0-201145637-953833073=:7710
Content-Type: TEXT/PLAIN; charset=US-ASCII
Dear all,
I've been hacking on histograms the past couple of days. I wanted to do
two things, add histograms where the breaks of one histogram is a
subset sequence of the other, and get a histogram plot from a histogram
object. I found no function to do these things and got no response on
r-help, so I started doing it myself. I think I have solved it now, so
I have attached the code I've got, in case it would be something to
include in R in the future.
I guess most of the file is your code, that is, it's just hist.default
with only two changes:
In the line
stop("`probability' is an alias for `!freq', however they differ.")
--------------------^ closing ' was missing
and it returns an object with class="histogram".
Then, I made hist.histogram, that plots an existing "histogram" object.
This is also just your code, I just did cut'n'paste on the parts that
seemed relevant. One might argue that the default method should be split
in two, since these two parts are almost identical.
Then, there's adding. To find a subset sequence, I wrote a
sub.vector-function, admittedly very ugly, what I really wanted was a
function that would output the union of sequences and pad the rest with
zeros. Anyway, the function solves my problem... (I'm not usually a
pragmatist... :-)) Then, there's the add.histogram function that outputs a
histogram object. I tried to declare "+".histogram, "%+%".histogram and
things like that, in the hope of creating a binary operator for
histograms, but I couldn't get it to work. Anyway, this is what I've got,
I hope it can be used.
Best,
Kjetil
--
Kjetil Kjernsmo
Graduate astronomy-student Problems worthy of attack
University of Oslo, Norway Prove their worth by hitting back
E-mail: kjetikj@astro.uio.no - Piet Hein
Homepage <URL:http://www.astro.uio.no/~kjetikj/>
Webmaster@skepsis.no
--0-201145637-953833073=:7710
Content-Type: TEXT/PLAIN; charset=US-ASCII; name="hist.R"
Content-Transfer-Encoding: BASE64
Content-ID: <Pine.OSF.4.05.10003231837530.7710@alnair.uio.no>
Content-Description: Histogram R-code
Content-Disposition: attachment; filename="hist.R"
aGlzdCA8LSBmdW5jdGlvbih4LCAuLi4pIFVzZU1ldGhvZCgiaGlzdCIpDQoN
Cmhpc3QuZGVmYXVsdCA8LQ0KICAgIGZ1bmN0aW9uICh4LCBicmVha3MsIGZy
ZXE9IE5VTEwsIHByb2JhYmlsaXR5ID0gIWZyZXEsIGluY2x1ZGUubG93ZXN0
PSBUUlVFLA0KCSAgICAgIHJpZ2h0PVRSVUUsIGNvbCA9IE5VTEwsIGJvcmRl
ciA9IHBhcigiZmciKSwNCgkgICAgICBtYWluID0gcGFzdGUoIkhpc3RvZ3Jh
bSBvZiIgLCBkZXBhcnNlKHN1YnN0aXR1dGUoeCkpKSwNCgkgICAgICB4bGlt
ID0gcmFuZ2UoYnJlYWtzKSwgeWxpbSA9IHJhbmdlKHksIDApLA0KCSAgICAg
IHhsYWIgPSBkZXBhcnNlKHN1YnN0aXR1dGUoeCkpLCB5bGFiLA0KCSAgICAg
IGF4ZXMgPSBUUlVFLCBwbG90ID0gVFJVRSwgbGFiZWxzID0gRkFMU0UsIG5j
bGFzcyA9IE5VTEwsIC4uLikNCnsNCiAgICBpZiAoIWlzLm51bWVyaWMoeCkp
DQoJc3RvcCgiaGlzdDogeCBtdXN0IGJlIG51bWVyaWMiKQ0KICAgIG1haW4g
IyBldmFsKCkgbm93OiBkZWZlYXQgbGF6eSBldmFsDQogICAgeGxhYg0KICAg
IG4gPC0gbGVuZ3RoKHggPC0geFshaXMubmEoeCldKQ0KICAgIHVzZS5iciA8
LSAhbWlzc2luZyhicmVha3MpDQogICAgaWYodXNlLmJyKSB7DQoJaWYoIW1p
c3NpbmcobmNsYXNzKSkNCgkgICAgd2FybmluZygiYG5jbGFzcycgbm90IHVz
ZWQgd2hlbiBgYnJlYWtzJyBzcGVjaWZpZWQiKQ0KICAgIH0NCiAgICBlbHNl
IGlmKCFpcy5udWxsKG5jbGFzcykgJiYgbGVuZ3RoKG5jbGFzcykgPT0gMSkN
CglicmVha3MgPC0gbmNsYXNzDQogICAgdXNlLmJyIDwtIHVzZS5iciAmJiAo
bkIgPC0gbGVuZ3RoKGJyZWFrcykpID4gMQ0KICAgIGlmKHVzZS5icikNCgli
cmVha3MgPC0gc29ydChicmVha3MpDQogICAgZWxzZSB7ICMgY29uc3RydWN0
IHZlY3RvciBvZiBicmVha3MNCglyeCA8LSByYW5nZSh4KQ0KCW5uYiA8LQ0K
CSAgICBpZihtaXNzaW5nKGJyZWFrcykpIDEgKyBsb2cyKG4pDQoJICAgIGVs
c2UgeyAjIGJyZWFrcyA9IGBuY2xhc3MnDQoJCWlmIChpcy5uYShicmVha3Mp
IHwgYnJlYWtzIDwgMikNCgkJICAgIHN0b3AoImludmFsaWQgbnVtYmVyIG9m
IGJyZWFrcyIpDQoJCWJyZWFrcw0KCSAgICB9DQoJYnJlYWtzIDwtIHByZXR0
eSAocngsIG4gPSBubmIsIG1pbi5uPTEsIGVwcy5jb3JyID0gMikNCgluQiA8
LSBsZW5ndGgoYnJlYWtzKQ0KCWlmKG5CIDw9IDEpIHsgIyMtLSBJbXBvc3Np
YmxlICENCgkgICAgc3RvcChwYXN0ZSgiaGlzdC5kZWZhdWx0OiBwcmV0dHko
KSBlcnJvciwgYnJlYWtzPSIsZm9ybWF0KGJyZWFrcykpKQ0KCX0NCiAgICB9
DQogICAgc3RvcmFnZS5tb2RlKHgpIDwtICJkb3VibGUiDQogICAgc3RvcmFn
ZS5tb2RlKGJyZWFrcykgPC0gImRvdWJsZSINCiAgICBjb3VudHMgPC0gLkMo
ImJpbmNvdW50IiwNCgkJIHgsDQoJCSBuLA0KCQkgYnJlYWtzLA0KCQkgbkIs
DQoJCSBjb3VudHMgPSBpbnRlZ2VyKG5CIC0gMSksDQoJCSByaWdodAk9IGFz
LmxvZ2ljYWwocmlnaHQpLA0KCQkgaW5jbHVkZT0gYXMubG9naWNhbChpbmNs
dWRlLmxvd2VzdCksDQoJCSBOQU9LID0gRkFMU0UsIERVUCA9IEZBTFNFLCBQ
QUNLQUdFID0gImJhc2UiKSAkY291bnRzDQogICAgaWYgKGFueShjb3VudHMg
PCAwKSkNCglzdG9wKCJuZWdhdGl2ZSBgY291bnRzJy4gSW50ZXJuYWwgRXJy
b3IgaW4gQy1jb2RlIGZvciBcImJpbmNvdW50XCIiKQ0KICAgIGlmIChzdW0o
Y291bnRzKSA8IG4pDQoJc3RvcCgic29tZSBgeCcgbm90IGNvdW50ZWQ7IG1h
eWJlIGBicmVha3MnIGRvIG5vdCBzcGFuIHJhbmdlIG9mIGB4JyIpDQogICAg
aCA8LSBkaWZmKGJyZWFrcykNCiAgICBpZiAoIXVzZS5iciAmJiBhbnkoaCA8
PSAwKSkNCglzdG9wKCJub3Qgc3RyaWN0bHkgaW5jcmVhc2luZyBgYnJlYWtz
Jy4iKQ0KICAgIGlmIChpcy5udWxsKGZyZXEpKSB7DQoJZnJlcSA8LSBpZigh
bWlzc2luZyhwcm9iYWJpbGl0eSkpDQoJICAgICFhcy5sb2dpY2FsKHByb2Jh
YmlsaXR5KQ0KCWVsc2UgaWYodXNlLmJyKSB7DQoJICAgICMjLS0gRG8gZnJl
cXVlbmNpZXMgaWYgYnJlYWtzIGFyZSBldmVubHkgc3BhY2VkDQoJICAgIG1h
eChoKS1taW4oaCkgPCAxZS03ICogbWVhbihoKQ0KCX0gZWxzZSBUUlVFDQog
ICAgfSBlbHNlIGlmKCFtaXNzaW5nKHByb2JhYmlsaXR5KSAmJiBhbnkocHJv
YmFiaWxpdHkgPT0gZnJlcSkpDQoJc3RvcCgiYHByb2JhYmlsaXR5JyBpcyBh
biBhbGlhcyBmb3IgYCFmcmVxJywgaG93ZXZlciB0aGV5IGRpZmZlci4iKQ0K
ICAgIGludGVuc2l0aWVzIDwtIGNvdW50cy8obipoKQ0KICAgIG1pZHMgPC0g
MC41ICogKGJyZWFrc1stMV0gKyBicmVha3NbLW5CXSkNCiAgICB5IDwtIGlm
IChmcmVxKSBjb3VudHMgZWxzZSBpbnRlbnNpdGllcw0KICAgIHIgPC0gc3Ry
dWN0dXJlKGxpc3QoYnJlYWtzID0gYnJlYWtzLCBjb3VudHMgPSBjb3VudHMs
DQoJICAgICAgaW50ZW5zaXRpZXMgPSBpbnRlbnNpdGllcywgbWlkcyA9IG1p
ZHMpLCBjbGFzcz0iaGlzdG9ncmFtIikNCiAgICBpZiAocGxvdCkgew0KCXBs
b3QubmV3KCkNCglwbG90LndpbmRvdyh4bGltLCB5bGltLCAiIikgIy0+IHls
aW0ncyBkZWZhdWx0IGZyb20gJ3knDQoJaWYgKG1pc3NpbmcoeWxhYikpDQoJ
ICAgIHlsYWIgPC0gcGFzdGUoaWYoIWZyZXEpIlJlbGF0aXZlICIsICJGcmVx
dWVuY3kiLCBzZXA9IiIpDQoJaWYoZnJlcSAmJiB1c2UuYnIgJiYgbWF4KGgp
LW1pbihoKSA+IDFlLTcgKiBtZWFuKGgpKQ0KCSAgICB3YXJuaW5nKCJ0aGUg
QVJFQVMgaW4gdGhlIHBsb3QgYXJlIHdyb25nIC0tIG1heWJlIHVzZSBgZnJl
cT1GQUxTRSciKQ0KCXRpdGxlKG1haW4gPSBtYWluLCB4bGFiID0geGxhYiwg
eWxhYiA9IHlsYWIsIC4uLikNCglpZihheGVzKSB7DQoJICAgIGF4aXMoMSwg
Li4uKQ0KCSAgICBheGlzKDIsIC4uLikNCgl9DQoJcmVjdChicmVha3NbLW5C
XSwgMCwgYnJlYWtzWy0xXSwgeSwNCgkgICAgIGNvbCA9IGNvbCwgYm9yZGVy
ID0gYm9yZGVyKQ0KCWlmKGxhYmVscykNCgkgICAgdGV4dChtaWRzLCB5LA0K
CQkgbGFiZWxzID0gaWYoZnJlcSkgY291bnRzIGVsc2Ugcm91bmQoaW50ZW5z
aXRpZXMsMyksDQoJCSBhZGogPSBjKDAuNSwgLTAuNSkpDQoJaW52aXNpYmxl
KHIpDQogICAgfQ0KICAgIGVsc2Ugcg0KfQ0KDQoNCmhpc3QuaGlzdG9ncmFt
IDwtDQogIGZ1bmN0aW9uIChoLCBmcmVxPSBOVUxMLCBwcm9iYWJpbGl0eSA9
ICFmcmVxLCANCgkgICAgICBjb2wgPSBOVUxMLCBib3JkZXIgPSBwYXIoImZn
IiksDQoJICAgICAgbWFpbiA9IHBhc3RlKCJIaXN0b2dyYW0gb2YiICwgZGVw
YXJzZShzdWJzdGl0dXRlKGgpKSksDQoJICAgICAgeGxpbSA9IHJhbmdlKGgk
YnJlYWtzKSwgeWxpbSA9IHJhbmdlKHksIDApLA0KCSAgICAgIHhsYWIgPSBk
ZXBhcnNlKHN1YnN0aXR1dGUoaCkpLCB5bGFiLA0KCSAgICAgIGF4ZXMgPSBU
UlVFLCBsYWJlbHMgPSBGQUxTRSwgIC4uLikNCnsNCiAgaWYgKGlzLm51bGwo
ZnJlcSkpIHsNCiAgICBmcmVxIDwtIGlmKCFtaXNzaW5nKHByb2JhYmlsaXR5
KSkNCiAgICAgICFhcy5sb2dpY2FsKHByb2JhYmlsaXR5KSBlbHNlIFRSVUUN
CiAgfSBlbHNlIGlmKCFtaXNzaW5nKHByb2JhYmlsaXR5KSAmJiBhbnkocHJv
YmFiaWxpdHkgPT0gZnJlcSkpDQogICAgc3RvcCgiYHByb2JhYmlsaXR5JyBp
cyBhbiBhbGlhcyBmb3IgYCFmcmVxJywgaG93ZXZlciB0aGV5IGRpZmZlci4i
KQ0KICB5IDwtIGlmIChmcmVxKSBoJGNvdW50cyBlbHNlIGgkaW50ZW5zaXRp
ZXMNCiAgbkIgPC0gbGVuZ3RoKGgkYnJlYWtzKQ0KICBwbG90Lm5ldygpDQog
IHBsb3Qud2luZG93KHhsaW0sIHlsaW0sICIiKSAjLT4geWxpbSdzIGRlZmF1
bHQgZnJvbSAneScNCiAgaWYgKG1pc3NpbmcoeWxhYikpDQogICAgeWxhYiA8
LSBwYXN0ZShpZighZnJlcSkiUmVsYXRpdmUgIiwgIkZyZXF1ZW5jeSIsIHNl
cD0iIikNCiAgdGl0bGUobWFpbiA9IG1haW4sIHhsYWIgPSB4bGFiLCB5bGFi
ID0geWxhYiwgLi4uKQ0KICBpZihheGVzKSB7DQogICAgYXhpcygxLCAuLi4p
DQogICAgYXhpcygyLCAuLi4pDQogIH0NCiAgcmVjdChoJGJyZWFrc1stbkJd
LCAwLCBoJGJyZWFrc1stMV0sIHksDQogICAgICAgY29sID0gY29sLCBib3Jk
ZXIgPSBib3JkZXIpDQogIGlmKGxhYmVscykNCiAgICB0ZXh0KGgkbWlkcywg
eSwNCiAgICAgICAgIGxhYmVscyA9IGlmKGZyZXEpIGgkY291bnRzIGVsc2Ug
cm91bmQoaCRpbnRlbnNpdGllcywzKSwNCiAgICAgICAgIGFkaiA9IGMoMC41
LCAtMC41KSkNCiAgaW52aXNpYmxlKHkpDQp9DQpzdWIudmVjdG9yIDwtIGZ1
bmN0aW9uKGIxLCBiMikNCnsNCiAgaSA8LSAwDQogIHdoaWxlKCEgYWxsKGIy
WyhpKzEpOihsZW5ndGgoYjEpK2kpXSA9PSBiMSkpDQogIHsgICANCiAgICBp
PC1pKzENCiAgICBpZihpK2xlbmd0aChiMSkgPiBsZW5ndGgoYjIpKSByZXR1
cm4oTlVMTCkNCiAgfQ0KICByZXR1cm4oKGkrMSk6KGxlbmd0aChiMSkraSkp
DQp9DQoNCmFkZC5oaXN0b2dyYW0gPC0gZnVuY3Rpb24oaDEsIGgyKQ0Kew0K
ICBpZihsZW5ndGgoaDEkYnJlYWtzKSA+PSBsZW5ndGgoaDIkYnJlYWtzKSkN
CiAgew0KICAgIGJsIDwtIGgxJGJyZWFrcw0KICAgIGJzIDwtIGgyJGJyZWFr
cw0KICAgIGNsIDwtIGgxJGNvdW50cw0KICAgIGNzIDwtIGgyJGNvdW50cw0K
ICAgIG1pIDwtIGgxJG1pZHMNCiAgfSBlbHNlIHsNCiAgICBicyA8LSBoMSRi
cmVha3MNCiAgICBibCA8LSBoMiRicmVha3MNCiAgICBjcyA8LSBoMSRjb3Vu
dHMNCiAgICBjbCA8LSBoMiRjb3VudHMNCiAgICBtaSA8LSBoMiRtaWRzDQog
IH0NCiAgaW5kIDwtIHN1Yi52ZWN0b3IoYnMsIGJsKQ0KICBpZighIGlzLnZl
Y3RvcihpbmQpKSBzdG9wKCJJbmNvbXBhdGlibGUgYnJlYWtzIikNCiAgYzAg
PC0gcmVwKDAsIGxlbmd0aChjbCkpDQogIGMwW2luZFsxOmxlbmd0aChjcyld
XSA8LSBjcw0KICBjdCA8LSBjMCArIGNsDQogIGludCA8LSBjdC8oc3VtKGN0
KSpkaWZmKGJsKSkgIyBUaGlzIHdvcmtzIGZvciBub24tZXF1aWRpc3RhbnQg
YnJlYWtzPw0KICByZXR1cm4oc3RydWN0dXJlKGxpc3QoYnJlYWtzPWJsLA0K
ICAgICAgICAgICAgICAgICAgICAgICAgY291bnRzPWN0LA0KICAgICAgICAg
ICAgICAgICAgICAgICAgaW50ZW5zaXRpZXM9aW50LA0KICAgICAgICAgICAg
ICAgICAgICAgICAgbWlkcz1taSksDQogICAgICAgICAgICAgICAgICAgY2xh
c3M9Imhpc3RvZ3JhbSIpKQ0KfQ0K
--0-201145637-953833073=:7710--
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To: r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._