Pörssärin JSON-datan koodaaminen bitteinä ja purkaminen takaisin kytkentäajoiksi

J

jalih

Jäsen
Toteutin 8th ohjelmointikielellä pörssärin JSON-datan koodaamisen bitteinä ja purkamisen takaisin kytkentäajoiksi. Oli kohtuullisen "viihdyttävä" tehtävä, kun piti huomioda aikavyöhyke ja mahdolliset kellojen siirtelyt. Lisäksi Pörssäri antaa vain tilamuutokset ja tarvittavat puuttuvat tilamuutokset vuorokauden vaihteessa piti muodostaa ja lisätä itse. Onneksi sentään 8th laskee isoilla luvuilla suoraan.

Käyttääkö kukaan muu bittikoodausta?

Koodi: 
needs stack/rstack
needs date/utils
needs date/daylight

: zerotime  \ dst-zone d -- d
  "%Y-%M-%DT00:00:00" swap d:format d:parse tuck d:dst-ofs d:tzadjust ;

: dayhours?  \ dst-zone d -- n
  zerotime dup>r d:year@ 10 31 d:ymd> d:Sun d:prev-dow d:= if
    25
  else
    r@ d:year@ 03 31 d:ymd> d:Sun d:prev-dow d:= if
      23
    else
      24
    then
  then rdrop ;

: unix>n0  \ n dst-zone -- n
  dup>r swap d:unix> dup d:>msec "%Y-%M-%DT00:00:00" rot d:format d:parse _swap tuck d:dst-ofs d:tzadjust
  tuck d:>msec n:- 1000 n:/ n:int
  60 n:/mod 15 n:/mod -rot 60 n:* n:+
  810 n:< !if n:1+ then r> rot dayhours? 2 n:shl n:mod ;

: unix>n  \ n dst-zone -- n
  swap d:unix> dup d:>msec "%Y-%M-%DT00:00:00" rot d:format d:parse _swap tuck d:dst-ofs d:tzadjust
  d:>msec n:- 1000 n:/ n:int
  60 n:/mod 15 n:/mod -rot 60 n:* n:+
  810 n:< !if n:1+ then ;

: n>d  \ n dst-zone d -- d
  repeat 
    2dup d:dst-ofs d:tzadjust 2dup dayhours? 2 n:shl dup>r 3 roll swap n:/mod 
    dup if
      dup n:1- r> n:* rot n:+ swap 
      >r swap d:>ymd r> if
        n:1+
      then
      3 a:close "%04d-%02d-%02dT00:00:00" s:strfmt d:parse
    else
      rdrop swap rot d:>ymd 3 roll 15 n:* 60 n:/mod swap 0 6 a:close d:join
    then

   _swap 2 pick 
  while! 2nip ;

: sequential-bits?  \ a -- a
  0 >r a:new swap
  repeat
    a:len n:1- r@ n:> !if
      rdrop break
    else
      r@ n:1+ a:@ n:1- swap r@ a:@ rot n:= !if
        r> n:1+ a:/ _swap a:push swap
        0 >r
      else
        1 n:r+
      then
    then
  again a:push ;

: msb?  \ n -- msb
  n:ln 2 n:ln n:/ n:int ;

: decode  \ n -- a
  a:new
  ( 2 pick 1 n:band if
      a:push
    else
      drop
    then
    swap 1 bint n:shr swap
  ) 0 3 pick msb? loop nip ;

: encode  \ a -- n
  0 bint swap ( 1 bint swap n:shl n:bor ) a:each! drop ;

: is-bit-set?  \ n n -- T
  1 bint swap n:shl n:band ;

: set-bit  \ n n -- n
  1 bint swap n:shl n:bor ;

: remove-bit  \ n n -- n
  1 bint swap n:shl n:bnot n:band ;
        
: pörssari>  \ m dst-zone -- a
  >r "metadata" m:@ "timestamp" m:_@ swap "controls" m:_@ a:len !if
    2drop rdrop null ;; 
  then

  ( "state" m:@ >n swap "schedules" m:_@ swap dup if
    2 a:close [ "timestamp", "state" ] swap m:zip a:push
  else
    drop
  then
  ( "timestamp" m:_@ >n d:unix> r@ swap zerotime d:>unix ) a:group
  ( nip ( "timestamp" m:_@ >n swap "timestamp" m:_@ >n n:cmp n:neg ) a:sort ) m:map 
  m:keys ( >n swap >n n:cmp n:neg ) a:sort 
  ( m:@ 0 a:@ "state" m:@ >n !if
    "timestamp" m:_@ >n d:unix> r@ swap zerotime
    d:>unix 1 2 a:close [ "timestamp", "state" ] swap m:zip a:slide 
  else
    drop
  then
  -1 a:@ "state" m:@ >n if
    "timestamp" m:_@ >n d:unix> r@ swap tuck dayhours? 
    2 n:shl r@ rot n>d d:>unix 0 2 a:close [ "timestamp", "state" ] swap m:zip a:push
  else 
    drop
  then
  drop ) a:each! drop

  ( nip ( "timestamp" m:@ >n r@ 3 roll if unix>n else unix>n0 then "timestamp" m:_! drop ) a:each  ) m:map 

  ( nip ( [1,0] a:_@ a:open "state" m:@ >n if
    "timestamp" m:_@ swap ["timestamp", "state"] m:_@ a:open !if n:1- then ' noop -rot a:generate
  else
    2drop a:new
  then ) 2 1 a:map+ a:squash encode ) m:map

  m:keys ( >n swap >n n:cmp n:neg ) a:sort 0 >r
  ( tuck m:@ r@ n:shl 2 pick >n d:unix> 1 rpick swap dayhours? 2 n:shl n:r+ rot m:_! ) a:each! drop
  m:vals nip ' n:bor 0 a:reduce rdrop ) a:map nip rdrop ;

: >d  \ n dst-zone d    -- a
  rot decode sequential-bits? ( [0,-1] a:_@ 1 ' n:1+ a:op! ( 2 pick 2 pick n>d ) a:map ) a:map 2nip ;


\ Sample data
{
  "metadata": {
    "mac": "XXXXXXXXXXXX",
    "channels": "1",
    "fetch_url": "https://api.porssari.fi/getcontrols.php",
    "timestamp": "1741798048",
    "timestamp_offset": "7200",
    "valid_until": "1741902300"
  },
  "controls": [
    {
      "id": "1",
      "name": "LVV",
      "updated": "1740313870",
      "state": "0",
      "schedules": [
        {
          "timestamp": "1741827683",
          "state": "1"
        },
        {
          "timestamp": "1741838460",
          "state": "0"
        }
      ]
    }
  ]
} constant data


: app:main 
  \ Parse and encode time periods as bits (bint):
  data "Europe/Helsinki" pörssari> dup . cr cr

  \ Decode and display time periods for the first channel:
  0 a:_@ "Europe/Helsinki" data "$.metadata.timestamp" json@ drop nip >n d:unix>
  >d ( "%s - %s\n" s:strfmt . ) a:each! drop ;

Testiohjelma tulostaa:
Koodi: 
[16773120]

2025-03-12T03:00:00+02:00 - 2025-03-12T06:00:00+02:00
 
  • Tykkää
Reactions: tk-
J

jalih

Jäsen
  • Keskustelun aloittaja
  • #2
Yksinkertaistin vähän ja "pörssäri>" sana palauttaa nyt kaksi taulukkoa. Ensimmäisessä taulukossa on bigint lukuina kanavien ohjaukset koodattuna bitteinä ja toisessa taulukossa on vastaavalla indeksillä Unix-aikaleima vuorokauden alusta. Näin ei hukata tietoa ja kanavan ohjauksien purkaminen on helppoa.
Koodi: 
needs stack/rstack
needs date/utils
needs date/daylight

: unix>
  swap d:unix> tuck d:dst-ofs d:tzadjust d:/ d:join ;

: zerotime  \ dst-zone d -- d
  "%Y-%M-%DT00:00:00" swap d:format d:parse tuck d:dst-ofs d:tzadjust ;

: dayhours?  \ dst-zone d -- n
  zerotime dup>r d:year@ 10 31 d:ymd> d:Sun d:prev-dow d:= if
    25
  else
    r@ d:year@ 03 31 d:ymd> d:Sun d:prev-dow d:= if
      23
    else
      24
    then
  then rdrop ;

: unix>n0  \ n dst-zone -- n
  dup>r swap d:unix> dup d:>msec "%Y-%M-%DT00:00:00" rot d:format d:parse _swap tuck d:dst-ofs d:tzadjust
  tuck d:>msec n:- 1000 n:/ n:int
  60 n:/mod 15 n:/mod -rot 60 n:* n:+
  810 n:< !if n:1+ then r> rot dayhours? 2 n:shl n:mod ;

: unix>n  \ n dst-zone -- n
  swap d:unix> dup d:>msec "%Y-%M-%DT00:00:00" rot d:format d:parse _swap tuck d:dst-ofs d:tzadjust
  d:>msec n:- 1000 n:/ n:int
  60 n:/mod 15 n:/mod -rot 60 n:* n:+
  810 n:< !if n:1+ then ;

: n>d  \ n dst-zone d -- d
  repeat
    2dup d:dst-ofs d:tzadjust 2dup dayhours? 2 n:shl dup>r 3 roll swap n:/mod
    dup if
      dup n:1- r> n:* rot n:+ swap
      >r swap d:>ymd r> if
        n:1+
      then
      3 a:close "%04d-%02d-%02dT00:00:00" s:strfmt d:parse
    else
      rdrop swap rot d:>ymd 3 roll 15 n:* 60 n:/mod swap 0 6 a:close d:join
    then _swap 2 pick
  while! 2nip ;

: sequential-bits?  \ a -- a
  0 >r a:new swap
  repeat
    a:len n:1- r@ n:> !if
      rdrop break
    else
      r@ n:1+ a:@ n:1- swap r@ a:@ rot n:= !if
        r> n:1+ a:/ _swap a:push swap
        0 >r
      else
        1 n:r+
      then
    then
  again a:push ;

: msb?  \ n -- msb
  n:ln 2 n:ln n:/ n:int ;

: decode  \ n -- a
  a:new
  ( 2 pick 1 n:band if
      a:push
    else
      drop
    then
    swap 1 bint n:shr swap
  ) 0 3 pick msb? loop nip ;

: encode  \ a -- n
  0 bint swap ( 1 bint swap n:shl n:bor ) a:each! drop ;

: is-bit-set?  \ n n -- T
  1 bint swap n:shl n:band ;

: set-bit  \ n n -- n
  1 bint swap n:shl n:bor ;

: remove-bit  \ n n -- n
  1 bint swap n:shl n:bnot n:band ;
       
: pörssari>  \ m dst-zone -- a a
  >r "metadata" m:@ "timestamp" m:_@ >n swap "controls" m:_@ a:len !if
    drop rdrop null ;;
  then
 
  a:new swap

  ( "schedules" m:_@
  ( "timestamp" m:_@ >n d:unix> r@ swap zerotime d:>unix ) a:group
  ( nip ( "timestamp" m:_@ >n swap "timestamp" m:_@ >n n:cmp n:neg ) a:sort ) m:map
  m:keys ( >n swap >n n:cmp n:neg ) a:sort
  ( m:@ 0 a:@ "state" m:@ >n !if
    "timestamp" m:_@ >n dup 5 pick n:> !if
      d:unix> r@ swap zerotime d:>unix
    else
      drop 3 pick
    then
    1 2 a:close [ "timestamp", "state" ] swap m:zip a:slide
  else
    drop
  then
  -1 a:@ "state" m:@ >n if
    "timestamp" m:_@ >n d:unix> r@ swap tuck dayhours?
    2 n:shl r@ rot n>d d:>unix 0 2 a:close [ "timestamp", "state" ] swap m:zip a:push
  else
    drop
  then
  drop ) a:each! 0 a:_@ 2 pick swap a:push drop 

  ( nip ( "timestamp" m:@ >n r@ 3 roll if unix>n else unix>n0 then "timestamp" m:_! drop ) a:each  ) m:map

  ( nip ( [1,0] a:_@ a:open "state" m:@ >n if
    "timestamp" m:_@ swap ["timestamp", "state"] m:_@ a:open !if n:1- then ' noop -rot a:generate
  else
    2drop a:new
  then ) 2 1 a:map+ a:squash encode ) m:map rot drop

  m:keys ( >n swap >n n:cmp n:neg ) a:sort 0 >r
  ( tuck m:@ r@ n:shl 2 pick >n d:unix> 1 rpick swap dayhours? 2 n:shl n:r+ rot m:_! ) a:each! drop
  m:vals nip ' n:bor 0 a:reduce rdrop ) a:map rdrop ;

: >d  \ n dst-zone d    -- a
  rot decode sequential-bits? ( [0,-1] a:_@ 1 ' n:1+ a:op! ( 2 pick 2 pick n>d ) a:map ) a:map 2nip ;


{
  "metadata": {
    "mac": "XXXXXXXXXXXX",
    "channels": "1",
    "fetch_url": "https://api.porssari.fi/getcontrols.php",
    "timestamp": "1741954890",
    "timestamp_offset": "7200",
    "valid_until": "1741988700"
  },
  "controls": [
    {
      "id": "1",
      "name": "LVV",
      "updated": "1740313870",
      "state": "1",
      "schedules": [
        {
          "timestamp": "1741960733",
          "state": "0"
        },
        {
          "timestamp": "1741986003",
          "state": "1"
        }
      ]
    }
  ]
} constant data


: app:main
  \ Parse and encode time periods as bits (bint):
  data "Europe/Helsinki" pörssari>

  \ Decode and display time periods for all the channels:
  ( rot n:1+ "Channel %d:\n\n" s:strfmt .
    "Europe/Helsinki" rot >n null? !if
      over unix> >d ( "%s - %s\n" s:strfmt . ) a:each! drop cr
    else
      drop
    then
  ) a:2each 2drop ;

Esimerkkiohjelma tulostaa:
Koodi: 
Channel 1:

2025-03-14T14:15:00+02:00 - 2025-03-14T16:00:00+02:00
2025-03-14T23:00:00+02:00 - 2025-03-15T00:00:00+02:00
 
Viimeksi muokattu:
T

tk-

Aktiivinen jäsen
jalih sanoi:
Yksinkertaistin vähän ja "pörssäri>" sana palauttaa nyt kaksi taulukkoa. Ensimmäisessä taulukossa on bigint lukuina kanavien ohjaukset koodattuna bitteinä ja toisessa taulukossa on vastaavalla indeksillä Unix-aikaleima vuorokauden alusta. Näin ei hukata tietoa ja kanavan ohjauksien purkaminen on helppoa.
Koodi: 
needs stack/rstack
needs date/utils
needs date/daylight

: unix>
  swap d:unix> tuck d:dst-ofs d:tzadjust d:/ d:join ;

: zerotime  \ dst-zone d -- d
  "%Y-%M-%DT00:00:00" swap d:format d:parse tuck d:dst-ofs d:tzadjust ;

: dayhours?  \ dst-zone d -- n
  zerotime dup>r d:year@ 10 31 d:ymd> d:Sun d:prev-dow d:= if
    25
  else
    r@ d:year@ 03 31 d:ymd> d:Sun d:prev-dow d:= if
      23
    else
      24
    then
  then rdrop ;

: unix>n0  \ n dst-zone -- n
  dup>r swap d:unix> dup d:>msec "%Y-%M-%DT00:00:00" rot d:format d:parse _swap tuck d:dst-ofs d:tzadjust
  tuck d:>msec n:- 1000 n:/ n:int
  60 n:/mod 15 n:/mod -rot 60 n:* n:+
  810 n:< !if n:1+ then r> rot dayhours? 2 n:shl n:mod ;

: unix>n  \ n dst-zone -- n
  swap d:unix> dup d:>msec "%Y-%M-%DT00:00:00" rot d:format d:parse _swap tuck d:dst-ofs d:tzadjust
  d:>msec n:- 1000 n:/ n:int
  60 n:/mod 15 n:/mod -rot 60 n:* n:+
  810 n:< !if n:1+ then ;

: n>d  \ n dst-zone d -- d
  repeat
    2dup d:dst-ofs d:tzadjust 2dup dayhours? 2 n:shl dup>r 3 roll swap n:/mod
    dup if
      dup n:1- r> n:* rot n:+ swap
      >r swap d:>ymd r> if
        n:1+
      then
      3 a:close "%04d-%02d-%02dT00:00:00" s:strfmt d:parse
    else
      rdrop swap rot d:>ymd 3 roll 15 n:* 60 n:/mod swap 0 6 a:close d:join
    then _swap 2 pick
  while! 2nip ;

: sequential-bits?  \ a -- a
  0 >r a:new swap
  repeat
    a:len n:1- r@ n:> !if
      rdrop break
    else
      r@ n:1+ a:@ n:1- swap r@ a:@ rot n:= !if
        r> n:1+ a:/ _swap a:push swap
        0 >r
      else
        1 n:r+
      then
    then
  again a:push ;

: msb?  \ n -- msb
  n:ln 2 n:ln n:/ n:int ;

: decode  \ n -- a
  a:new
  ( 2 pick 1 n:band if
      a:push
    else
      drop
    then
    swap 1 bint n:shr swap
  ) 0 3 pick msb? loop nip ;

: encode  \ a -- n
  0 bint swap ( 1 bint swap n:shl n:bor ) a:each! drop ;

: is-bit-set?  \ n n -- T
  1 bint swap n:shl n:band ;

: set-bit  \ n n -- n
  1 bint swap n:shl n:bor ;

: remove-bit  \ n n -- n
  1 bint swap n:shl n:bnot n:band ;
       
: pörssari>  \ m dst-zone -- a a
  >r "controls" m:_@ a:len !if
    drop rdrop null ;;
  then
 
  a:new swap

  ( "schedules" m:_@
  ( "timestamp" m:_@ >n d:unix> r@ swap zerotime d:>unix ) a:group
  ( nip ( "timestamp" m:_@ >n swap "timestamp" m:_@ >n n:cmp n:neg ) a:sort ) m:map
  m:keys ( >n swap >n n:cmp n:neg ) a:sort
  ( m:@ 0 a:@ "state" m:@ >n !if
    "timestamp" m:_@ >n d:unix> r@ swap zerotime
    d:>unix 1 2 a:close [ "timestamp", "state" ] swap m:zip a:slide
  else
    drop
  then
  -1 a:@ "state" m:@ >n if
    "timestamp" m:_@ >n d:unix> r@ swap tuck dayhours?
    2 n:shl r@ rot n>d d:>unix 0 2 a:close [ "timestamp", "state" ] swap m:zip a:push
  else
    drop
  then
  drop ) a:each! 0 a:_@ 2 pick swap a:push drop 

  ( nip ( "timestamp" m:@ >n r@ 3 roll if unix>n else unix>n0 then "timestamp" m:_! drop ) a:each  ) m:map

  ( nip ( [1,0] a:_@ a:open "state" m:@ >n if
    "timestamp" m:_@ swap ["timestamp", "state"] m:_@ a:open !if n:1- then ' noop -rot a:generate
  else
    2drop a:new
  then ) 2 1 a:map+ a:squash encode ) m:map

  m:keys ( >n swap >n n:cmp n:neg ) a:sort 0 >r
  ( tuck m:@ r@ n:shl 2 pick >n d:unix> 1 rpick swap dayhours? 2 n:shl n:r+ rot m:_! ) a:each! drop
  m:vals nip ' n:bor 0 a:reduce rdrop ) a:map rdrop ;

: >d  \ n dst-zone d    -- a
  rot decode sequential-bits? ( [0,-1] a:_@ 1 ' n:1+ a:op! ( 2 pick 2 pick n>d ) a:map ) a:map 2nip ;


{
  "metadata": {
    "mac": "XXXXXXXXXXXX",
    "channels": "1",
    "fetch_url": "https://api.porssari.fi/getcontrols.php",
    "timestamp": "1741615908",
    "timestamp_offset": "7200",
    "valid_until": "1741729500"
  },
  "controls": [
    {
      "id": "1",
      "name": "LVV",
      "updated": "1740313870",
      "state": "0",
      "schedules": [
        {
          "timestamp": "1741640383",
          "state": "1"
        },
        {
          "timestamp": "1741647633",
          "state": "0"
        },
        {
          "timestamp": "1741658416",
          "state": "1"
        },
        {
          "timestamp": "1741665591",
          "state": "0"
        }
      ]
    }
  ]
} constant data


: app:main
  \ Parse and encode time periods as bits (bint):
  data "Europe/Helsinki" pörssari>

  \ Decode and display time periods for all the channels:
  ( rot n:1+ "Channel %d:\n\n" s:strfmt .
    "Europe/Helsinki" rot >n null? !if
      over unix> >d ( "%s - %s\n" s:strfmt . ) a:each! drop cr
    else
      drop
    then
  ) a:2each 2drop ;

Esimerkkiohjelma tulostaa:
Koodi: 
Channel 1:

2025-03-10T23:00:00+02:00 - 2025-03-11T01:00:00+02:00
2025-03-11T04:00:00+02:00 - 2025-03-11T06:00:00+02:00
Klikkaa laajentaaksesi..
Hienoa työtä kyllä!

Rajapinnasta tosiaan saadaan tarvittaessa pihalle tietoa ihan minkälaisena JSON-datana tahansa, ohjausdata on palvelimella jokaiselle vartille 0/1 -muodossa. Randomointiluku on siinä taulussa erillisenä, eli aikaleimat saa tarvittaessa pihalle tasavartteina, tai sitten sillä randomoinnilla ohjattuna. Eli sinällään mikä vaan loppulaitteen päässä on helpoin, niin serveri kyllä taipuu monenlaiseen ohjaustietoon.
 
Sinun on kirjauduttava sisään tai rekisteröityä kirjoittaaksesi tänne.
Back
Ylös Bottom