NB. setup:
require'jd pacman'
load JDP,'tools/csv_load.ijs'
F=: jpath '~temp/rosettacode/example/CSV'
jdcreatefolder_jd_ CSVFOLDER=: F

assert 0<{{)n
PATIENTID,LASTNAME
1001,Hopper
4004,Wirth
3003,Kemeny
2002,Gosling
5005,Kurtz
}} fwrite F,'patients.csv'

assert 0<{{)n
PATIENTID,VISIT_DATE,SCORE
2002,2020-09-10,6.8
1001,2020-09-17,5.5
4004,2020-09-24,8.4
2002,2020-10-08,
1001,,6.6
3003,2020-11-12,
4004,2020-11-05,7.0
1001,2020-11-19,5.3
}} fwrite F,'visits.csv'

csvprepare 'patients';F,'patients.csv'
csvprepare 'visits';F,'visits.csv'

csvload 'patients';1
csvload 'visits';1

jd'ref patients PATIENTID  visits PATIENTID'


# objectify/1 takes an array of atomic values as inputs, and packages
# these into an object with keys specified by the "headers" array and
# values obtained by trimming string values, replacing empty strings
# by null, and converting strings to numbers if possible.
def objectify(headers):
  def tonumberq: tonumber? // .;
  def trimq: if type == "string" then sub("^ +";"") | sub(" +$";"") else . end;
  def tonullq: if . == "" then null else . end;
  . as $in
  | reduce range(0; headers|length) as $i
      ({}; .[headers[$i]] = ($in[$i] | trimq | tonumberq | tonullq) );

def csv2jsonHelper:
  .[0] as $headers
  | reduce (.[1:][] | select(length > 0) ) as $row
      ([]; . + [ $row|objectify($headers) ]);


using CSV, DataFrames, Statistics

# load data from csv files
#df_patients = CSV.read("patients.csv", DataFrame)
#df_visits = CSV.read("visits.csv", DataFrame)

# create DataFrames from text that is hard coded, so use IOBuffer(String) as input
str_patients = IOBuffer("""PATIENT_ID,LASTNAME
1001,Hopper
4004,Wirth
3003,Kemeny
2002,Gosling
5005,Kurtz
""")
df_patients = CSV.read(str_patients, DataFrame)
str_visits = IOBuffer("""PATIENT_ID,VISIT_DATE,SCORE
2002,2020-09-10,6.8
1001,2020-09-17,5.5
4004,2020-09-24,8.4
2002,2020-10-08,
1001,,6.6
3003,2020-11-12,
4004,2020-11-05,7.0
1001,2020-11-19,5.3
""")
df_visits = CSV.read(str_visits, DataFrame)

# merge on PATIENT_ID, using an :outer join or we lose Kurtz, who has no data, sort by ID
df_merge = sort(join(df_patients, df_visits, on="PATIENT_ID", kind=:outer), (:PATIENT_ID,))

fnonmissing(a, f) = isempty(a) ? [] : isempty(skipmissing(a)) ? a[1] : f(skipmissing(a))

# group by patient id / last name and then aggregate to get latest visit and mean score
df_result = by(df_merge, [:PATIENT_ID, :LASTNAME]) do df
    DataFrame(LATEST_VISIT = fnonmissing(df[:VISIT_DATE], maximum),
              SUM_SCORE = fnonmissing(df[:SCORE], sum),
              MEAN_SCORE = fnonmissing(df[:SCORE], mean))
end
println(df_result)


:- module rosetta.

:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.

:- implementation.
:- import_module list, int, float, string, maybe, solutions.

:- pred patient(int::out, string::out) is multi.
patient(1001, "Hopper").
patient(4004, "Wirth").
patient(3003, "Kemeny").
patient(2002, "Gosling").
patient(5005, "Kurtz").

:- func nan = float.
nan = det_to_float("NaN").

:- type maybe_date ---> date(year::int, month::int, day::int); no.

:- pred visit(int::out, maybe_date::out, float::out) is multi.
visit(2002, date(2020,09,10), 6.8).
visit(1001, date(2020,09,17), 5.5).
visit(4004, date(2020,09,24), 8.4).
visit(2002, date(2020,10,08), nan).
visit(1001, no, 6.6).
visit(3003, date(2020,11,12), nan).
visit(4004, date(2020,11,05), 7.0).
visit(1001, date(2020,11,19), 5.3).

%% Utilities
:- pred bag_count(pred(T)::(pred(out) is nondet), int::out) is det.
:- pred bag_sum(pred(float)::(pred(out) is nondet), float::out) is det.
:- pred bag_avg(pred(float)::(pred(out) is nondet), float::out) is det.
:- pred bag_max(pred(T)::(pred(out) is nondet), T::in, T::out) is det.
bag_count(Predicate, Count) :-
    promise_equivalent_solutions[Count] (
	unsorted_aggregate(Predicate,
			   (pred(_X::in,Y::in,Z::out) is det :- Z is Y+1),
			   0, Count)).
bag_sum(Predicate, Sum) :-
    promise_equivalent_solutions[Sum] (
	unsorted_aggregate(Predicate,
			   (pred(X::in,Y::in,Z::out) is det :- Z is X+Y),
			   0.0, Sum)).
bag_avg(Predicate, Avg) :-
    bag_count(Predicate, N),
    bag_sum(Predicate, Sum),
    (if N = 0 then Avg = nan else Avg is Sum/float(N)).
bag_max(Predicate, Initial, Max) :-
    promise_equivalent_solutions [Max] (
	unsorted_aggregate(Predicate,
			   (pred(X::in,Y::in,Z::out) is det :-
				compare(R,X,Y),
				(if R = (>) then Z = X else Z = Y)),
			   Initial, Max)).

main(!IO) :-
    io.write_string("{Id, Lastname, SumScores, AvgScores, MaxDate}:\n", !IO),
    solutions((pred({Id,Lastname,Sum,Avg,MaxDate}::out) is nondet :-
	           patient(Id,Lastname),
	           Scores = (pred(Score::out) is nondet :- visit(Id,_,Score), \+is_nan(Score)),
	           bag_avg(Scores, Avg),
	  	   bag_sum(Scores, Sum),
	           Dates = (pred(Date::out) is nondet :- visit(Id,Date,_), Date=date(_,_,_)),
	           bag_max(Dates, date(0,0,0), MaxDate1),
		   (if MaxDate1 = date(0,0,0) then MaxDate = no else MaxDate = MaxDate1)),
	      Solutions),
    foldl(io.write_line, Solutions, !IO).


import algorithm, parsecsv, strformat, strutils, tables

const NoValue = -1.0

type

  Names = OrderedTable[Positive, string]      # Mapping id -> last name.

  Visit = tuple[date: string; score: float]
  Visits = Table[Positive, seq[Visit]]        # Mapping id -> list of visits.

proc readNames(path: string): Names =
  ## Read the records (id, lastname) from the CSV file and fill a Names table.
  var parser: CsvParser
  parser.open(path)
  parser.readHeaderRow()
  while parser.readRow():
    let id = parser.row[0].parseInt
    let name = parser.row[1]
    result[id] = name

proc readVisits(path: string): Visits =
  ## Read the records (id, date, score) from the CSV file and fill a Visits table.
  var parser: CsvParser
  parser.open(path)
  parser.readHeaderRow()
  while parser.readRow():
    let id = parser.row[0].parseInt
    let date = parser.row[1]
    let score = if parser.row[2].len == 0: NoValue else: parser.row[2].parseFloat
    result.mgetOrPut(id, @[]).add (date, score)

var
  names = readNames("patients1.csv")
  visits = readVisits("patients2.csv")

names.sort(system.cmp)

echo "| PATIENT_ID |  LASTNAME  | LAST_VISIT |  SCORE_SUM | SCORE_AVG |"
for (id, name) in names.pairs:
  let visitList = visits.getOrDefault(id).sorted()
  let lastVisit = if visitList.len == 0: "" else: visitList[^1].date
  var sum = 0.0
  var count = 0
  for visit in visitList:
    if visit.score != NoValue:
      sum += visit.score
      inc count
  let scoreSum = if count == 0: "" else: &"{sum:>4.1f}"
  let scoreAvg = if count == 0: "" else: &"{sum / count.toFloat: >4.2f}"
  echo &"| {id:^10} | {name:^10} | {lastVisit:^10} | {scoreSum:>7}    | {scoreAvg:>6}    |"


constant patients_txt = split("""
PATIENT_ID,LASTNAME
1001,Hopper
4004,Wirth
3003,Kemeny
2002,Gosling
5005,Kurtz""",'\n'),
         visits_txt = split("""
PATIENT_ID,VISIT_DATE,SCORE
2002,2020-09-10,6.8
1001,2020-09-17,5.5
4004,2020-09-24,8.4
2002,2020-10-08,
1001,,6.6
3003,2020-11-12,
4004,2020-11-05,7.0
1001,2020-11-19,5.3""",'\n')
--or, assuming these files contain exactly the same actual raw text,
--    and the use of GT_LF_STRIPPED is instead of above split('\n'):
--constant patients_txt = get_text("patients.csv",GT_LF_STRIPPED),
--         visits_txt   = get_text("visits.csv",GT_LF_STRIPPED)

function sap(string s) return split(s,',',false)&{"",0,0} end function
function svp(string s) return split(s,',',false) end function
sequence patient_data = sort(apply(patients_txt[2..$],sap)),
         visit_data = sort_columns(apply(visits_txt[2..$],svp),{1,-2})
visit_data = append(visit_data,{"","","0"}) -- (add a sentinel)
string last_id = "",id,name,dt,scstr,avstr
atom score,score_total,average
integer visit_count = 0, pdx = 1
for i=1 to length(visit_data) do
    {id,dt,scstr} = visit_data[i]
    score = iff(scstr=""?0:scanf(scstr,"%f")[1][1])
    if id!=last_id then
        if visit_count then
            average = score_total/visit_count
            patient_data[pdx][4..5] = {score_total,average}
        end if
        if i=length(visit_data) then exit end if -- (sentinel)
        score_total = score
        visit_count = (score!=0)
        while id!=patient_data[pdx][1] do pdx += 1 end while
        patient_data[pdx][3] = dt
        last_id = id
    elsif score!=0 then
        score_total += score
        visit_count += 1
    end if
end for
printf(1,"| PATIENT_ID | LASTNAME | LAST_VISIT |  SCORE_SUM | SCORE_AVG |\n")
for i=1 to length(patient_data) do
    {id,name,dt,score,average} = patient_data[i]
    scstr = iff(score=0?"":sprintf("%4.1f",score))
    avstr = iff(average=0?"":sprintf("%4.2f",average))
    printf(1,"| %-10s |  %-7s | %10s |  %-9s | %-9s |\n",
            {id,name,dt,scstr,avstr})
end for


patient(1001,'Hopper').
patient(4004,'Wirth').
patient(3003,'Kemeny').
patient(2002,'Gosling').
patient(5005,'Kurtz').

visit(2002,'2020-09-10',6.8).
visit(1001,'2020-09-17',5.5).
visit(4004,'2020-09-24',8.4).
visit(2002,'2020-10-08',nan).
visit(1001,'',6.6).
visit(3003,'2020-11-12',nan).
visit(4004,'2020-11-05',7.0).
visit(1001,'2020-11-19',5.3).

summaryDates(Id, Lastname, LastDate) :-
     aggregate(max(Ts),
	       Score^Date^(visit(Id, Date, Score), Date \= '', parse_time(Date, iso_8601, Ts)),
	       MaxTs),
     format_time(atom(LastDate), '%Y-%m-%d', MaxTs),
     patient(Id,Lastname).

summaryScores(Id, Lastname, Sum, Mean) :-
     aggregate(r(sum(Score),count), Date^(visit(Id, Date, Score), Score \= nan), r(Sum,Count)),
     patient(Id,Lastname),
     Mean is Sum/Count.

test :-
    summaryDates(Id, Lastname, LastDate),
    writeln(summaryDates(Id, Lastname, LastDate)),
    fail.

test :-
    summaryScores(Id, Lastname, ScoreSum, ScoreMean),
    writeln(summaryScores(Id, Lastname, ScoreSum, ScoreMean)),
    fail.


Structure Person
  Name$
EndStructure

Structure Visits
  Datum$
  Score$
EndStructure

Structure Merge
  Patient.Person
  List PVisit.Visits()
EndStructure

NewMap P.Merge()
NewList ID$()

If ReadFile(1,"./Data/patients.csv")=0 : End 1 : EndIf
header=1
While Not Eof(1)
  buf1$=ReadString(1)
  If header=1 : header=0 : Continue : EndIf
  bufId$=StringField(buf1$,1,",")
  P(bufId$)\Patient\Name$=StringField(buf1$,2,",")
  AddElement(ID$()) : ID$()=bufId$
Wend
CloseFile(1)

If ReadFile(2,"./Data/visits.csv")=0 : End 2 : EndIf
header=1
While Not Eof(2)
  buf1$=ReadString(2)
  If header=1 : header=0 : Continue : EndIf
  bufId$=StringField(buf1$,1,",")
  AddElement(P(bufId$)\PVisit())
  P(bufId$)\PVisit()\Datum$=StringField(buf1$,2,",")
  P(bufId$)\PVisit()\Score$=StringField(buf1$,3,",")
Wend
CloseFile(2)

If OpenConsole()=0 : End 3 : EndIf
SortList(ID$(),#PB_Sort_Ascending)
PrintN("| PATIENT_ID | LASTNAME | LAST_VISIT | SCORE_SUM | SCORE_AVG |")
ForEach ID$()
  Print("| "+LSet(ID$(),11))
  Print("| "+LSet(P(ID$())\Patient\Name$,9)+"|")
  SortStructuredList(P(ID$())\PVisit(),#PB_Sort_Ascending,OffsetOf(Visits\Datum$),TypeOf(Visits\Datum$))
  ForEach P(ID$())\PVisit()
    scs.f+ValF(p(ID$())\PVisit()\Score$) : c+Bool(ValF(p(ID$())\PVisit()\Score$))
  Next
  If LastElement(P(ID$())\PVisit())
    sca.f=scs/c
    Print(" "+LSet(P(ID$())\PVisit()\Datum$,10)+" |")
    Print(RSet(StrF(scs,1),10)+" |")
    If Not IsNAN(sca) : Print(RSet(StrF(sca,2),10)+" |") : Else : Print(Space(11)+"|") : EndIf
  Else
    Print(Space(12)+"|"+Space(11)+"|"+Space(11)+"|")
  EndIf
  PrintN("") : scs=0 : c=0
Next
Input()


# to install pandas library go to cmd prompt and type:
# cd %USERPROFILE%\AppData\Local\Programs\Python\Python38-32\Scripts\
# pip install pandas
import pandas as pd

# load data from csv files
df_patients = pd.read_csv (r'patients.csv', sep = ",", decimal=".")
df_visits = pd.read_csv (r'visits.csv', sep = ",", decimal=".")

''' # load data hard coded, create data frames
import io
str_patients = """PATIENT_ID,LASTNAME
1001,Hopper
4004,Wirth
3003,Kemeny
2002,Gosling
5005,Kurtz
"""
df_patients = pd.read_csv(io.StringIO(str_patients), sep = ",", decimal=".")
str_visits = """PATIENT_ID,VISIT_DATE,SCORE
2002,2020-09-10,6.8
1001,2020-09-17,5.5
4004,2020-09-24,8.4
2002,2020-10-08,
1001,,6.6
3003,2020-11-12,
4004,2020-11-05,7.0
1001,2020-11-19,5.3
"""
df_visits = pd.read_csv(io.StringIO(str_visits), sep = ",", decimal=".")
'''

# typecast from string to datetime so .agg can 'max' it
df_visits['VISIT_DATE'] = pd.to_datetime(df_visits['VISIT_DATE'])

# merge on PATIENT_ID
df_merge = df_patients.merge(df_visits, on='PATIENT_ID', how='left')

# groupby is an intermediate object
df_group = df_merge.groupby(['PATIENT_ID','LASTNAME'], as_index=False)

# note: you can use 'sum' instead of the lambda function but that returns NaN as 0 (zero)
df_result = df_group.agg({'VISIT_DATE': 'max', 'SCORE': [lambda x: x.sum(min_count=1),'mean']})

print(df_result)


# load data from csv files
# setwd("C:\Temp\csv\")
# df_patient <- read.csv(file="patients.csv", header = TRUE, sep = ",")
# df_visits <- read.csv(file="visits.csv", header = TRUE, sep = ",", dec = ".", colClasses=c("character","character","numeric"))

# load data hard coded, create data frames
df_patient <- read.table(text = "
PATIENT_ID,LASTNAME
1001,Hopper
4004,Wirth
3003,Kemeny
2002,Gosling
5005,Kurtz
", header = TRUE, sep = ",") #  character fields so no need for extra parameters colClasses etc.

df_visits <- read.table(text = "
PATIENT_ID,VISIT_DATE,SCORE
2002,2020-09-10,6.8
1001,2020-09-17,5.5
4004,2020-09-24,8.4
2002,2020-10-08,
1001,,6.6
3003,2020-11-12,
4004,2020-11-05,7.0
1001,2020-11-19,5.3
", header = TRUE, dec = ".", sep = ",", colClasses=c("character","character","numeric"))

# aggregate visit date and scores
df_agg <- data.frame(
  cbind(
    PATIENT_ID = names(tapply(df_visits$VISIT_DATE, list(df_visits$PATIENT_ID), max, na.rm=TRUE)),
    last_visit = tapply(df_visits$VISIT_DATE, list(df_visits$PATIENT_ID), max, na.rm=TRUE),
    score_sum = tapply(df_visits$SCORE, list(df_visits$PATIENT_ID), sum, na.rm=TRUE),
    score_avg = tapply(df_visits$SCORE, list(df_visits$PATIENT_ID), mean, na.rm=TRUE)
  )
)

# merge patients and aggregate dataset
# all.x = all the non matching cases of df_patient are appended to the result as well (i.e. 'left join')
df_result <- merge(df_patient, df_agg, by = 'PATIENT_ID', all.x = TRUE)

print(df_result)


my @names = map { ( <PATIENT_ID LASTNAME> Z=> .list ).hash },
    ( 1001, 'Hopper'  ),
    ( 4004, 'Wirth'   ),
    ( 3003, 'Kemeny'  ),
    ( 2002, 'Gosling' ),
    ( 5005, 'Kurtz'   ),
;
my @visits = map { ( <PATIENT_ID VISIT_DATE SCORE> Z=> .list ).hash },
    ( 2002, '2020-09-10', 6.8 ),
    ( 1001, '2020-09-17', 5.5 ),
    ( 4004, '2020-09-24', 8.4 ),
    ( 2002, '2020-10-08', Nil ),
    ( 1001,         Nil , 6.6 ),
    ( 3003, '2020-11-12', Nil ),
    ( 4004, '2020-11-05', 7.0 ),
    ( 1001, '2020-11-19', 5.3 ),
;

my %v = @visits.classify: *.<PATIENT_ID>;

my @result = gather for @names -> %n {
    my @p = %v{ %n.<PATIENT_ID> }<>;

    my @dates  = @p».<VISIT_DATE>.grep: *.defined;
    my @scores = @p».<     SCORE>.grep: *.defined;

    take {
        %n,
        LAST_VISIT => ( @dates.max          if @dates  ),
        SCORE_AVG  => ( @scores.sum/@scores if @scores ),
        SCORE_SUM  => ( @scores.sum         if @scores ),
    };
}

my @out_field_names = <PATIENT_ID LASTNAME LAST_VISIT SCORE_SUM SCORE_AVG>;
my @rows = @result.sort(*.<PATIENT_ID>).map(*.{@out_field_names});
say .map({$_ // ''}).fmt('%-10s', ' | ') for @out_field_names, |@rows;


/* REXX */
patients='patients.csv'
l=linein(patients)
Parse Var l h1 ',' h2
n=0
idl=''
Do n=1 By 1 While lines(patients)>0
  l=linein(patients)
  Parse Var l id ',' lastname.id
  idl=idl id
  End
n=n-1 /* number of patients */
visits='visits.csv'
l=linein(visits) /* skip the header line of this file */
h3='LAST_VISIT'
h4='SCORE_SUM'
h5='SCORE_AVG'
date.=''
score.=0
Say '|' h1 '|' h2 '|' h3 '|' h4 '|' h5 '|'
Do While lines(visits)>0
  l=linein(visits)
  Parse Var l id ',' date ',' score
  if date>date.id Then date.id=date
  If score>'' Then Do
    z=score.id.0+1
    score.id.z=score
    score.id.0=z
    End
  end
idl=wordsort(idl)
Do While idl<>''
  Parse Var idl id idl
  If date.id='' Then date.id=copies(' ',10)
  ol='|' left(id,length(h1)) '|' left(lastname.id,length(h2)),
                             '|' left(date.id,length(h3))
  If score.id.0=0 Then Do
  ol=ol '|' left(' ',length(h4)) '|',
            left(' ',length(h5)) '|'
    score_sum=copies(' ',length(h4))
    score_avg=copies(' ',length(h4))
    End
  Else Do
    score_sum=0
    Do j=1 To score.id.0
      score_sum=score_sum+score.id.j
      End
    score_avg=score_sum/score.id.0
    ol=ol '|' left(format(score_sum,2,1),length(h4)) '|',
             left(format(score_avg,2,1),length(h5)) '|'
    End
  Say ol
  End
Exit

wordsort: Procedure
/**********************************************************************
* Sort the list of words supplied as argument. Return the sorted list
**********************************************************************/
  Parse Arg wl
  wa.=''
  wa.0=0
  Do While wl<>''
    Parse Var wl w wl
    Do i=1 To wa.0
      If wa.i>w Then Leave
      End
    If i<=wa.0 Then Do
      Do j=wa.0 To i By -1
        ii=j+1
        wa.ii=wa.j
        End
      End
    wa.i=w
    wa.0=wa.0+1
    End
  swl=''
  Do i=1 To wa.0
    swl=swl wa.i
    End
  Return strip(swl)


  %let datefmt=E8601DA10.;
  data patient;
      infile "patient.csv" dsd dlm=',';
      attrib
          id length=4
          lastname length=$10;
      input id lastname;
  data visit;
      infile "visit.csv" dsd dlm=',';
      attrib
          id length=4
          date informat=&datefmt format=&datefmt
          score length=8;
      input id date score;
  proc sql;
      select * from
          (select id, max(date) format=&datefmt as max_date, sum(score) as sum_score,
          	avg(score) as avg_score from visit group by id)
          natural right join patient
          order by id;


* set working directory to location of .csv files

CD 'C:\Temp\csv\'.

* load patients csv data

GET DATA /TYPE=TXT
  /FILE="patients.csv"
  /ENCODING='UTF8'
  /DELCASE=LINE
  /DELIMITERS=","
  /QUALIFIER='"'
  /ARRANGEMENT=DELIMITED
  /FIRSTCASE=2
  /IMPORTCASE=ALL
  /VARIABLES=
PATIENT_ID F5.0
LASTNAME A20
.
CACHE.
EXECUTE.

* sort cases is needed to match files

SORT CASES BY PATIENT_ID (A).
DATASET NAME Patients WINDOW=FRONT.

* load visits csv data

GET DATA /TYPE=TXT
  /FILE="visit.csv"
  /ENCODING='UTF8'
  /DELCASE=LINE
  /DELIMITERS=","
  /QUALIFIER='"'
  /ARRANGEMENT=DELIMITED
  /FIRSTCASE=2
  /IMPORTCASE=ALL
  /VARIABLES=
PATIENT_ID F5.0
VISIT_DATE SDATE10
SCORE F4.1
.
CACHE.
EXECUTE.

* sort cases is needed, else match files will raise error "Files out of order"

SORT CASES BY PATIENT_ID (A) VISIT_DATE (A).
DATASET NAME Visits WINDOW=FRONT.

* load visits csv data

* merge datasets, one to many, FILE is the 'one', TABLE is 'many'

MATCH FILES TABLE = Patients / FILE = Visits
/BY PATIENT_ID.
EXECUTE.

* aggregate visit date and scores, group by and order (A)=ascending or (D)=descending

AGGREGATE OUTFILE *
/BREAK=PATIENT_ID(A)
/last_visit = MAX(VISIT_DATE)
/score_avg = MEAN(SCORE)
/score_sum = SUM(SCORE).


-- drop tables
DROP TABLE IF EXISTS tmp_patients;
DROP TABLE IF EXISTS tmp_visits;

-- create tables
CREATE TABLE tmp_patients(
	PATIENT_ID INT,
	LASTNAME VARCHAR(20)
);

CREATE TABLE tmp_visits(
	PATIENT_ID INT,
	VISIT_DATE DATE,
	SCORE NUMERIC(4,1)
);

-- load data from csv files
/*
-- Note: LOAD DATA LOCAL requires `local-infile` enabled on both the client and server else you get error "#1148 command is not allowed.."
LOAD DATA LOCAL INFILE '/home/csv/patients.csv' INTO TABLE `tmp_patients` FIELDS TERMINATED BY ',' LINES TERMINATED BY '\n' IGNORE 1 LINES;
LOAD DATA LOCAL INFILE '/home/csv/visits.csv' INTO TABLE `tmp_visits` FIELDS TERMINATED BY ',' LINES TERMINATED BY '\n' IGNORE 1 LINES;
*/

-- load data hard coded
INSERT INTO tmp_patients(PATIENT_ID, LASTNAME)
VALUES
(1001, 'Hopper'),
(4004, 'Wirth'),
(3003, 'Kemeny'),
(2002, 'Gosling'),
(5005, 'Kurtz');

INSERT INTO tmp_visits(PATIENT_ID, VISIT_DATE, SCORE)
VALUES
(2002, '2020-09-10', 6.8),
(1001, '2020-09-17', 5.5),
(4004, '2020-09-24', 8.4),
(2002, '2020-10-08', NULL),
(1001, NULL, 6.6),
(3003, '2020-11-12', NULL),
(4004, '2020-11-05', 7.0),
(1001, '2020-11-19', 5.3);

-- join tables and group
SELECT
	p.PATIENT_ID,
	p.LASTNAME,
	MAX(VISIT_DATE) AS LAST_VISIT,
	SUM(SCORE) AS SCORE_SUM,
	CAST(AVG(SCORE) AS DECIMAL(10,2)) AS SCORE_AVG
FROM
	tmp_patients p
	LEFT JOIN tmp_visits v
		ON v.PATIENT_ID = p.PATIENT_ID
GROUP BY
	p.PATIENT_ID,
	p.LASTNAME
ORDER BY
	p.PATIENT_ID;


#lang transd

MainModule: {

tbl: `1001,Hopper
4004,Wirth
3003,Kemeny
2002,Gosling
5005,Kurtz`,

tbl1: `
2002,2020-09-10,6.8
1001,2020-09-17,5.5
4004,2020-09-24,8.4
2002,2020-10-08,
1001,,6.6
3003,2020-11-12,
4004,2020-11-05,7.0
1001,2020-11-19,5.3`,

cols: `@key_PATIENT_ID:Int,
        LASTNAME:String,
        VISIT_DATE:DateTime,
        SCORE:Double,
        SCORE_AVG:Double,
        NUM_VISITS:Int`,

Record : typealias(Tuple<Int DateTime Double>()),

	_start: (λ (with base TSDBase()
		(load-table base tbl colNames: cols)
        (build-index base "PATIENT_ID")

        (with vizs Vector<Record>()
            (load-table vizs tbl1 :mixedTypes fieldSep: "," rowSep: "\n" )
            (for viz in vizs do
                (tsd-query base
                    :update set:
                (lambda PATIENT_ID Int() VISIT_DATE DateTime()
                        SCORE Double() SCORE_AVG Double() NUM_VISITS Int()
                    (+= NUM_VISITS 1)
                    (set VISIT_DATE (get viz 1))
                    (set SCORE (+ SCORE (get viz 2)))
                    (set SCORE_AVG (/ SCORE NUM_VISITS)))
            where: (lambda PATIENT_ID Int() (eq PATIENT_ID (get viz 0))))
            ))

        (with cols ["PATIENT_ID","LASTNAME","VISIT_DATE","SCORE","SCORE_AVG"]
        (with recs (tsd-query base select: cols
                as: [[Int(), String(), DateTime(), Double(), Double()]]
                where: (lambda PATIENT_ID Int() true)
                )
                (for i in cols do (textout width: 10 i "|")) (lout "")
                (for rec in recs do
                    (for-each rec (λ i :Data() (textout width: 10 i "|" )))
                    (lout ""))
		))
	))
}


BEGIN;
  TYPE Date UNION;
  TYPE DateValid IS {Date POSSREP {year INTEGER, month INTEGER, day INTEGER}};
  TYPE DateNone IS {Date POSSREP {}};
  TYPE DateUnknown IS {Date POSSREP {}};
END;

VAR patient REAL RELATION {id INT, lastname CHAR} KEY {id};

INSERT patient RELATION
{TUPLE {id 1001, lastname 'Hopper'},
 TUPLE {id 4004, lastname 'Wirth'},
 TUPLE {id 3003, lastname 'Kemeny'},
 TUPLE {id 2002, lastname 'Gosling'},
 TUPLE {id 5005, lastname 'Kurtz'}
 };

VAR visit REAL RELATION {id INT, date Date, score RATIONAL} KEY {id, date};

INSERT visit RELATION
{
TUPLE {id 2002, date DateValid(2020,09,10), score 6.8},
TUPLE {id 1001, date DateValid(2020,09,17), score 5.5},
TUPLE {id 4004, date DateValid(2020,09,24), score 8.4},
TUPLE {id 2002, date DateValid(2020,10,08), score NAN},
TUPLE {id 1001, date DateNone(), score 6.6},
TUPLE {id 3003, date DateValid(2020,11,12), score NAN},
TUPLE {id 4004, date DateValid(2020,11,05), score 7.0},
TUPLE {id 1001, date DateValid(2020,11,19), score 5.3}
};

((SUMMARIZE (visit WHERE score>0.0) BY {id}: {sumscore := SUM(score), avgscore := AVG(score)}) UNION
 (EXTEND (patient {id} MINUS ((visit WHERE score>0.0) {id})): {sumscore := NaN, avgscore := NaN})) JOIN
    (SUMMARIZE visit BY {id}: {maxdate := MAX(date)} UNION
     (EXTEND (patient {id} MINUS (visit {id})): {maxdate := DateUnknown()})) JOIN
    patient


import "/fmt" for Fmt
import "/sort" for Sort

class Patient {
    construct new(id, lastName) {
        _id = id
        _lastName = lastName
        if (!__dir) __dir = {}
        __dir[id] = lastName
        if (!__ids) {
            __ids = [id]
        } else {
            __ids.add(id)
            Sort.insertion(__ids)
        }
    }

    id       { _id }
    lastName { _lastName }

    // maps an id to a lastname
    static dir { __dir }

    // maintains a sorted list of ids
    static ids { __ids }
}

class Visit {
    construct new(id, date, score) {
        _id = id
        _date = date || "0000-00-00"
        _score = score
        if (!__dir) __dir = {}
        if (!__dir[id]) {
            __dir[id] = [ [_date], [score] ]
        } else {
            __dir[id][0].add(_date)
            __dir[id][1].add(score)
        }
    }

    id    { _id }
    date  { _date }
    score { _score }

     // maps an id to lists of dates and scores
    static dir { __dir }
}

class Merge {
    construct new(id) {
        _id = id
    }

    id        { _id }
    lastName  { Patient.dir[_id] }
    dates     { Visit.dir[_id][0] }
    scores    { Visit.dir[_id][1] }
    lastVisit { Sort.merge(dates)[-1] }

    scoreSum  { scores.reduce(0) { |acc, s| s ? acc + s : acc } }
    scoreAvg  { scoreSum / scores.count { |s| s } }

    static print(merges) {
        System.print("| PATIENT_ID | LASTNAME | LAST_VISIT | SCORE_SUM | SCORE_AVG |")
        var fmt = "| $d       | $-7s  | $s | $4s      | $4s      |"
        for (m in merges) {
            if (Visit.dir[m.id]) {
                var lv = (m.lastVisit != "0000-00-00") ? m.lastVisit : "          "
                var ss = (m.scoreSum > 0) ? Fmt.f(4, m.scoreSum, 1) : "    "
                var sa = (!m.scoreAvg.isNan) ? Fmt.f(4, m.scoreAvg, 2) : "    "
                Fmt.print(fmt, m.id, m.lastName, lv, ss, sa)
            } else {
                Fmt.print(fmt, m.id, m.lastName, "          ", "    ", "    ")
            }
        }
    }
}

Patient.new(1001, "Hopper")
Patient.new(4004, "Wirth")
Patient.new(3003, "Kemeny")
Patient.new(2002, "Gosling")
Patient.new(5005, "Kurtz")

Visit.new(2002, "2020-09-10", 6.8)
Visit.new(1001, "2020-09-17", 5.5)
Visit.new(4004, "2020-09-24", 8.4)
Visit.new(2002, "2020-10-08", null)
Visit.new(1001,  null       , 6.6)
Visit.new(3003, "2020-11-12", null)
Visit.new(4004, "2020-11-05", 7.0)
Visit.new(1001, "2020-11-19", 5.3)

var merges = Patient.ids.map { |id| Merge.new(id) }.toList
Merge.print(merges)


* Request to Get Storage Managed by "GETMAIN" Supervisor Call (SVC 4)
       LA    1,PLIST       Point Reg 1 to GETMAIN/FREEMAIN Parm List
       SVC   4             Issue GETMAIN SVC
       LTR   15,15         Register 15 = 0?
       BZ    GOTSTG         Yes: Got Storage
*      [...]                 No: Handle GETMAIN Failure
GOTSTG L     2,[email protected]        Load Reg (any Reg) with Addr of Aquired Stg
*      [...]               Continue
* Request to Free Storage Managed by "FREEMAIN" Supervisor Call (SVC 5)
       LA    1,PLIST       Point Reg 1 to GETMAIN/FREEMAIN Parm List
       SVC   5             Issue FREEMAIN SVC
       LTR   15,15         Register 15 = 0?
       BZ    STGFRE         Yes: Storage Freed
*      [...]                 No: Handle FREEMAIN Failure
STGFRE EQU   *             Storage Freed
*      [...]               Continue
*
[email protected]   DS    A             Address of Stg Area (Aquired or to be Freed)
PLIST  EQU   *             10-Byte GETMAIN/FREEMAIN Parameter List
       DC    A(256)        Number of Bytes; Max=16777208 ((2**24)-8)
       DC    A([email protected])       Pointer to Address of Storage Area
       DC    X'0000'       (Unconditional Request; Subpool 0)


LDA #$FF ;load 255 into the accumulator
STA $00   ;store at zero page memory address $00
STA $0400 ;store at absolute memory address $0400


declare
   X : Integer; -- Allocated on the stack
begin
   ...
end; -- X is freed


MODE MYSTRUCT = STRUCT(INT i, j, k, REAL r, COMPL c);


begin
    % define a record structure - instances must be created dynamically %
    record Element ( integer atomicNumber; string(16) name );
    reference(Element) X;
    % allocate and initialise memory for X - heap storage is the only option %
    X := Element( 1, "Hydrogen" );
    % allocate new memory for X, the original could now be garbage collected %
    X := Element( 2, "Helium" )
    % the memory allocated will now be garbage collected - there is no explicit de-allocation %
end.


INCLUDE "H6:LOADPPM5.ACT"
INCLUDE "D2:SORT.ACT" ;from the Action! Tool Kit

DEFINE HISTSIZE="256"

PROC PutBigPixel(INT x,y BYTE col)
  IF x>=0 AND x<=79 AND y>=0 AND y<=47 THEN
    y==LSH 2
    col==RSH 4
    IF col<0 THEN col=0
    ELSEIF col>15 THEN col=15 FI
    Color=col
    Plot(x,y)
    DrawTo(x,y+3)
  FI
RETURN

PROC DrawImage(GrayImage POINTER image INT x,y)
  INT i,j
  BYTE c

  FOR j=0 TO image.gh-1
  DO
    FOR i=0 TO image.gw-1
    DO
      c=GetGrayPixel(image,i,j)
      PutBigPixel(x+i,y+j,c)
    OD
  OD
RETURN

INT FUNC Clamp(INT x,min,max)
  IF x<min THEN
    RETURN (min)
  ELSEIF x>max THEN
    RETURN (max)
  FI
RETURN (x)

BYTE FUNC Median(BYTE ARRAY a BYTE len)
  SortB(a,len,0)
  len==RSH 1
RETURN (a(len))

PROC Median3x3(GrayImage POINTER src,dst)
  INT x,y,i,j,ii,jj,index,sum
  BYTE ARRAY arr(9)
  BYTE c

  FOR j=0 TO src.gh-1
  DO
    FOR i=0 TO src.gw-1
    DO
      sum=0 index=0
      FOR jj=-1 TO 1
      DO
        y=Clamp(j+jj,0,src.gh-1)
        FOR ii=-1 TO 1
        DO
          x=Clamp(i+ii,0,src.gw-1)
          c=GetGrayPixel(src,x,y)
          arr(index)=c
          index==+1
        OD
      OD
      c=Median(arr,9)
      SetGrayPixel(dst,i,j,c)
    OD
  OD
RETURN

PROC Main()
  BYTE CH=$02FC ;Internal hardware value for last key pressed
  BYTE ARRAY dataIn(900),dataOut(900)
  GrayImage in,out
  INT size=[30],x,y

  Put(125) PutE() ;clear the screen

  InitGrayImage(in,size,size,dataIn)
  InitGrayImage(out,size,size,dataOut)
  PrintE("Loading source image...")
  LoadPPM5(in,"H6:LENA30G.PPM")
  PrintE("Median filter...")
  Median3x3(in,out)

  Graphics(9)
  x=(40-size)/2
  y=(48-size)/2
  DrawImage(in,x,y)
  DrawImage(out,x+40,y)

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN


VarSetCapacity(Var, 10240000)  ; allocate 10 megabytes
VarSetCapacity(Var, 0)  ; free it


Buff(100)→Str1
.Str1 points to a 100-byte memory region allocated at compile time


      size% = 12345
      DIM mem% size%-1
      PRINT ; size% " bytes of heap allocated at " ; mem%


( alc$2000:?p           {allocate 2000 bytes}
& pok$(!p,123456789,4)  { poke a large value as a 4 byte integer }
& pok$(!p+4,0,4)        { poke zeros in the next 4 bytes }
& out$(pee$(!p,1))      { peek the first byte }
& out$(pee$(!p+2,2))    { peek the short int located at the third and fourth byte }
& out$(pee$(!p,4))      { peek the first four bytes }
& out$(pee$(!p+6,2))    { peek the two bytes from the zeroed-out range }
& out$(pee$(!p+1000,2)) { peek some uninitialized data }
& fre$!p                { free the memory }
&);


#include <stdlib.h>

/* size of "members", in bytes */
#define SIZEOF_MEMB (sizeof(int))
#define NMEMB 100

int main()
{
  int *ints = malloc(SIZEOF_MEMB*NMEMB);
  /* realloc can be used to increase or decrease an already
     allocated memory (same as malloc if ints is NULL) */
  ints = realloc(ints, sizeof(int)*(NMEMB+1));
  /* calloc set the memory to 0s */
  int *int2 = calloc(NMEMB, SIZEOF_MEMB);
  /* all use the same free */
  free(ints); free(int2);
  return 0;
}


function Median (Picture : Image; Radius : Positive) return Image is
   type Extended_Luminance is range 0..10_000_000;
   type VRGB is record
      Color : Pixel;
      Value : Luminance;
   end record;
   Width : constant Positive := 2*Radius*(Radius+1);
   type Window is array (-Width..Width) of VRGB;
   Sorted : Window;
   Next   : Integer;

   procedure Put (Color : Pixel) is -- Sort using binary search
      pragma Inline (Put);
      This   : constant Luminance :=
                  Luminance
                  (  (  2_126 * Extended_Luminance (Color.R)
                     +  7_152 * Extended_Luminance (Color.G)
                     +    722 * Extended_Luminance (Color.B)
                     )
                  /  10_000
                  );
      That   : Luminance;
      Low    : Integer := Window'First;
      High   : Integer := Next - 1;
      Middle : Integer := (Low + High) / 2;
   begin
      while Low <= High loop
         That   := Sorted (Middle).Value;
         if That > This then
            High := Middle - 1;
         elsif That < This then
            Low := Middle + 1;
         else
            exit;
         end if;
         Middle := (Low + High) / 2;
      end loop;
      Sorted (Middle + 1..Next) := Sorted (Middle..Next - 1);
      Sorted (Middle) := (Color, This);
      Next := Next + 1;
   end Put;
   Result : Image (Picture'Range (1), Picture'Range (2));
begin
   for I in Picture'Range (1) loop
      for J in Picture'Range (2) loop
         Next := Window'First;
         for X in I - Radius .. I + Radius loop
            for Y in J - Radius .. J + Radius loop
               Put
               (  Picture
                  (  Integer'Min (Picture'Last (1), Integer'Max (Picture'First (1), X)),
                     Integer'Min (Picture'Last (2), Integer'Max (Picture'First (2), Y))
               )  );
            end loop;
         end loop;
         Result (I, J) := Sorted (0).Color;
      end loop;
   end loop;
   return Result;
end Median;


      INSTALL @lib$+"SORTLIB"
      Sort% = FN_sortinit(0,0)

      Width% = 200
      Height% = 200

      DIM out&(Width%-1, Height%-1)

      VDU 23,22,Width%;Height%;8,16,16,128
      *DISPLAY Lenagrey
      OFF

      REM Do the median filtering:
      DIM pix&(24)
      C% = 25
      FOR Y% = 2 TO Height%-3
        FOR X% = 2 TO Width%-3
          P% = 0
          FOR I% = -2 TO 2
            FOR J% = -2 TO 2
              pix&(P%) = TINT((X%+I%)*2, (Y%+J%)*2) AND &FF
              P% += 1
            NEXT
          NEXT
          CALL Sort%, pix&(0)
          out&(X%, Y%) = pix&(12)
        NEXT
      NEXT Y%

      REM Display:
      GCOL 1
      FOR Y% = 0 TO Height%-1
        FOR X% = 0 TO Width%-1
          COLOUR 1, out&(X%,Y%), out&(X%,Y%), out&(X%,Y%)
          LINE X%*2,Y%*2,X%*2,Y%*2
        NEXT
      NEXT Y%

      REPEAT
        WAIT 1
      UNTIL FALSE


#include <stdio.h>
#include <stdlib.h>
#include <fcntl.h>
#include <unistd.h>
#include <ctype.h>
#include <string.h>

typedef struct { unsigned char r, g, b; } rgb_t;
typedef struct {
	int w, h;
	rgb_t **pix;
} image_t, *image;

typedef struct {
	int r[256], g[256], b[256];
	int n;
} color_histo_t;

int write_ppm(image im, char *fn)
{
	FILE *fp = fopen(fn, "w");
	if (!fp) return 0;
	fprintf(fp, "P6\n%d %d\n255\n", im->w, im->h);
	fwrite(im->pix[0], 1, sizeof(rgb_t) * im->w * im->h, fp);
	fclose(fp);
	return 1;
}

image img_new(int w, int h)
{
	int i;
	image im = malloc(sizeof(image_t) + h * sizeof(rgb_t*)
			+ sizeof(rgb_t) * w * h);
	im->w = w; im->h = h;
	im->pix = (rgb_t**)(im + 1);
	for (im->pix[0] = (rgb_t*)(im->pix + h), i = 1; i < h; i++)
		im->pix[i] = im->pix[i - 1] + w;
	return im;
}

int read_num(FILE *f)
{
	int n;
	while (!fscanf(f, "%d ", &n)) {
		if ((n = fgetc(f)) == '#') {
			while ((n = fgetc(f)) != '\n')
				if (n == EOF) break;
			if (n == '\n') continue;
		} else return 0;
	}
	return n;
}

image read_ppm(char *fn)
{
	FILE *fp = fopen(fn, "r");
	int w, h, maxval;
	image im = 0;
	if (!fp) return 0;

	if (fgetc(fp) != 'P' || fgetc(fp) != '6' || !isspace(fgetc(fp)))
		goto bail;

	w = read_num(fp);
	h = read_num(fp);
	maxval = read_num(fp);
	if (!w || !h || !maxval) goto bail;

	im = img_new(w, h);
	fread(im->pix[0], 1, sizeof(rgb_t) * w * h, fp);
bail:
	if (fp) fclose(fp);
	return im;
}

void del_pixels(image im, int row, int col, int size, color_histo_t *h)
{
	int i;
	rgb_t *pix;

	if (col < 0 || col >= im->w) return;
	for (i = row - size; i <= row + size && i < im->h; i++) {
		if (i < 0) continue;
		pix = im->pix[i] + col;
		h->r[pix->r]--;
		h->g[pix->g]--;
		h->b[pix->b]--;
		h->n--;
	}
}

void add_pixels(image im, int row, int col, int size, color_histo_t *h)
{
	int i;
	rgb_t *pix;

	if (col < 0 || col >= im->w) return;
	for (i = row - size; i <= row + size && i < im->h; i++) {
		if (i < 0) continue;
		pix = im->pix[i] + col;
		h->r[pix->r]++;
		h->g[pix->g]++;
		h->b[pix->b]++;
		h->n++;
	}
}

void init_histo(image im, int row, int size, color_histo_t*h)
{
	int j;

	memset(h, 0, sizeof(color_histo_t));

	for (j = 0; j < size && j < im->w; j++)
		add_pixels(im, row, j, size, h);
}

int median(const int *x, int n)
{
	int i;
	for (n /= 2, i = 0; i < 256 && (n -= x[i]) > 0; i++);
	return i;
}

void median_color(rgb_t *pix, const color_histo_t *h)
{
	pix->r = median(h->r, h->n);
	pix->g = median(h->g, h->n);
	pix->b = median(h->b, h->n);
}

image median_filter(image in, int size)
{
	int row, col;
	image out = img_new(in->w, in->h);
	color_histo_t h;

	for (row = 0; row < in->h; row ++) {
		for (col = 0; col < in->w; col++) {
			if (!col) init_histo(in, row, size, &h);
			else {
				del_pixels(in, row, col - size, size, &h);
				add_pixels(in, row, col + size, size, &h);
			}
			median_color(out->pix[row] + col, &h);
		}
	}

	return out;
}

int main(int c, char **v)
{
	int size;
	image in, out;
	if (c <= 3) {
		printf("Usage: %s size ppm_in ppm_out\n", v[0]);
		return 0;
	}
	size = atoi(v[1]);
	printf("filter size %d\n", size);
	if (size < 0) size = 1;

	in = read_ppm(v[2]);
	out = median_filter(in, size);
	write_ppm(out, v[3]);
	free(in);
	free(out);

	return 0;
}


using System;
using System.Runtime.InteropServices;

public unsafe class Program
{
    public static unsafe void HeapMemory()
    {
        const int HEAP_ZERO_MEMORY = 0x00000008;
        const int size = 1000;
        int ph = GetProcessHeap();
        void* pointer = HeapAlloc(ph, HEAP_ZERO_MEMORY, size);
        if (pointer == null)
            throw new OutOfMemoryException();
        Console.WriteLine(HeapSize(ph, 0, pointer));
        HeapFree(ph, 0, pointer);
    }

    public static unsafe void StackMemory()
    {
        byte* buffer = stackalloc byte[1000];
        // buffer is automatically discarded when the method returns
    }
    public static void Main(string[] args)
    {
        HeapMemory();
        StackMemory();
    }
    [DllImport("kernel32")]
    static extern void* HeapAlloc(int hHeap, int flags, int size);
    [DllImport("kernel32")]
    static extern bool HeapFree(int hHeap, int flags, void* block);
    [DllImport("kernel32")]
    static extern int GetProcessHeap();
    [DllImport("kernel32")]
    static extern int HeapSize(int hHeap, int flags, void* block);

}


#include <string>

int main()
{
  int* p;

  p = new int;    // allocate a single int, uninitialized
  delete p;       // deallocate it

  p = new int(2); // allocate a single int, initialized with 2
  delete p;       // deallocate it

  std::string* p2;

  p2 = new std::string; // allocate a single string, default-initialized
  delete p2;            // deallocate it

  p = new int[10]; // allocate an array of 10 ints, uninitialized
  delete[] p;      // deallocation of arrays must use delete[]

  p2 = new std::string[10]; // allocate an array of 10 strings, default-initialized
  delete[] p2;              // deallocate it
}


import grayscale_image;

Image!Color medianFilter(uint radius=10, Color)(in Image!Color img)
pure nothrow @safe if (radius > 0) in {
    assert(img.nx >= radius && img.ny >= radius);
} body {
    alias Hist = uint[256];

    static ubyte median(uint no)(in ref Hist cumulative)
    pure nothrow @safe @nogc {
        size_t localSum = 0;
        foreach (immutable k, immutable v; cumulative)
            if (v) {
                localSum += v;
                if (localSum > no / 2)
                    return k;
            }
        return 0;
    }

    // Copy image borders in the result image.
    auto result = new Image!Color(img.nx, img.ny);
    foreach (immutable y; 0 .. img.ny)
        foreach (immutable x; 0 .. img.nx)
            if (x < radius || x > img.nx - radius - 1 ||
                y < radius || y > img.ny - radius - 1)
                result[x, y] = img[x, y];

    enum edge = 2 * radius + 1;
    auto hCol = new Hist[img.nx];

    // Create histogram columns.
    foreach (immutable y; 0 .. edge - 1)
        foreach (immutable x, ref hx; hCol)
            hx[img[x, y]]++;

    foreach (immutable y; radius .. img.ny - radius) {
        // Add to each histogram column lower pixel.
        foreach (immutable x, ref hx; hCol)
            hx[img[x, y + radius]]++;

        // Calculate main Histogram using first edge-1 columns.
        Hist H;
        foreach (immutable x; 0 .. edge - 1)
            foreach (immutable k, immutable v; hCol[x])
                if (v)
                    H[k] += v;

        foreach (immutable x; radius .. img.nx - radius) {
            // Add right-most column.
            foreach (immutable k, immutable v; hCol[x + radius])
                if (v)
                    H[k] += v;

            result[x, y] = Color(median!(edge ^^ 2)(H));

            // Drop left-most column.
            foreach (immutable k, immutable v; hCol[x - radius])
                if (v)
                    H[k] -= v;
        }

        // Substract the upper pixels.
        foreach (immutable x, ref hx; hCol)
            hx[img[x, y - radius]]--;
    }

    return result;
}

version (median_filter_main)
    void main() { // Demo.
        loadPGM!Gray(null, "lena.pgm").
        medianFilter!10
        .savePGM("lena_median_r10.pgm");
    }


       PROGRAM-ID. memory-allocation.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  based-data              PIC X(20) VALUE "Hello, World!"
                                   BASED.

       PROCEDURE DIVISION.
           *> INITIALIZED sets the data item to the VALUE.
           ALLOCATE based-data INITIALIZED
           DISPLAY based-data
           FREE based-data

           GOBACK
           .


(defun show-allocation ()
  (let ((a (cons 1 2))
        (b (cons 1 2)))
    (declare (dynamic-extent b))
    (list a b)))


// D is a system language so its memory management is refined.
// D supports thread-local memory on default, global memory, memory
// allocated on the stack, the C heap, or the D heap managed by a
// garbage collector, both manually and automatically.

// This program looks scary because its purpose is to show all the
// variety. But lot of this stuff is only for special situations
// (like alloca), and it's not necessary in most user code.

enum int nInts = 10; // Compile-time constant.

// This is thread-local:
int[nInts] data1;

// This is global:
__gshared int[nInts] data2;

void main() {
    // Static memory, it's thread-local but its name is usable
    // only locally:
    static int[nInts] data3;

    // Static memory, it's global but its name is usable only locally:
    __gshared static int[nInts] data4;

    // ----------------------
    // D supports the functions that manage memory of the C heap:
    import core.stdc.stdlib: malloc, calloc, realloc, free, alloca;

    // Allocates space for some integers on the heap,
    // the memory is not initialized:
    auto ptr1 = cast(int*)malloc(nInts * int.sizeof);
    if (ptr1 == null)
        return;

    // Increases the space for one more integer, the new space
    // is not initialized, but the old space is not modified:
    ptr1 = cast(int*)realloc(ptr1, (nInts + 1) * int.sizeof);
    if (ptr1 == null)
        return;

    // calloc allocates on the heap and zeros the memory:
    auto ptr2 = cast(int*)calloc(nInts, int.sizeof);
    if (ptr2 == null)
        return;

    // You can create a slice from a pointer:
    auto slice1 = ptr2[0 .. nInts];

    // Frees the memory:
    free(ptr2);
    free(ptr1);

    // ----------------------
    import core.stdc.stdio: puts;

    static struct Test {
        ~this() { puts("Test destructor"); }
    }

    // Memory allocated on the stack:
    Test[2] array1;

    {
        // More memory allocated on the stack:
        Test[2] array2;
        // Here array2 is removed from the stack,
        // and all array2 destructors get called.
    }
    puts("Block end.");

    // alloca is supported in D. It's similar to malloc but the
    // memory is allocated on the stack:
    int* ptr3 = cast(int*)alloca(nInts * int.sizeof);

    // You can create a slice from the pointer:
    auto slice2 = ptr3[0 .. nInts];

    // Do not free the memory allocated with alloca:
    // free(ptr3);

    // ----------------------
    // Allocates a dynamic array on the D heap managed by
    // the D garbage collector:
    auto array3 = new int[nInts];

    // Try to reserve capacity for a dynamic array on the D heap:
    int[] array4;
    array4.reserve(nInts);
    assert(array4.capacity >= nInts);
    assert(array4.length == 0);

    // Appends one integer to the dynamic array:
    array4 ~= 100;

    // Assume that it is safe to append to this array. Appends made
    // to this array after calling this function may append in place,
    // even if the array was a slice of a larger array to begin with:
    array4.assumeSafeAppend;
    array4 ~= 200;
    array4 ~= 300;
    assert(array4.length == 3);
    // See here for more info:
    // http://dlang.org/d-array-article.html

    // Allocates a struct and a class on the D GC heap:
    static class Foo { int x; }
    Test* t = new Test; // This destructor will not be called.
    Foo f1 = new Foo; // f1 is a class reference.

    // Optional. Destroys the given object and puts it in
    // an invalid state:
    f1.destroy;

    import std.typecons: scoped;

    // Allocates a class on the stack, unsafe:
    auto f3 = scoped!Foo();

    // ----------------------
    import core.memory: GC;

    // Allocates an aligned block from the GC, initialized to zero.
    // Plus it doesn't scan through this block on collect.
    auto ptr4 = cast(int*)GC.calloc(nInts * int.sizeof,
                                    GC.BlkAttr.NO_SCAN);

    // No need to test for this, because GC.calloc usually
    // throws OutOfMemoryError if it can't allocate.
    // if (ptr4 == null)
    //    exit(1);

    GC.free(ptr4); // This is optional.
}


FUNCTION MEDIANF,ARRAY,WINDOW
	RET=fltarr(N_ELEMENTS(ARRAY),1)
	EDGEX=WINDOW/2
	FOR X=EDGEX, N_ELEMENTS(ARRAY)-EDGEX DO BEGIN
		PRINT, "X", X
		COLARRAY=fltarr(WINDOW,1)
		FOR FX=0, WINDOW-1 DO BEGIN
			COLARRAY[FX]=ARRAY[X + FX - EDGEX]
		END
		T=COLARRAY[SORT(COLARRAY)]
		RET[X]=T[WINDOW/2]
	END
	RETURN, RET
END


package main

// Files required to build supporting package raster are found in:
// * Bitmap
// * Grayscale image
// * Read a PPM file
// * Write a PPM file

import (
    "fmt"
    "raster"
)

var g0, g1 *raster.Grmap
var ko [][]int
var kc []uint16
var mid int

func init() {
    // hard code box of 9 pixels
    ko = [][]int{
        {-1, -1}, {0, -1}, {1, -1},
        {-1,  0}, {0,  0}, {1,  0},
        {-1,  1}, {0,  1}, {1,  1}}
    kc = make([]uint16, len(ko))
    mid = len(ko) / 2
}

func main() {
    // Example file used here is Lenna50.jpg from the task "Percentage
    // difference between images" converted with with the command
    // convert Lenna50.jpg -colorspace gray Lenna50.ppm
    // It shows very obvious compression artifacts when viewed at higher
    // zoom factors.
    b, err := raster.ReadPpmFile("Lenna50.ppm")
    if err != nil {
        fmt.Println(err)
        return
    }
    g0 = b.Grmap()
    w, h := g0.Extent()
    g1 = raster.NewGrmap(w, h)
    for y := 0; y < h; y++ {
        for x := 0; x < w; x++ {
            g1.SetPx(x, y, median(x, y))
        }
    }
    // side by side comparison with input file shows compression artifacts
    // greatly smoothed over, although at some loss of contrast.
    err = g1.Bitmap().WritePpmFile("median.ppm")
    if err != nil {
        fmt.Println(err)
    }
}

func median(x, y int) uint16 {
    var n int
    // construct sorted list as pixels are read.  insertion sort can't be
    // beat for a small number of items, plus there would be lots of overhead
    // just to get numbers in and out of a library sort routine.
    for _, o := range ko {
        // read a pixel of the kernel
        c, ok := g0.GetPx(x+o[0], y+o[1])
        if !ok {
            continue
        }
        // insert it in sorted order
        var i int
        for ; i < n; i++ {
            if c < kc[i] {
                for j := n; j > i; j-- {
                    kc[j] = kc[j-1]
                }
                break
            }
        }
        kc[i] = c
        n++
    }
    // compute median from sorted list
    switch {
    case n == len(kc): // the usual case, pixel with complete neighborhood
        return kc[mid]
    case n%2 == 1: // edge case, odd number of pixels
        return kc[n/2]
    }
    // else edge case, even number of pixels
    m := n / 2
    return (kc[m-1] + kc[m]) / 2
}


? <elib:tables.makeFlexList>.fromType(<type:java.lang.Byte>, 128)
# value: [].diverge()


Pid = erlang:spawn_opt( Fun, [{min_heap_size, 1024}] ).


unused .  \ memory available for use in dictionary
here .    \ current dictionary memory pointer
: mem, ( addr len -- ) here over allot swap move ;
: s, ( str len -- ) here over char+ allot place align ;   \ built-in on some forths
: ,"  [char] " parse s, ;
variable num
create array  60 cells allot
create struct  0 , 10 ,  char A c,  ," string"
unused .
here .


program allocation_test
    implicit none
    real, dimension(:), allocatable :: vector
    real, dimension(:, :), allocatable :: matrix
    real, pointer :: ptr
    integer, parameter :: n = 100 ! Size to allocate

    allocate(vector(n))      ! Allocate a vector
    allocate(matrix(n, n))   ! Allocate a matrix
    allocate(ptr)            ! Allocate a pointer

    deallocate(vector)       ! Deallocate a vector
    deallocate(matrix)       ! Deallocate a matrix
    deallocate(ptr)          ! Deallocate a pointer
end program allocation_test


F mertens(count)
   ‘Generate Mertens numbers’
   V m = [-1, 1]
   L(n) 2 .. count
      m.append(1)
      L(k) 2 .. n
         m[n] -= m[n I/ k]
   R m

V ms = mertens(1000)

print(‘The first 99 Mertens numbers are:’)
print(‘  ’, end' ‘ ’)
V col = 1
L(n) ms[1.<100]
   print(‘#2’.format(n), end' ‘ ’)
   col++
   I col == 10
      print()
      col = 0

V zeroes = sum(ms.map(x -> Int(x == 0)))
V crosses = sum(zip(ms, ms[1..]).map((a, b) -> Int(a != 0 & b == 0)))
print(‘M(N) equals zero #. times.’.format(zeroes))
print(‘M(N) crosses zero #. times.’.format(crosses))


using Images, ImageFiltering, FileIO
Base.isless(a::RGB{T}, b::RGB{T}) where T =
    red(a) < red(b) || green(a) < green(b) || blue(a) < blue(b)
Base.middle(x::RGB) = x

img = load("data/lenna100.jpg")
mapwindow(median!, img, (3, 3))


// Version 1.2.41
import java.awt.Color
import java.awt.Graphics
import java.awt.image.BufferedImage
import java.io.File
import javax.imageio.ImageIO

class BasicBitmapStorage(width: Int, height: Int) {
    val image = BufferedImage(width, height, BufferedImage.TYPE_3BYTE_BGR)

    fun fill(c: Color) {
        val g = image.graphics
        g.color = c
        g.fillRect(0, 0, image.width, image.height)
    }

    fun setPixel(x: Int, y: Int, c: Color) = image.setRGB(x, y, c.getRGB())

    fun getPixel(x: Int, y: Int) = Color(image.getRGB(x, y))

    fun medianFilter(windowWidth: Int, windowHeight: Int) {
        val window = Array(windowWidth * windowHeight) { Color.black }
        val edgeX = windowWidth / 2
        val edgeY = windowHeight / 2
        val compareByLuminance = {
            c: Color -> 0.2126 * c.red + 0.7152 * c.green + 0.0722 * c.blue
        }
        for (x in edgeX until image.width - edgeX) {
            for (y in edgeY until image.height - edgeY) {
                var i = 0
                for (fx in 0 until windowWidth) {
                    for (fy in 0 until windowHeight) {
                        window[i] = getPixel(x + fx - edgeX, y + fy - edgeY)
                        i++
                    }
                }
                window.sortBy(compareByLuminance)
                setPixel(x, y, window[windowWidth * windowHeight / 2])
            }
        }
    }
}

fun main(args: Array<String>) {
    val img = ImageIO.read(File("Medianfilterp.png"))
    val bbs = BasicBitmapStorage(img.width / 2, img.height)
    with (bbs) {
        for (y in 0 until img.height) {
            for (x in 0 until img.width / 2) {
                setPixel(x, y, Color(img.getRGB(x, y)))
            }
        }
        medianFilter(3, 3)
        val mfFile = File("Medianfilterp2.png")
        ImageIO.write(image, "png", mfFile)
    }
}


Dim As Integer size = 12345
Dim As Integer mem = size-1
Print size; " bytes of heap allocated at " ; mem
Clear (mem, , 10)
Print size; " bytes of heap allocated at " ; mem


func inc(n int) {
    x := n + 1
    println(x)
}


import Foreign

bytealloc :: IO ()
bytealloc = do
  a0 <- mallocBytes 100 -- Allocate 100 bytes
  free a0 -- Free them again
  allocaBytes 100 $ \a -> -- Allocate 100 bytes; automatically
                          -- freed when closure finishes
    poke (a::Ptr Word32) 0


    t := table() # The table's memory is allocated
                 #... do things with t
    t := &null   # The table's memory can be reclaimed


//All of these objects will be deallocated automatically once the program leaves
//their scope and there are no more pointers to the objects
Object foo = new Object(); //Allocate an Object and a reference to it
int[] fooArray = new int[size]; //Allocate all spaces in an array and a reference to it
int x = 0; //Allocate an integer and set its value to 0


MAX:	equ	1000	; Amount of numbers to generate
	org	100h
	;;;	Generate Mertens numbers
	lxi	b,1	; Start at place 1; BC = current Mertens number
	lxi	h,MM	; First one is 1
	dad	b
	mvi	m,1
outer:	inx 	b	; Next Mertens number
	lxi	h,MM
	dad	b
	mvi	m,1	; Initialize at 1
	lxi	d,2	; DE = inner loop counter ('k'), starts at 2
	;;;	Now we need to find BC/DE, but there is no hardware divide
	;;;	We also need to be somewhat clever so it doesn't take forever
inner:	push	d	; Keep both loop counters safe on the stack
	push 	b
	xchg		; Divisor in HL
	mov	d,b	; Dividend in DE
	mov	e,c
	lxi	b,100h	; B = counter, C = zero
double:	dad	h	; Double divisor
	inr	b	; Increment counter
	call	cdehl	; Dividend <= divisor?
	jnc	double	; If so, keep doubling
	mov	a,b	; Keep counter
	mov	b,c	; BC = 0
	push 	b	; Push result variable on stakc (initial 0)
	mov	b,a	; Restore counter
	xchg		; HL = dividend, DE = doubled divisor
subtr:	mov	a,l	; Try HL -= DE
	sub	e
	mov	l,a
	mov	a,h
	sbb	d
	mov	h,a
	xthl		; Get result accumulator from stack
	cmc		; Flip borrow
	mov	a,l	; Rotate into result
	ral
	mov	l,a
	mov	a,h
	ral
	mov	h,a
	mov	a,l	; Retrieve flag
	rar
	xthl		; Retrieve rest of divisor
	jc	$+4	; If borrow,
	dad	d	; Add dividend back into divisor
	xra     a       ; DE >> 1
	ora     d
	rar
	mov     d,a
	mov     a,e
	rar
	mov     e,a
	dcr     b       ; Are we there yet?
	jnz     subtr   ; If not, try another subtraction
	pop	h  	; HL = quotient
	;;;	Division is done, do lookup and subraction
	lxi	d,MM	; Look up M[outer/inner]
	dad	d
	mov	e,m	; E = M[BC/DE]
	pop	b	; Restore BC (n)
	lxi	h,MM
	dad	b
	mov	a,m 	; A = M[BC]
	sub	e	; A = M[BC] - M[BC/DE]
	mov	m,a	; M[BC] = A
	pop	d	; Restore DE (k)
	;;;	Update loops
	inx	d	; k++
	call	cbcde	; DE <= BC?
	jnc	inner
	lxi	h,MAX
	call	chlbc	; BC <= MAX?
	jnc	outer
	;;;	Print table
	lxi	d,frst99
	call	puts
	lxi	h,MM+1	; Start of Merten numbers
	mvi	c,9	; Column counter
table:	mov	a,m	; Get Merten number
	ana	a	; Set flags
	mvi	b,' '	; Space
	jp 	prtab	; If positive, print space-number-space
	mvi	b,'-'	; Otherwise, print minus sign
	cma		; And negate the number (make positive)
	inr	a
prtab:	adi	'0'	; Make ASCII digit
	mov	d,a	; Keep number
	mov	a,b	; Print space or minus sign
	call	putc
	mov	a,d	; Restore number
	call	putc	; Print number
	mvi	a,' '	; Print space
	call	putc
	dcr	c	; Decrement column counter
	jnz	tnext
	lxi	d,nl	; End of columns - print newline
	call	puts
	mvi	c,10	; Column counter
tnext:	inx	h	; Table done?
	mov	a,l
	cpi	100
	jnz	table	; If not, keep going
	;;;	Find zeroes and crossings
	lxi	b,0	; B=zeroes, C=crossings
	lxi	d,MAX	; Counter
	lxi	h,MM+1
count:	mov	a,m	; Get number
	ana	a 	; Zero?
	jnz	cnext
	inr	b	; If so, add zero
	dcx	h	; Previous number also zero?
	mov	a,m
	inx	h
	ana	a
	jz	cnext
	inr	c	; If not, add crossiong
cnext:	inx	h
	dcx	d
	mov	a,d
	ora	e
	jnz	count
	lxi	d,zero	; Print zeroes
	call	puts
	mov	a,b
	call	puta
	lxi	d,cross ; Print crossings
	call	puts
	mov	a,c
	call	puta
	lxi	d,tms
	jmp	puts
	;;;	Print character in A using CP/M, keeping registers
putc:	push	b
	push	d
	push	h
	mov	e,a
	mvi	c,2
	call	5
	jmp	resrgs
	;;;	Print number in A, keeping registers
puta:	push	b
	push	d
	push 	h
	lxi	h,num
putad:	mvi	c,-1
putal:	inr 	c
	sui	10
	jnc	putal
	adi	10+'0'
	dcx	h
	mov	m,a
	mov	a,c
	ana	a
	jnz	putad
	xchg
	mvi	c,9
	call	5
	jmp	resrgs
	;;;	Print string in DE using CP/M, keeping registers
puts:	push	b
	push	d
	push	h
	mvi	c,9
	call	5
resrgs:	pop	h
	pop	d
	pop 	b
	ret
cdehl:	mov	a,d
	cmp 	h
	rnz
	mov	a,e
	cmp	l
	ret
cbcde:	mov	a,b
	cmp	d
	rnz
	mov	a,c
	cmp	e
	ret
chlbc:	mov	a,h
	cmp	b
	rnz
	mov	a,l
	cmp	c
	ret
	;;;	Strings
	db	'***'
num:	db	'$'
frst99:	db	'First 99 Mertens numbers:',13,10,'   $'
nl:	db	13,10,'$'
zero:	db	'M(N) is zero $'
cross:	db	' times.',13,10,'M(N) crosses zero $'
tms:	db	' times.$'
	;;; Numbers are stored page-aligned after program
MM:	equ	($/256)*256+256


MAX:	equ	1000		; Amount of Mertens numbers to generate
puts:	equ	9		; MS-DOS syscall to print a string
putch:	equ	2		; MS-DOS syscall to print a character
	cpu	8086
	org	100h
section	.text
	;;;	Generate Mertens numbers
	mov	bx,M		; BX = pointer to start of Mertens numbers
	mov	si,1		; Current Mertens number
	mov	[si+bx],byte 1	; First Mertens number is 1
outer:	inc	si		; Next Mertens number
	mov	[si+bx],byte 1	; Starts out at 1...
	mov	cx,2		; CX = from 2 to current number,
inner:	mov	ax,si		; Divide current number,
	xor	dx,dx
	div	cx		; By CX
	mov	di,ax
	mov	al,[di+bx]	; Get value at that location
	sub	[si+bx],al 	; Subtract from current number
	inc	cx
	cmp	cx,si
	jbe	inner
	cmp	si,MAX
	jbe	outer
	;;;	Print the table
	mov	dx,frst99	; First string
	call	outstr
	mov	si,1		; Start at index 1
	mov	dh,9		; Column count
table:	mov	cl,[si+bx]	; Get item
	test	cl,cl
	mov	dl,' '
	jns	.print		; Positive?
	mov	dl,'-'		; Otherwise, it is negative,
	neg	cl		; print ' ' and negate
.print:	call	putc		; Print space or minus
	add	cl,'0'		; Add ASCII 0
	mov	dl,cl
	call	putc		; Print number
	mov 	dl,' '
	call	putc		; Print space
	dec	dh		; One less column left
	jnz	.next
	mov	dx,nl		; Print newline
	call	outstr
	mov	dh,10
.next:	inc	si		; Done yet?
	cmp	si,100
	jb	table		; If not, print next item from table
	;;;	Calculate zeroes and crossings
	xor	cx,cx		; CL = zeroes, CH = crossings
	mov	si,1
	mov	al,[si+bx]	; AL = current item
zc:	inc	si
	mov	ah,al		; AH = previous item
	mov	al,[si+bx]
	test	al,al		; Zero?
	jnz	.next
	inc	cx		; Then increment zero counter
	test	ah,ah		; Previous one also zero?
	jz 	.next
	inc	ch		; Then increment crossing counter
.next:	cmp	si,MAX		; Done yet?
	jbe	zc
	;;;	Print zeroes and crossings
	mov	dx,zero
	call	outstr
	mov	al,cl
	call	putal
	mov	dx,cross
	call 	outstr
	mov	al,ch
	call	putal
	mov	dx,tms
	jmp	outstr
putc:	mov	ah,putch	; Print character
	int	21h
	ret
	;;;	Print AL in decimal format
putal:	mov	di,num
.loop:	aam			; Extract digit
	add	al,'0'		; Store digit
	dec	di
	mov	[di],al
	mov	al,ah		; Rest of number
	test	al,al		; Done?
	jnz	.loop		; If not, get more digits
	mov	dx,di		; Otherwise, print string
outstr:	mov	ah,puts
	int	21h
	ret
section .data
	db	'***'		; Number output placeholder
num:	db	'$'
frst99:	db	'First 99 Mertens numbers:',13,10,'   $'
nl:	db	13,10,'$'
zero:	db	'M(N) is zero $'
cross:	db	' times.',13,10,'M(N) crosses zero $'
tms:	db	' times.$'
section .bss
mm:	resb	MAX	; Mertens numbers
M:	equ	mm-1	; 1-based indexing


import algorithm
import imageman

func luminance(color: ColorRGBF64): float =
  0.2126 * color.r + 0.7152 * color.g + 0.0722 * color.b

proc applyMedianFilter(img: var Image; windowWidth, windowHeight: Positive) =
  var window = newSeq[ColorRGBF64](windowWidth * windowHeight)
  let edgeX = windowWidth div 2
  let edgeY = windowHeight div 2

  for x in edgeX..<(img.width - edgeX):
    for y in edgeY..<(img.height - edgeY):
      var i = 0
      for fx in 0..<windowWidth:
        for fy in 0..<windowHeight:
          window[i] = img[x + fx - edgeX, y + fy - edgeY]
          inc i
      window = window.sortedByIt(luminance(it))
      img[x, y] = window[windowWidth * windowHeight div 2]

when isMainModule:
  let fullImage = loadImage[ColorRGBF64]("Medianfilterp.png")
  # Extract left part of the image.
  var image = fullImage[0..<(fullImage.width div 2), 0..<fullImage.height]
  image.applyMedianFilter(3, 3)
  savePNG(image, "Medianfilterp_3x3.png")


let color_add (r1,g1,b1) (r2,g2,b2) =
  ( (r1 + r2),
    (g1 + g2),
    (b1 + b2) )

let color_div (r,g,b) d =
  ( (r / d),
    (g / d),
    (b / d) )

let compare_as_grayscale (r1,g1,b1) (r2,g2,b2) =
  let v1 = (2_126 * r1 +  7_152 * g1 + 722 * b1)
  and v2 = (2_126 * r2 +  7_152 * g2 + 722 * b2) in
  (Pervasives.compare v1 v2)

let get_rgb img x y =
  let _, r_channel,_,_ = img in
  let width = Bigarray.Array2.dim1 r_channel
  and height = Bigarray.Array2.dim2 r_channel in
  if (x < 0) || (x >= width) then (0,0,0) else
  if (y < 0) || (y >= height) then (0,0,0) else  (* feed borders with black *)
  (get_pixel img x y)

let median_value img radius =
  let samples = (radius*2+1) * (radius*2+1) in
  fun x y ->
    let sample = ref [] in

    for _x = (x - radius) to (x + radius) do
      for _y = (y - radius) to (y + radius) do

        let v = get_rgb img _x _y in

        sample := v :: !sample;
      done;
    done;

    let ssample = List.sort compare_as_grayscale !sample in
    let mid = (samples / 2) in

    if (samples mod 2) = 1
    then List.nth ssample (mid+1)
    else
      let median1 = List.nth ssample (mid)
      and median2 = List.nth ssample (mid+1) in
      (color_div (color_add median1 median2) 2)

let median img radius =
  let _, r_channel,_,_ = img in
  let width = Bigarray.Array2.dim1 r_channel
  and height = Bigarray.Array2.dim2 r_channel in

  let _median_value = median_value img radius in

  let res = new_img ~width ~height in
  for y = 0 to pred height do
    for x = 0 to pred width do
      let color = _median_value x y in
      put_pixel res color x y;
    done;
  done;
  (res)


matrix = Array{Float64,2}(100,100)
matrix[31,42] = pi


// version 1.1.2

class MyClass(val myInt: Int) {
    // in theory this method should be called automatically prior to GC
    protected fun finalize() {
        println("MyClass being finalized...")
    }
}

fun myFun() {
    val mc: MyClass = MyClass(2)   // new non-nullable MyClass object allocated on the heap
    println(mc.myInt)
    var mc2: MyClass? = MyClass(3) // new nullable MyClass object allocated on the heap
    println(mc2?.myInt)
    mc2 = null                     // allowed as mc2 is nullable
    println(mc2?.myInt)
    // 'mc' and 'mc2' both become eligible for garbage collection here as no longer used
}

fun main(args: Array<String>) {
    myFun()
    Thread.sleep(3000)  // allow time for GC to execute
    val i: Int  = 4     // new non-nullable Int allocated on stack
    println(i)
    var j: Int? = 5     // new nullable Int allocated on heap
    println(j)
    j = null            // allowed as 'j' is nullable
    println(j)
    // 'j' becomes eligible for garbage collection here as no longer used
}


-- Create a ByteArray of 100 Kb (pre-filled with 0 bytes)
ba = byteArray(102400)

-- Lingo uses garbage-collection, so allocated memory is released when no more references exist.
-- For the above variable ba, this can be achieved by calling:
ba = VOID


Module Checkit {
      Buffer Clear Mem1 as Byte*12345
      Print Len(Mem1)
      Hex Mem1(0) ' print in Hex address of first element
      Print Mem1(Len(Mem1)-1)-Mem1(0)+1=12345
      Buffer Mem1 as Byte*20000  ' redim block
      Print Mem1(Len(Mem1)-1)-Mem1(0)+1=20000
      Try {
            Print Mem1(20000)  ' it is an error
      }
      Print Error$  ' return message: Buffer Locked, wrong use of pointer
}
Checkit


a := Array( 1 .. 10^6, datatype = integer[1] ):


INCLUDE "D2:PRINTF.ACT" ;from the Action! Tool Kit

PROC MertensNumbers(INT ARRAY m INT count)
  INT n,k

  m(1)=1
  FOR n=2 TO count
  DO
    m(n)=1
    FOR k=2 TO n
    DO
      m(n)==-m(n/k)
    OD
  OD
RETURN

PROC PrintMertens(INT ARRAY m INT count)
  CHAR ARRAY s(6)
  INT i,col

  PrintF("First %I Mertens numbers:%E   ",count)
  col=1
  FOR i=1 TO count
  DO
    StrI(m(i),s)
    PrintF("%3S",s)
    col==+1
    IF col=10 THEN
      col=0 PutE()
    FI
  OD
RETURN

PROC Main()
  DEFINE MAX="1001"
  INT ARRAY m(MAX)
  INT i,zeroCnt=[0],crossCnt=[0],prev=[0]

  Put(125) PutE() ;clear the screen
  PrintF("Calculation of Mertens numbers,%E  please wait...")
  MertensNumbers(m,MAX)

  Put(125) PutE() ;clear the screen
  PrintMertens(m,99)

  FOR i=1 TO MAX
  DO
    IF m(i)=0 THEN
      zeroCnt==+1
      IF prev THEN
        crossCnt==+1
      FI
    FI
    prev=m(i)
  OD
  PrintF("%EM(n) is zero %I times for 1<=n<=%I.%E",zeroCnt,MAX-1)
  PrintF("%EM(n) crosses zero %I times for 1<=n<=%I.%E",crossCnt,MAX-1)
RETURN


BEGIN # compute values of the Mertens function                      #
    # Generate Mertens numbers                                      #
    [ 1 : 1000 ]INT m;
    m[ 1 ] := 1;
    FOR n FROM 2 TO UPB m DO
        m[ n ] := 1;
        FOR k FROM 2 TO n DO m[ n ] -:= m[ n OVER k ] OD
    OD;
    # Print table                                                   #
    print( ( "The first 99 Mertens numbers are:", newline ) );
    print( ( "   " ) );
    INT k := 9;
    FOR n TO 99 DO
        print( ( whole( m[ n ], -3 ) ) );
        IF ( k -:= 1 ) = 0 THEN
            k := 10;
            print( ( newline ) )
        FI
    OD;
    # Calculate zeroes and crossings                                #
    INT zero  := 0;
    INT cross := 0;
    FOR n FROM 2 TO UPB m DO
        IF m[ n ] = 0 THEN
            zero +:= 1;
            IF m[ n - 1 ] /= 0 THEN cross +:= 1 FI
        FI
    OD;
    print( ( newline ) );
    print( ( "M(N) is zero      ", whole( zero,  -4 ), " times.", newline ) );
    print( ( "M(N) crosses zero ", whole( cross, -4 ), " times.", newline ) )
END


use strict 'vars';
use warnings;

use PDL;
use PDL::Image2D;

my $image = rpic 'plasma.png';
my $smoothed = med2d $image, ones(3,3), {Boundary => Truncate};
wpic $smoothed, 'plasma_median.png';


-- demo\rosetta\Bitmap_Median_filter.exw
include ppm.e

constant neigh = {{-1,-1},{0,-1},{1,-1},
                  {-1, 0},{0, 0},{1, 0},
                  {-1, 1},{0, 1},{1, 1}}

--constant neigh = {{-2,-2},{-1,-2},{0,-2},{1,-2},{2,-2},
--                {-2,-1},{-1,-1},{0,-1},{1,-1},{2,-1},
--                {-2, 0},{-1, 0},{0, 0},{1, 0},{2, 0},
--                {-2, 1},{-1, 1},{0, 1},{1, 1},{2, 1},
--                {-2, 2},{-1, 2},{0, 2},{1, 2},{2, 2}}

sequence kn = repeat(0,length(neigh))

function median(sequence image)
    integer h = length(image),
            w = length(image[1])
    for i=1 to length(image) do
        for j=1 to length(image[i]) do
            integer n = 0, c, p, x, y
            for k=1 to length(neigh) do
                x = i+neigh[k][1]
                y = j+neigh[k][2]
                if  x>=1 and x<=h
                and y>=1 and y<=w then
                    n += 1
                    c = image[x,j]
                    p = n
                    while p>1 do
                        if c>kn[p-1] then exit end if
                        kn[p] = kn[p-1]
                        p -= 1
                    end while
                    kn[p] = c
                end if
            end for
            if and_bits(n,1) then
                c = kn[(n+1)/2]
            else
                c = floor((kn[n/2]+kn[n/2+1])/2)
            end if
            image[i,j] = c
        end for
    end for
    return image
end function

sequence img = read_ppm("Lena.ppm")
    img = median(img)
    write_ppm("LenaMedian.ppm",img)


(de ppmMedianFilter (Radius Ppm)
   (let Len (inc (* 2 Radius))
      (make
         (chain (head Radius Ppm))
         (for (Y Ppm  T  (cdr Y))
            (NIL (nth Y Len)
               (chain (tail Radius Y)) )
            (link
               (make
                  (chain (head Radius (get Y (inc Radius))))
                  (for (X (head Len Y) T)
                     (NIL (nth X 1 Len)
                        (chain (tail Radius (get X (inc Radius)))) )
                     (link
                        (cdr
                           (get
                              (sort
                                 (mapcan
                                    '((Y)
                                       (mapcar
                                          '((C)
                                             (cons
                                                (+
                                                   (* (car C) 2126)     # Red
                                                   (* (cadr C) 7152)    # Green
                                                   (* (caddr C) 722) )  # Blue
                                                C ) )
                                          (head Len Y) ) )
                                    X ) )
                              (inc Radius) ) ) )
                     (map pop X) ) ) ) ) ) ) )


import Image, ImageFilter
im = Image.open('image.ppm')

median = im.filter(ImageFilter.MedianFilter(3))
median.save('image2.ppm')


#lang racket
(require images/flomap math)

(define lena <<paste image of Lena here>> )
(define bm (send lena get-bitmap))
(define fm (bitmap->flomap bm))

(flomap->bitmap
 (build-flomap
  4 (send bm get-width) (send bm get-height)
  (λ (k x y)
    (define (f x y) (flomap-ref fm k x y))
    (median < (list (f (- x 1) (- y 1))
                    (f (- x 1)    y)
                    (f (- x 1) (+ y 1))
                    (f    x    (- y 1))
                    (f    x       y)
                    (f    x    (+ y 1))
                    (f (+ x 1) (- y 1))
                    (f (+ x 1)    y)
                    (f (+ x 1) (+ y 1)))))))


use PDL:from<Perl5>;
use PDL::Image2D:from<Perl5>;

my $image = rpic 'plasma.png';
my $smoothed = med2d($image, ones(3,3), {Boundary => 'Truncate'});
wpic $smoothed, 'plasma_median.png';


   A = zeros(1000); 	% allocates memory for a 1000x1000 double precision matrix.
   clear A;		% deallocates memory

   b = zeros(1,100000);	% pre-allocate memory to improve performance
   for k=1:100000,
	b(k) = 5*k*k-3*k+2;
   end


begin % compute values of the Mertens function                      %
    integer array M ( 1 :: 1000 );
    integer k, zero, cross;
    % Generate Mertens numbers                                      %
    M( 1 ) := 1;
    for n := 2 until 1000 do begin
        M( n ) := 1;
        for k := 2 until n do M( n ) := M( n ) - M( n div k )
    end for_n ;
    % Print table                                                   %
    write( "The first 99 Mertens numbers are:" );
    write( "   " );
    k := 9;
    for n := 1 until 99 do begin
        writeon( i_w := 3, s_w := 0, M( n ) );
        k := k - 1;
        if k = 0 then begin
            k := 10;
            write()
        end if_k_eq_0
    end for_n ;
    % Calculate zeroes and crossings                                %
    zero  := 0;
    cross := 0;
    for n :=2 until 1000 do begin
        if M( n ) = 0 then begin
            zero := zero + 1;
            if M( n - 1 ) not = 0 then cross := cross + 1
        end if_M_n_eq_0
    end for_n ;
    write( i_w := 2, s_w := 0, "M(N) is zero ", zero, " times." );
    write( i_w := 2, s_w := 0, "M(N) crosses zero ", cross, " times." )
end.


mertens←{
    step  ← {⍵,-⍨/⌽1,⍵[⌊n÷1↓⍳n←1+≢⍵]}
    m1000 ← step⍣999⊢,1
    zero  ← m1000+.=0
    cross ← +/(~∧1⌽⊢)m1000≠0
    ⎕←'First 99 Mertens numbers:'
    ⎕←10 10⍴'∘',m1000
    ⎕←'M(N) is zero ',(⍕zero),' times.'
    ⎕←'M(N) crosses zero ',(⍕cross),' times.'
}


mobius: function [n][
    if n=0 -> return ""
    if n=1 -> return 1
    f: factors.prime n

    if f <> unique f -> return 0
    if? odd? size f -> return neg 1
    else -> return 1
]

mertens: function [z][sum map 1..z => mobius]

print "The first 99 Mertens numbers are:"
loop split.every:20 [""]++map 1..99 => mertens 'a [
    print map a 'item -> pad to :string item 2
]

print ""

mertens1000: map 1..1000 => mertens
print ["Times M(x) is zero between 1 and 1000:" size select mertens1000 => zero?]

crossed: new 0
fold mertens1000 [a,b][if and? zero? b not? zero? a -> inc 'crossed, b]
print ["Times M(x) crosses zero between 1 and 1000:" crossed]


class Pixmap
  def median_filter(radius=3)
    radius += 1 if radius.even?
    filtered = self.class.new(@width, @height)
    pb = ProgressBar.new(@height) if $DEBUG
    @height.times do |y|
      @width.times do |x|
        window = []
        (x - radius).upto(x + radius).each do |win_x|
          (y - radius).upto(y + radius).each do |win_y|
            win_x = 0 if win_x < 0
            win_y = 0 if win_y < 0
            win_x = @width-1 if win_x >= @width
            win_y = @height-1 if win_y >= @height
            window << self[win_x, win_y]
          end
        end
        # median
        filtered[x, y] = window.sort[window.length / 2]
      end
      pb.update(y) if $DEBUG
    end
    pb.close if $DEBUG
    filtered
  end
end

class RGBColour
  # refactoring
  def luminosity
    Integer(0.2126*@red + 0.7152*@green + 0.0722*@blue)
  end
  def to_grayscale
    l = luminosity
    self.class.new(l, l, l)
  end

  # defines how to compare (and hence, sort)
  def <=>(other)
    self.luminosity <=> other.luminosity
  end
end

class ProgressBar
  def initialize(max)
    $stdout.sync = true
    @progress_max = max
    @progress_pos = 0
    @progress_view = 68
    $stdout.print "[#{'-'*@progress_view}]\r["
  end

  def update(n)
    new_pos = n * @progress_view/@progress_max
    if new_pos > @progress_pos
      @progress_pos = new_pos
      $stdout.print '='
    end
  end

  def close
    $stdout.puts '=]'
  end
end

bitmap = Pixmap.open('file')
filtered = bitmap.median_filter


package require Tk

# Set the color of a pixel
proc applyMedian {srcImage x y -> dstImage} {
    set x0 [expr {$x==0 ? 0 : $x-1}]
    set y0 [expr {$y==0 ? 0 : $y-1}]
    set x1 $x
    set y1 $y
    set x2 [expr {$x+1==[image width $srcImage]  ? $x : $x+1}]
    set y2 [expr {$y+1==[image height $srcImage] ? $y : $y+1}]

    set r [set g [set b {}]]
    foreach X [list $x0 $x1 $x2] {
	foreach Y [list $y0 $y1 $y2] {
	    lassign [$srcImage get $X $Y] rPix gPix bPix
	    lappend r $rPix
	    lappend g $gPix
	    lappend b $bPix
	}
    }
    set r [lindex [lsort -integer $r] 4]
    set g [lindex [lsort -integer $g] 4]
    set b [lindex [lsort -integer $b] 4]
    $dstImage put [format "#%02x%02x%02x" $r $g $b] -to $x $y
}
# Apply the filter to the whole image
proc medianFilter {srcImage {dstImage ""}} {
    if {$dstImage eq ""} {
	set dstImage [image create photo]
    }
    set w [image width $srcImage]
    set h [image height $srcImage]
    for {set x 0} {$x < $w} {incr x} {
	for {set y 0} {$y < $h} {incr y} {
	    applyMedian $srcImage $x $y -> $dstImage
	}
    }
    return $dstImage
}

# Demonstration code using the Tk widget demo's teapot image
image create photo teapot -file $tk_library/demos/images/teapot.ppm
pack [labelframe .src -text Source] -side left
pack [label .src.l -image teapot]
update
pack [labelframe .dst -text Median] -side left
pack [label .dst.l -image [medianFilter teapot]]


/* Maxima allocates memory dynamically and uses a garbage collector.
Here is how to check available memory */

room();
  3221/3221   72.3%       2 CONS RATIO COMPLEX STRUCTURE
   272/307    61.6%         FIXNUM SHORT-FLOAT CHARACTER RANDOM-STATE READTABLE SPICE
   226/404    90.8%         SYMBOL STREAM
     1/2      37.2%         PACKAGE
   127/373    44.9%         ARRAY HASH-TABLE VECTOR BIT-VECTOR PATHNAME CCLOSURE CLOSURE
   370/370    49.1%       1 STRING
   325/440     8.2%         CFUN BIGNUM LONG-FLOAT
    31/115    98.9%         SFUN GFUN VFUN AFUN CFDATA
  1188/1447                 contiguous (478 blocks)
       11532                hole
       5242    5.0%         relocatable
      4573 pages for cells
     22535 total pages
     97138 pages available
     11399 pages in heap but not gc'd + pages needed for gc marking
    131072 maximum pages


import native

// allocate 26 bytes
ptr = native.allocate(26)

// store the uppercase alphabet
for i in range(0, 25)
    native.poke(ptr + i, ord("A") + i)
end

// output the allocated memory
for i in range(0, 25)
    print chr(native.peek(ptr + i))
end

// free the allocated memory
native.free(ptr)


# Allocate thread local heap memory
var a = alloc(1000)
dealloc(a)

# Allocate memory block on shared heap
var b = allocShared(1000)
deallocShared(b)

# Allocate and Dellocate a single int on the thread local heap
var p = create(int, sizeof(int)) # allocate memory
# create zeroes memory; createU does not.
echo p[]                         # 0
p[] = 123                        # assign a value
echo p[]                         # 123
discard resize(p, 0)             # deallocate it
# p is now invalid. Let's set it to nil
p = nil                          # set pointer to nil
echo isNil(p)                    # true


foo := Object->New(); // allocates an object on the heap
foo_array := Int->New[size]; // allocates an integer array on the heap
x := 0; // allocates an integer on the stack


'ALLOCATING MEMORY FROM DIFFERENT MEMORY SOURCES

sys p

static byte b[0x1000] 'global memory
[email protected]

function f()
local byte b[0x1000]  'stack memory in a procedure
[email protected]
end function

p=getmemory 0x1000 'heap memory
...
freememory p 'to disallocate

sub rsp,0x1000     'stack memory direct
p=rsp
...
rsp=p 'to disallocate

'Named Memory shared between processes is
'also available using the Windows API (kernel32.dll)
'see MSDN:
'CreateFileMapping
'OpenFileMapping
'MapViewOfFile
'UnmapViewOfFile
'CloseHandle


10 DEFINT C,Z,N,K,M: DIM M(1000)
20 M(1)=1
30 FOR N=2 TO 1000
40 M(N)=1
50 FOR K=2 TO N: M(N) = M(N)-M(INT(N/K)): NEXT
60 NEXT
70 PRINT "First 99 Mertens numbers:"
80 PRINT "   ";
90 FOR N=1 TO 99
100 PRINT USING "###";M(N);
110 IF N MOD 10 = 9 THEN PRINT
120 NEXT
130 C=0: Z=0
140 FOR N=1 TO 1000
150 IF M(N)=0 THEN Z=Z+1: IF M(N-1)<>0 THEN C=C+1
160 NEXT
170 PRINT "M(N) is zero";Z;"times."
180 PRINT "M(N) crosses zero";C;"times."
190 END


#!/bin/bash
MAX=1000

m[1]=1
for n in `seq 2 $MAX`
do
    m[n]=1
    for k in `seq 2 $n`
    do
        m[n]=$((m[n]-m[n/k]))
    done
done

echo 'The first 99 Mertens numbers are:'
echo -n '   '
for n in `seq 1 99`
do
    printf '%2d ' ${m[n]}
    test $((n%10)) -eq 9 && echo
done

zero=0
cross=0
for n in `seq 1 $MAX`
do
    if [ ${m[n]} -eq 0 ]
    then
        ((zero++))
        test ${m[n-1]} -ne 0 && ((cross++))
    fi
done

echo "M(N) is zero $zero times."
echo "M(N) crosses zero $cross times."


get "libhdr"

manifest $( limit = 1000 $)

let mertens(v, max) be
$(  v!1 := 1
    for n = 2 to max do
    $(  v!n := 1
        for k = 2 to n do
            v!n := v!n - v!(n/k)
    $)
$)

let start() be
$(  let m = vec limit
    let eqz, crossz = 0, 0

    writes("The first 99 Mertens numbers are:*N")
    mertens(m, limit)
    for y=0 to 90 by 10 do
    $(  for x=0 to 9 do
            test x+y=0
                then writes("   ")
                else writed(m!(x+y),3)
        wrch('*N')
    $)

    for x=2 to limit do
        if m!x=0 then
        $(  eqz := eqz + 1
            unless m!(x-1)=0 do crossz := crossz + 1
        $)

    writef("M(N) is zero %N times.*N", eqz)
    writef("M(N) crosses zero %N times.*N", crossz)
$)


import "graphics" for Canvas, ImageData, Color
import "dome" for Window

class MedianFilter {
    construct new(filename, filename2, windowWidth, windowHeight) {
        Window.title = "Median filter"
        var image = ImageData.loadFromFile(filename)
        Window.resize(image.width, image.height)
        Canvas.resize(image.width, image.height)
        _ww = windowWidth
        _wh = windowHeight
        // split off the left half
        _image = ImageData.create(filename2, image.width/2, image.height)
        _name = filename2
        for (x in 0...image.width/2) {
            for (y in 0...image.height) _image.pset(x, y, image.pget(x, y))
        }
        // display it on the left before filtering
        _image.draw(0, 0)
    }

    luminance(c) { 0.2126 * c.r + 0.7152 * c.g + 0.0722 * c.b }

    medianFilter(windowWidth, windowHeight) {
        var window = List.filled(windowWidth * windowHeight, Color.black)
        var edgeX = (windowWidth / 2).floor
        var edgeY = (windowHeight / 2).floor
        var comparer = Fn.new { |a, b| luminance(a) < luminance(b) }
        for (x in edgeX..._image.width - edgeX) {
            for (y in edgeY..._image.height - edgeY) {
                var i = 0
                for (fx in 0...windowWidth) {
                    for (fy in 0...windowHeight) {
                        window[i] = _image.pget(x + fx - edgeX, y + fy - edgeY)
                        i = i + 1
                    }
                }
                window.sort(comparer)
                _image.pset(x, y, window[((windowWidth * windowHeight)/2).floor])
            }
        }
    }

    init() {
        medianFilter(_ww, _wh)
        // display it on the right after filtering
        _image.draw(_image.width, 0)
        // save it to a file
        _image.saveToFile(_name)
    }

    update() {}

    draw(alpha) {}
}

var Game = MedianFilter.new("Medianfilterp.png", "Medianfilterp2.png", 3, 3)


type
  TByteArray = array of byte;
var
  A: TByteArray;
begin
  setLength(A,1000);
...
  setLength(A,0);
end;


atom addr = allocate(512)                  -- limit is 1,610,612,728 bytes on 32-bit systems
...
free(addr)
atom addr2 = allocate(512,1)               -- automatically freed when addr2 drops out of scope or re-assigned
atom addr3 = allocate_string("a string",1) -- automatically freed when addr3 drops out of scope or re-assigned


 mainproc: proc options(main) reorder;

 subproc: proc;
 dcl subvar char init ('X');

 put skip data(subvar);
 subvar = 'Q';
 end subproc;

 call subproc();
 call subproc();
 end mainproc;


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

int* mertens_numbers(int max) {
    int* m = malloc((max + 1) * sizeof(int));
    if (m == NULL)
        return m;
    m[1] = 1;
    for (int n = 2; n <= max; ++n) {
        m[n] = 1;
        for (int k = 2; k <= n; ++k)
            m[n] -= m[n/k];
    }
    return m;
}

int main() {
    const int max = 1000;
    int* mertens = mertens_numbers(max);
    if (mertens == NULL) {
        fprintf(stderr, "Out of memory\n");
        return 1;
    }
    printf("First 199 Mertens numbers:\n");
    const int count = 200;
    for (int i = 0, column = 0; i < count; ++i) {
        if (column > 0)
            printf(" ");
        if (i == 0)
            printf("  ");
        else
            printf("%2d", mertens[i]);
        ++column;
        if (column == 20) {
            printf("\n");
            column = 0;
        }
    }
    int zero = 0, cross = 0, previous = 0;
    for (int i = 1; i <= max; ++i) {
        int m = mertens[i];
        if (m == 0) {
            ++zero;
            if (previous != 0)
                ++cross;
        }
        previous = m;
    }
    free(mertens);
    printf("M(n) is zero %d times for 1 <= n <= %d.\n", zero, max);
    printf("M(n) crosses zero %d times for 1 <= n <= %d.\n", cross, max);
    return 0;
}


type Bit is mod 2;
type Rs_232_Layout is record
   Carrier_Detect      : Bit;
   Received_Data       : Bit;
   Transmitted_Data    : Bit;
   Data_Terminal_ready : Bit;
   Signal_Ground       : Bit;
   Data_Set_Ready      : Bit;
   Request_To_Send     : Bit;
   Clear_To_Send       : Bit;
   Ring_Indicator      : Bit;
end record;

for Rs_232_Layout use record
   Carrier_Detect      at 0 range 0..0;
   Received_Data       at 0 range 1..1;
   Transmitted_Data    at 0 range 2..2;
   Data_Terminal_Ready at 0 range 3..3;
   Signal_Ground       at 0 range 4..4;
   Data_Set_Ready      at 0 range 5..5;
   Request_To_Send     at 0 range 6..6;
   Clear_To_Send       at 0 range 7..7;
   Ring_Indicator      at 0 range 8..8;
end record;


MODE RSTWOTHREETWO = BITS;
INT ofs = bits width - 9;
INT
   lwb rs232           = ofs + 1,
   carrier detect      = ofs + 1,
   received data       = ofs + 2,
   transmitted data    = ofs + 3,
   data terminal ready = ofs + 4,
   signal ground       = ofs + 5,
   data set ready      = ofs + 6,
   request to send     = ofs + 7,
   clear to send       = ofs + 8,
   ring indicator      = ofs + 9,
   upb rs232           = ofs + 9;

RSTWOTHREETWO rs232 bits := 2r10000000; # up to bits width, OR #
print(("received data: ",received data ELEM rs232bits, new line));

rs232 bits := bits pack((FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE));
print(("received data: ",received data ELEM rs232bits, new line))


struct RS232_data
{
  unsigned carrier_detect        : 1;
  unsigned received_data         : 1;
  unsigned transmitted_data      : 1;
  unsigned data_terminal_ready   : 1;
  unsigned signal_ground         : 1;
  unsigned data_set_ready        : 1;
  unsigned request_to_send       : 1;
  unsigned clear_to_send         : 1;
  unsigned ring_indicator        : 1;
};


fcn medianFilter(img){  //-->new image
   var [const] window=[-2..2].walk(), edge=(window.len()/2);  // 5x5 window

   MX,MY,new := img.w,img.h,PPM(MX,MY);
   pixel,pixels:=List(),List();
   foreach x,y in ([edge..MX-edge-1],[edge..MY-edge-1]){
      pixels.clear();
      foreach ox,oy in (window,window){   // construct sorted list as pixels are read.
	 pixels.merge(pixel.clear(img[x+ox, y+oy]));    // merge sort two lists
      }
      new[x,y]=pixels[4];  // median value
   }
   new
}


*buffer=AllocateMemory(20)

*newBuffer = ReAllocateMemory(*buffer, 2000) ;increase size of buffer
;*buffer value is still valid if newBuffer wasn't able to be reallocated
If *newBuffer <> 0
  *buffer = *newBuffer : *newBuffer = 0
EndIf

FreeMemory(*buffer)

size=20
; allocate an image for use with image functions
CreateImage(1,size,size)
FreeImage(1)


>>> from array import array
>>> argslist = [('l', []), ('c', 'hello world'), ('u', u'hello \u2641'),
	('l', [1, 2, 3, 4, 5]), ('d', [1.0, 2.0, 3.14])]
>>> for typecode, initializer in argslist:
	a = array(typecode, initializer)
	print a
	del a

array('l')
array('c', 'hello world')
array('u', u'hello \u2641')
array('l', [1, 2, 3, 4, 5])
array('d', [1.0, 2.0, 3.1400000000000001])
>>>


#include <iomanip>
#include <iostream>
#include <vector>

std::vector<int> mertens_numbers(int max) {
    std::vector<int> m(max + 1, 1);
    for (int n = 2; n <= max; ++n) {
        for (int k = 2; k <= n; ++k)
            m[n] -= m[n / k];
    }
    return m;
}

int main() {
    const int max = 1000;
    auto m(mertens_numbers(max));
    std::cout << "First 199 Mertens numbers:\n";
    for (int i = 0, column = 0; i < 200; ++i) {
        if (column > 0)
            std::cout << ' ';
        if (i == 0)
            std::cout << "  ";
        else
            std::cout << std::setw(2) << m[i];
        ++column;
        if (column == 20) {
            std::cout << '\n';
            column = 0;
        }
    }
    int zero = 0, cross = 0, previous = 0;
    for (int i = 1; i <= max; ++i) {
        if (m[i] == 0) {
            ++zero;
            if (previous != 0)
                ++cross;
        }
        previous = m[i];
    }
    std::cout << "M(n) is zero " << zero << " times for 1 <= n <= 1000.\n";
    std::cout << "M(n) crosses zero " << cross << " times for 1 <= n <= 1000.\n";
    return 0;
}


module controlFieldsInStruct;

import tango.core.BitArray;
import tango.io.Stdout;
import tango.text.convert.Integer;

class RS232Wrapper(int Length = 9)
{
    static assert(Length == 9 || Length == 25, "ERROR, wrong type");
    BitArray ba;
    static uint[char[]] _map;

    public:

    static if (Length == 9) {
        static this() {
            _map = [ cast(char[])
                "CD"  : 1, "RD"  : 2, "TD"  : 3, "DTR" : 4, "SG"  : 5,
                "DSR" : 6, "RTS" : 7, "CTS" : 8, "RI"  : 9
            ];
        }
    } else {
        static this() {
            _map = [ cast(char[])
                "PG"  : 1u, "TD"  :  2, "RD"  :  3, "RTS" :  4, "CTS" :  5,
                "DSR" :  6, "SG"  :  7, "CD"  :  8, "+"   :  9, "-"   : 10,
                "SCD" : 12, "SCS" : 13, "STD" : 14, "TC"  : 15, "SRD" : 16,
                "RC"  : 17, "SRS" : 19, "DTR" : 20, "SQD" : 21, "RI"  : 22,
                "DRS" : 23, "XTC" : 24
            ];
        }
    }

    this() {
        ba.length = Length;
    }

    bool opIndex(uint pos) { return ba[pos]; }
    bool opIndexAssign(bool b, uint pos) { return (ba[pos] = b); }
    bool opIndex(char[] name) {
        assert (name in _map, "don't know that plug: " ~ name);
        return opIndex(_map[name]);
    }
    bool opIndexAssign(bool b, char[] name) {
        assert (name in _map, "don't know that plug: " ~ name);
        return opIndexAssign(b, _map[name]);
    }
    void opSliceAssign(bool b) { foreach (ref r; ba) r = b; }
    char[] toString() {
        char[] ret = "[";
        foreach (name, value; _map)
            ret ~= name ~ ":" ~ (ba[value]?"1":"0") ~", ";
        ret ~= "]";
        return ret;
    }
}

int main(char[][] args)
{
    auto ba = new RS232Wrapper!(25);

    // set all bits
    ba[] = 1;
    ba["RD"] = 0;
    ba[5] = 0;

    Stdout (ba).newline;

    return 0;
}


x=numeric(10)  # allocate a numeric vector of size 10 to x
rm(x)  # remove x

x=vector("list",10) #allocate a list of length 10
x=vector("numeric",10) #same as x=numeric(10), space allocated to list vector above now freed
rm(x)  # remove x


#lang racket
(collect-garbage) ; This function forces a garbage collection

(current-memory-use) ;Gives an estimate on the memory use based on the last garbage collection

(custodian-require-memory <limit-custodian>
                          <amount>
                          <stop-custodian>) ; Registers a check on required memory for the <limit-custodian>
                                            ; If amount of bytes can't be reached, <stop-custodian> is shutdown

(custodian-limit-memory <custodian> <amount>) ; Register a limit on memory for the <custodian>


display total memory available

~~~
EOM n:put
~~~

display unused memory

~~~
EOM here - n:put
~~~

display next free address

~~~
here n:put
~~~

allocate 1000 cells

~~~
#1000 allot
~~~

free 500 cells

~~~
#-500 allot
~~~


Axtec_god.3='Quetzalcoatl ("feathered serpent"), god of learning, civilization, regeneration, wind and storms'


cVar = "     "  # create variable contains string of 5 bytes
cVar = NULL     # destroy the 5 bytes string !


% Generate Mertens numbers up to a given limit
mertens = proc (limit: int) returns (array[int])
    M: array[int] := array[int]$fill(1,limit,0)
    M[1] := 1
    for n: int in int$from_to(2,limit) do
        M[n] := 1
        for k: int in int$from_to(2,n) do
            M[n] := M[n] - M[n/k]
        end
    end
    return (M)
end mertens

start_up = proc ()
    max = 1000

    po: stream := stream$primary_output()
    M: array[int] := mertens(max)

    stream$putl(po, "The first 99 Mertens numbers are:")
    for y: int in int$from_to_by(0,90,10) do
        for x: int in int$from_to(0,9) do
            stream$putright(po, int$unparse(M[x+y]), 3)
            except when bounds:
                stream$putright(po, "", 3)
            end
        end
        stream$putl(po, "")
    end

    eqz: int := 0
    crossz: int := 0
    for i: int in int$from_to(2,max) do
        if M[i]=0 then
            eqz := eqz + 1
            if M[i-1]~=0 then crossz := crossz + 1 end
        end
    end

    stream$putl(po, "M(N) is zero " || int$unparse(eqz) || " times.")
    stream$putl(po, "M(N) crosses zero " || int$unparse(crossz) || " times.")
end start_up


       IDENTIFICATION DIVISION.
       PROGRAM-ID.  MERTENS.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 VARIABLES.
          03 M             PIC S99 OCCURS 1000 TIMES.
          03 N             PIC 9(4).
          03 K             PIC 9(4).
          03 V             PIC 9(4).
          03 IS-ZERO       PIC 99 VALUE 0.
          03 CROSS-ZERO    PIC 99 VALUE 0.

       01 OUTPUT-FORMAT.
          03 OUT-ITEM.
             05 OUT-NUM    PIC -9.
             05 FILLER     PIC X VALUE SPACE.
          03 OUT-LINE      PIC X(30) VALUE SPACES.
          03 OUT-PTR       PIC 99 VALUE 4.

       PROCEDURE DIVISION.
       BEGIN.
           PERFORM GENERATE-MERTENS.
           PERFORM WRITE-TABLE.
           PERFORM COUNT-ZEROES.
           STOP RUN.

       GENERATE-MERTENS.
           MOVE 1 TO M(1).
           PERFORM MERTENS-OUTER-LOOP VARYING N FROM 2 BY 1
               UNTIL N IS GREATER THAN 1000.

       MERTENS-OUTER-LOOP.
           MOVE 1 TO M(N).
           PERFORM MERTENS-INNER-LOOP VARYING K FROM 2 BY 1
               UNTIL K IS GREATER THAN N.

       MERTENS-INNER-LOOP.
           DIVIDE N BY K GIVING V.
           SUBTRACT M(V) FROM M(N).

       WRITE-TABLE.
           DISPLAY "The first 99 Mertens numbers are: "
           PERFORM WRITE-ITEM VARYING N FROM 1 BY 1
               UNTIL N IS GREATER THAN 99.

       WRITE-ITEM.
           MOVE M(N) TO OUT-NUM.
           STRING OUT-ITEM DELIMITED BY SIZE INTO OUT-LINE
               WITH POINTER OUT-PTR.
           IF OUT-PTR IS EQUAL TO 31,
               DISPLAY OUT-LINE,
               MOVE 1 TO OUT-PTR.

       COUNT-ZEROES.
           PERFORM TEST-N-ZERO VARYING N FROM 2 BY 1
               UNTIL N IS GREATER THAN 1000.
           DISPLAY "M(N) is zero " IS-ZERO " times.".
           DISPLAY "M(N) crosses zero " CROSS-ZERO " times.".

       TEST-N-ZERO.
           IF M(N) IS EQUAL TO ZERO,
               ADD 1 TO IS-ZERO,
               SUBTRACT 1 FROM N GIVING K,
               IF M(K) IS NOT EQUAL TO ZERO,
                   ADD 1 TO CROSS-ZERO.


 : masks ( n -- ) 0 do 1 i lshift constant loop ;

 9 masks DCD RxD TxD DTR SG DSR RTS CTS RI


       TYPE RS232PIN9
        LOGICAL CARRIER_DETECT		!1
        LOGICAL RECEIVED_DATA		!2
        LOGICAL TRANSMITTED_DATA	!3
        LOGICAL DATA_TERMINAL_READY	!4
        LOGICAL SIGNAL_GROUND		!5
        LOGICAL DATA_SET_READY		!6
        LOGICAL REQUEST_TO_SEND		!7
        LOGICAL CLEAR_TO_SEND		!8
        LOGICAL RING_INDICATOR		!9
       END TYPE RS232PIN9


program rs232(input, output, stdErr);
type
	{$packEnum 2}{$scopedEnums off}
	pin = (carrierDetect, receivedData, transmittedData, dataTerminalReady,
		signalGround, dataSetReady, requestToSend, clearToSend, ringIndicator);
	{$packSet 2}
	pins = set of pin;
var
	signal: pins;
	// for demonstration purposes, in order to reveal the memory layout
	signalMemoryStructure: word absolute signal;
	{$if sizeOf(signal) <> sizeOf(word)} // just as safe-guard
		{$fatal signal size}
	{$endIf}
begin
	signal := [];
	include(signal, signalGround); // equivalent to signal := signal + [signalGround];
	// for demonstration purposes: obviously we know this is always `true`
	if signalGround in signal then
	begin
		writeLn(binStr(signalMemoryStructure, bitSizeOf(signal)));
	end;
end.


' FB 1.05.0 Win64

' using bit fields
Type RS232_Pin9
  carrierDetect     : 1 As UByte
  receivedData      : 1 As UByte
  transmittedData   : 1 As UByte
  dataTerminalReady : 1 As UByte
  signalGround      : 1 As UByte
  dataSetReady      : 1 As UByte
  requestToSend     : 1 As UByte
  clearToSend       : 1 As UByte
  ringIndicator     : 1 As UByte
End Type

Print SizeOf(RS232_Pin9)  '' 2 bytes
Sleep


class Thingamajig
  def initialize
    fail 'not yet implemented'
  end
end
t = Thingamajig.allocate


// we have to use `unsafe` here because
// we will be dereferencing a raw pointer
unsafe {
    use std::alloc::{Layout, alloc, dealloc};
    // define a layout of a block of memory
    let int_layout = Layout::new::<i32>();

    // memory is allocated here
    let ptr = alloc(int_layout);

    // let us point to some data
    *ptr = 123;
    assert_eq!(*ptr, 123);

    // deallocate `ptr` with associated layout `int_layout`
    dealloc(ptr, int_layout);
}


handle := ExternalBytes new:size
...
handle free


newstring = "This is creating and saving" " a new single string " "starting with three separate strings."