Clipper On Line • Ver Tópico - Pedido de ajuda para converter algoritmo em Harbour

Pedido de ajuda para converter algoritmo em Harbour

Discussão sobre outras linguagens de programação.

Moderador: Moderadores

 

Pedido de ajuda para converter algoritmo em Harbour

Mensagempor flamenegon » 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
flamenegon
Usuário Nível 1

Usuário Nível 1
 
Mensagens: 2
Data de registro: 19 Fev 2014 13:28
Cidade/Estado: São Paulo
Curtiu: 3 vezes
Mens.Curtidas: 0 vez

Pedido de ajuda para converter algoritmo em Harbour

Mensagempor JoséQuintas » 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.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18007
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Pedido de ajuda para converter algoritmo em Harbour

Mensagempor alxsts » 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...
*-------------------------------------------------------------------------------
*
* 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

//--------------------------------------------------------------------------------
[]´s
Alexandre Santos (AlxSts)
alxsts
Colaborador

Colaborador
 
Mensagens: 2943
Data de registro: 12 Ago 2008 15:50
Cidade/Estado: São Paulo-SP-Brasil
Curtiu: 21 vezes
Mens.Curtidas: 248 vezes

Pedido de ajuda para converter algoritmo em Harbour

Mensagempor flamenegon » 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
flamenegon
Usuário Nível 1

Usuário Nível 1
 
Mensagens: 2
Data de registro: 19 Fev 2014 13:28
Cidade/Estado: São Paulo
Curtiu: 3 vezes
Mens.Curtidas: 0 vez

Pedido de ajuda para converter algoritmo em Harbour

Mensagempor alxsts » 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.
[]´s
Alexandre Santos (AlxSts)
alxsts
Colaborador

Colaborador
 
Mensagens: 2943
Data de registro: 12 Ago 2008 15:50
Cidade/Estado: São Paulo-SP-Brasil
Curtiu: 21 vezes
Mens.Curtidas: 248 vezes




Retornar para Outras linguagens de programação

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 15 visitantes


Ola Amigo, espero que meu site e forum tem lhe beneficiado, com exemplos e dicas de programacao.
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
Faça uma doação para o forum
cron
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro