Clipper On Line • Ver Tópico - Pedido de ajuda para converter algoritmo em Harbour
Mudar para estilo Clássico
Discussão sobre outras linguagens de programação.
Postar uma resposta

Pedido de ajuda para converter algoritmo em Harbour

19 Fev 2014 13:43

Preciso converter esse algoritmo para Harbour 64 bits, no entanto, não entendo nada dessa linguagem fonte.

Desde já grato.

==========================================================================================================================================

Lunar Phase Computation

by Stephen R. Schmitt



Introduction

During a lunar month (about 29.5) days, the Moon's appearance changes through eight well-known phases that comprise a lunation. These phases of the Moon are:

New Moon
Waxing Crescent
First Quarter
Waxing Gibbous
Full Moon
Waning Gibbous
Last Quarter
Waning Crescent
New Moon, First Quarter, Full Moon, and Last Quarter are the primary phases. The crescent and gibbous phases are intermediate phases. First and Last Quarters occur when the Sun and Moon are 90° degrees apart. The First Quarter and Last Quarter phases are named this way because they occur when the Moon is at one- and three-quarters of a complete cycle. The phases New Moon, First Quarter, Full Moon, and Last Quarter occur when the ecliptic longitude of the Moon differs from that of the Sun by 0°, 90°, 180°, and 270°.

The time in days counted from the time of New Moon is called the Moon's age.

The ecliptic longitude is measured from the vernal equinox along the ecliptic in the direction of the Sun's apparent motion through the stars.

The ecliptic latitude is positive north of the ecliptic and negative if south.

Algorithm

This program helps anyone who needs to know the Moon's phase, age, distance, and position along the ecliptic on any date within several thousand years in the past or future. The age of the moon in days as well as its visual phase are given. The Moon's ecliptic longitude is calculated as well as the corresponding zodiac constellation.

The Moon's calculated position is based on the Julian Day number corresponding to the calendar date. The date is checked for valid day of the month.

Zeno source code

const PI : real := 3.1415926535897932385

program

var year, month, day : int
var tm : real := localtime

year := dateyear( tm )
month := datemonth( tm )
day := dateday( tm )

put "Moon on ", month, '/', day, '/', year
moon_posit( year, month, day )

end program

% compute moon position and phase
procedure moon_posit( Y, M, D : int )

var AG : real % Moon's age
var DI : real % Moon's distance in earth radii
var LA : real % Moon's ecliptic latitude
var LO : real % Moon's ecliptic longitude
var Phase : string
var Zodiac : string

var YY, MM, K1, K2, K3, JD : int
var IP, DP, NP, RP : real

if not isdayofmonth( Y, M, D ) then
put "invalid date"
return
end if

% calculate the Julian date at 12h UT
YY := Y - floor( ( 12 - M ) / 10 )
MM := M + 9
if (MM >= 12) then
MM := MM - 12
end if

K1 := floor( 365.25 * ( YY + 4712 ) )
K2 := floor( 30.6 * MM + 0.5 )
K3 := floor( floor( ( YY / 100 ) + 49 ) * 0.75 ) - 38

JD := K1 + K2 + D + 59 % for dates in Julian calendar
if (JD > 2299160) then
JD := JD - K3 % for Gregorian calendar
end if

% calculate moon's age in days
IP := normalize( ( JD - 2451550.1 ) / 29.530588853 )
AG := IP*29.53

if AG < 1.84566 then Phase := "NEW"
elsif AG < 5.53699 then Phase := "Waxing crescent"
elsif AG < 9.22831 then Phase := "First quarter"
elsif AG < 12.91963 then Phase := "Waxing gibbous"
elsif AG < 16.61096 then Phase := "FULL"
elsif AG < 20.30228 then Phase := "Waning gibbous"
elsif AG < 23.99361 then Phase := "Last quarter"
elsif AG < 27.68493 then Phase := "Waning crescent"
else Phase := "NEW"
end if

IP := IP*2*PI % Convert phase to radians

% calculate moon's distance
DP := 2*PI*normalize( ( JD - 2451562.2 ) / 27.55454988 )
DI := 60.4 - 3.3*cos( DP ) - 0.6*cos( 2*IP - DP ) - 0.5*cos( 2*IP )

% calculate moon's ecliptic latitude
NP := 2*PI*normalize( ( JD - 2451565.2 ) / 27.212220817 )
LA := 5.1*sin( NP )

% calculate moon's ecliptic longitude
RP := normalize( ( JD - 2451555.8 ) / 27.321582241 )
LO := 360*RP + 6.3*sin( DP ) + 1.3*sin( 2*IP - DP ) + 0.7*sin( 2*IP )

if LO < 33.18 then Zodiac := "Pisces"
elsif LO < 51.16 then Zodiac := "Aries"
elsif LO < 93.44 then Zodiac := "Taurus"
elsif LO < 119.48 then Zodiac := "Gemini"
elsif LO < 135.30 then Zodiac := "Cancer"
elsif LO < 173.34 then Zodiac := "Leo"
elsif LO < 224.17 then Zodiac := "Virgo"
elsif LO < 242.57 then Zodiac := "Libra"
elsif LO < 271.26 then Zodiac := "Scorpio"
elsif LO < 302.49 then Zodiac := "Sagittarius"
elsif LO < 311.72 then Zodiac := "Capricorn"
elsif LO < 348.58 then Zodiac := "Aquarius"
else Zodiac := "Pisces"
end if

% display results
put "phase = ", Phase
put "age = ", round2( AG ), " days"
put "distance = ", round2( DI ), " earth radii"
put "ecliptic"
put " latitude = ", round2( LA ), '°'
put " longitude = ", round2( LO ), '°'
put "constellation = ", Zodiac

end procedure

% check for valid date
function isdayofmonth( year, month, day : int ) : boolean

var daysofmonth : int

if (month < 1) or (12 < month) then
return false % invalid month
end if

case month of % get days in this month
value 4,6,9,11:
daysofmonth := 30 % Apr, Jun, Sep, Nov
value 2:
daysofmonth := 28 % Feb normal
if year mod 4 = 0 then
if not((year mod 100 = 0) and
(year mod 400 ~= 0)) then
daysofmonth := 29 % Feb leap year
end if
end if
value:
daysofmonth := 31 % other months
end case

return (0 < day) and (day <= daysofmonth)

end function

% round to 2 decimal places
function round2( x : real ) : real
return ( round( 100*x )/100.0 )
end function

% normalize values to range 0...1
function normalize( v : real ) : real
v := v - floor( v )
if v < 0 then
v := v + 1
end if
return v
end function
Sample output

Moon on 3/24/2004
phase = Waxing crescent
age = 3.31 days
distance = 62.87 earth radii
ecliptic
latitude = -0.1°
longitude = 44.92°
constellation = Aries

Fonte.. http://www.abecedarical.com/zenosamples ... ecalc.html

Pedido de ajuda para converter algoritmo em Harbour

19 Fev 2014 19:43

Comece por colocar o fonte num fonte Harbour.
Vá ajustando aonde dá, e veja o que sobra pra arrumar funções equivalentes.
Provavelmente precisão numérica não é exigência, já que o valor do PI é infinito.
No final talvez sobre pra confirmar Floor(), Normalize(), Sen(), etc.

Pedido de ajuda para converter algoritmo em Harbour

20 Fev 2014 04:17

Olá1

Seja bem-vindo ao fórum!

Não sei se você gosta de astronomia ou horóscopo mas, achei muito interessante este link de onde vem o código original deste algoritmo. Segue o código convertido. Não conferi se os valores gerados estão corretos...
Código:
*-------------------------------------------------------------------------------
*
* Astro.Prg
*
* Compilar com hbmk2 astro hbct.hbc
*
* Alexandre Santos - 20/02/2014
*-------------------------------------------------------------------------------

#include "box.ch"
#include "set.ch"
#include "setcurs.ch"
#include "inkey.ch"
#include "hbcompat.ch"

#define PI 3.1415926535897932385
//------------------------------------------------------------------------------

REQUEST HB_CODEPAGE_PTISO

INIT PROCEDURE AppInit()

   RELEASE GetList

   Set( _SET_DATEFORMAT, "dd/mm/yyyy" )   
   Set( _SET_DELETED, .T. )     
   Set( _SET_SCOREBOARD, .F. )     
   Set( _SET_EVENTMASK, 255 )
 
   SetMode(25,80)   
   SetBlink( .F. )
   SetCursor( SC_NONE )
   SetColor( "N/W, W+/N" )

   DispOutAt( 0,0, PadC("Compute moon position and phase",80), "W+/N*" )
   DispBox(1,0,MaxRow() - 1, MaxCol(), B_SINGLE + " ")
   DispOutAt( MaxRow(),0, PadR( " Enter date or <ESC> to exit...", 80), "W+/N*" )
     
RETURN

//------------------------------------------------------------------------------

Function AppMain()

   LOCAL dDate As Date := Date()
   LOCAL GetList As Array := {}
   
   @ 06, 05 Say "Moon on " ;
            Get dDate
           
   READ SAVE
   
   WHILE LastKey() != K_ESC
     
      DispBox(08,05,16,75, Space(9))

      moon_posit( Year(dDate ), Month(dDate ),Day(dDate ) )

      READ SAVE
         
   ENDDO

RETURN NIL

//------------------------------------------------------------------------------

EXIT PROCEDURE AppExit()

   CLS
                                                                             
   RETURN
//------------------------------------------------------------------------------
   
// compute moon position and phase
PROCEDURE moon_posit( Y, M, D )

   LOCAL AG As Numeric // Moon's age
   LOCAL DI As Numeric // Moon's distance in earth radii
   LOCAL LA As Numeric // Moon's ecliptic latitude
   LOCAL LO As Numeric // Moon's ecliptic longitude
   LOCAL Phase As Character
   LOCAL Zodiac As Character
   
   LOCAL YY, MM, K1, K2, K3, JD As Numeric
   LOCAL IP, DP, NP, RP As Numeric

   // calculate the Julian date at 12h UT
   YY := Y - floor( ( 12 - M ) / 10 )
   MM := M + 9

   if (MM >= 12) 
      MM := MM - 12
   end if

   K1 := Floor( 365.25 * ( YY + 4712 ) )
   K2 := Floor( 30.6 * MM + 0.5 )
   K3 := Floor( Floor( ( YY / 100 ) + 49 ) * 0.75 ) - 38
   
   JD := K1 + K2 + D + 59 // for dates in Julian calendar
   if (JD > 2299160)
      JD := JD - K3 // for Gregorian calendar
   endif
   
   // calculate moon's age in days
   IP := normalize( ( JD - 2451550.1 ) / 29.530588853 )
   AG := IP*29.53
   
   if AG < 1.84566 
      Phase := "NEW"
   ElseIf AG < 5.53699 
      Phase := "Waxing crescent"
   ElseIf AG < 9.22831 
      Phase := "First quarter"
   ElseIf AG < 12.91963 
      Phase := "Waxing gibbous"
   ElseIf AG < 16.61096 
      Phase := "FULL"
   ElseIf AG < 20.30228 
      Phase := "Waning gibbous"
   ElseIf AG < 23.99361 
      Phase := "Last quarter"
   ElseIf AG < 27.68493 
      Phase := "Waning crescent"
   Else
      Phase := "NEW"
   Endif
   
   IP := IP*2*PI // Convert phase to radians
   
   // calculate moon's distance
   DP := 2*PI*normalize( ( JD - 2451562.2 ) / 27.55454988 )
   DI := 60.4 - 3.3*cos( DP ) - 0.6*cos( 2*IP - DP ) - 0.5*cos( 2*IP )
   
   // calculate moon's ecliptic latitude
   NP := 2*PI*normalize( ( JD - 2451565.2 ) / 27.212220817 )
   LA := 5.1*sin( NP )
   
   // calculate moon's ecliptic longitude
   RP := normalize( ( JD - 2451555.8 ) / 27.321582241 )
   LO := 360*RP + 6.3*sin( DP ) + 1.3*sin( 2*IP - DP ) + 0.7*sin( 2*IP )
   
   if LO < 33.18 
      Zodiac := "Pisces"
   ElseIf LO < 51.16 
      Zodiac := "Aries"
   ElseIf LO < 93.44 
      Zodiac := "Taurus"
   ElseIf LO < 119.48 
      Zodiac := "Gemini"
   ElseIf LO < 135.30 
      Zodiac := "Cancer"
   ElseIf LO < 173.34 
      Zodiac := "Leo"
   ElseIf LO < 224.17 
      Zodiac := "Virgo"
   ElseIf LO < 242.57 
      Zodiac := "Libra"
   ElseIf LO < 271.26 
      Zodiac := "Scorpio"
   ElseIf LO < 302.49 
      Zodiac := "Sagittarius"
   ElseIf LO < 311.72 
      Zodiac := "Capricorn"
   ElseIf LO < 348.58 
      Zodiac := "Aquarius"
   else
      Zodiac := "Pisces"
   endif
   
   // display results
   
   DispOutAt(08, 05, "Phase         = " + Phase)
   DispOutAt(09, 05, "Age           = " + Ltrim(Str(round2( AG ))) + " days")
   DispOutAt(10, 05, "Distance      = " + LTrim(Str(round2( DI ))) + " earth radii")

   DispOutAt(12, 05, "Ecliptic        ")
   DispOutAt(13, 05, " Latitude     = " + LTrim(Str(round2( LA ))) + Chr(167))
   DispOutAt(14, 05, " Longitude    = " + LTrim(Str(round2( LO ))) + Chr(167))
   
   DispOutAt(16, 05, "Constellation = " + Zodiac )
      
RETURN

//--------------------------------------------------------------------------------
STATIC FUNCTION round2( x )
   RETURN ( round( 100*x, 1 )/100.0 )
//--------------------------------------------------------------------------------   
STATIC FUNCTION Normalize(v)

   v := v - floor( v )
   
   if v < 0
      v++
   end if
   
   RETURN v

//--------------------------------------------------------------------------------

Pedido de ajuda para converter algoritmo em Harbour

20 Fev 2014 11:18

Alexandre, muito obrigado!

Ficou excelente, estava batendo cabeça a tempos, outra coisa que não estava dando certo era a compilação sua dica foi ótima.

Compilar com hbmk2 astro hbct.hbc

Grande abraço!
Flávio

Pedido de ajuda para converter algoritmo em Harbour

20 Fev 2014 18:31

Olá!

Fico feliz em ajudar.

Na linha de compilação, hbct.hbc é usado para incluir a CT.Lib, que é de onde vem a função Floor(). Se não precisasse dela , seria apenas hbmk2 astro.
Postar uma resposta