Как взять от вещественного числа его целую часть?

[Mixxx]

Привет All
Мне нужно написать функцию trunc
тоесть взять от вещественного числа его целую часть.
Какие будут идеи?
PS Пользоваться int и frac нельзя
PSS Желательно на чистом паскале (без asm вставок)

Сообщение отредактировано: Mixxx - 21.08.03, 16:21

[albom]

Попробуй так:

var
    e: real;
    s: string;
    k,v: integer;
begin
    e := 123.39;    { Это наше число }
    if e = 0 then s := '0'
    else
        if e < 0 then str(e+0.5:0:0, s)
        else str(e-0.5:0:0, s);
    val(s, v, k);
 
    if k = 0 then writeln('Целая часть: ',v)
    else writeln('Ошибка');
end.

Сообщение отредактировано: volvo877 - 06.01.09, 07:35

[albom]

Ну и напомню, что trunc(-123.456)=-123, а не -124.

[Mixxx]

Спасибо а по другому нельзя (без str)?
А то получается что str - волшебная функция которую реализовать самому нереально?

[albom]

Вот это вроде работает:

var
    i: longint;
    r: single;
const
    OneHalf: single = 0.49999998509;
begin
    r := 123.9999;
    if r = 0 then i := 0
    else
        if r < 0 then
        asm
            fld dword ptr [r]
            fadd dword ptr [OneHalf]
            fistp dword ptr [i]
        end
        else
        asm
            fld dword ptr [r]
            fsub dword ptr [OneHalf]
            fistp dword ptr [i]
        end;
    writeln(i); { В "i" находится целая часть }
end.

А вообще, в каком-то FAQ`е эта функция была так расписана:

; extern "C" int truncate (double x);
_truncate PROC NEAR
PUBLIC  _truncate
    FLD QWORD PTR [ESP+4]   ; x
    SUB ESP, 12     ; space for local variables
    FIST DWORD PTR [ESP]    ; rounded value
    FST DWORD PTR [ESP+4]   ; float value
    FISUB DWORD PTR [ESP]   ; subtract rounded value
    FSTP DWORD PTR [ESP+8]  ; difference
    POP EAX         ; rounded value
    
    POP ECX         ; float value
    POP EDX         ; difference (float)
    TEST ECX, ECX       ; test sign of x
    JS SHORT NEGATIVE
    ADD EDX, 7FFFFFFFH  ; produce carry if difference < -0
    SBB EAX, 0      ; subtract 1 if x-round(x) < -0
    RET
NEGATIVE:
    XOR ECX, ECX
    TEST EDX, EDX
    SETG CL         ; 1 if difference > 0
    ADD EAX, ECX        ; add 1 if x-round(x) > 0
    RET
_truncate ENDP

Сообщение отредактировано: volvo877 - 06.01.09, 07:42

[albom]

А вот еще вариант:

var
    i: longint;
    s: integer;
    r: real;
    setbit: boolean;
begin
    r := 123.4567;
    if r < 0 then begin
        r := -r; setbit := true;
    end
    else setbit := false;
    i := 0;
    for s := 30 downto 0 do begin
        i := i or (word(1) shl s);
        if i > r then i := i and not(word(1) shl s);
    end;
    if setbit then i := -i;
    writeln(i);     { В "i" находится целая часть }
end.

Сообщение отредактировано: volvo877 - 06.01.09, 07:43

[albom]

И еще:

function power2(s: Integer): Longint;
var r: Longint;
begin
    if s < 0 then begin
        power2 := 0; exit
    end;
    r := 1;
    while s > 0 do begin
        r := r*2;
        dec(s);
    end;
    power2:=r;
end;
 
var
    i: longint;
    r: single;
    e,m: longint;
    s: boolean;
begin
    r := -123.456;
    m := longint(r) and ((1 shl 23) - 1);
    e := (longint(r)shr 23) and (1 shl 8 - 1);
    s := longint(r) and $80000000 <> 0;
    if e <> 0 then begin
        if e - 150 < 0 then i := power2(e - 127) + m div power2(150 - e)
        else i := (power2(e - 127) + m * power2(e - 150));
        if s then i := -i;
    end
    else i := 0;
    writeln(i); { В "i" находится целая часть }
end.

Сообщение отредактировано: volvo877 - 06.01.09, 07:47

[Mixxx]

2 albom
Спасибо, мне понравилось решение из 7-ой мессаги.
Самый софтварный метод
Сам придумал?

[tserega]

2 albom: а, случаем, код из сообщения 8 не запорется, если single поменять на double или extended?

[albom]