10  ' Horizontal sundial calculations
20  PRINT "Enter latitude       => ";
30  INPUT LAT
40  PRINT "Enter longitude      => ";
50  INPUT LNG
60  PRINT "Enter legal meridian => ";
70  INPUT REF
80  PRINT
90  LET PI = 4 * ATN(1)
100 LET SLAT = SIN(LAT * PI / 180)
110 PRINT "    sine of latitude:   "; USING "#.##^^^^"; SLAT
120 PRINT "    diff longitude:     "; USING "####.###"; LNG - REF
130 PRINT
140 PRINT "Hour, sun hour angle, dial hour line angle from 6am to 6pm"
150 FOR H% = -6 TO 6
160  LET HRA = 15 * H%
170  LET HRA = HRA - (LNG - REF): ' correct for longitude difference
180  LET HLA = ATN(SLAT * TAN(HRA * PI / 180)) * 180 / PI
190  PRINT "HR="; USING "+##"; H%;
200  PRINT "; HRA="; USING "+###.###"; HRA;
210  PRINT "; HLA="; USING "+###.###"; HLA
220 NEXT H%
230 END


roundDec :: Int -> Double -> Double
roundDec d = (/ 10.0 ^ d) . fromIntegral . round . (* 10.0 ^ d)

radToDegr = ((180 / pi) *)

degrToRad = ((pi / 180) *)

main = do
  let lat = -4.95
      long = -150.5
      legalMerid = -150
      sinOfLat = sin $ degrToRad lat
      diff = legalMerid - long
  (putStrLn . unlines)
    [ "Latitude         " ++ show lat
    , "Longitude        " ++ show long
    , "Legal meridian   " ++ show legalMerid
    , "Sine of latitude " ++ show (roundDec 6 sinOfLat)
    , "Diff longitude   " ++ show (-diff)
    , "hour   sun hour angle   dial hour  line angle"
    ]
  mapM_
    (\h ->
        let sha = diff + 15 * h
            dhla = radToDegr . atan . (sinOfLat *) . tan $ degrToRad sha
        in putStrLn $
           take 7 (show h ++ repeat ' ') ++
           take 16 (show (roundDec 3 sha) ++ repeat ' ') ++
           " " ++ show (roundDec 3 dhla))
    [-6,-5 .. 6]


procedure main()
   PrintSundial(-4.95, -150.5, -150);
end

procedure PrintSundial(lat, lng, mer )
   write("latitude:        ", lat,
         "\nlongitude:       ", lng,
         "\nlegal meridian:  ", mer)

   slat := sin(dtor(lat))

   write("sine of latitude: ",slat,
         "\ndiff longitude:   ", lng-mer)
   write("\nHour, sun hour angle, dial hour line angle from 6am to 6pm")

   every h := -6 to 6 do {
      hraRad := dtor(hra := 15 * h - (lng - mer))
      hla :=rtod(atan(sin(hraRad)*slat, cos(hraRad)))
      write("HR=",
            right(if h <= 0 then 12+h else h,2),
            if h < 0 then "am" else "pm",
            " HRA=",hra,", HLA=",hla)
      }
end


100 PROGRAM "SunDial.bas"
110 OPTION ANGLE RADIANS
120 TEXT 80
130 LET DR=PI/180:LET RD=180/PI
140 INPUT PROMPT "Enter latitude:  ":LAT
150 INPUT PROMPT "Enter longitude: ":LNG
160 INPUT PROMPT "Enter legal meridian: ":REF
170 LET S=SIN(LAT*DR)
180 PRINT :PRINT "Sine of latitude :";S
190 PRINT "Diff longitude: ";LNG-REF
200 PRINT " Hour,",,"sun hour angle, dial hour line angle from 6am to 6 pm"
210 FOR H=6 TO 18
220   LET HRA=15*H-LNG+REF
230   LET HLA=ATN(S*TAN(HRA*DR))*RD
240   PRINT "HR = ";H,"HRA =";HRA,"HLA =";HLA
250 NEXT


require 'trig'
atan2=: {:@*[email protected] NB. arc tangent of y divided by x

horiz=: verb define
  'lat lng ref'=. y
  out=. [email protected],&":
  'Latitude         ' out lat
  'Longitude        ' out lng
  'Legal meridian   ' out ref
  'Sine of latitude ' out slat=. sin rfd lat
  'Diff longitude   ' out -diff=. ref - lng
  lbl=.'hour  ';'sun hour angle  ';'dial hour line angle'
  r=.((,. (,. (atan2 *&slat)/@[email protected]&.rfd)) diff + 15&*) i:6
  smoutput lbl ,: ('3.0';'7.3';'7.3') 8!:1 r
)


import java.util.Scanner;

public class Sundial {
    public static void main(String[] args) {
        double lat, slat, lng, ref;
        Scanner sc = new Scanner(System.in);

        System.out.print("Enter latitude: ");
        lat = sc.nextDouble();
        System.out.print("Enter longitude: ");
        lng = sc.nextDouble();
        System.out.print("Enter legal meridian: ");
        ref = sc.nextDouble();
        System.out.println();

        slat = Math.sin(Math.toRadians(lat));
        System.out.printf("sine of latitude: %.3f\n", slat);
        System.out.printf("diff longitude: %.3f\n\n", lng - ref);

        System.out.printf("Hour, sun hour angle, dial hour line angle from 6am to 6pm\n");

        for (int h = -6; h <= 6; h++) {
            double hla, hra, hraRad;
            hra = 15.0 * h;
            hra = hra - lng + ref;
            hraRad = Math.toRadians(hra);
            hla = Math.toDegrees(Math.atan2(Math.sin(hraRad)*Math.sin(Math.toRadians(lat)), Math.cos(hraRad)));
            System.out.printf("HR= %3d;  \t  HRA=%7.3f;  \t  HLA= %7.3f\n",
                    h, hra, hla);
        }
    }
}


print("Enter latitude       => ")
lat = parse(Float64, readline(STDIN))
print("Enter longitude      => ")
lng = parse(Float64, readline(STDIN))
print("Enter legal meridian => ")
ref = parse(Float64, readline(STDIN))
println()

slat = sin(deg2rad(lat))
@printf "    sine of latitude:   %.3f\n" slat
@printf "    diff longitude:     %.3f\n" (lng - ref)

println("\nHour, sun hour angle, dial hour line angle from 6am to 6pm\n")

for h in -6:6
  hra = 15 * h
  hra -= lng - ref
  hla = rad2deg(atan(slat * tan(deg2rad(hra))))
  @printf "HR = %3d; HRA = %7.3f; HLA = %7.3f\n" h hra hla
end


import java.lang.Math.atan2
import java.lang.Math.cos
import java.lang.Math.sin
import java.lang.Math.toDegrees
import java.lang.Math.toRadians

// version 1.1.4

fun main(args: Array<String>) {
    println("Please enter the following in degrees:")
    print("  Latitude       : ")
    val lat = readLine()!!.toDouble()
    print("  Longitude      : ")
    val lng = readLine()!!.toDouble()
    print("  Legal Meridian : ")
    val mer = readLine()!!.toDouble()

    val slat = sin(toRadians(lat))
    val diff = lng - mer
    println("\nSine of latitude     = ${"%.6f".format(slat)}")
    println("Longitude - Meridian = ${"%.3f".format(diff)}\n")
    println("Hour   Sun Hour Angle  Dial Hour Line Angle")
    println("-----  --------------  --------------------")
    println("              °               °")
    for (h in -6..6) {
        var hr = h + 12
        val am = if (hr < 12) "AM" else "PM"
        if (hr > 12) hr -= 12
        val sha = 15.0 * h - diff
        val dhla = toDegrees(atan2(slat * sin(toRadians(sha)), cos(toRadians(sha))))
        println("%2d %s      %+7.3f         %+7.3f".format(hr, am, sha, dhla))
    }
}


global pi
pi = 3.14159265
input "Enter latitude  (degrees)     : "; latitude      '     -4.95
input "Enter longitude (degrees)     : "; longitude     '   -150.5
input "Enter legal meridian (degrees): "; meridian      '   -150.0
print
print "Time       Sun hour angle   Dial hour line angle"
for hour = 6 TO 18
    hra = 15 * hour - longitude + meridian - 180
    hla = rad2deg(atn(sin(deg2rad(latitude)) * tan(deg2rad(hra))))
    if abs(hra) > 90 then hla = hla + 180 * sgn(hra * latitude)
    print using( "##.##", hour), using("####.###  ", hra), using("####.###", hla)
next hour
end

function rad2deg(theta)
    rad2deg = theta * 180 / pi
end function

function deg2rad(theta)
    deg2rad = theta * pi / 180
end function

function sgn(x)
    if x > 0 then sgn = 1 else sgn = -1
end function


on mouseUp
    ask "Enter lng,lat,meridian"
    if it is empty then exit mouseup
    // -150.5, -4.95, -150.0
    put item 1 of it into longitude
    put item 2 of it into latitude
    put item 3 of it into meridian

    repeat with hour = 6 TO 18
        put 15 *hour - longitude + meridian - 180 into hra
        put rad2deg(atan(sin(deg2rad(latitude)) * tan(deg2rad(hra)))) into hla
        if abs(hra) > 90 then put hla + 180 * sgn(hra *latitude) into hla
        put hour && hra && hla & cr after sunhours
    end repeat
    put sunhours
end mouseUp

function rad2deg theta
    return theta * (180 / pi)
end rad2deg

function deg2rad theta
    return theta * (pi / 180)
end deg2rad

function sgn x
    if x >0 then return 1 else return -1
end sgn


type "|Enter latitude: |
make "lat readword
type "|Enter longitude: |
make "long readword
type "|Enter legal meridian: |
make "long :long - readword

print [Hour : HourAngle , DialAngle]
for [hour -6 6] [
   make "hra 15 * :hour - :long
   make "hla arctan product sin :lat quotient sin :hra cos :hra
   print (sentence "hour :hour ": :hra ", :hla)
]


io.write("Enter latitude       => ")
lat = tonumber(io.read())

io.write("Enter longitude      => ")
lng = tonumber(io.read())

io.write("Enter legal meridian => ")
ref = tonumber(io.read())

print()

slat = math.sin(math.rad(lat))

print(string.format("    sine of latitude:   %.3f", slat))
print(string.format("    diff longitude:     %.3f", lng-ref))
print()
print("Hour, sun hour angle, dial hour line angle from 6am to 6pm")

for h = -6, 6 do
	hra = 15 * h
	hra = hra - (lng - ref)
	hla = math.deg(math.atan(slat * math.tan(math.rad(hra))))
	print(string.format("HR=%3d; HRA=%7.3f; HLA=%7.3f", h, hra, hla))
end


lat = Input["latitude", -4.95];
lng = Input["longitude", -150.5];
ref = Input["legal meridian", -150];

slat = Sin[lat Degree];
Table[
   hra = 15 h;
   hra -= lng - ref;
   hla = [email protected][slat Tan[hra Degree]]/Degree;
   {h, hra, hla}
   ,
   {h, -6, 6}
   ] // Prepend[{"Hour", "Sun hour angle",
    "Dial hour line angle"}] // Grid


TextWindow.Write("Enter latitude       => ")
lat = TextWindow.ReadNumber()
TextWindow.Write("Enter longitude      => ")
lng = TextWindow.ReadNumber()
TextWindow.Write("Enter legal meridian => ")
ref = TextWindow.ReadNumber()
sLat = Math.Sin(Math.GetRadians(lat))
TextWindow.WriteLine("")
TextWindow.Write("    sine of latitude:   ")
TextWindow.WriteLine(Math.Round(sLat * 10000) / 10000)
TextWindow.Write("    diff longitude:     ")
TextWindow.WriteLine(lng - ref)
TextWindow.WriteLine("")
TextWindow.WriteLine("Hour, sun hour angle, dial hour line angle from 6am to 6pm")
For hour = -6 To 6
  hourAngle = 15 * hour
  hourAngle = hourAngle - (lng - ref) ' correct for longitude difference
  hourLineAngle = math.GetDegrees(Math.ArcTan(sLat * Math.Tan(Math.GetRadians(hourAngle))))
  TextWindow.Write("HR=")
  TextWindow.CursorLeft = 3 + (3 - Text.GetLength(hour))
  TextWindow.Write(hour)
  TextWindow.Write("; HRA=")
  TextWindow.CursorLeft = 12 + (6 - Text.GetLength(hourAngle))
  TextWindow.Write(hourAngle)
  TextWindow.Write("; HLA=")
  TextWindow.CursorLeft = 24 + (4 - Text.GetLength(Math.Floor(hourLineAngle)))
  TextWindow.Write(Math.Round(hourLineAngle * 1000) / 1000)
  TextWindow.WriteLine("")
EndFor


МГ	П2	->	МГ	П1	->	МГ	sin	П0
6	/-/	П3
ИП3	1	5	*	ИП1	ИП2	-	-	П4
tg	ИП0	*	arctg	ИП4	ИП3	С/П
ИП3	1	+	П3	7	-	x=0	12
Сx	С/П


MODULE SunDial;

FROM STextIO IMPORT
  WriteString, WriteLn, SkipLine;
FROM SRealIO IMPORT
  ReadReal, WriteFixed, WriteFloat;
FROM SWholeIO IMPORT
  WriteInt;
FROM RealMath IMPORT
  sin, pi, arctan, tan;

VAR
  Lat, Slat, Lng, Ref: REAL;
  Hour: INTEGER;
  HourAngle, HourLineAngle: REAL;
BEGIN
  WriteString("Enter latitude       => ");
  ReadReal(Lat);
  SkipLine;
  WriteString("Enter longitude      => ");
  ReadReal(Lng);
  SkipLine;
  WriteString("Enter legal meridian => ");
  ReadReal(Ref);
  SkipLine;
  WriteLn;
  Slat := sin(Lat * pi / 180.0);
  WriteString("    sine of latitude:   ");
  WriteFloat(Slat, 2, 8);
  WriteLn;
  WriteString("    diff longitude:     ");
  WriteFixed(Lng - Ref, 3, 1);
  WriteLn;
  WriteLn;
  WriteString("Hour, sun hour angle, dial hour line angle from 6am to 6pm");
  WriteLn;
  FOR Hour := -6 TO 6 DO
    HourAngle := FLOAT(15 * Hour);
    HourAngle := HourAngle - (Lng - Ref); (* correct for longitude difference *)
    HourLineAngle := arctan(Slat * tan(HourAngle * pi / 180.0)) * 180.0 / pi;
    WriteString("HR=");
    WriteInt(Hour, 3);
    WriteString("; HRA=");
    WriteFixed(HourAngle, 3, 8);
    WriteString("; HLA=");
    WriteFixed(HourLineAngle, 3, 8);
    WriteLn;
  END;
END SunDial.


(define pi 3.141592654)
(define (radians degrees) (mul degrees (div pi 180)))
(define (degrees radians) (mul radians (div 180 pi)))

(print "Enter latitude       => ")
(set 'lat (float (read-line)))

(print "Enter longitude      => ")
(set 'lng (float (read-line)))

(print "Enter legal meridian => ")
(set 'rf (float (read-line)))

(println)

(set 'slat (sin (radians lat)))

(println (format "    sine of latitude:   %.3f" slat))
(println (format "    diff longitude:     %.3f" (sub lng rf)))
(println)
(println "Hour, sun hour angle, dial hour line angle from 6am to 6pm")

(for (h -6 6)
	(set 'hra (sub (mul 15 h) lng rf))
	(set 'hla (degrees (atan (mul slat (tan (radians hra))))))
	(println (format "HR=%3d; HRA=%7.3f; HLA=%7.3f" h hra hla))
)

(exit)


import rdstdin, strutils, math, strformat

let lat = parseFloat readLineFromStdin "Enter latitude       => "
let lng = parseFloat readLineFromStdin "Enter longitude      => "
let med = parseFloat readLineFromStdin "Enter legal meridian => "
echo ""

let slat = sin lat.degToRad
echo &"    sine of latitude:   {slat:.3f}"
echo &"    diff longitude:     {lng-med:.3f}"
echo ""
echo "Hour, sun hour angle, dial hour line angle from 6am to 6pm"

for h in -6..6:
  let hra = float(15 * h) - lng + med
  let hla = arctan(slat * tan(hra.degToRad)).radToDeg
  echo &"HR={h:3d}; HRA={hra:7.3f}; HLA={hla:7.3f}"


class Sundial {
  function : Main(args : String[]) ~ Nil {
    "Enter latitude: "->Print();
    lat := System.IO.Console->ReadString()->ToFloat();
    "Enter longitude: "->Print();
    lng := System.IO.Console->ReadString()->ToFloat();
    "Enter legal meridian: "->Print();
    ref := System.IO.Console->ReadString()->ToFloat();
    '\n'->PrintLine();

    slat := lat->ToRadians()->Sin();
    "sine of latitude: {$slat}"->PrintLine();
    value := lng - ref;
    "diff longitude: {$value}"->PrintLine();
    '\n'->PrintLine();

    "Hour\t\tsun hour angle\t\tdial hour line angle from 6am to 6pm"->PrintLine();
    for (h := -6; h <= 6; h+=1;) {
      hra := 15.0 * h;
      hra -= lng - ref;
      hla := (slat* (hra*2*Float->Pi()/360.0)->Tan())->ArcTan() * 360.0 / (2*Float->Pi());
      "HR={$h}\t\tHRA={$hra}\t\tHLA={$hla}"->PrintLine();
    };
  }
}


let () =
  let pi = 4. *. atan 1. in
  print_endline "Enter latitude		=> ";
  let lat = read_float () in
  print_endline "Enter longitude	=> ";
  let lng = read_float () in
  print_endline "Enter legal meridian	=> ";
  let ref = read_float () in
  print_newline ();

  let slat = sin (lat *. 2. *. pi /. 360.) in
  Printf.printf "    sine of latitude:   %.3f\n" slat;
  Printf.printf "    diff longitude:     %.3f\n" (lng -. ref);
  print_newline ();

  print_endline "Hour, sun hour angle, dial hour line angle from 6am to 6pm";

  for h = -6 to 6 do
    let hra = 15. *. float h in
    let hra = hra -. (lng -. ref) in
    let hla = atan (slat *. tan (hra *. 2. *. pi /. 360.)) *. 360. /. (2. *. pi) in
    Printf.printf "HR= %3d;  \t  HRA=%7.3f;  \t  HLA= %7.3f\n" h hra hla;
  done


lat = input("Enter latitude: ");
lng = input("Enter longitude: ");
ref = input("Enter legal meridian: ");
slat = sind(lat);
printf("sine of latitude: %.3f\n", slat);
printf("diff longitude: %.3f\n\n", lng - ref);
printf("Hour, sun hour angle, dial hour line angle from 6am to 6pm\n");

hras = [-6:6] .* 15.0 .- lng .+ ref;
hlas = atand( tand(hras) .* slat );
printf("HR= %3d;  \t  HRA=%7.3f;  \t  HLA= %7.3f\n",
       [ [-6:6]; hras; hlas] );


/*REXX pgm shows:  hour,  sun hour angle,  dial hour line angle,  6am ---> 6pm*/
/* Use trigonometric functions provided by rxCalc                             */
parse arg lat lng mer .               /*get the optional arguments from the CL*/
                          /*None specified?   Then use the default of Jules   */
                          /*Verne's Lincoln Island,  aka  Ernest Legouve Reef.*/

if lat=='' | lat==',' then lat=-4.95  /*Not specified?   Then use the default.*/
if lng=='' | lng==',' then lng=-150.5 /* "      "          "   "   "     "    */
if mer=='' | mer==',' then mer=-150   /* "      "          "   "   "     "    */
L=max(length(lat), length(lng), length(mer))
say '       latitude:' right(lat,L)
say '      longitude:' right(lng,L)
say ' legal meridian:' right(mer,L)
sineLat=rxCalcSin(lat,,'D')
w1=max(length('hour')     ,length('midnight'))+2
w2=max(length('sun hour') ,length('angle'))+2
w3=max(length('dial hour'),length('line angle'))+2
indent=left('',30)               /*make the presentation prettier.      */
say indent center('    ',w1) center('sun hour',w2) center('dial hour' ,w3)
say indent center('hour',w1) center('angle'   ,w2) center('line angle',w3)
call sep                         /*add a separator line for the eyeballs*/

do h=-6  to 6                    /*Okey dokey then, let's get busy.     */
  select
    when abs(h)==12  then hc='midnight'      /*above the arctic circle? */
    when h<0  then hc=-h 'am'    /*convert the hour for human beans.    */
    when h==0 then hc='noon'     /*  ... easier to understand now.      */
    when h>0  then hc=h 'pm'     /*  ... even more meaningful.          */
    end   /*select*/
  hra=15*h-lng+mer
  hla=rxCalcArctan(sineLat*rxCalctan(hra,,'D'),,'D')
  say indent center(hc,w1) right(format(hra,,1),w2) right(format(hla,,1),w3)
  end
call sep
Exit
sep: say indent copies('-',w1) copies('-',w2) copies('-',w3)
     Return
::Requires rxMath Library


Program SunDial;

Const
   pi  = 3.14159265358979323846;
   dr  = pi/180.0;
   rd  = 180.0/pi;
   tab =  chr(9);

Var
   lat, slat, lng, ref : Real;
   hla, hra	       : Real;
   h		       : Integer;

function tan(val : Real) : Real;
begin
   tan := sin(val)/cos(val)
end;

Begin
   Write('Enter latitude: '); Read(lat);
   Write('Enter longitude: '); Read(lng);
   Write('Enter legal meridian: '); Read(ref);
   WriteLn;
   slat := sin(lat * dr);
   WriteLn('sine of latitude: ', slat);
   WriteLn('diff longitude: ', lng - ref);
   WriteLn('Hour, sun hour angle, dial hour line angle from 6am to 6pm');
   for h := -6 to 6 do begin
      hra := 15.0 * h;
      hra := hra - lng + ref;
      hla := arctan(slat * tan(hra * dr)) * rd;
      WriteLn('HR= ', h:3, ';  ',
	      tab, '  HRA= ', hra:7:3, ';  ',
	      tab, '  HLA= ', hla:7:3)
   end
end.


use utf8;
binmode STDOUT, ":utf8";

use constant π => 3.14159265;

sub d2r { $_[0] * π / 180 } # degrees to radians
sub r2d { $_[0] * 180 / π } # radians to degrees

print 'Enter latitude       => '; $latitude  = <>;
print 'Enter longitude      => '; $longitude = <>;
print 'Enter legal meridian => '; $meridian  = <>;

$lat_sin = sin( d2r($latitude) );
$offset = $meridian - $longitude;
print 'Sine of latitude: ' . sprintf "%.4f\n", $lat_sin;
print 'Longitude offset: ' . $offset . "\n";
print '=' x 48 . "\n";
print " Hour : Sun hour angle°: Dial hour line angle°\n";

for $hour (-6 .. 6) {
    my $sun_deg  = $hour * 15 + $offset;
    my $line_deg = r2d atan2( ( sin(d2r($sun_deg)) * $lat_sin ), cos(d2r($sun_deg)) );
    printf "%2d %s     %8.3f            %8.3f\n",
    ($hour + 12) % 12 || 12, ($hour < 0 ? 'AM' : 'PM'), $sun_deg, $line_deg;
}


with javascript_semantics
function prompt(string text, atom v)
    if platform()!=JS then
        printf(1,"Enter %s (%g):",{text,v})
        object answer = gets(0)
        puts(1, '\n')
        if string(answer) then
            v = to_number(trim(answer),v)
        end if
    else
        printf(1,"%s:%g\n",{text,v})
    end if
    return v
end function

constant deg2rad = PI/180,
         rad2deg = 180/PI

atom lat = prompt("Latitude",-4.95),
     lng = prompt("Longitude",-150.5),
     mer = prompt("Legal Meridian",-150),
     slat = sin(lat*deg2rad)

printf(1,"""

  Sine of latitude: %g
  Longitude offset: %g

  Hour    Sun hour angle  Dial hour line angle
--------  --------------  --------------------
""",{slat,lng-mer})

for hour = -6 to 6 do
    atom ha = hour * 15 - lng + mer,
         s = sin(ha*deg2rad),
         c = cos(ha*deg2rad),
         hla = atan2(slat*s,c)*rad2deg
    integer hour12 = iff(hour<=0?hour+12:hour)
    string am = iff(hour<0?"am":"pm")
    printf(1,"%3d:00%s %12.3f %17.3f\n",{hour12,am,ha,hla})
end for


(load "@lib/math.l")

(de prompt (Str . Arg)
   (prin Str " => ")
   (set (car Arg) (in NIL (read))) )

(use (Lat Lng Ref)
   (prompt "Enter latitude      " Lat)
   (prompt "Enter longitude     " Lng)
   (prompt "Enter legal meridian" Ref)
   (prinl)
   (let Slat (sin (*/ Lat pi 180.0))
      (prinl "    sine of latitude:   " (round Slat))
      (prinl "    diff longitude:     " (round (- Lng Ref)))
      (prinl)
      (prinl "Hour, sun hour angle, dial hour line angle from 6am to 6pm")
      (for H (range -6 6)
         (let Hra (- (* 15.0 H) (- Lng Ref))
            (let Hla (*/ (atan (*/ Slat (tan (*/ Hra pi 180.0)) 1.0)) 180.0 pi)
               (prinl
                  "HR="
                  (align 3 H)
                  "; HRA="
                  (align 8 (round Hra))
                  "; HLA="
                  (align 8 (round Hla)) ) ) ) ) ) )


function Get-Sundial
{
    [CmdletBinding()]
    [OutputType([PSCustomObject])]
    Param
    (
        [Parameter(Mandatory=$true)]
        [ValidateRange(-90,90)]
        [double]
        $Latitude,

        [Parameter(Mandatory=$true)]
        [ValidateRange(-180,180)]
        [double]
        $Longitude,

        [Parameter(Mandatory=$true)]
        [ValidateRange(-180,180)]
        [double]
        $Meridian
    )

    [double]$sinLat = [Math]::Sin($Latitude*2*[Math]::PI/360)

    $object = [PSCustomObject]@{
        "Sine of Latitude"     = [Math]::Round($sinLat,3)
        "Longitude Difference" = $Longitude - $Meridian
    }

    [int[]]$hours = -6..6

    $hoursArray = foreach ($hour in $hours)
    {
        [double]$hra = (15 * $hour) - ($Longitude - $Meridian)
        [double]$hla = [Math]::Atan($sinLat*[Math]::Tan($hra*2*[Math]::PI/360))*360/(2*[Math]::PI)
        [PSCustomObject]@{
            "Hour"                 = "{0,8}" -f ((Get-Date -Hour ($hour + 12) -Minute 0).ToString("t"))
            "Sun Hour Angle"       = [Math]::Round($hra,3)
            "Dial Hour Line Angle" = [Math]::Round($hla,3)
        }
    }

    $object | Add-Member -MemberType NoteProperty -Name Hours -Value $hoursArray -PassThru
}

$sundial = Get-Sundial -Latitude -4.95 -Longitude -150.5 -Meridian -150
$sundial | Select-Object -Property "Sine of Latitude", "Longitude Difference" | Format-List
$sundial.Hours | Format-Table -AutoSize


If OpenConsole()
  Define.f lat, slat, lng, ref
  Define.i h
  Print("Enter latitude       => "): lat=ValF(Input())
  Print("Enter longitude      => "): lng=ValF(Input())
  Print("Enter legal meridian => "): ref=ValF(Input())
  PrintN("")

  slat=Sin(lat*2*#PI/360)
  PrintN("    sine of latitude:   "+StrF(slat,3))
  PrintN("    diff longitude:     "+StrF((lng-ref),3)+#CRLF$)
  PrintN("Hour, sun hour angle, dial hour line angle from 6am to 6pm")

  For h=-6 To 6
    Define.f hra, hla
    hra=15*h
    hra=hra-(lng-ref)
    hla=ATan(slat*Tan(hra*2*#PI/360))*360/(2*#PI)
    PrintN("HR="+RSet(Str(h),3)+"; HRA="+RSet(StrF(hra,3),7)+"; HLA="+RSet(StrF(hla,3),7))
  Next

EndIf


from __future__ import print_function
import math
try: raw_input
except: raw_input = input

lat = float(raw_input("Enter latitude       => "))
lng = float(raw_input("Enter longitude      => "))
ref = float(raw_input("Enter legal meridian => "))
print()

slat = math.sin(math.radians(lat))
print("    sine of latitude:   %.3f" % slat)
print("    diff longitude:     %.3f" % (lng-ref))
print()
print("Hour, sun hour angle, dial hour line angle from 6am to 6pm")

for h in range(-6, 7):
  hra = 15 * h
  hra -= lng - ref
  hla = math.degrees(math.atan(slat * math.tan(math.radians(hra))))
  print("HR=%3d; HRA=%7.3f; HLA=%7.3f" % (h, hra, hla))


#lang racket

;; print the table for a given latitude and longitude-offset,
;; given in degrees
(define (print-table lat long-offset)
  ;; print the table header
  (display
   (~a "    sine of latitude: "
       (~r (sin (deg->rad lat)) #:precision '(= 3))
       "\n"
       "    diff longitude:   "
       (~r long-offset #:precision '(= 3))
       "\n\nHour, sun hour angle, dial hour line angle "
       "from 6am to 6pm\n"))
  ;; print the table
  (for ([h (in-range -6 7)])
    (define hra (- (* 15 h) long-offset))
    (define hla (to-hla lat hra))
    (display (~a "HR="(pad-to 3 (~a h))"; "
                 "HRA="(pad-to 7 (~r hra #:precision '(= 3)))"; "
                 "HLA="(pad-to 7 (~r hla #:precision '(= 3)))"\n"))))

;; compute the angle on the gnomon corresponding to a
;; given angle of the sun (angles given and returned in degrees)
(define (to-hla lat ang)
  (define lat-sign (cond [(< lat 0) -1] [else 1]))
  ;; move to the right quadrant for
  ;; angles outside [-90,90]
  (define correction (* (cond [(< ang -90) -180]
                              [(> ang 90) 180]
                              [else 0])
                        lat-sign))
  (+ (rad->deg (atan (* (sin (deg->rad lat))
                        (tan (deg->rad ang)))))
     correction))

;; write the prompt, return the entered number
(define (prompt->num p)
  (printf "~a" p)
  (string->number (read-line)))

;; translate degrees to radians
(define (deg->rad d) (* 2 pi (/ d 360)))

;; translate radians to degrees
(define (rad->deg r) (* 360 (/ r (* 2 pi))))

;; add spaces to reach given length
(define (pad-to cols str)
  (define spaces-needed (max 0 (- cols (string-length str))))
  (string-append
   (list->string (for/list ([i spaces-needed]) #\space))
   str))

;; INPUT PARAMETERS, PRINT TABLE:
(define lat (prompt->num "Enter latitude       => "))
(define lng (prompt->num "Enter longitude      => "))
(define ref (prompt->num "Enter legal meridian => "))

(print-table lat (- lng ref))

;; test cases for angle conversion
(require rackunit)
(check < (to-hla 30 89) 90)
(check-= (to-hla 30 90) 90 1e-5)
(check > (to-hla 30 91) 90)
(check > (to-hla 30 -89) -90)
(check-= (to-hla 30 90) 90 1e-5)
(check < (to-hla 30 -91) -90)
(check < (to-hla -30 -89) 90)
(check-= (to-hla -30 -90) 90 1e-5)
(check > (to-hla -30 -91) 90)
(check > (to-hla -30 89) -90)
(check-= (to-hla -30 90) -90 1e-5)
(check < (to-hla -30 91) -90)


sub postfix:<°> ($a) { $a * pi / 180 } # degrees to radians
sub postfix:<®> ($a) { $a * 180 / pi } # radians to degrees

my $latitude  = prompt 'Enter latitude       => ';
my $longitude = prompt 'Enter longitude      => ';
my $meridian  = prompt 'Enter legal meridian => ';

my $lat_sin = sin( $latitude° );
say 'Sine of latitude: ', $lat_sin.fmt("%.4f");
say 'Longitude offset: ', my $offset = $meridian - $longitude;
say '=' x 48;
say ' Hour  : Sun hour angle° : Dial hour line angle°';

for -6 .. 6 -> $hour {
    my $sun_deg  = $hour * 15 + $offset;
    my $line_deg = atan2( ( sin($sun_deg°) * $lat_sin ), cos($sun_deg°) )®;
    printf "%2d %s      %7.3f             %7.3f\n",
    ($hour + 12) % 12 || 12, ($hour < 0 ?? 'AM' !! 'PM'), $sun_deg, $line_deg;
}


/*REXX program displays:   hour,  sun hour angle,  dial hour line angle,  6am ───► 6pm. */
numeric digits length( pi() )    -    length(.)  /*in case sundial is in polar regions. */
parse arg lat lng .                              /*obtain optional arguments from the CL*/
                              /*     ┌───────────◄ None specified?  Then use the default*/
                              /*     │             of Jules Verne's Lincoln Island,     */
$= left('', 30)               /*     ↓             aka      Ernest Legouve Reef.        */
if lat=='' | lat==","  then lat=   -4.95         /*Not specified?  Then use the default.*/
if lng=='' | lng==","  then lng= -150.5          /* "      "         "   "   "     "    */
mer= format(lng/15, , 0)  *  15                  /*calculate legal meridian longitude.  */
sineLat= sin( d2r(lat) )                         /*calculate sine of (radian) latitude. */
w1= max( length('hour'     ), length("midnight"  ))  + 2   /*compute the max hour  width*/
w2= max( length('sun hour' ), length("angle"     ))  + 2   /*   "     "   " angle    "  */
w3= max( length('dial hour'), length("line angle"))  + 2   /*   "     "   " lineº    "  */
L=  max( length(lat), length(lng), length(mer) ) /*find the maximum length of 3 numbers.*/
     say '       latitude:'    right(lat, L)     /*display the  latitude to the terminal*/
     say '      longitude:'    right(lng, L)     /*   "     "  longitude  "  "     "    */
     say ' legal meridian:'    right(mer, L)     /*   "    legal meridian "  "     "    */
     say $  center('    ', w1)    center("sun hour", w2)      center('dial hour' , w3)
     say $  center('hour', w1)    center(" angle"  , w2)      center('line angle', w3)
call sep                                         /*to help a one─eyed pirate's eyeball. */
        do h=5  to 19  by .25                    /*Okey dokey then, now let's show stuff*/
        hra= 15 * h   -   lng  +  mer - 180      /*calculate sun hour angle (in degrees)*/
        hla= r2d( Atan(sineLat * tan(d2r(hra)))) /*this is the heavy lifting calculation*/
        if abs(hra)>90  then hla= hla + 180 * sign(hra*lat)  /*adjust for negative angle*/
        call civil                               /*convert the time─of─day to civil time*/
        say $ center(hc, w1)   right(format(hra,,1), w2-2)@   right(format(hla,,1), w3-5)
        end        /*h*/
call sep                                         /*to help a one─eyed pirate's eyeball. */
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
pi:   pi= 3.1415926535897932384626433832795028841971693993751058209749445923078; return pi
d2d:  return arg(1)              // 360          /*normalize degrees ──► a unit circle. */
d2r:  return r2r( arg(1) * pi()   / 180)         /*convert degrees   ──► radians.       */
r2d:  return d2d( (arg(1) * 180   / pi() )  )    /*convert radians   ──► degrees.       */
r2r:  return arg(1)              //(pi() * 2)    /*normalize radians ──► a unit circle. */
sep:  say $  copies('═', w1)  copies("═", w2)   copies('═', w3);   @= left('',3);   return
tan:  procedure; parse arg x;  _= cos(x);   if _=0  then call tanErr;      return sin(x)/_
tellErr: say;    say '*** error ***';       say;        say arg(1);      say;      exit 13
AsinErr: call tellErr 'Asin(x),  X  must be in the range of  -1 ──► +1,  X='   x
AcosErr: call tellErr 'Acos(x),  X  must be in the range of  -1 ──► +1,  X='   x
tanErr:  call tellErr 'tan(' || x") causes division by zero,  X="              x
Acos: procedure; arg x;  if x<-1 | x>1  then call AcosErr;      return .5 * pi() - Asin(x)
Atan: procedure; parse arg x; if abs(x)=1 then return pi()*x/4; return Asin(x/sqrt(1+x*x))
/*──────────────────────────────────────────────────────────────────────────────────────*/
Asin: procedure; parse arg x;   if x<-1 | x>1  then call AsinErr;    s= x*x
      if abs(x)>=sqrt(2)*.5  then return sign(x) * Acos(sqrt(1-s));  z= x;  o= x;     p= z
        do j=2 by 2; o= o*s*(j-1)/j; z=z+o/(j+1); if z=p  then leave; p= z;  end; return z
/*──────────────────────────────────────────────────────────────────────────────────────*/
sin:  procedure; parse arg x;        x= r2r(x);          numeric fuzz min(5, digits() - 3)
                 if abs(x)=pi  then return;              return .sinCos(x, x, 1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
cos:  procedure; parse arg x;        x= r2r(x);          a= abs(x);          hpi= pi * .5
                 numeric fuzz min(6, digits() - 3);      if a=pi      then return -1
                 if a=hpi | a=hpi*3  then return 0;      if a=pi/3    then return .5
                 if a=pi * 2 / 3     then return '-.5';  return .sinCos(1, 1, '-1')
/*──────────────────────────────────────────────────────────────────────────────────────*/
.sinCos: parse arg z,!,i;                  x= x*x;                     p= z
           do #=2 by 2; != -!*x/(#*(#+i)); z= z+!; if z=p  then leave; p= z; end; return z
/*──────────────────────────────────────────────────────────────────────────────────────*/
civil:      select                               /* [↓]  Maybe below  Antarctic circle, */
            when h== 0  then hc= 'midnight'      /*        or  above     Arctic    "    */
            when h <12  then hc=    h  'am'      /*convert da hour for human beans (sic)*/
            when h==12  then hc= 'noon'          /*   ···  easier to understand now.    */
            when h >0   then hc=    h  'pm'      /*   ···  even more meaningful.        */
            end   /*select*/
      parse var hc  hh ampm .;    if \datatype(hh, 'N')  then return     /*not numeric? */
      hh= hh / 1;   if hh>12  then hh= hh - 12                           /*civil time ? */
      if pos(., hh)==0  then do; hc= right(hh, 2)'   ' ampm; return; end /*exact hour ? */
      parse var  hh   hr '.' -0 mn;  if hr==0  then hr= 12               /*get MN; noon?*/
      mn= mn * 60 / 1;  hc= right(hr, 2)":"right(mn, 2, 0) ampm; return  /*reformat time*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x;  if x=0  then return 0;  d=digits();  numeric digits;  h=d+6
      m.=9; numeric form; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_ % 2
        do j=0  while h>9;      m.j= h;             h= h % 2 + 1;    end  /*j*/
        do k=j+5  to 0  by -1;  numeric digits m.k; g= (g+x/g) *.5;  end  /*k*/;  return g


# Project : Horizontal sundial calculations

load "stdlib.ring"
pi = 22/7
decimals(3)

latitude = -4.95
longitude = -150.5
meridian = -150.0

see "enter latitude (degrees): " + latitude + nl
see "enter longitude (degrees): " + longitude + nl
see "enter legal meridian (degrees): " + meridian + nl

see "time   " + "   sun hour angle" + "      dial hour line angle" + nl

for hour = 6 to 18
    hra = 15*hour - longitude + meridian - 180
    hla = 180/pi*(atan(sin(pi/180*latitude) * tan(pi/180*hra)))
    if fabs(hra) > 90
       hla = hla + 180 * sign(hra * latitude)
    ok
    see "" + hour + "           " + hra + "                  " + hla + nl
next


include Math
DtoR = PI/180

print 'Enter latitude: '
lat = Float( gets )
print 'Enter longitude: '
lng = Float( gets )
print 'Enter legal meridian: '
ref = Float( gets )
puts

slat = sin( lat * DtoR )

puts "    sine of latitude:  %.3f"% slat
puts "    diff longitude:    %.3f"% (lng-ref)
puts
puts 'Hour, sun hour angle, dial hour line angle from 6am to 6pm'
-6.upto(6) do |h|
  hra = 15 * h
  hra -= lng - ref
  hla =  atan( slat * tan( hra * DtoR ))/ DtoR
  puts "HR =%3d; HRA =%7.3f; HLA =%7.3f" % [h, hra, hla]
end


global pi
pi = 22 / 7

print "Enter latitude  (degrees)     : "; :input latitude      '    -4.95
print "Enter longitude (degrees)     : "; :input longitude     '   -150.5
print "Enter legal meridian (degrees): "; :input meridian      '   -150.0

print
print "Time     Sun hour angle   Dial hour line angle"

for hour = 6 TO 18
   hra = (15 * hour) - longitude + meridian -180
   hla =rad2deg( atn( sin( deg2rad( latitude)) *tan( deg2rad( hra))))
   if abs( hra) >90 then hla =hla +180 *sgn( hra *latitude)
   print using( "##", hour);"         ";using("####.##", hra);"         ";using("####.###", hla)
next hour

function rad2deg( theta)
    rad2deg =theta *180 /pi
end function

function deg2rad( theta)
    deg2rad =theta *pi /180
end function

function sgn( x)
    if x >0 then sgn =1 else sgn =-1
end function
end


use std::io;
struct SundialCalculation {
    hour_angle: f64,
    hour_line_angle: f64,
}

fn get_input(prompt: &str) -> Result<f64, Box<dyn std::error::Error>> {
    println!("{}", prompt);
    let mut input = String::new();
    let stdin = io::stdin();
    stdin.read_line(&mut input)?;
    Ok(input.trim().parse::<f64>()?)
}

fn calculate_sundial(hour: i8, lat: f64, lng: f64, meridian: f64) -> SundialCalculation {
    let diff = lng - meridian;
    let hour_angle = f64::from(hour) * 15. - diff;
    let hour_line_angle = (hour_angle.to_radians().tan() * lat.to_radians().sin())
        .atan()
        .to_degrees();

    SundialCalculation {
        hour_angle,
        hour_line_angle,
    }
}
fn main() -> Result<(), Box<dyn std::error::Error>> {
    let lat = get_input("Enter latitude       => ")?;
    let lng = get_input("Enter longitude      => ")?;
    let meridian = get_input("Enter legal meridian => ")?;
    let diff = lng - meridian;

    let sine_lat = lat.to_radians().sin();
    println!("Sine of latitude: {:.5}", sine_lat);
    println!("Diff longitude: {}", diff);

    println!("  Hrs Angle   Hour Line Angle");
    (-6..=6).for_each(|hour| {
        let sd = calculate_sundial(hour, lat, lng, meridian);
        println!(
            "{:>3}{} {:>5}   {:>+15.5}",
            if hour == 0 { 12 } else { (hour + 12) % 12 },
            if hour <= 6 { "pm" } else { "am" },
            sd.hour_angle,
            sd.hour_line_angle
        );
    });
    Ok(())
}


class MAIN is

  getvalue(s:STR):FLT is
    #OUT + s + ": ";
    return #FLT(#IN.get_line.str);
  end;

  dr(a:FLT):FLT is
    return a * FLT::pi / 180.0;
  end;

  rd(a:FLT):FLT is
    return a * 180.0 / FLT::pi;
  end;

  main is
    lat ::= getvalue("Enter latitude");
    lng ::= getvalue("Enter longitude");
    ref ::= getvalue("Enter legal meridian");
    #OUT + "\n";
    slat ::= dr(lat).sin;
    #OUT + "sine of latitude: " + #FMT("%.3f\n", slat);
    #OUT + "diff longitude: " + #FMT("%.3f\n\n", lng - ref);
    #OUT + "Hour, sun hour angle, dial hour line angle from 6am to 6pm\n";
    loop h ::= (-6).upto!(6);
      hra ::= 15.0 * h.flt;
      hra := hra - lng + ref;
      hla ::= rd((dr(hra).tan * slat).atan);
      #OUT + #FMT("HR = %3d;  \t  HRA=%7.3f;  \t  HLA= %7.3f\n", h, hra, hla);
    end;
  end;
end;


import java.util.Scanner

import scala.math.{atan2, cos, sin, toDegrees, toRadians}

object Sundial extends App {
  var lat, slat,lng, ref = .0
  val sc = new Scanner(System.in)
  print("Enter latitude: ")
  lat = sc.nextDouble
  print("Enter longitude: ")
  lng = sc.nextDouble
  print("Enter legal meridian: ")
  ref = sc.nextDouble
  println()
  slat = Math.sin(Math.toRadians(lat))
  println(f"sine of latitude: $slat%.3f")
  println(f"diff longitude: ${lng - ref}%.3f\n")
  println("Hour, sun hour angle, dial hour line angle from 06h00 to 18h00")

  for (h <- -6 to 6) {
    val hra = 15.0 * h - lng + ref
    val hraRad = toRadians(hra)
    val hla = toDegrees(atan2(Math.sin(hraRad) * sin(Math.toRadians(lat)), cos(hraRad)))
    println(f"HR= $h%3d;\tHRA=$hra%7.3f;\tHLA= $hla%7.3f")
  }

}


$ include "seed7_05.s7i";
  include "float.s7i";
  include "math.s7i";

const float: radianToDegrees is 57.295779513082320876798154814114;
const float: degreesToRadian is 0.017453292519943295769236907684883;

const proc: main is func
  local
    var float: lat is 0.0;
    var float: slat is 0.0;
    var float: lng is 0.0;
    var float: meridian is 0.0;
    var float: hla is 0.0;
    var float: hra is 0.0;
    var integer: h is 0;
  begin
    write("Enter latitude: ");
    readln(lat);
    write("Enter longitude: ");
    readln(lng);
    write("Enter legal meridian: ");
    readln(meridian);
    writeln;
    slat := sin(degreesToRadian * lat);
    writeln("sine of latitude: " <& slat digits 3);
    writeln("diff longitude: " <& lng - meridian digits 3);
    writeln;
    writeln("Hour, sun hour angle, dial hour line angle from 6am to 6pm");
    for h range -6 to 6 do
      hra := 15.0 * flt(h);
      hra := hra - lng + meridian;
      hla := radianToDegrees * atan(slat * tan(degreesToRadian * hra));
      writeln("HR= " <& h lpad 2 <& "; HRA= " <& hra digits 3 lpad 7 <&
              "; HLA= " <& hla digits 3 lpad 7);
    end for;
  end func;


var latitude  = read('Enter latitude       => ', Number)
var longitude = read('Enter longitude      => ', Number)
var meridian  = read('Enter legal meridian => ', Number)

var lat_sin = latitude.deg2rad.sin
var offset = (meridian - longitude)

say('Sine of latitude: ', "%.4f" % lat_sin)
say('Longitude offset: ', offset)
say('=' * 48)
say(' Hour  : Sun hour angle° : Dial hour line angle°')

for hour (-6 .. 6) {
    var sun_deg  = (15*hour + offset)
    var line_deg = rad2deg(
        atan2(
            sin(deg2rad(sun_deg)) * lat_sin,
            cos(deg2rad(sun_deg))
        )
    )
    printf("%2d %s      %7.3f             %7.3f\n",
      (hour + 12) % 12 || 12, (hour < 0 ? 'AM' : 'PM'), sun_deg, line_deg)
}


|lat slat lng ref hra hla pi|
pi := 1 arcTan * 4.
'Enter latitude:       ' display. lat := stdin nextLine asNumber.
'Enter longitude:      ' display. lng := stdin nextLine asNumber.
'Enter legal meridian: ' display. ref := stdin nextLine asNumber.
slat := lat degreesToRadians sin.
('sine of latitude: %1' % { slat }) displayNl.
('diff longitude: %1' % { lng - ref }) displayNl.

'Hour, sun hour angle, dial hour line angle from 6am to 6pm' displayNl.

-6 to: 6 do: [ :h |
  hra := 15.0 * h.
  hra := hra - lng + ref.
  hla := (hra degreesToRadians tan * slat) arcTan radiansToDegrees.
  ('HR= %1;  %4  HRA=%2;  %4  HLA= %3' % { h. hra. hla. $<9> }) displayNl.
]


set PI 3.1415927
fconfigure stdout -buffering none
puts -nonewline "Enter latitude       => "; gets stdin lat
puts -nonewline "Enter longitude      => "; gets stdin lng
puts -nonewline "Enter legal meridian => "; gets stdin ref
puts ""

set slat [expr {sin($lat*$PI/180)}]
puts [format "    sine of latitude:   %8g" $slat]
puts [format "    diff longitude:     %3.3f" [expr {$lng - $ref}]]
puts ""
puts "Hour, sun hour angle, dial hour line angle from 6am to 6pm"

for {set h -6} {$h<=6} {incr h} {
    set hra [expr {15.0 * $h}];      # hour angle is 15 times the hour #
    set hra [expr {$hra-$lng+$ref}]; # but correct for longitude difference #
    set hla [expr {atan($slat * tan($hra*$PI/180)) * 180/$PI}]
    puts [format "HR=%+3d; HRA=%+8.3f; HLA=%+8.3f" $h $hra $hla]
}


import "io" for Stdin, Stdout
import "/fmt" for Fmt

var getNum = Fn.new { |prompt|
    while (true) {
        System.write(prompt)
        Stdout.flush()
        var input = Stdin.readLine()
        var n = Num.fromString(input)
        if (n) return n
        System.print("Invalid number, try again.")
    }
}

var lat = getNum.call("Enter latitude       : ")
var lng = getNum.call("Enter longitude      : ")
var ref = getNum.call("Enter legal meridian : ")
var slat = (lat * Num.pi / 180).sin
var diff = lng - ref
System.print("\n    sine of latitude : %(slat)")
System.print("    diff longitude   : %(diff)")
System.print("\nHour, sun hour angle, dial hour line angle from 6am to 6pm")
for (h in -6..6) {
    var hra = 15*h - diff
    var s = (hra * Num.pi /180).sin
    var c = (hra * Num.pi /180).cos
    var hla = (slat*s).atan(c) * 180 / Num.pi
    Fmt.print("$2.0f $8.3f $8.3f", h, hra, hla)
}


	global main
	extern printf, scanf

	section .text

getvalue:
	push	edx
	push	eax
	call	printf
	add	esp, 4
	push	in_ft
	call	scanf
	add	esp, 8
	ret

st0dr:
	fld	qword [drfact]
	fmul
	ret

main:
	lea	eax, [lat_t]
	lea	edx, [lat]
	call    getvalue
	lea	eax, [lng_t]
	lea	edx, [lng]
	call	getvalue
	lea	eax, [ref_t]
	lea	edx, [ref]
	call	getvalue

	push	newline
	call	printf
	add	esp, 4

	fld	qword [lat]
	call	st0dr
	fsin
	fst	qword [slat]

	sub	esp, 8
	fstp	qword [esp]
	push	sin_ft
	call	printf
	add	esp, 12

	fld	qword [lng]
	fld	qword [ref]
	fsubr	st0, st1
	sub	esp, 8
	fstp	qword [esp]
	push	diff_ft
	call	printf
	add 	esp, 12

	push	tab_t
	call	printf
	add	esp, 4

	mov	ecx, -6
.loop:
	cmp	ecx, 6
	jg	.endloop

	push	ecx
	fild	dword [esp]
	fld	qword [xv]
	fmulp
	fld	qword [lng]
	fsubp
	fld	qword [ref]
	faddp
	pop	ecx

	sub	esp, 20
	mov	dword [esp], ecx
	fst	qword [esp+4]

	call	st0dr

	fptan
	fxch
	fld	qword [slat]
	fmulp
	fxch
	fpatan

	fld	qword [rdinv]
	fmul

	fstp	qword [esp+12]

	push	o_ft
	call	printf
	mov	ecx, [esp+4]
	add 	esp, 24

	inc	ecx
	jmp	.loop
.endloop:

	xor	eax, eax
	ret

	section .data

lat:	dq	0.0
lng:	dq	0.0
ref:	dq	0.0
xv:	dq	15.0
slat:	dq	0.0
drfact:	dq	0.01745329251994329576
rdinv:	dq	57.29577951308232090712

	section .rodata

lat_t:	db "Enter latitude: ", 0
lng_t:	db "Enter longitude: ", 0
ref_t:	db "Enter legal meridian: ", 0

in_ft:	db "%lf", 0
newline:
	db 10, 0

sin_ft:
	db "sine of latitude: %.3f", 10, 0
diff_ft:
	db "diff longitude: %.3f", 10, 10, 0

tab_t:
	db "Hour, sun hour angle, dial hour line angle from 6am to 6pm", 10, 0

o_ft:
	db "HR= %3d;  ",9,"  HRA=%7.3f;  ",9,"  HLA= %7.3f", 10, 0


PROGRAM "sundial"
VERSION "0.0001"

IMPORT "xma"

DECLARE FUNCTION Entry()

FUNCTION Entry()
  lat! = SINGLE(INLINE$("Enter latitude       => "))
  lng! = SINGLE(INLINE$("Enter longitude      => "))
  ref! = SINGLE(INLINE$("Enter legal meridian => "))
  PRINT
  slat! = SIN(lat! * $$PI / 180.0)
  PRINT "    sine of latitude:   "; FORMAT$("#.##^^^^", slat!)
  PRINT "    diff longitude:     "; FORMAT$("#.###", lng! - ref!)
  PRINT
  PRINT "Hour, sun hour angle, dial hour line angle from 6am to 6pm"
  FOR hour@ = -6 TO 6
    hourAngle! = 15 * hour@
    hourAngle! = hourAngle! - (lng! - ref!) ' correct for longitude difference
    hourLineAngle! = ATAN(slat! * TAN(hourAngle! * $$PI / 180.0)) * 180.0 / $$PI
    PRINT "HR="; FORMAT$("###", hour@);
    PRINT "; HRA="; FORMAT$("####.###", hourAngle!);
    PRINT "; HLA="; FORMAT$("####.###", hourLineAngle!)
  NEXT hour@
END FUNCTION
END PROGRAM


inc  c:\cxpl\codes;
def  Pi = 3.14159265358979323846,
     Deg2Rad = Pi/180.0,
     Rad2Deg = 180.0/Pi,
     Tab = $09;
real Lat, SinLat, Long, Mer;
real HA, HLA;                   \hour angle and hour line angle
int  H, T;                      \hour, time
[Text(0, "Latitude:       ");  Lat:=  RlIn(0);
 Text(0, "Longitude:      ");  Long:= RlIn(0);
 Text(0, "Legal meridian: ");  Mer:=  RlIn(0);
Text(0, "
Hour  Sun hour angle   Dial hour line angle
");
Format(4, 3);
SinLat:= Sin(Lat*Deg2Rad);
for H:= -6 to 6 do
   [HA:= float(15 * H);         \hour angle is 15 times the hour
    HA:= HA - (Long-Mer);       \ but corrected for longitude difference
    HLA:= ATan2( SinLat * Sin(HA*Deg2Rad), Cos(HA*Deg2Rad) ) * Rad2Deg;
    T:= H+12;  if T>12 then T:= T-12;
    if T<10 then ChOut(0, ^ );  IntOut(0, T);
    Text(0, if H>=0 then "pm    " else "am      ");
    RlOut(0, HA);  ChOut(0, Tab);  RlOut(0, HLA);  CrLf(0);
   ];
]


//(degree measure)*Degrees => Radian measure
//(radian measure)/Degrees => Degree measure
const pi=(0.0).pi, toDeg=(0.0).pi/180;

latitude :=ask(0,"Enter latitude: ").toFloat();
longitude:=ask(1,"Enter longitude: ").toFloat();
meridian :=ask(2,"Enter legal meridian: ").toFloat();

sineLatitude:=(latitude * toDeg).sin();
Console.writeln();
Console.writeln("Sine of latitude: ",sineLatitude);
Console.writeln("Difference of Longitudes (given longitude - meridian): ",longitude-meridian);
Console.writeln();

println("Numbers from 6 AM to 6 PM: ");
println("Hour\t\tSun hour angle\t Dial hour line angle");

foreach hour in ([-6..6]){
   clockHour:=( if(hour < 0) "%sAM".fmt(hour.abs()) else "%sPM".fmt(hour) );
   shr      :=15.0*hour - (longitude - meridian);
   dhla     :=(sineLatitude*(shr*toDeg).tan()).atan()/toDeg;
   Console.writeln("%s\t\t%5.1f\t\t%+7.3f".fmt(clockHour,shr,dhla));
}


10 DEF FN r(x)=x*PI/180
20 DEF FN d(x)=x*180/PI
30 INPUT "Enter latitude (degrees): ";latitude
40 INPUT "Enter longitude (degrees): ";longitude
50 INPUT "Enter legal meridian (degrees): ";meridian
60 PRINT "Latitude: ";latitude
70 PRINT "Longitude:";longitude
80 PRINT "Legal meridian: ";meridian
90 PRINT '"      Sun         Dial"
100 PRINT "Time  hour angle  hour line ang."
110 PRINT "________________________________"
120 FOR h=6 TO 18
130 LET hra=15*h-longitude+meridian-180
140 LET hla=FN d(ATN (SIN (FN r(latitude))*TAN (FN r(hra))))
150 IF ABS (hra)>90 THEN LET hla=hla+180*SGN (hra*latitude)
160 PRINT h;"    ";hra;"        ";hla
170 NEXT h


T Element
   Int weight
   [(Char, String)] symbols

   F (weight, symbols)
      .weight = weight
      .symbols = symbols

   F <(other)
      R (.weight, .symbols) < (other.weight, other.symbols)

F encode(symb2freq)
   V heap = symb2freq.map((sym, wt) -> Element(wt, [(sym, ‘’)]))
   minheap:heapify(&heap)

   L heap.len > 1
      V lo = minheap:pop(&heap)
      V hi = minheap:pop(&heap)

      L(&sym) lo.symbols
         sym[1] = ‘0’sym[1]

      L(&sym) hi.symbols
         sym[1] = ‘1’sym[1]

      minheap:push(&heap, Element(lo.weight + hi.weight, lo.symbols [+] hi.symbols))

   R sorted(minheap:pop(&heap).symbols, key' p -> (p[1].len, p))

V txt = ‘this is an example for huffman encoding’
V symb2freq = DefaultDict[Char, Int]()
L(ch) txt
   symb2freq[ch]++

V huff = encode(symb2freq)
print("Symbol\tWeight\tHuffman Code")
L(p) huff
   print("#.\t#.\t#.".format(p[0], symb2freq[p[0]], p[1]))


with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Containers.Ordered_Maps;
with Ada.Finalization;
generic
   type Symbol_Type is private;
   with function "<" (Left, Right : Symbol_Type) return Boolean is <>;
   with procedure Put (Item : Symbol_Type);
   type Symbol_Sequence is array (Positive range <>) of Symbol_Type;
   type Frequency_Type is private;
   with function "+" (Left, Right : Frequency_Type) return Frequency_Type
     is <>;
   with function "<" (Left, Right : Frequency_Type) return Boolean is <>;
package Huffman is
   -- bits = booleans (true/false = 1/0)
   type Bit_Sequence is array (Positive range <>) of Boolean;
   Zero_Sequence : constant Bit_Sequence (1 .. 0) := (others => False);
   -- output the sequence
   procedure Put (Code : Bit_Sequence);

   -- type for freqency map
   package Frequency_Maps is new Ada.Containers.Ordered_Maps
     (Element_Type => Frequency_Type,
      Key_Type     => Symbol_Type);

   type Huffman_Tree is private;
   -- create a huffman tree from frequency map
   procedure Create_Tree
     (Tree        : out Huffman_Tree;
      Frequencies : Frequency_Maps.Map);
   -- encode a single symbol
   function Encode
     (Tree   : Huffman_Tree;
      Symbol : Symbol_Type)
      return   Bit_Sequence;
   -- encode a symbol sequence
   function Encode
     (Tree    : Huffman_Tree;
      Symbols : Symbol_Sequence)
      return    Bit_Sequence;
   -- decode a bit sequence
   function Decode
     (Tree : Huffman_Tree;
      Code : Bit_Sequence)
      return Symbol_Sequence;
   -- dump the encoding table
   procedure Dump_Encoding (Tree : Huffman_Tree);
private
   -- type for encoding map
   package Encoding_Maps is new Ada.Containers.Indefinite_Ordered_Maps
     (Element_Type => Bit_Sequence,
      Key_Type     => Symbol_Type);

   type Huffman_Node;
   type Node_Access is access Huffman_Node;
   -- a node is either internal (left_child/right_child used)
   -- or a leaf (left_child/right_child are null)
   type Huffman_Node is record
      Frequency   : Frequency_Type;
      Left_Child  : Node_Access := null;
      Right_Child : Node_Access := null;
      Symbol      : Symbol_Type;
   end record;
   -- create a leaf node
   function Create_Node
     (Symbol    : Symbol_Type;
      Frequency : Frequency_Type)
      return      Node_Access;
   -- create an internal node
   function Create_Node (Left, Right : Node_Access) return Node_Access;
   -- fill the encoding map
   procedure Fill
     (The_Node : Node_Access;
      Map      : in out Encoding_Maps.Map;
      Prefix   : Bit_Sequence);

   -- huffman tree has a tree and an encoding map
   type Huffman_Tree is new Ada.Finalization.Controlled with record
      Tree : Node_Access       := null;
      Map  : Encoding_Maps.Map := Encoding_Maps.Empty_Map;
   end record;
   -- free memory after finalization
   overriding procedure Finalize (Object : in out Huffman_Tree);
end Huffman;


      INSTALL @lib$+"SORTSALIB"
      SortUp% = FN_sortSAinit(0,0) : REM Ascending
      SortDn% = FN_sortSAinit(1,0) : REM Descending

      Text$ = "this is an example for huffman encoding"

      DIM tree{(127) ch&, num%, lkl%, lkr%}
      FOR i% = 1 TO LEN(Text$)
        c% = ASCMID$(Text$,i%)
        tree{(c%)}.ch& = c%
        tree{(c%)}.num% += 1
      NEXT

      C% = DIM(tree{()},1) + 1
      CALL SortDn%, tree{()}, tree{(0)}.num%
      FOR i% = 0 TO DIM(tree{()},1)
        IF tree{(i%)}.num% = 0 EXIT FOR
      NEXT
      size% = i%

      linked% = 0
      REPEAT
        C% = size%
        CALL SortUp%, tree{()}, tree{(0)}.num%
        i% = 0 : WHILE tree{(i%)}.lkl% OR tree{(i%)}.lkr% i% += 1 : ENDWHILE
        tree{(i%)}.lkl% = size%
        j% = 0 : WHILE tree{(j%)}.lkl% OR tree{(j%)}.lkr% j% += 1 : ENDWHILE
        tree{(j%)}.lkr% = size%
        linked% += 2
        tree{(size%)}.num% = tree{(i%)}.num% + tree{(j%)}.num%
        size% += 1
      UNTIL linked% = (size% - 1)

      FOR i% = size% - 1 TO 0 STEP -1
        IF tree{(i%)}.ch& THEN
          h$ = ""
          j% = i%
          REPEAT
            CASE TRUE OF
              WHEN tree{(j%)}.lkl% <> 0:
                h$ = "0" + h$
                j% = tree{(j%)}.lkl%
              WHEN tree{(j%)}.lkr% <> 0:
                h$ = "1" + h$
                j% = tree{(j%)}.lkr%
              OTHERWISE:
                EXIT REPEAT
            ENDCASE
          UNTIL FALSE
          VDU tree{(i%)}.ch& : PRINT "  " h$
        ENDIF
      NEXT
      END


( "this is an example for huffman encoding":?S
& 0:?chars
& 0:?p
& ( @( !S
     :   ?
         ( [!p %?char [?p ?
         & !char+!chars:?chars
         & ~
         )
     )
  |
  )
& 0:?prioritized
&   whl
  ' ( !chars:?n*%@?w+?chars
    & (!n.!w)+!prioritized:?prioritized
    )
&   whl
  ' ( !prioritized:(?p.?x)+(?q.?y)+?nprioritized
    & (!p+!q.(!p.0,!x)+(!q.1,!y))+!nprioritized:?prioritized
    )
& 0:?L
& ( walk
  =   bits tree bit subtree
    .   !arg:(?bits.?tree)
      &   whl
        ' ( !tree:(?p.?bit,?subtree)+?tree
          & (   !subtree:@
              & (!subtree.str$(!bits !bit))+!L:?L
            | walk$(!bits !bit.!subtree)
            )
          )
  )
& !prioritized:(?.?prioritized)
& walk$(.!prioritized)
& lst$L
& :?encoded
& 0:?p
& ( @( !S
     :   ?
         ( [!p %?char [?p ?
         & !L:?+(!char.?code)+?
         & !encoded !code:?encoded
         & ~
         )
     )
  | out$(str$!encoded)
  )
& ( decode
  =   char bits
    .       !L
          : ?+(?char.?bits&@(!arg:!bits ?arg))+?
        & !char decode$!arg
      | !arg
  )
& out$("decoded:" str$(decode$(str$!encoded)));


#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#define BYTES 256

struct huffcode {
  int nbits;
  int code;
};
typedef struct huffcode huffcode_t;

struct huffheap {
  int *h;
  int n, s, cs;
  long *f;
};
typedef struct huffheap heap_t;

/* heap handling funcs */
static heap_t *_heap_create(int s, long *f)
{
  heap_t *h;
  h = malloc(sizeof(heap_t));
  h->h = malloc(sizeof(int)*s);
  h->s = h->cs = s;
  h->n = 0;
  h->f = f;
  return h;
}

static void _heap_destroy(heap_t *heap)
{
  free(heap->h);
  free(heap);
}

#define swap_(I,J) do { int t_; t_ = a[(I)];	\
      a[(I)] = a[(J)]; a[(J)] = t_; } while(0)
static void _heap_sort(heap_t *heap)
{
  int i=1, j=2; /* gnome sort */
  int *a = heap->h;

  while(i < heap->n) { /* smaller values are kept at the end */
    if ( heap->f[a[i-1]] >= heap->f[a[i]] ) {
      i = j; j++;
    } else {
      swap_(i-1, i);
      i--;
      i = (i==0) ? j++ : i;
    }
  }
}
#undef swap_

static void _heap_add(heap_t *heap, int c)
{
  if ( (heap->n + 1) > heap->s ) {
    heap->h = realloc(heap->h, heap->s + heap->cs);
    heap->s += heap->cs;
  }
  heap->h[heap->n] = c;
  heap->n++;
  _heap_sort(heap);
}

static int _heap_remove(heap_t *heap)
{
  if ( heap->n > 0 ) {
    heap->n--;
    return heap->h[heap->n];
  }
  return -1;
}

/* huffmann code generator */
huffcode_t **create_huffman_codes(long *freqs)
{
  huffcode_t **codes;
  heap_t *heap;
  long efreqs[BYTES*2];
  int preds[BYTES*2];
  int i, extf=BYTES;
  int r1, r2;

  memcpy(efreqs, freqs, sizeof(long)*BYTES);
  memset(&efreqs[BYTES], 0, sizeof(long)*BYTES);

  heap = _heap_create(BYTES*2, efreqs);
  if ( heap == NULL ) return NULL;

  for(i=0; i < BYTES; i++) if ( efreqs[i] > 0 ) _heap_add(heap, i);

  while( heap->n > 1 )
  {
    r1 = _heap_remove(heap);
    r2 = _heap_remove(heap);
    efreqs[extf] = efreqs[r1] + efreqs[r2];
    _heap_add(heap, extf);
    preds[r1] = extf;
    preds[r2] = -extf;
    extf++;
  }
  r1 = _heap_remove(heap);
  preds[r1] = r1;
  _heap_destroy(heap);

  codes = malloc(sizeof(huffcode_t *)*BYTES);

  int bc, bn, ix;
  for(i=0; i < BYTES; i++) {
    bc=0; bn=0;
    if ( efreqs[i] == 0 ) { codes[i] = NULL; continue; }
    ix = i;
    while( abs(preds[ix]) != ix ) {
      bc |= ((preds[ix] >= 0) ? 1 : 0 ) << bn;
      ix = abs(preds[ix]);
      bn++;
    }
    codes[i] = malloc(sizeof(huffcode_t));
    codes[i]->nbits = bn;
    codes[i]->code = bc;
  }
  return codes;
}

void free_huffman_codes(huffcode_t **c)
{
  int i;

  for(i=0; i < BYTES; i++) free(c[i]);
  free(c);
}

#define MAXBITSPERCODE 100

void inttobits(int c, int n, char *s)
{
  s[n] = 0;
  while(n > 0) {
    s[n-1] = (c%2) + '0';
    c >>= 1; n--;
  }
}

const char *test = "this is an example for huffman encoding";

int main()
{
  huffcode_t **r;
  int i;
  char strbit[MAXBITSPERCODE];
  const char *p;
  long freqs[BYTES];

  memset(freqs, 0, sizeof freqs);

  p = test;
  while(*p != '\0') freqs[*p++]++;

  r = create_huffman_codes(freqs);

  for(i=0; i < BYTES; i++) {
    if ( r[i] != NULL ) {
      inttobits(r[i]->code, r[i]->nbits, strbit);
      printf("%c (%d) %s\n", i, r[i]->code, strbit);
    }
  }

  free_huffman_codes(r);

  return 0;
}


using System;
using System.Collections.Generic;

namespace Huffman_Encoding
{
    public class PriorityQueue<T> where T : IComparable
    {
        protected List<T> LstHeap = new List<T>();

        public virtual int Count
        {
            get { return LstHeap.Count; }
        }

        public virtual void Add(T val)
        {
            LstHeap.Add(val);
            SetAt(LstHeap.Count - 1, val);
            UpHeap(LstHeap.Count - 1);
        }

        public virtual T Peek()
        {
            if (LstHeap.Count == 0)
            {
                throw new IndexOutOfRangeException("Peeking at an empty priority queue");
            }

            return LstHeap[0];
        }

        public virtual T Pop()
        {
            if (LstHeap.Count == 0)
            {
                throw new IndexOutOfRangeException("Popping an empty priority queue");
            }

            T valRet = LstHeap[0];

            SetAt(0, LstHeap[LstHeap.Count - 1]);
            LstHeap.RemoveAt(LstHeap.Count - 1);
            DownHeap(0);
            return valRet;
        }

        protected virtual void SetAt(int i, T val)
        {
            LstHeap[i] = val;
        }

        protected bool RightSonExists(int i)
        {
            return RightChildIndex(i) < LstHeap.Count;
        }

        protected bool LeftSonExists(int i)
        {
            return LeftChildIndex(i) < LstHeap.Count;
        }

        protected int ParentIndex(int i)
        {
            return (i - 1) / 2;
        }

        protected int LeftChildIndex(int i)
        {
            return 2 * i + 1;
        }

        protected int RightChildIndex(int i)
        {
            return 2 * (i + 1);
        }

        protected T ArrayVal(int i)
        {
            return LstHeap[i];
        }

        protected T Parent(int i)
        {
            return LstHeap[ParentIndex(i)];
        }

        protected T Left(int i)
        {
            return LstHeap[LeftChildIndex(i)];
        }

        protected T Right(int i)
        {
            return LstHeap[RightChildIndex(i)];
        }

        protected void Swap(int i, int j)
        {
            T valHold = ArrayVal(i);
            SetAt(i, LstHeap[j]);
            SetAt(j, valHold);
        }

        protected void UpHeap(int i)
        {
            while (i > 0 && ArrayVal(i).CompareTo(Parent(i)) > 0)
            {
                Swap(i, ParentIndex(i));
                i = ParentIndex(i);
            }
        }

        protected void DownHeap(int i)
        {
            while (i >= 0)
            {
                int iContinue = -1;

                if (RightSonExists(i) && Right(i).CompareTo(ArrayVal(i)) > 0)
                {
                    iContinue = Left(i).CompareTo(Right(i)) < 0 ? RightChildIndex(i) : LeftChildIndex(i);
                }
                else if (LeftSonExists(i) && Left(i).CompareTo(ArrayVal(i)) > 0)
                {
                    iContinue = LeftChildIndex(i);
                }

                if (iContinue >= 0 && iContinue < LstHeap.Count)
                {
                    Swap(i, iContinue);
                }

                i = iContinue;
            }
        }
    }

    internal class HuffmanNode<T> : IComparable
    {
        internal HuffmanNode(double probability, T value)
        {
            Probability = probability;
            LeftSon = RightSon = Parent = null;
            Value = value;
            IsLeaf = true;
        }

        internal HuffmanNode(HuffmanNode<T> leftSon, HuffmanNode<T> rightSon)
        {
            LeftSon = leftSon;
            RightSon = rightSon;
            Probability = leftSon.Probability + rightSon.Probability;
            leftSon.IsZero = true;
            rightSon.IsZero = false;
            leftSon.Parent = rightSon.Parent = this;
            IsLeaf = false;
        }

        internal HuffmanNode<T> LeftSon { get; set; }
        internal HuffmanNode<T> RightSon { get; set; }
        internal HuffmanNode<T> Parent { get; set; }
        internal T Value { get; set; }
        internal bool IsLeaf { get; set; }

        internal bool IsZero { get; set; }

        internal int Bit
        {
            get { return IsZero ? 0 : 1; }
        }

        internal bool IsRoot
        {
            get { return Parent == null; }
        }

        internal double Probability { get; set; }

        public int CompareTo(object obj)
        {
            return -Probability.CompareTo(((HuffmanNode<T>) obj).Probability);
        }
    }

    public class Huffman<T> where T : IComparable
    {
        private readonly Dictionary<T, HuffmanNode<T>> _leafDictionary = new Dictionary<T, HuffmanNode<T>>();
        private readonly HuffmanNode<T> _root;

        public Huffman(IEnumerable<T> values)
        {
            var counts = new Dictionary<T, int>();
            var priorityQueue = new PriorityQueue<HuffmanNode<T>>();
            int valueCount = 0;

            foreach (T value in values)
            {
                if (!counts.ContainsKey(value))
                {
                    counts[value] = 0;
                }
                counts[value]++;
                valueCount++;
            }

            foreach (T value in counts.Keys)
            {
                var node = new HuffmanNode<T>((double) counts[value] / valueCount, value);
                priorityQueue.Add(node);
                _leafDictionary[value] = node;
            }

            while (priorityQueue.Count > 1)
            {
                HuffmanNode<T> leftSon = priorityQueue.Pop();
                HuffmanNode<T> rightSon = priorityQueue.Pop();
                var parent = new HuffmanNode<T>(leftSon, rightSon);
                priorityQueue.Add(parent);
            }

            _root = priorityQueue.Pop();
            _root.IsZero = false;
        }

        public List<int> Encode(T value)
        {
            var returnValue = new List<int>();
            Encode(value, returnValue);
            return returnValue;
        }

        public void Encode(T value, List<int> encoding)
        {
            if (!_leafDictionary.ContainsKey(value))
            {
                throw new ArgumentException("Invalid value in Encode");
            }
            HuffmanNode<T> nodeCur = _leafDictionary[value];
            var reverseEncoding = new List<int>();
            while (!nodeCur.IsRoot)
            {
                reverseEncoding.Add(nodeCur.Bit);
                nodeCur = nodeCur.Parent;
            }

            reverseEncoding.Reverse();
            encoding.AddRange(reverseEncoding);
        }

        public List<int> Encode(IEnumerable<T> values)
        {
            var returnValue = new List<int>();

            foreach (T value in values)
            {
                Encode(value, returnValue);
            }
            return returnValue;
        }

        public T Decode(List<int> bitString, ref int position)
        {
            HuffmanNode<T> nodeCur = _root;
            while (!nodeCur.IsLeaf)
            {
                if (position > bitString.Count)
                {
                    throw new ArgumentException("Invalid bitstring in Decode");
                }
                nodeCur = bitString[position++] == 0 ? nodeCur.LeftSon : nodeCur.RightSon;
            }
            return nodeCur.Value;
        }

        public List<T> Decode(List<int> bitString)
        {
            int position = 0;
            var returnValue = new List<T>();

            while (position != bitString.Count)
            {
                returnValue.Add(Decode(bitString, ref position));
            }
            return returnValue;
        }
    }

    internal class Program
    {
        private const string Example = "this is an example for huffman encoding";

        private static void Main()
        {
            var huffman = new Huffman<char>(Example);
            List<int> encoding = huffman.Encode(Example);
            List<char> decoding = huffman.Decode(encoding);
            var outString = new string(decoding.ToArray());
            Console.WriteLine(outString == Example ? "Encoding/decoding worked" : "Encoding/Decoding failed");

            var chars = new HashSet<char>(Example);
            foreach (char c in chars)
            {
                encoding = huffman.Encode(c);
                Console.Write("{0}:  ", c);
                foreach (int bit in encoding)
                {
                    Console.Write("{0}", bit);
                }
                Console.WriteLine();
            }
            Console.ReadKey();
        }
    }
}


#include <iostream>
#include <queue>
#include <map>
#include <climits> // for CHAR_BIT
#include <iterator>
#include <algorithm>

const int UniqueSymbols = 1 << CHAR_BIT;
const char* SampleString = "this is an example for huffman encoding";

typedef std::vector<bool> HuffCode;
typedef std::map<char, HuffCode> HuffCodeMap;

class INode
{
public:
    const int f;

    virtual ~INode() {}

protected:
    INode(int f) : f(f) {}
};

class InternalNode : public INode
{
public:
    INode *const left;
    INode *const right;

    InternalNode(INode* c0, INode* c1) : INode(c0->f + c1->f), left(c0), right(c1) {}
    ~InternalNode()
    {
        delete left;
        delete right;
    }
};

class LeafNode : public INode
{
public:
    const char c;

    LeafNode(int f, char c) : INode(f), c(c) {}
};

struct NodeCmp
{
    bool operator()(const INode* lhs, const INode* rhs) const { return lhs->f > rhs->f; }
};

INode* BuildTree(const int (&frequencies)[UniqueSymbols])
{
    std::priority_queue<INode*, std::vector<INode*>, NodeCmp> trees;

    for (int i = 0; i < UniqueSymbols; ++i)
    {
        if(frequencies[i] != 0)
            trees.push(new LeafNode(frequencies[i], (char)i));
    }
    while (trees.size() > 1)
    {
        INode* childR = trees.top();
        trees.pop();

        INode* childL = trees.top();
        trees.pop();

        INode* parent = new InternalNode(childR, childL);
        trees.push(parent);
    }
    return trees.top();
}

void GenerateCodes(const INode* node, const HuffCode& prefix, HuffCodeMap& outCodes)
{
    if (const LeafNode* lf = dynamic_cast<const LeafNode*>(node))
    {
        outCodes[lf->c] = prefix;
    }
    else if (const InternalNode* in = dynamic_cast<const InternalNode*>(node))
    {
        HuffCode leftPrefix = prefix;
        leftPrefix.push_back(false);
        GenerateCodes(in->left, leftPrefix, outCodes);

        HuffCode rightPrefix = prefix;
        rightPrefix.push_back(true);
        GenerateCodes(in->right, rightPrefix, outCodes);
    }
}

int main()
{
    // Build frequency table
    int frequencies[UniqueSymbols] = {0};
    const char* ptr = SampleString;
    while (*ptr != '\0')
        ++frequencies[*ptr++];

    INode* root = BuildTree(frequencies);

    HuffCodeMap codes;
    GenerateCodes(root, HuffCode(), codes);
    delete root;

    for (HuffCodeMap::const_iterator it = codes.begin(); it != codes.end(); ++it)
    {
        std::cout << it->first << " ";
        std::copy(it->second.begin(), it->second.end(),
                  std::ostream_iterator<bool>(std::cout));
        std::cout << std::endl;
    }
    return 0;
}


(require '[clojure.pprint :refer :all])

(defn probs [s]
  (let [freqs (frequencies s) sum (apply + (vals freqs))]
    (into {} (map (fn [[k v]] [k (/ v sum)]) freqs))))

(defn init-pq [weighted-items]
  (let [comp (proxy [java.util.Comparator] []
                (compare [a b] (compare (:priority a) (:priority b))))
        pq (java.util.PriorityQueue. (count weighted-items) comp)]
    (doseq [[item prob] weighted-items] (.add pq { :symbol item, :priority prob }))
    pq))

(defn huffman-tree [pq]
  (while (> (.size pq) 1)
    (let [a (.poll pq) b (.poll pq)
	  new-node {:priority (+ (:priority a) (:priority b)) :left a :right b}]
      (.add pq new-node)))
  (.poll pq))

(defn symbol-map
  ([t] (symbol-map t ""))
  ([{:keys [symbol priority left right] :as t} code]
    (if symbol [{:symbol symbol :weight priority :code code}]
      (concat (symbol-map left (str code \0))
              (symbol-map right (str code \1))))))

(defn huffman-encode [items]
  (-> items probs init-pq huffman-tree symbol-map))

(defn display-huffman-encode [s]
  (->> s huffman-encode (sort-by :weight >) print-table))

(display-huffman-encode "this is an example for huffman encoding")


huffman_encoding_table = (counts) ->
  # counts is a hash where keys are characters and
  # values are frequencies;
  # return a hash where keys are codes and values
  # are characters

  build_huffman_tree = ->
    # returns a Huffman tree.  Each node has
    #   cnt: total frequency of all chars in subtree
    #   c: character to be encoded (leafs only)
    #   children: children nodes (branches only)
    q = min_queue()
    for c, cnt of counts
      q.enqueue cnt,
        cnt: cnt
        c: c
    while q.size() >= 2
      a = q.dequeue()
      b = q.dequeue()
      cnt = a.cnt + b.cnt
      node =
        cnt: cnt
        children: [a, b]
      q.enqueue cnt, node
    root = q.dequeue()

  root = build_huffman_tree()

  codes = {}
  encode = (node, code) ->
    if node.c?
      codes[code] = node.c
    else
      encode node.children[0], code + "0"
      encode node.children[1], code + "1"

  encode(root, "")
  codes

min_queue = ->
  # This is very non-optimized; you could use a binary heap for better
  # performance.  Items with smaller priority get dequeued first.
  arr = []
  enqueue: (priority, data) ->
    i = 0
    while i < arr.length
      if priority < arr[i].priority
        break
      i += 1
    arr.splice i, 0,
      priority: priority
      data: data
  dequeue: ->
    arr.shift().data
  size: -> arr.length
  _internal: ->
    arr

freq_count = (s) ->
  cnts = {}
  for c in s
    cnts[c] ?= 0
    cnts[c] += 1
  cnts

rpad = (s, n) ->
  while s.length < n
    s += ' '
  s

examples = [
  "this is an example for huffman encoding"
  "abcd"
  "abbccccddddddddeeeeeeeee"
]

for s in examples
  console.log "---- #{s}"
  counts = freq_count(s)
  huffman_table = huffman_encoding_table(counts)
  codes = (code for code of huffman_table).sort()
  for code in codes
    c = huffman_table[code]
    console.log "#{rpad(code, 5)}: #{c} (#{counts[c]})"
  console.log()


(defstruct huffman-node
  (weight 0 :type number)
  (element nil :type t)
  (encoding nil :type (or null bit-vector))
  (left nil :type (or null huffman-node))
  (right nil :type (or null huffman-node)))

(defun initial-huffman-nodes (sequence &key (test 'eql))
  (let* ((length (length sequence))
         (increment (/ 1 length))
         (nodes (make-hash-table :size length :test test))
         (queue '()))
    (map nil #'(lambda (element)
                 (multiple-value-bind (node presentp) (gethash element nodes)
                   (if presentp
                     (incf (huffman-node-weight node) increment)
                     (let ((node (make-huffman-node :weight increment
                                                    :element element)))
                       (setf (gethash element nodes) node
                             queue (list* node queue))))))
         sequence)
    (values nodes (sort queue '< :key 'huffman-node-weight))))

(defun huffman-tree (sequence &key (test 'eql))
  (multiple-value-bind (nodes queue)
      (initial-huffman-nodes sequence :test test)
    (do () ((endp (rest queue)) (values nodes (first queue)))
      (destructuring-bind (n1 n2 &rest queue-rest) queue
        (let ((n3 (make-huffman-node
                   :left n1
                   :right n2
                   :weight (+ (huffman-node-weight n1)
                              (huffman-node-weight n2)))))
          (setf queue (merge 'list (list n3) queue-rest '<
                             :key 'huffman-node-weight)))))))1

(defun huffman-codes (sequence &key (test 'eql))
  (multiple-value-bind (nodes tree)
      (huffman-tree sequence :test test)
    (labels ((hc (node length bits)
               (let ((left (huffman-node-left node))
                     (right (huffman-node-right node)))
                 (cond
                  ((and (null left) (null right))
                   (setf (huffman-node-encoding node)
                         (make-array length :element-type 'bit
                                     :initial-contents (reverse bits))))
                  (t (hc left (1+ length) (list* 0 bits))
                     (hc right (1+ length) (list* 1 bits)))))))
      (hc tree 0 '())
      nodes)))

(defun print-huffman-code-table (nodes &optional (out *standard-output*))
  (format out "~&Element~10tWeight~20tCode")
  (loop for node being each hash-value of nodes
        do (format out "~&~s~10t~s~20t~s"
                   (huffman-node-element node)
                   (huffman-node-weight node)
                   (huffman-node-encoding node))))


import std.stdio, std.algorithm, std.typecons, std.container, std.array;

auto encode(alias eq, R)(Group!(eq, R) sf) /*pure nothrow @safe*/ {
    auto heap = sf.map!(s => tuple(s[1], [tuple(s[0], "")]))
                .array.heapify!q{b < a};

    while (heap.length > 1) {
        auto lo = heap.front; heap.removeFront;
        auto hi = heap.front; heap.removeFront;
        lo[1].each!((ref pair) => pair[1] = '0' ~ pair[1]);
        hi[1].each!((ref pair) => pair[1] = '1' ~ pair[1]);
        heap.insert(tuple(lo[0] + hi[0], lo[1] ~ hi[1]));
    }
    return heap.front[1].schwartzSort!q{ tuple(a[1].length, a[0]) };
}

void main() /*@safe*/ {
    immutable s = "this is an example for huffman encoding"d;
    foreach (const p; s.dup.sort().group.encode)
        writefln("'%s'  %s", p[]);
}


class HUFFMAN_NODE[T -> COMPARABLE]
inherit
	COMPARABLE
	redefine
		three_way_comparison
	end
create
	leaf_node, inner_node
feature {NONE}
	leaf_node (a_probability: REAL_64; a_value: T)
	do
		probability := a_probability
		value := a_value
		is_leaf := true

		left := void
		right := void
		parent := void
	end

	inner_node (a_left, a_right: HUFFMAN_NODE[T])
	do
		left := a_left
		right := a_right

		a_left.parent := Current
		a_right.parent := Current
		a_left.is_zero := true
		a_right.is_zero := false

		probability := a_left.probability + a_right.probability
		is_leaf := false
	end

feature
	probability: REAL_64
	value: detachable T

	is_leaf: BOOLEAN
	is_zero: BOOLEAN assign set_is_zero

	set_is_zero (a_value: BOOLEAN)
	do
		is_zero := a_value
	end

	left: detachable HUFFMAN_NODE[T]
	right: detachable HUFFMAN_NODE[T]
	parent: detachable HUFFMAN_NODE[T] assign set_parent

	set_parent (a_parent: detachable HUFFMAN_NODE[T])
	do
		parent := a_parent
	end

	is_root: BOOLEAN
	do
		Result := parent = void
	end

	bit_value: INTEGER
	do
		if is_zero then
			Result := 0
		else
			Result := 1
		end
	end
feature -- comparable implementation
	is_less alias "<" (other: like Current): BOOLEAN
	do
		Result := three_way_comparison (other) = -1
	end

	three_way_comparison (other: like Current): INTEGER
	do
		Result := -probability.three_way_comparison (other.probability)
	end
end

class HUFFMAN
create
	make
feature {NONE}
	make(a_string: STRING)
	require
		non_empty_string: a_string.count > 0
	local
		l_queue: HEAP_PRIORITY_QUEUE[HUFFMAN_NODE[CHARACTER]]
		l_counts: HASH_TABLE[INTEGER, CHARACTER]
		l_node: HUFFMAN_NODE[CHARACTER]
		l_left, l_right: HUFFMAN_NODE[CHARACTER]
	do
		create l_queue.make (a_string.count)
		create l_counts.make (10)

		across a_string as  char
		loop
			if not l_counts.has (char.item) then
				l_counts.put (0, char.item)
			end
			l_counts.replace (l_counts.at (char.item) + 1, char.item)
		end

		create leaf_dictionary.make(l_counts.count)

		across l_counts as kv
		loop
			create l_node.leaf_node ((kv.item * 1.0) / a_string.count, kv.key)
			l_queue.put (l_node)
			leaf_dictionary.put (l_node, kv.key)
		end

		from
		until
			l_queue.count <= 1
		loop
			l_left := l_queue.item
			l_queue.remove
			l_right := l_queue.item
			l_queue.remove

			create l_node.inner_node (l_left, l_right)
			l_queue.put (l_node)
		end

		root := l_queue.item
		root.is_zero := false
	end
feature
	root: HUFFMAN_NODE[CHARACTER]
	leaf_dictionary: HASH_TABLE[HUFFMAN_NODE[CHARACTER], CHARACTER]

	encode(a_value: CHARACTER): STRING
	require
		encodable: leaf_dictionary.has (a_value)
	local
		l_node: HUFFMAN_NODE[CHARACTER]
	do
		Result := ""
		if attached  leaf_dictionary.item (a_value) as attached_node then
			l_node := attached_node
			from

			until
				l_node.is_root
			loop
				Result.append_integer (l_node.bit_value)
				if attached l_node.parent as parent then
					l_node := parent
				end
			end

			Result.mirror
		end
	end
end

class
	APPLICATION
create
	make

feature {NONE}
	make -- entry point
	local
		l_str: STRING
		huff: HUFFMAN
		chars: BINARY_SEARCH_TREE_SET[CHARACTER]
	do
		l_str := "this is an example for huffman encoding"

		create huff.make (l_str)

		create chars.make
		chars.fill (l_str)

		from
			chars.start
		until
			chars.off
		loop
			print (chars.item.out + ": " + huff.encode (chars.item) + "%N")
			chars.forth
		end
	end
end


-module(huffman).

-export([encode/1, decode/2, main/0]).

encode(Text)  ->
    Tree  = tree(freq_table(Text)),
    Dict = dict:from_list(codewords(Tree)),
    Code = << <<(dict:fetch(Char, Dict))/bitstring>> || Char <- Text >>,
    {Code, Tree, Dict}.

decode(Code, Tree) ->
    decode(Code, Tree, Tree, []).

main() ->
    {Code, Tree, Dict} = encode("this is an example for huffman encoding"),
    [begin
        io:format("~s: ",[[Key]]),
        print_bits(Value)
     end || {Key, Value} <- lists:sort(dict:to_list(Dict))],
    io:format("encoded: "),
    print_bits(Code),
    io:format("decoded: "),
    io:format("~s\n",[decode(Code, Tree)]).

decode(<<>>, _, _, Result) ->
    lists:reverse(Result);
decode(<<0:1, Rest/bits>>, Tree, {L = {_, _}, _R}, Result) ->
    decode(<<Rest/bits>>, Tree, L, Result);
decode(<<0:1, Rest/bits>>, Tree, {L, _R}, Result) ->
    decode(<<Rest/bits>>, Tree, Tree, [L | Result]);
decode(<<1:1, Rest/bits>>, Tree, {_L, R = {_, _}}, Result) ->
    decode(<<Rest/bits>>, Tree, R, Result);
decode(<<1:1, Rest/bits>>, Tree, {_L, R}, Result) ->
    decode(<<Rest/bits>>, Tree, Tree, [R | Result]).

codewords({L, R}) ->
    codewords(L, <<0:1>>) ++ codewords(R, <<1:1>>).

codewords({L, R}, <<Bits/bits>>) ->
    codewords(L, <<Bits/bits, 0:1>>) ++ codewords(R, <<Bits/bits, 1:1>>);
codewords(Symbol, <<Bits/bitstring>>) ->
    [{Symbol, Bits}].

tree([{N, _} | []]) ->
    N;
tree(Ns) ->
    [{N1, C1}, {N2, C2} | Rest] = lists:keysort(2, Ns),
    tree([{{N1, N2}, C1 + C2} | Rest]).

freq_table(Text) ->
    freq_table(lists:sort(Text), []).

freq_table([], Acc) ->
    Acc;
freq_table([S | Rest], Acc) ->
    {Block, MoreBlocks} = lists:splitwith(fun (X) -> X == S end, Rest),
    freq_table(MoreBlocks, [{S, 1 + length(Block)} | Acc]).

print_bits(<<>>) ->
  io:format("\n");
print_bits(<<Bit:1, Rest/bitstring>>) ->
  io:format("~w", [Bit]),
  print_bits(Rest).


type 'a HuffmanTree =
    | Leaf of int * 'a
    | Node of int * 'a HuffmanTree * 'a HuffmanTree

let freq = function Leaf (f, _) | Node (f, _, _) -> f
let freqCompare a b = compare (freq a) (freq b)

let buildTree charFreqs =
    let leaves = List.map (fun (c,f) -> Leaf (f,c)) charFreqs
    let freqSort = List.sortWith freqCompare
    let rec aux = function
        | [] -> failwith "empty list"
        | [a] -> a
        | a::b::tl ->
            let node = Node(freq a + freq b, a, b)
            aux (freqSort(node::tl))
    aux (freqSort leaves)

let rec printTree = function
  | code, Leaf (f, c) ->
      printfn "%c\t%d\t%s" c f (String.concat "" (List.rev code));
  | code, Node (_, l, r) ->
      printTree ("0"::code, l);
      printTree ("1"::code, r)

let () =
  let str = "this is an example for huffman encoding"
  let charFreqs =
    str |> Seq.groupBy id
        |> Seq.map (fun (c, vals) -> (c, Seq.length vals))
        |> Map.ofSeq

  let tree = charFreqs |> Map.toList |> buildTree
  printfn "Symbol\tWeight\tHuffman code";
  printTree ([], tree)


USING: kernel sequences combinators accessors assocs math hashtables math.order
sorting.slots classes formatting prettyprint ;

IN: huffman

! -------------------------------------
! CLASSES -----------------------------
! -------------------------------------

TUPLE: huffman-node
    weight element encoding left right ;

! For nodes
: <huffman-tnode> ( left right -- huffman )
    huffman-node new [ left<< ] [ swap >>right ] bi ;

! For leafs
: <huffman-node> ( element -- huffman )
    1 swap f f f huffman-node boa ;

! --------------------------------------
! INITIAL HASHTABLE --------------------
! --------------------------------------

<PRIVATE

! Increment node if it already exists
! Else make it and add it to the hash-table
: huffman-gen ( element nodes  -- )
    2dup at
    [ [ [ 1 + ] change-weight ] change-at ]
    [ [ dup <huffman-node> swap ] dip set-at ] if ;

! Curry node-hash.  Then each over the seq
! to get the weighted values
: (huffman) ( nodes seq --  nodes )
    dup [ [ huffman-gen ] curry each ] dip ;

! ---------------------------------------
! TREE GENERATION -----------------------
! ---------------------------------------

: (huffman-weight) ( node1 node2 -- weight )
    [ weight>> ] dup bi* + ;

! Combine two nodes into the children of a parent
! node which has a weight equal to their collective
! weight
: (huffman-combine) ( node1 node2 -- node3 )
    [ (huffman-weight) ]
    [ <huffman-tnode> ] 2bi
    swap >>weight ;

! Generate a tree by combining nodes
! in the priority queue until we're
! left with the root node
: (huffman-tree) ( nodes -- tree )
    dup rest empty?
    [ first ] [
        { { weight>> <=> } } sort-by
        [ rest rest ] [ first ]
        [ second ] tri
        (huffman-combine) prefix
        (huffman-tree)
    ] if  ; recursive

! --------------------------------------
! ENCODING -----------------------------
! --------------------------------------

: (huffman-leaf?) ( node -- bool )
    [ left>>  huffman-node instance? ]
    [ right>> huffman-node instance? ] bi and not ;

: (huffman-leaf) ( leaf bit -- )
    swap encoding<< ;

DEFER: (huffman-encoding)

! Recursively walk the nodes left and right
: (huffman-node) ( bit nodes -- )
    [ 0 suffix ] [ 1 suffix ] bi
    [ [ left>> ] [ right>> ] bi ] 2dip
    [ swap ] dip
    [ (huffman-encoding) ] [email protected] ;

: (huffman-encoding) ( bit nodes -- )
    over (huffman-leaf?)
    [ (huffman-leaf) ]
    [ (huffman-node) ] if ;

PRIVATE>

! -------------------------------
! USER WORDS --------------------
! -------------------------------

: huffman-print ( nodes -- )
    "Element" "Weight" "Code" "\n%10s\t%10s\t%6s\n" printf
    { { weight>> >=< } } sort-by
    [  [ encoding>> ] [ element>> ] [ weight>> ] tri
       "%8c\t%7d\t\t" printf  pprint "\n" printf ] each ;

: huffman ( sequence -- nodes )
    H{ } clone (huffman) values
    [ (huffman-tree) { } (huffman-encoding) ] keep ;

! ---------------------------------
! USAGE ---------------------------
! ---------------------------------

! { 1 2 3 4 } huffman huffman-print
! "this is an example of a huffman tree" huffman huffman-print

! Element   Weight	  Code
!      	      7		{ 0 0 0 }
!     a	      4		{ 1 1 1 }
!     e	      4		{ 1 1 0 }
!     f	      3		{ 0 0 1 0 }
!     h	      2		{ 1 0 1 0 }
!     i	      2		{ 0 1 0 1 }
!     m	      2		{ 0 1 0 0 }
!     n	      2		{ 0 1 1 1 }
!     s	      2		{ 0 1 1 0 }
!     t	      2		{ 0 0 1 1 }
!     l	      1		{ 1 0 1 1 1 }
!     o	      1		{ 1 0 1 1 0 }
!     p	      1		{ 1 0 0 0 1 }
!     r	      1		{ 1 0 0 0 0 }
!     u	      1		{ 1 0 0 1 1 }
!     x	      1		{ 1 0 0 1 0 }


class Node
{
  Float probability := 0.0f
}

class Leaf : Node
{
  Int character

  new make (Int character, Float probability)
  {
    this.character = character
    this.probability = probability
  }
}

class Branch : Node
{
  Node left
  Node right

  new make (Node left, Node right)
  {
    this.left = left
    this.right = right
    probability = this.left.probability + this.right.probability
  }
}

class Huffman
{
  Node[] queue := [,]
  Str:Str table := [:]

  new make (Int[] items)
  {
    uniqueItems := items.dup.unique
    uniqueItems.each |Int item|
    {
      num := items.findAll { it == item }.size
      queue.add (Leaf(item, num.toFloat / items.size))
    }
    createTree
    createTable
  }

  Void createTree ()
  {
    while (queue.size > 1)
    {
      queue.sort |a,b| {a.probability <=> b.probability}
      node1 := queue.removeAt (0)
      node2 := queue.removeAt (0)
      queue.add (Branch (node1, node2))
    }
  }

  Void traverse (Node node, Str encoding)
  {
    if (node is Leaf)
    {
      table[(node as Leaf).character.toChar] = encoding
    }
    else // (node is Branch)
    {
      traverse ((node as Branch).left, encoding + "0")
      traverse ((node as Branch).right, encoding + "1")
    }
  }

  Void createTable ()
  {
    if (queue.size != 1) return // error!
    traverse (queue.first, "")
  }

  override Str toStr ()
  {
    result := "Huffman Encoding Table:\n"
    table.keys.sort.each |Str key|
    {
      result += "$key -> ${table[key]}\n"
    }
    return result
  }
}

class Main
{
  public static Void main ()
  {
    example := "this is an example for huffman encoding"
    huffman := Huffman (example.chars)
    echo ("From \"$example\"")
    echo (huffman)
  }
}


! output:
! d-> 00000, t-> 00001, h-> 0001, s-> 0010,
! c-> 00110, x-> 00111, m-> 0100, o-> 0101,
! n-> 011, u-> 10000, l-> 10001, a-> 1001,
! r-> 10100, g-> 101010, p-> 101011,
! e-> 1011, i-> 1100, f-> 1101,  -> 111
!
! 00001|0001|1100|0010|111|1100|0010|111|1001|011|
! 111|1011|00111|1001|0100|101011|10001|1011|111|
! 1101|0101|10100|111|0001|10000|1101|1101|0100|
! 1001|011|111|1011|011|00110|0101|00000|1100|011|101010|
!
module huffman
implicit none
type node
  character (len=1 ), allocatable :: sym(:)
  character (len=10), allocatable :: code(:)
  integer                         :: freq
contains
  procedure                       :: show => show_node
end type

type queue
  type(node), allocatable :: buf(:)
  integer                 :: n = 0
contains
  procedure :: extractmin
  procedure :: append
  procedure :: siftdown
end type

contains

subroutine siftdown(this, a)
  class (queue)           :: this
  integer                 :: a, parent, child
  associate (x => this%buf)
  parent = a
  do while(parent*2 <= this%n)
    child = parent*2
    if (child + 1 <= this%n) then
      if (x(child+1)%freq < x(child)%freq ) then
        child = child +1
      end if
    end if
    if (x(parent)%freq > x(child)%freq) then
      x([child, parent]) = x([parent, child])
      parent = child
    else
      exit
    end if
  end do
  end associate
end subroutine

function extractmin(this) result (res)
  class(queue) :: this
  type(node)   :: res
  res = this%buf(1)
  this%buf(1) = this%buf(this%n)
  this%n = this%n - 1
  call this%siftdown(1)
end function

subroutine append(this, x)
  class(queue), intent(inout) :: this
  type(node)                  :: x
  type(node), allocatable     :: tmp(:)
  integer                     :: i
  this%n = this%n +1
  if (.not.allocated(this%buf)) allocate(this%buf(1))
  if (size(this%buf)<this%n) then
    allocate(tmp(2*size(this%buf)))
    tmp(1:this%n-1) = this%buf
    call move_alloc(tmp, this%buf)
  end if
  this%buf(this%n) = x
  i = this%n
  do
    i = i / 2
    if (i==0) exit
    call this%siftdown(i)
  end do
end subroutine

function join(a, b) result(c)
  type(node)             :: a, b, c
  integer                :: i, n, n1
  n1 = size(a%sym)
  n = n1 + size(b%sym)
  c%freq = a%freq + b%freq
  allocate (c%sym(n), c%code(n))
  do i = 1, n1
    c%sym(i) = a%sym(i)
    c%code(i) = "0" // trim(a%code(i))
  end do
  do i = 1, size(b%sym)
    c%sym(i+n1) = b%sym(i)
    c%code(i+n1) = "1" // trim(b%code(i))
  end do
end function

subroutine show_node(this)
  class(node) :: this
  integer     :: i
  write(*, "(*(g0,'-> ',g0,:,', '))", advance="no") &
   (this%sym(i), trim(this%code(i)), i=1,size(this%sym))
  print *
end subroutine

function create(letter, freq) result (this)
  character :: letter
  integer   :: freq
  type(node) :: this
  allocate(this%sym(1), this%code(1))
  this%sym(1) = letter ; this%code(1) = ""
  this%freq = freq
end function
end module

program main
  use huffman
  character (len=*), parameter   :: txt = &
   "this is an example for huffman encoding"
  integer                        :: i, freq(0:255) = 0
  type(queue)                    :: Q
  type(node)                     :: x
  do i = 1, len(txt)
    freq(ichar(txt(i:i))) = freq(ichar(txt(i:i))) + 1
  end do
  do i = 0, 255
    if (freq(i)>0) then
      call Q%append(create(char(i), freq(i)))
    end if
  end do
  do i = 1, Q%n-1
    call Q%append(join(Q%extractmin(),Q%extractmin()))
  end do
  x = Q%extractmin()
  call x%show()
  do i = 1, len(txt)
    do k = 1, size(x%sym)
      if (x%sym(k)==txt(i:i)) exit
     end do
     write (*, "(a,'|')", advance="no")  trim(x%code(k))
  end do
  print *
end program


type block
    freq as uinteger
    chars as string
end type

type code
    char as string*1
    code as string
end type

sub bubble( lst() as block, n_l as uinteger )
    for j as integer = n_l-1 to 0 step -1
        if j>0 andalso lst(j).freq > lst(j-1).freq then
            swap lst(j), lst(j-1)
        endif
    next j
end sub

dim as string Sample = "this is an example for huffman encoding"
redim as block hufflist(0)
hufflist(0).freq = 1 : hufflist(0).chars = mid(Sample,1,1)
dim as boolean newchar
dim as string*1 currchar
dim as uinteger n_h = 1, n_c

'read characters in one-by-one and simultaneously bubblesort them
for i as uinteger = 2 to len(Sample)
    currchar = mid(Sample,i,1)
    newchar = true
    for j as uinteger = 0 to n_h-1
        if mid(Sample,i,1) = hufflist(j).chars then
            hufflist(j).freq += 1
            newchar = false
        end if
        if j>0 andalso hufflist(j).freq > hufflist(j-1).freq then
            swap hufflist(j), hufflist(j-1)
        endif
    next j
    if newchar then
        redim preserve hufflist(0 to n_h)
        hufflist(n_h).chars = currchar
        hufflist(n_h).freq  = 1
        n_h+=1
    end if
next i
'one final pass of bubblesort may be necessary
bubble hufflist(), n_h

'initialise huffman code
redim as code codelist(0 to n_h-1)
for i as uinteger = 0 to n_h-1
    codelist(i).char = hufflist(i).chars
    codelist(i).code = ""
next i
n_c = n_h

do
    'characters in the least common block get "0" appended
    for i as uinteger = 1 to len(hufflist(n_h-1).chars)
        for j as uinteger = 0 to n_c-1
            if codelist(j).char = mid(hufflist(n_h-1).chars,i,1) then
                codelist(j).code = "0" + codelist(j).code
            end if
        next j
    next i
    'characters in the second-least common block get "1" appended
    for i as uinteger = 1 to len(hufflist(n_h-2).chars)
        for j as uinteger = 0 to n_c-1
            if codelist(j).char = mid(hufflist(n_h-2).chars,i,1) then
                codelist(j).code = "1" + codelist(j).code
            end if
        next j
    next i
    'combine the two least frequent blocks
    hufflist(n_h-2).chars = hufflist(n_h-2).chars + hufflist(n_h-1).chars
    hufflist(n_h-2).freq = hufflist(n_h-2).freq + hufflist(n_h-1).freq
    redim preserve hufflist(0 to n_h-2)
    n_h -= 1
    'move the new combined block to its proper place in the list
    bubble hufflist(), n_h
loop until n_h = 1

for i as uinteger = 0 to n_c - 1
    print "'"+codelist(i).char+"'", codelist(i).code
next i


package main

import (
    "container/heap"
    "fmt"
)

type HuffmanTree interface {
    Freq() int
}

type HuffmanLeaf struct {
    freq  int
    value rune
}

type HuffmanNode struct {
    freq        int
    left, right HuffmanTree
}

func (self HuffmanLeaf) Freq() int {
    return self.freq
}

func (self HuffmanNode) Freq() int {
    return self.freq
}

type treeHeap []HuffmanTree

func (th treeHeap) Len() int { return len(th) }
func (th treeHeap) Less(i, j int) bool {
    return th[i].Freq() < th[j].Freq()
}
func (th *treeHeap) Push(ele interface{}) {
    *th = append(*th, ele.(HuffmanTree))
}
func (th *treeHeap) Pop() (popped interface{}) {
    popped = (*th)[len(*th)-1]
    *th = (*th)[:len(*th)-1]
    return
}
func (th treeHeap) Swap(i, j int) { th[i], th[j] = th[j], th[i] }

func buildTree(symFreqs map[rune]int) HuffmanTree {
    var trees treeHeap
    for c, f := range symFreqs {
        trees = append(trees, HuffmanLeaf{f, c})
    }
    heap.Init(&trees)
    for trees.Len() > 1 {
        // two trees with least frequency
        a := heap.Pop(&trees).(HuffmanTree)
        b := heap.Pop(&trees).(HuffmanTree)

        // put into new node and re-insert into queue
        heap.Push(&trees, HuffmanNode{a.Freq() + b.Freq(), a, b})
    }
    return heap.Pop(&trees).(HuffmanTree)
}

func printCodes(tree HuffmanTree, prefix []byte) {
    switch i := tree.(type) {
    case HuffmanLeaf:
        // print out symbol, frequency, and code for this
        // leaf (which is just the prefix)
        fmt.Printf("%c\t%d\t%s\n", i.value, i.freq, string(prefix))
    case HuffmanNode:
        // traverse left
        prefix = append(prefix, '0')
        printCodes(i.left, prefix)
        prefix = prefix[:len(prefix)-1]

        // traverse right
        prefix = append(prefix, '1')
        printCodes(i.right, prefix)
        prefix = prefix[:len(prefix)-1]
    }
}

func main() {
    test := "this is an example for huffman encoding"

    symFreqs := make(map[rune]int)
    // read each symbol and record the frequencies
    for _, c := range test {
        symFreqs[c]++
    }

    // build tree
    tree := buildTree(symFreqs)

    // print out results
    fmt.Println("SYMBOL\tWEIGHT\tHUFFMAN CODE")
    printCodes(tree, []byte{})
}


import groovy.transform.*

@Canonical
@Sortable(includes = ['freq', 'letter'])
class Node {
    String letter
    int freq
    Node left
    Node right
    boolean isLeaf() { left == null && right == null }
}

Map correspondance(Node n, Map corresp = [:], String prefix = '') {
    if (n.isLeaf()) {
        corresp[n.letter] = prefix ?: '0'
    } else {
        correspondance(n.left,  corresp, prefix + '0')
        correspondance(n.right, corresp, prefix + '1')
    }
    return corresp
}

Map huffmanCode(String message) {
    def queue = message.toList().countBy { it } // char frequencies
        .collect { String letter, int freq ->   // transformed into tree nodes
            new Node(letter, freq)
        } as TreeSet // put in a queue that maintains ordering

    while(queue.size() > 1) {
        def (nodeLeft, nodeRight)  = [queue.pollFirst(), queue.pollFirst()]

        queue << new Node(
            freq:   nodeLeft.freq   + nodeRight.freq,
            letter: nodeLeft.letter + nodeRight.letter,
            left: nodeLeft, right: nodeRight
        )
    }

    return correspondance(queue.pollFirst())
}

String encode(CharSequence msg, Map codeTable) {
    msg.collect { codeTable[it] }.join()
}

String decode(String codedMsg, Map codeTable, String decoded = '') {
    def pair = codeTable.find { k, v -> codedMsg.startsWith(v) }
    pair ? pair.key + decode(codedMsg.substring(pair.value.size()), codeTable)
         : decoded
}


import Data.List (group, insertBy, sort, sortBy)
import Control.Arrow ((&&&), second)
import Data.Ord (comparing)

data HTree a
  = Leaf a
  | Branch (HTree a)
           (HTree a)
  deriving (Show, Eq, Ord)

test :: String -> IO ()
test =
  mapM_ (\(a, b) -> putStrLn ('\'' : a : ("' : " ++ b))) .
  serialize . huffmanTree . freq

serialize :: HTree a -> [(a, String)]
serialize (Branch l r) =
  (second ('0' :) <$> serialize l) ++ (second ('1' :) <$> serialize r)
serialize (Leaf x) = [(x, "")]

huffmanTree
  :: (Ord w, Num w)
  => [(w, a)] -> HTree a
huffmanTree =
  snd .
  head . until (null . tail) hstep . sortBy (comparing fst) . fmap (second Leaf)

hstep
  :: (Ord a, Num a)
  => [(a, HTree b)] -> [(a, HTree b)]
hstep ((w1, t1):(w2, t2):wts) =
  insertBy (comparing fst) (w1 + w2, Branch t1 t2) wts

freq
  :: Ord a
  => [a] -> [(Int, a)]
freq = fmap (length &&& head) . group . sort

main :: IO ()
main = test "this is an example for huffman encoding"