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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
## Copyright 2010-2012 Sebastian Gibb
## <mail@sebastiangibb.de>
##
## This file is part of readBrukerFlexData for R and related languages.
##
## readBrukerFlexData 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.
##
## readBrukerFlexData 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.
##
## You should have received a copy of the GNU General Public License
## along with readBrukerFlexData. If not, see <https://www.gnu.org/licenses/>
#' Converts double to single precision.
#'
#' This function simulates the conversion of floating point numbers from double
#' precision (64bit, R: \code{double()}, C: \code{double}) to single precision
#' (32bit, R: \code{none}, C: \code{float}). It follows IEEE 754 standard.
#'
#' @param x \code{double}, numeric value which should reduce from double
#' precision to single precision.
#' @return \code{double} (in single precision).
#'
#' @details
#' The same could be done in C by using casts:
#' \preformatted{
#' double precision32(double value) {
#' float x=value;
#' return (double)x;
#' }}
#' @seealso \code{\link[readBrukerFlexData]{.changePrecision}},
#' \code{\link[readBrukerFlexData]{.hpc}}
#' @rdname double2singlePrecision
#' @keywords internal
#' @references
#' IEEE 754 standard: \url{https://ieeexplore.ieee.org/xpl/articleDetails.jsp?arnumber=30711&filter=AND(p_Publication_Number:2355)}
#' @examples
#' ## load library
#' library("readBrukerFlexData")
#'
#' ## show more details
#' oldDigits <- options()$digits
#' options(digits=22)
#'
#' ## a test number
#' num <- 1/3
#'
#' num
#' readBrukerFlexData:::.double2singlePrecision(num)
#'
#' ## reset digits option
#' options(digits=oldDigits)
#'
.double2singlePrecision <- function(x) {
stopifnot(is.double(x))
.changePrecision(x, size=4L)
}
#' Change precision.
#'
#' This function converts double values to double values in a given
#' precision (only correctly working for cut a higher precision to a lower one;
#' e.g. IEEE 754 double precision to IEEE 754 single precision)
#'
#' @param x \code{double}, a vector of double values which should converted.
#' @param size \code{integer}, how many bytes using for target precision
#' e.g. IEEE 754 single precision: \code{size=4},
#' IEEE 754 double precision: \code{size=8}
#' @return \code{double}.
#' @seealso \code{\link[readBrukerFlexData]{.double2singlePrecision}},
#' @rdname changePrecision
#' @keywords internal
#'
.changePrecision <- function(x, size) {
## create a raw object to avoid direct file access
virtualCon <- raw()
## write binary data to raw object and change (mostly cut) precision to size
## size==4 # 32bit, single precision
## size==8 # 64bit, double precision
virtualCon <- writeBin(object=x, con=virtualCon, size=size)
## re-read data
readBin(con=virtualCon, what=double(), size=size, n=length(x))
}
|
