errores resta, R - rextester

Language: Layout:

#R version 3.3.2 
####  funciones
#### Genera un sistema de punto flotante

sisflot <- function(beta=10,p=3,emin=-1,emax=2){
    i=1
    m=vector(length=(emax-emin)*(beta^(p)))
    ex=vector(length=(emax-emin)*(beta^(p)))
    v=vector(length=(emax-emin)*(beta^(p)))
    for(expo in seq(from=emin, to=emax)){
        for(mant in seq(from=1, to=beta-beta^(1-p),by=beta^(1-p))){
        m[i]=mant
        ex[i]=expo
        v[i]=mant*beta^expo
        i=i+1
        }
    }
    return(list(mant=m,ex=ex,val=v))
}

#### Normalizar y redondear un numero a punto flotante solo funciona en base 10.

normaliza <- function(mant,ex=0,beta=10){
    while(abs(mant)<1 && abs(mant>0)){
        mant=mant*beta
        ex=ex-1
    }
    while(abs(mant)>=beta){
        mant=mant/beta
        ex=ex+1
    }
    return(list(mant=mant,ex=ex))
}

#### Resta exacta, realiza la resta exacta y redondea luego de restar.

restae <- function(mx,ex=0,my,ey=0,beta=10,p=3){
    x=normaliza(mx,ex,beta)
    y=normaliza(my,ey,beta)
    mx=x$mant
    my=y$mant
    ex=x$ex
    ey=y$ex

if(mx*beta^ex>my*beta^ey){
        c=ex-ey
        my=my/beta^c
        ey=ey+c
    }else{
        c=ey-ex
        mx=mx/beta^c
        ex=ex+c
    }
    mr=mx-my
    er=ex

resta=normaliza(mr,er,beta)
    mr=signif(resta$mant,p)
    er=resta$ex

resta=normaliza(mr,er,beta)
    mr=resta$mant
    er=resta$ex

return(list(mr=mr, er=er))
}

#### Resta con k digitos, trunca, realiza la resta y vuelve a redondear redondea luego de restar.

restak <- function(mx,ex=0,my,ey=0,beta=10,p=3,k=3){
    x=normaliza(mx,ex,beta)
    y=normaliza(my,ey,beta)
    mx=x$mant
    my=y$mant
    ex=x$ex
    ey=y$ex

if(mx*beta^ex>my*beta^ey){
        c=ex-ey
        my=my/beta^c
        ey=ey+c
    }else{
        c=ey-ex
        mx=mx/beta^c
        ex=ex+c
    }
    
    mx=trunc(mx*beta^(k-1))/beta^(k-1)
    my=trunc(my*beta^(k-1))/beta^(k-1)

mr=mx-my
    er=ex

resta=normaliza(mr,er,beta)
    mr=signif(resta$mant,p)
    er=resta$ex

resta=normaliza(mr,er,beta)
    mr=resta$mant
    er=resta$ex

return(list(mr=mr, er=er))
}
restae(mx=110,my=8.59)
restak(mx=110,my=8.59,k=4)

[ + ] Show input
Absolute running time: 0.3 sec, cpu time: 0.57 sec, memory peak: 30 Mb, absolute service time: 0,31 sec