Insight network: Difference between revisions

From Opasnet
Jump to navigation Jump to search
mNo edit summary
 
(33 intermediate revisions by the same user not shown)
Line 36: Line 36:


gr <- makeInsightGraph(graphTable) # Creates a DiagrammeR graph object
gr <- makeInsightGraph(graphTable) # Creates a DiagrammeR graph object
ui <- makeUi() # Shiny user interface


shinyApp(ui, server)
shinyApp(ui, server)
Line 49: Line 47:


=== Process ===
=== Process ===
{| {{prettytable}}
|+ '''The parameters of an argument and possible combinations.
|----
! Id
! Title
! Content
! Sign
! Target
! Type
! Paradigm
! Relation
! Result
! Comment
|----
| arg1234
| Short title for display
| Actual argument
| Signature
| arg9876
| relevance
| science
| attack
| 1
| If paradigm changes (all else equal), relation may change, although typically only the result changes.
|----
| arg1234
| Short title for display
| Actual argument
| Signature
| arg5555
| relevance
| science
| comment
| 0
|
|----
| arg1234
| Short title for display
| Actual argument
| Signature
| arg6666
| truth
| science
| defense
| 1
| Truth refers to the truth of the target
|----
| arg1234
| Short title for display
| Actual argument
| Signature
| arg1234
| selftruth
| science
| attack
| 0
| Selftruth refers to the truth of the argument itself, unlike other types that refer to the target.
|----
| arg1234
| Short title for display
| Actual argument
| Signature
| arg9876
| relevance
| toldya
| comment
| 0
|
|----
| arg1234
| Short title for display
| Actual argument
| Signature
| arg5555
| relevance
| toldya
| defense
| 1
|
|----
| arg1234
| Short title for display
| Actual argument
| Signature
| arg6666
| truth
| toldya
| attack
| 0
|
|----
| arg1234
| Short title for display
| Actual argument
| Signature
| arg1234
| selftruth
| toldya
| comment
| 1
| The relation in case of type=selftruth is irrelevant and is ignored.
|----
| {{yes|}}
| {{yes|}}
| {{yes|}}
| {{yes|}}
|
|
|
|
|
| These are unique to an argument
|----
|
|
|
|
| {{yes|}}
| {{yes|}}
|
|
|
| These are unique to an argument-target pair
|----
|
|
|
|
|
|
| {{yes|}}
| {{yes|}}
| {{yes|}}
| These are unique to a triple of argument-target-paradigm
|----
|}


:''Insight networks have been described in a scientific article manuscript [[From open assessment to shared understanding: practical experiences#Insight networks]]. Objects and their relations used in [[open policy practice]] are described on page [[Open policy ontology]].
:''Insight networks have been described in a scientific article manuscript [[From open assessment to shared understanding: practical experiences#Insight networks]]. Objects and their relations used in [[open policy practice]] are described on page [[Open policy ontology]].
Line 192: Line 53:


These diagrams use graph theory with vertices (or nodes) and arcs (or arrows). They are used to describe and define all the pieces needed for a description of the situation under scrutiny. Diagrams may be produced with any graphics software, providing that calculation functions are not required. If calculations ''are'' needed, we recommend the use of [[R]] software and [[OpasnetUtils]] package.
These diagrams use graph theory with vertices (or nodes) and arcs (or arrows). They are used to describe and define all the pieces needed for a description of the situation under scrutiny. Diagrams may be produced with any graphics software, providing that calculation functions are not required. If calculations ''are'' needed, we recommend the use of [[R]] software and [[OpasnetUtils]] package.
{| {{prettytable}}
|+'''Parameter properties
! Parameter
! Css selector (Opasnet page scraping)
! Requirements
|----
| Id
| .argument attr=id
| Must start with a letter
|----
| Title
| .argument .title
| Short text. Is shown on insight graph as node label
|----
| Content
| .argument .content
| Text, may be long. Is shown with hover on graph
|----
| Sign
| .argument .sign a:first-of-type
| Must contain a link to participant's user page. Is shown with hover on graph
|----
| Target
| NA
| Previous argument one level up, or the statement for arguments on the first level
|----
| Type
| .argument i.type
| One of the three: relevance, truth, or selftruth (or "both", which is depreciated)
|----
| Paradigm
| .argument .paradigm
| Each paradigm should be described on a dedicated page. The rules implemented must be clear
|----
| Relation
| .argument .relation
| Is one of these: attack, defense, comment. "Branches" are typically uninteresting and ignored.
|----
| Result
|
* relevance= .argument .relation attr=color. Gray= 0 (irrelevant), other=1 (relevant).
* truth= .argument .relation attr=color. Gray=0 (untrue), other=1 (true)
* selftruth= .argument .selftruth attr=color. Gray=0 (untrue), other=1 (true)
| Truthlikeness of the relation. Either 1 or 0
|----
|}


This is the process how data flows into insight diagrams:
This is the process how data flows into insight diagrams:
Line 254: Line 68:
In the next phase, each csv file is opened, interpreted, and defined as items and relations. This is done in code Op_fi5810/graphs on page [[:op_fi:Ympäristöterveysindikaattori]]. All these are saved as a DiagrammeR graph, and each topic may be separately selected as a subgraph.
In the next phase, each csv file is opened, interpreted, and defined as items and relations. This is done in code Op_fi5810/graphs on page [[:op_fi:Ympäristöterveysindikaattori]]. All these are saved as a DiagrammeR graph, and each topic may be separately selected as a subgraph.
* {{argument|relat1=relevant attack|truth1=true|id=0094|type=|content=Are Tehtäväkokonaisuus, Osiotyyppi, JHS-luokka actually types of objects, or are they just indices. Yes, they should be indices and the objects relate to them with "has index". Correct table 4.|sign=--[[User:Jouni|Jouni]] ([[User talk:Jouni|talk]]) 20:46, 17 July 2018 (UTC)}}
* {{argument|relat1=relevant attack|truth1=true|id=0094|type=|content=Are Tehtäväkokonaisuus, Osiotyyppi, JHS-luokka actually types of objects, or are they just indices. Yes, they should be indices and the objects relate to them with "has index". Correct table 4.|sign=--[[User:Jouni|Jouni]] ([[User talk:Jouni|talk]]) 20:46, 17 July 2018 (UTC)}}
* {{argument|relat1=relevant attack|truth1=true|id=0095|type=|content=Check the code about renderging graphs and creating a server function that also works on non-web environments on [[:op_fi:Keskustelu:Näkemysverkko#Näkemysverkkoabstrakti vaikuttavuuden tutkimuksen päiville 4.-5.12.2018]]|sign=--[[User:Jouni|Jouni]] ([[User talk:Jouni|talk]]) 20:46, 17 July 2018 (UTC)}}


=== Data ===
=== Data ===
Line 261: Line 76:
<t2b name="Graphical properties of objects and relations" index="Property,Value,Parameter" obs="Result" desc="Description" unit="-">
<t2b name="Graphical properties of objects and relations" index="Property,Value,Parameter" obs="Result" desc="Description" unit="-">
default|default|node.shape|circle|Default values unless something else is specified
default|default|node.shape|circle|Default values unless something else is specified
default|default|node.style|filled|
default|default|node.sides|4|
default|default|node.sides|4|
default|default|node.skew|0|
default|default|node.skew|0|
Line 303: Line 119:
type|process|node.shape|pentagon|Process type object
type|process|node.shape|pentagon|Process type object
type|process|node.fillcolor|purple1|Process type object
type|process|node.fillcolor|purple1|Process type object
type|action|node.fillcolor|pink|Process type object
type|action|node.fillcolor|#009246|Process type object, dark green (0,146,70)
type|action|node.shape|rectangle|Decision type object
type|task 1|node.color|brown|Illustration of the responsible organisation of the task
type|task 1|node.color|brown|Illustration of the responsible organisation of the task
type|task 2|node.color|yellow|Illustration of the responsible organisation of the task
type|task 2|node.color|yellow|Illustration of the responsible organisation of the task
Line 309: Line 126:
type|task 4|node.color|green|Illustration of the responsible organisation of the task
type|task 4|node.color|green|Illustration of the responsible organisation of the task
type|task 5|node.color|red|Illustration of the responsible organisation of the task
type|task 5|node.color|red|Illustration of the responsible organisation of the task
type|decision|node.shape|rectangle|Decision type object
type|decision|node.fillcolor|red|Decision type object
type|decision|node.fillcolor|red|Decision type object
type|data|node.shape|rectangle|Data type object
type|data|node.shape|rectangle|Data type object
Line 323: Line 139:
type|true statement|node.fillcolor|gold|Argument type object
type|true statement|node.fillcolor|gold|Argument type object
type|false statement|node.fillcolor|gray|Argument type object
type|false statement|node.fillcolor|gray|Argument type object
type|fact opening statement|node.fillcolor|lightskyblue1|Argument type object
type|fact opening statement|node.fillcolor|lightskyblue1|Argument type object. Discussion start
type|value opening statement|node.fillcolor|palegreen1|Argument type object
type|value opening statement|node.fillcolor|palegreen1|Argument type object
type|fact closing statement|node.fillcolor|skyblue|Argument type object
type|fact closing statement|node.fillcolor|skyblue|Argument type object. Discussion end
type|value closing statement|node.fillcolor|springgreen|Argument type object
type|value closing statement|node.fillcolor|springgreen|Argument type object.
type|fact discussion|node.fillcolor|skyblue|Argument type object. Not neede?
type|fact discussion|node.fillcolor|skyblue|Argument type object. Not neede?
type|value discussion|node.fillcolor|springgreen|Value judgement type object. Not needed?
type|value discussion|node.fillcolor|springgreen|Value judgement type object. Not needed?
Line 332: Line 148:
type|indicator|node.color|brown|Additional information about object class
type|indicator|node.color|brown|Additional information about object class
type|indicator|node.fillcolor|gold|Additional information about object class
type|indicator|node.fillcolor|gold|Additional information about object class
type|operational indicator|node.fillcolor|#00d7a7|Additional information about object class light green (0,215,167)
type|tactical indicator|node.fillcolor|#9fc9eb|Additional information about object class light blue (159,201,235)
type|strategic indicator|node.fillcolor|#0072c6|Additional information about object class dark blue (0,114,198)
type|strategic indicator|node.shape|diamond|Additional information about object class
type|arviointikriteeri|node.color|orange|Not quite clear what criteria objects are: indicators or value statements, or something else
type|arviointikriteeri|node.color|orange|Not quite clear what criteria objects are: indicators or value statements, or something else
type|task|node.color|green|Additional information about object class
type|task|node.color|green|Additional information about object class
Line 338: Line 158:
Relation|causal link|edge.color|black|Causal link
Relation|causal link|edge.color|black|Causal link
Relation|causal link|edge.style|solid|Causal link
Relation|causal link|edge.style|solid|Causal link
Relation|positive causal link|edge.fontcolor|green|Causal link
Relation|positive causal link|edge.fontcolor|#009246|Causal link, dark green (0,146,70)
Relation|negative causal link|edge.fontcolor|red|Causal link
Relation|increases|edge.fontcolor|#009246|Causal link, dark green (0,146,70)
Relation|negative causal link|edge.fontcolor|#bd2719|Causal link, red (189,39,25)
Relation|decreases|edge.fontcolor|#bd2719|Causal link, red (189,39,25)
Relation|part_of|edge.fontcolor|gray|Part of (set theory link)
Relation|participatory link|edge.color|purple|Participatory link
Relation|participatory link|edge.color|purple|Participatory link
Relation|participatory link|edge.style|dashed|Participatory link
Relation|participatory link|edge.style|dashed|Participatory link
Line 355: Line 178:
</t2b>
</t2b>


==== Types of insight network tables ====
=== Calculations ===
 
'''Insight network 2.0
 
An updated version should improve the
* a) context sensitivity (referring to primarily to objects within own context but secondarily to those from another context),
* b) making graphs by default from a single context rather than a full list of contexts from a meta table,
* c) compatibility with cytoscape.js,
* d) merging ready-made graphs meaningfully,
* e) have a reasonable intermediate object format that contains all data needed, such as
** tables for nodes and edges, compatible with Diagrammer, Cytoscape.js, AND Gephi.
** metadata for display, such as seeds, steps, object types to ignore, whether to show labels etc. Or should these just be implemented on the graph?
 
What should be done?
# Fetch the data table by scrape or other function and with data about URL, table, and initial row.
# Use splizzeria and fillprev if needed.
# Interpret columns based on a vector of column numbers (with possibly  1+2 notation to paste columns) to create the standard columns. If this is done in an ovariable formula, there is no need for a specific function.
#* Context
#* Item
#* type
#* label
#* rel
#* Object
#* Description
#* Reldescription
#* URL
#* Result (dummy, always 0)
# Create missing node rows from objects. Do NOT assume context.
# Create URL from permanent resource location trunk and the identifier (where does the identifier come from?)
# Item ja label laitetaan pötköön ja haetaan mätsi. Tulos onrow-pötköstä.
# Create an ovariable from the table.
# Add meta to the ovariable with formatting data.
#* insightGraph:
#** seed
#** removenodes
#** formatting (character vector with possible entries: Hide node labels, Hide edge labels, Show legend nodes, Remove branches only)
#** ignoreobj
#** steps
 
# (NOT NEEDED? Create Oldid if does not exist from context and numbering)
# If a relation is presented as item, the formatting is applied to the ring.
 
Combine graph objects
* Find items without context. Match them with items with the same Item (label) that do have a type.
 
Tuplarelaatiot, voidaanko kategorisesti poistaa?
 
 
Out <- rep(NA, length(find))
For(x in cond,)
For(i in 1:length(find)
Tmp<-id[context==contextfind(i))])[Match(find(i), df$cond(x)(df$context==contextfind(i))] pitää etsiä id alkuperäisestä taulukosta heti muuten ei toimi
Out<- ifelse(isna(out). Tmp,out)
))
Sitten sama ioman contekstirajoitusta.
 


<t2b name="Table types" index="Type,Column names" obs="Dummy" unit="-">
'''Insight network 1.0
oletus|type, Item, label, Relation, Object, Description, URL|1
 
sotearv|Ikaryhma, AHVK, Item, Teema, Ulottuvuus, Osiotyyppi, Tietolahde, KUVA id, Sotkanet id, JHS-luokka, Ryhman perustelut|1
There are three different identifiers for a subject item.
hnh2035|Teema, Oldid, Item, Ohjelma, Vastuu, Aikajanne, Vaativuus, Kustannukset, Kust.kaupungille, Hyodyt.kaupungille, Kust.muille, Hyodyt.muille, Paastovahenema, Muut.vaikutukset, Seurantaindikaattori, Esimerkki, Description|1
* Oldid: a technical identifier typically of format context.number, where number is a sequential number within a context.
kuvaind|Oldid, Item, Teema, Aihe2, Aihe3, Tietopaketti1, Tietopaketti2, Tietopaketti3, Mita.mittaa, Mitta-arvo ja muodostaminen, Tietolahde, Tietolahde ja tausta, Tuotannossa, Tietotarpeen taso, Tuottamistaso, Kansainvaliset tietotoimitukset, Muut kayttotarkoitukset, Description|1
* Item: the actual name of the item, detailed enough to give a good understanding of its meaning.
sitra100|Item, Suuruus, Teema, URL|1
* label: a short name shown on insight networks. Does not exmplain everything, just enough to distinguish it from other items.
hvkertomus|Oldid, Item, Teema, Vaestoryhma, Lahde ja muodostaminen, Mita mittaa, KUVA-mittarissa, Hyte-kertoimessa, Arviointiraportissa, Hyvinvointikertomuksessa, Perustelut|1
hnhos|Oldid, type, Item, Description|1
keskustelu|Oldid, type, Item, label, Relation, Object, Description, URL|1
arviointi|Oldid, type, Item, Relation, Object, Description, URL|1
</t2b>


=== Calculations ===
If Oldid is not given, it is created from the context and a number. If label is not given in data, it is truncated from Item.


==== Making insight graphs ====
Object item has one column ''Object'' that may contain any of these. The priority is Item > label > Oldid > Object. The last option means that it is assumed that Object refers to a new item that is not mentioned in the Item column.


<rcode name="splizzeria" label="Initiate splizzeria (for developers only)" embed=1>
An insight network is produced in this order (last object mentioned first).
# This is code Op_en3861/splizzeria on page [[Insight network]]
# gr: a diagrammer graph with all data and formatting for an insight network. Produced by makeInsightGraph.
library(OpasnetUtils)
# makeInsightGraph


#' Split cells contents into vectors
#'
#' splizzeria function takes a data.frame and splits entries in cells of certain columns into separate rows. The idea is to make entries easier.
#'
#' @param df data.frame to be splitted
#' @param cols names of columns that have the splittable contents
#' @param split splitting character that separates individual entries in the cells
#' @return data.frame with the same columns but (possibly) more rows than df.


splizzeria <- function(
==== Making insight graphs ====
  df,
  cols,
  split=","
) { 
  require(reshape2)
  for(i in cols) {
    d <- as.character(df[[i]])
    d[d==""] <- NA # Because "" is incorrectly strsplitted
    d <- melt(strsplit(d, split=split), value.name=i)
    df$L1 <- 1:nrow(df)
    df <- merge(df[colnames(df)!=i], d)
    df[[i]] <- trimws(df[[i]])
    df[is.na(df[[i]]),i] <- ""
    df$L1 <- NULL
  }
  return(df)
}


objects.store(splizzeria)
<rcode name="formatted" label="Initiate data.frame formatted (for developers only)" embed=1>
cat("Function splizzeria stored.\n")
# This is code Op_en3861/formatted on page [[Insight network]]
</rcode>


<rcode name="fillprev" label="Initiate function fillprev (for developers only)" embed=1>
# This is code Op_en3861/fillprev on page [[Insight network]]
library(OpasnetUtils)
library(OpasnetUtils)


#' Filling empty cells
#' Function formatting creates a formatting table for nodes and edges.
#'  
#' The function as no parameters.
#' fillprev fills empty cells in a data.frame by using content from the previous row.
#' @return data.frame with ontology terms as rows and formatting properties as columns.
#'
 
#' @param df data.frame to be filled
formatting <- function() { 
#' @param cols vector of column names or positions to be filled.
  ## Replace default setting with additional class info
#' @return Returns a data.frame with the same shape as df.
 
  ## Find all classes for item subclasses
 
  hierItem <- opbase.data("Op_en7783", subset="Item types") # [[Open policy ontology]]
  hierItem <- hierItem[c("Object","English name","Finnish name")]
  colnames(hierItem)[colnames(hierItem)=="Object"] <- "Class" # Contains also other relations than subclass, notably "part of".
 
  ## Find all classes for relation subclasses
 
  hierRel <- opbase.data("Op_en7783", subset="Relation types") # [[Open policy ontology]]. All relations are of type 'has subclass'
  for(i in colnames(hierRel)) hierRel[[i]] <- as.character(hierRel[[i]])
  hierRel <- data.frame(
    Class = rep(hierRel$Class, 2),
    Tmp1 = c(hierRel$`English name`, hierRel$`English inverse`),
    Tmp2 = c(hierRel$`Finnish name`, hierRel$`Finnish inverse`)
  )
  colnames(hierRel) <- c("Class", "English name", "Finnish name")
 
  # Make a single resource list
  hier <- rbind(hierItem, hierRel)
  for(i in colnames(hier)) hier[[i]] <- as.character(hier[[i]])
 
  # Combine language versions of resource list
  hier <- unique(data.frame(
    Class = c(hier$Class, rep(hier$`English name`, 2)),
    Item = c(rep(hier$`English name`, 2), hier$`Finnish name`),
    stringsAsFactors = FALSE
  ))
 
  out <- hier
  tmp <- out$Class
  for(i in 1:6) {
    tmp <- hier$Class[match(tmp, hier$Item)]
    out <- rbind(
      out,
      cbind(
        Class = tmp,
        Item = hier$Item
      )
    )
  }
  hier <- out[!is.na(out$Class),]
 
  # Replace default settings with property-specific settings
 
  # First fetch the graphical styles of properties from [[Insight network]]
 
  prop_gen <- opbase.data(
    "Op_en3861", # [[Insight network]]
    subset="Graphical properties of objects and relations"
  )
 
  tmp <- prop_gen[grepl("edge", prop_gen$Parameter) & prop_gen$Value!="default",]
  tmp$Parameter <- gsub("edge","node",tmp$Parameter)
  prop_gen <- rbind(prop_gen, tmp)


fillprev <- function(df, cols) {
  # Create a data.frame with all item * parameter combinations.
   out <- df
  # This will be filled with item-specific graph settings
   for(i in cols) {  
 
     for(j in 2:nrow(out)) {
  prop_spec <- merge(
       if(out[j,i] %in% c("", NA)) out[j,i] <- out[j-1,i]
    data.frame(Resource = unique(c(hier$Class, hier$Item))),
    prop_gen[prop_gen$Property=="default",c("Parameter","Result")]
  )
    
   for(i in 1:nrow(prop_gen)) {  
     if(prop_gen$Property[i] != "default") {  
       # Names of items that should have the property replaced
      tst <- unique(hier$Item[hier$Class==prop_gen$Value[i]])
      prop_spec$Result[prop_spec$Resource %in% tst & prop_spec$Parameter==prop_gen$Parameter[i]] <- prop_gen$Result[i]
     }
     }
   }
   }
   return(out)
 
  prop_spec$Result <- as.character(prop_spec$Result)
 
  formatted <- reshape(prop_spec, idvar="Resource", timevar="Parameter", direction="wide")
  colnames(formatted) <- gsub("Result.", "", colnames(formatted))
 
  #  > colnames(formatted)
  #  [1] "Resource"        "node.shape"      "node.sides"      "node.skew"     
  #  [5] "node.fillcolor"  "node.fontsize"  "node.height"    "node.width"   
  #  [9] "node.color"      "node.penwidth"  "node.fontcolor"  "node.distortion"
  #  [13] "edge.color"      "edge.fontsize"  "edge.fontcolor"  "edge.style"   
  #  [17] "edge.penwidth"  "edge.arrowsize"
 
  for(i in c(
    "node.sides",
    "node.skew",
    "node.fontsize",
    "node.height",
    "node.width",
    "node.penwidth",
    "node.distortion",
    "edge.fontsize",
    "edge.penwidth",
    "edge.arrowsize"
  )) formatted[[i]] <- as.numeric(formatted[[i]])
 
   return(formatted)
}
}


objects.store(fillprev)
formatted <- formatting()
cat("Function fillprev stored.\n")
 
objects.store(formatted)
cat("Data.frame formatted stored.\n")
</rcode>
</rcode>


<rcode name="grspec" label="Initiate grspec (for developers only)" embed=1>
<rcode name="makeGraph2" label="Initiate function makeGraph (for developers only)">
# This is code Op_en3861/grspec on page [[Insight network]]
# This is code Op_en3861/makeGraph2 on page [[Insight network]]
library(OpasnetUtils)
library(OpasnetUtils)


#' Updating graph properties
#' Making insight network graph object
#'  
#'  
#' grspec (graph specifier) replaces the default properties with the item-specific ones
#' makeGraph is a function for taking an insight ovariable and making a graph object.
#'  
#'
#' @param df data.frame whose properties are to be replaced
#' @param a is data.frame defining nodes and edges with at least columns: Oldid, type, Item, label, Relation, Object, Description. Other columns for nodes such as URL are allowed.
#' @param Parameter name of parameter as defined in prop_spec
#' @return two data.frames: nodes_df and edges_df that are directly given as parameters for DiagrammeR::create_graph.
#' @param prop_spec data.frame with specific properties
#' @return data.frame with the shape of df with an additional column whose name comes from Parameter


grspec <- function(df, Parameter, prop_spec) {  
makeGraph <- function(ova, formatting=data.frame(), ...) {
   out <- prop_spec[prop_spec$Parameter==Parameter,]
   require(OpasnetUtils)
   coln <- ifelse("Object" %in% colnames(df), "Relation","Item")
  require(DiagrammeR)
   out <- out$Result[match(df[[coln]], out$Item)]
 
   return(as.character(out))
  if(!exists("formatted") & nrow(formatted)==0){
    objects.latest("Op_en3861", code_name="formatted") # [[Insight network]] formatted
  }
  if(!exists("chooseGr")) {
    objects.latest("Op_en3861", code_name="chooseGr") # [[Insight network]] chooseGr
  }
 
  if("ovariable" %in% class(ova)) {
    a <- ova@output
    meta <- ova@meta$insightnetwork
  } else {
    a <- ova
    meta <- NULL
  }
  a$truth <- signif(a$truth,2)
  a$relevance <- signif(a$relevance,2)
  for(i in 1:ncol(a)) {
    a[[i]] <- gsub("[\"']", " ", a[[i]])
  }
 
  # Fill in missing labels, Items, and object nodes
 
  a$label <- ifelse(is.na(a$label),substr(a$Item,1,30), a$label)
  a$Item  <- ifelse(is.na(a$Item),a$label, a$Item)
 
  # Find nrow that matches the Object based on Item or label.
  tst <- rep(1:nrow(a),2)[match(a$Object, c(a$Item, a$label))]
 
  # Use Item as Object identifier when possible
  hasobj <- !(is.na(a$Object) | a$Object=="") # Rows of data.frame a that have Object
  a$Object[hasobj] <- a$Item[tst][hasobj]
 
  # Find objects that have not been defined
  newbies  <- ifelse(is.na(tst), a$Object,NA)
  newbies <- newbies[!is.na(newbies)]
    
  if(length(newbies)>0) {
    a <- orbind(
      a,
      data.frame(
        Item=newbies,
        label=substr(newbies,1,30),
        stringsAsFactors = FALSE
      )
    )
  }
 
  nodes <- a[!(duplicated(a$Item) | is.na(a$Item) | a$Item==""),]
  #  nodes$tooltip <- paste0(
  #    nodes$label, ". ",
  #    ifelse(nodes$label == nodes$Item, "", paste0(nodes$Item, ". ")),
  #    ifelse(is.na(nodes$Description), "", paste0("\n", nodes$Description)),
  #    " (", nodes$Context, "/", nodes$id,")",
  #  )
  nodes$tooltip <- paste0(
    nodes$Item, ". ", nodes$Description, "/ truth: ", nodes$truth, " relevance: ", nodes$relevance)
  nodes <- merge(nodes, formatted[setdiff(colnames(formatted),colnames(nodes))],
                by.x="type", by.y="Resource")
  colnames(nodes) <- gsub("node.","",colnames(nodes))
  nodes <- nodes[!grepl("edge.", colnames(nodes))]
  nodes$id <- 1:nrow(nodes)
 
  # Create edges and flip unpreferred relations to their inverse relations
 
  inver <- opbase.data("Op_en7783", subset="Relation types")
  for(i in colnames(inver)) inver[[i]] <- as.character(inver[[i]])
  inve <- data.frame(
    rel = c(inver$`English name`,inver$`Finnish name`),
    inve = c(inver$`English inverse`,inver$`Finnish inverse`),
    stringsAsFactors = FALSE
  )
 
  edges <- a[!(is.na(a$Object) | a$Object=="") , ]
  flip <- edges$rel %in% inve$inve
  tmp <- edges$Item
   edges$Item[flip] <- edges$Object[flip]
  edges$Object[flip] <- tmp[flip]
  edges$rel[flip] <- inve$rel[match(edges$rel, inve$inve)][flip]
  edges$from <- match(edges$Item, nodes$Item)
  edges$to <- match(edges$Object, nodes$Item)
  edges$label <- edges$rel
  edges <- merge(edges, formatted[setdiff(colnames(formatted),colnames(edges))],
                by.x="rel", by.y="Resource")
  colnames(edges) <- gsub("edge.","",colnames(edges))
  edges <- edges[!grepl("node.", colnames(edges))]
  edges$id <- 1:nrow(edges)
  edges$labeltooltip <- paste0(edges$label, " (",edges$Context, "/",edges$id, ")")
 
  gr <- create_graph(
    nodes_df=nodes,
    edges_df=edges
  )
   if(!is.null(meta)) {
    gr <- chooseGr(gr, input=meta)
  }
 
  return(gr)  
}
}


objects.store(grspec)
objects.store(makeGraph)
cat("Function grspec stored.\n")
cat("Function makeGraph stored.\n")
</rcode>
</rcode>


<rcode name="makeInsightGraph" label="Initiate makeInsightGraph (for developers only)" embed=1>
<rcode name="makeGraph" label="Initiate function makeGraph (old version)" embed=1>
# This is code Op_en3861/makeInsightGraph on page [[Insight network]]
# This is code Op_en3861/makeGraph on page [[Insight network]]
library(OpasnetUtils)
library(OpasnetUtils)


#' Making insight network graph object
#' Making insight network graph object
#'  
#'  
#' makeInsightGraph is a function for fetching data for insight networks and making a graph object
#' makeGraph is a function for taking an insight ovariable and making a graph object.
#'
#'
#' @param a is data.frame defining nodes and edges with at least columns: Oldid, type, Item, label, Relation, Object, Description. Other columns for nodes such as URL are allowed.
#' @param a is data.frame defining nodes and edges with at least columns: Oldid, type, Item, label, Relation, Object, Description. Other columns for nodes such as URL are allowed.
#' @return list of two data.frames: nodes_df and edges_df. These can be directly given as parameters for DiagrammeR::create_graph.
#' @return two data.frames: nodes_df and edges_df that are directly given as parameters for DiagrammeR::create_graph.


makeInsightGraph <- function(a) {
makeGraph <- function(ova, ...) {
   require(OpasnetUtils)
   require(OpasnetUtils)
   require(DiagrammeR)
   require(DiagrammeR)
    
    
   for(i in 1:ncol(a)) {
   if(!exists("formatted")){
     a[[i]] <- gsub("[\"']", " ", a[[i]])
     objects.latest("Op_en3861", code_name="formatted") # [[Insight network]] formatted
  }
  if(!exists("chooseGr")) {
    objects.latest("Op_en3861", code_name="chooseGr") # [[Insight network]] chooseGr
   }
   }
    
    
   # First fetch the graphical styles of properties from [[Insight network]]
   if("ovariable" %in% class(ova)) {
    a <- ova@output
    meta <- ova@meta$insightnetwork
  } else {
    a <- ova
    meta <- NULL
  }
    
    
   prop_gen <- opbase.data(
   for(i in 1:ncol(a)) {
     "Op_en3861", # [[Insight network]]
     a[[i]] <- gsub("[\"']", " ", a[[i]])
    subset="Graphical properties of objects and relations"
  )
  prop_gen <- splizzeria(prop_gen, c("Property","Value"))
 
  dbltst <- duplicated(prop_gen[c("Property","Value","Parameter")])
  if(any(dbltst)) {
    cat("There are double definitions in Insight networks/Graphical properties of objects and relations.\n")
    oprint(prop_gen[dbltst,])
   }
   }
    
    
   ## Replace default setting with additional class info
   # Fill in missing labels, Items, and object nodes
    
    
   clas <- splizzeria(
   a$label <- ifelse(is.na(a$label),substr(a$Item,1,30), a$label)
    opbase.data("Op_en7783", subset="Hierarchies"), # [[Open policy ontology]]
   a$Item  <- ifelse(is.na(a$Item),a$label, a$Item)
    c("Class","Result")
  )[-1]
  # Clas for nodes (type)
  clas_n <- merge(a, clas, by.x="type", by.y="Result")
  clas_n <- unique(data.frame( # Currently looks at immediate, not recursive, hierarchies only.
    Item = rep(clas_n$Item,2),
    Class = c(clas_n$type,clas_n$Class),
    stringsAsFactors = FALSE
    #    clas_n[c("type","Item")],
    #    data.frame(type=clas_n$Class,Item=clas_n$Item)
   ))
  # Clas for edges (Relation)
  clas_e <- merge(a, clas, by.x="Relation", by.y="Result")
  clas_e <- unique( # Currently looks at immediate, not recursive, hierarchies only.
    data.frame(
      Relation=rep(clas_e$Relation,2),
      Class=c(clas_e$Relation,clas_e$Class),
      stringsAsFactors = FALSE
    )
  )
    
    
   # Create nodes 
   # Find nrow that matches the Object based on Item or label.
  tst <- rep(1:nrow(a),2)[match(a$Object, c(a$Item, a$label))]
    
    
   a$label <- ifelse(is.na(a$label), ifelse(is.na(a$Item), a$Oldid, substr(a$Item,1,30)), a$label)
   # Use Item as Object identifier when possible
  hasobj <- !(is.na(a$Object) | a$Object=="") # Rows of data.frame a that have Object
  a$Object[hasobj] <- a$Item[tst][hasobj]
    
    
   # Find Oldid that matches the Object based on Item, label, Oldid, or none (in this order)
   # Find objects that have not been defined
   tmp  <- a$Oldid[match(a$Object, a$Item)]
   newbies <- ifelse(is.na(tst), a$Object,NA)
  tmp2 <- a$Oldid[match(a$Object, a$label)]
   newbies <- newbies[!is.na(newbies)]
  tmp <- ifelse(is.na(tmp),tmp2,tmp)
  tmp2 <- a$Oldid[match(a$Object, a$Oldid)]
   tmp  <- ifelse(is.na(tmp), tmp2,tmp)
  tmp  <- ifelse(is.na(tmp), a$Object,tmp)
  a$Object <- tmp
    
    
   nodes <- orbind(
   if(length(newbies)>0) {
    a[!colnames(a) %in% c("Relation","Object")],
    a <- orbind(
    data.frame(
      a,
      Oldid=a$Object,
      data.frame(
      Item=a$Object,
        Item=newbies,
      label=substr(a$Object,1,30),
        label=substr(newbies,1,30),
      stringsAsFactors = FALSE
        stringsAsFactors = FALSE
      )
     )
     )
   )
   }
    
    
   nodes <- nodes[!(duplicated(nodes$Item) | is.na(nodes$Item) | nodes$Item==""),]
   nodes <- a[!(duplicated(a$Item) | is.na(a$Item) | a$Item==""),]
  nodes$id <- 1:nrow(nodes)
   nodes$tooltip <- paste0(
   nodes$tooltip <- paste0(
     nodes$label, ". ",
     nodes$label, ". ",
     ifelse(nodes$label == nodes$Item, "", paste0(nodes$Item, ". ")),  
     ifelse(nodes$label == nodes$Item, "", paste0(nodes$Item, ". ")),  
     ifelse(is.na(nodes$Description), "", paste0("\n", nodes$Description)),
     ifelse(is.na(nodes$Description), "", paste0("\n", nodes$Description)),
    nodes$Description,
     " (", nodes$Context, "/", nodes$id,")"
     " (", nodes$Oldid, "/", nodes$id,")"
   )
   )
  nodes <- merge(nodes, formatted, by.x="type", by.y="Resource")
  colnames(nodes) <- gsub("node.","",colnames(nodes))
  nodes <- nodes[!grepl("edge.", colnames(nodes))]
  nodes$id <- 1:nrow(nodes)
    
    
   # Create edges and flip unpreferred relations to their inverse relations
   # Create edges and flip unpreferred relations to their inverse relations
    
    
   inver <- opbase.data("Op_en7783", subset="Inverse relations")
   inver <- opbase.data("Op_en7783", subset="Relation types")
  for(i in colnames(inver)) inver[[i]] <- as.character(inver[[i]])
  inve <- data.frame(
    rel = c(inver$`English name`,inver$`Finnish name`),
    inve = c(inver$`English inverse`,inver$`Finnish inverse`),
    stringsAsFactors = FALSE
  )
    
    
  cols <- intersect(c("Oldid","Item","Relation","Object","Description","Edgedescription"),colnames(a))
   edges <- a[!(is.na(a$Object) | a$Object=="") , ]
   edges <- a[!(is.na(a$Object) | a$Object=="") , cols]
   flip <- edges$rel %in% inve$inve
   flip <- edges$Relation %in% inver$Result
   tmp <- edges$Item
   tmp <- edges$Oldid
   edges$Item[flip] <- edges$Object[flip]
   edges$Oldid[flip] <- edges$Object[flip]
   edges$Object[flip] <- tmp[flip]
   edges$Object[flip] <- tmp[flip]
   edges$Relation[flip] <- as.character(inver$Preferred[match(edges$Relation, inver$Result)][flip])
   edges$rel[flip] <- inve$rel[match(edges$rel, inve$inve)][flip]
  edges$from <- match(edges$Item, nodes$Item)
  edges$to <- match(edges$Object, nodes$Item)
  edges$label <- edges$rel
  edges$labeltooltip <- paste0(edges$label, " (",edges$Context, "/",edges$id, ")")
  edges <- merge(edges, formatted, by.x="rel", by.y="Resource")
  colnames(edges) <- gsub("edge.","",colnames(edges))
  edges <- edges[!grepl("node.", colnames(edges))]
   edges$id <- 1:nrow(edges)
   edges$id <- 1:nrow(edges)
  edges$from <- match(edges$Oldid, nodes$Oldid)
  edges$to <- match(edges$Object, nodes$Oldid)
  edges$rel<-edges$Relation # Not clear what rel is used for
  edges$label <- edges$Relation
  edges$labeltooltip <- paste0(edges$label, "(", edges$Oldid, "/", edges$id, ")")
    
    
   # Create a data.frame containing item-specific graph settings
   gr <- create_graph(
    nodes_df=nodes,
    edges_df=edges
  )
  if(!is.null(meta)) {
    gr <- chooseGr(gr, input=meta)
  }
    
    
   prop_spec <- merge(
   return(gr)
    data.frame(Item = union(nodes$Item, edges$Relation)),
}
     prop_gen[prop_gen$Property=="default",c("Parameter","Result")]
 
objects.store(makeGraph)
cat("Function makeGraph stored.\n")
</rcode>
 
<rcode name="chooseGr" label="Initiate ovariable chooseGr" embed=1>
# This is code Op_en3861/chooseGr on page [[Insight diagram]].
library(OpasnetUtils)
 
#' Function chooseGr takes a diagrammer graph and selects s subgraph based on topic, labels, steps from selected nodes etc.
#' @param gr diagrammer graph
#' @param input list of arguments to be used in selection
#' @seeds ovariable where @data has columns Topic to be chosen and Node for Oldid's to select.
#' @return diagrammer graph where node_selection contains the selected nodes
 
chooseGr <- function(gr, input, seeds=NULL, verbose=FALSE) {
  if(!is.null(seeds)) seeds <- match(seeds@data$Node[seeds@data$Topic==input$topic], gr$nodes_df$Oldid)
  nods <- union(c(
    seeds,
    match(input$addnodes, gr$nodes_df$label)),
     match(input$addnodesByid, gr$nodes_df$id)
   )
   )
    
   nods <- nods[!is.na(nods)]
   # Replace default settings with property-specific settings
  gr <- deselect_nodes(gr, get_selection(gr))
   for(i in 1:nrow(prop_gen)) {
   gr <- select_nodes_by_id(gr, nods)
     if(prop_gen$Property[i] != "default") {
   if(input$steps>0) {
       tst <- union( # Names of items that should have the property replaced
    for(i in 1:input$steps) {
        nodes$Item[nodes[[prop_gen$Property[i]]]==prop_gen$Value[i]],
      gr <- deselect_nodes(gr,match(input$removenodes, gr$nodes_df$label))
        c(edges$Relation[edges[[prop_gen$Property[i]]]==prop_gen$Value[i]],
      if(nrow(gr$node_selection)>0) {
          clas_n$Item[clas_n$Class == prop_gen$Value[i]],
        gr <- trav_both(gr,add_to_selection = TRUE)
          clas_e$Relation[clas_e$Class == prop_gen$Value[i]]
      }
        )
    }
      )
     if("Remove branches only" %in% input$formatting) {
       prop_spec$Result[prop_spec$Item %in% tst & prop_spec$Parameter==prop_gen$Parameter[i]] <- prop_gen$Result[i]
       gr <- select_nodes_by_id(gr,match(input$removenodes, gr$nodes_df$label))
    } else {
       gr <- deselect_nodes(gr,match(input$removenodes, gr$nodes_df$label))
     }
     }
   }
   }
    
   if("Show legend nodes" %in% input$formatting) {
  # Apply item-specific settings to nodes and edges
    gr <- select_nodes_by_id(gr, match(seeds@data$Node[seeds@data$Topic=="Selitykset"], gr$nodes_df$Oldid))
  nodes$fillcolor <- grspec(nodes,"node.fillcolor", prop_spec)
   }
  nodes$color <- grspec(nodes,"node.color", prop_spec)
   gr <- deselect_nodes(gr, match(input$ignoreobj, gr$nodes_df$type))
  nodes$fontcolor <- grspec(nodes,"node.fontcolor", prop_spec)
   if(verbose) cat("Selected nodes: ", gr$nodes_df$label[gr$nodes_df$id %in% gr$node_selection[[1]]])
  nodes$fontsize <- as.numeric(grspec(nodes,"node.fontsize", prop_spec))
   return(gr)
   nodes$shape <- grspec(nodes,"node.shape", prop_spec)
   nodes$sides <- as.numeric(grspec(nodes,"node.sides", prop_spec))
  nodes$width <- as.numeric(grspec(nodes, "node.width", prop_spec))
  nodes$height <- as.numeric(grspec(nodes,"node.height", prop_spec))
   nodes$penwidth <- as.numeric(grspec(nodes, "node.penwidth", prop_spec))
  nodes$orientation <- as.numeric(grspec(nodes,"node.orientation", prop_spec))
  nodes$skew <- as.numeric(grspec(nodes,"node.skew", prop_spec))
  nodes$distortion <- as.numeric(grspec(nodes, "node.distortion", prop_spec))
  edges$fontcolor <- grspec(edges,"edge.fontcolor", prop_spec)
  edges$penwidth <- grspec(edges,"edge.penwidth", prop_spec)
  edges$color <- grspec(edges,"edge.color", prop_spec)
  edges$style <- grspec(edges,"edge.style", prop_spec)
 
   return(
    create_graph(
      nodes_df=nodes,
      edges_df=edges
    )
  )
}
}


objects.store(makeInsightGraph)
objects.store(chooseGr)
cat("Function makeInsightGraph stored.\n")
cat("Ovariable chooseGr stored.\n")
</rcode>
</rcode>


==== Fetch data from the web: makeInsightTables function ====
Function insightJSON fetches a JSON file of an insight network through a REST API. Works on own computer only.


<rcode name="makeInsightTables" label="Create function makeInsightTables (for developers only)" embed=1>
<rcode name="insightJSON" label="Initiate function insightJSON (run on own computer)" embed=1>
# This is code Op_en3861/makeInsightTables on page [[Insight network]]
# This is code Op_en3861/insightJSON on page [[Insight network]]
library(OpasnetUtils)


#' @title makeInsightTables is a function for scraping web sources given in meta table and convert those to data.frames for further use.
#' This function fetches an insight network data as JSON through REST api and makes a graph
#' @param meta table containing information about the tables, assessments, and discussions to scrape. Typically contains columns Name, Id, Type, URL, Table, Firstrow, Description.
#' @param URL URL for the insight network data
#' @param types table with standardized column names that will be used. meta$Type matches with Type column. Other required columns: Column names.
#' @return a diagrammer graph object
#' @param savecsv TRUE if the created tables are to be saved as csv files. Default is FALSE.
#' @return a list of data.frames, including the original meta table as $meta.


makeInsightTables <- function(
insightJSON <- function(URL) {
  meta,
  types = opbase.data("Op_en3861", subset="Table types"),
  savecsv = FALSE
) {
   require(OpasnetUtils)
   require(OpasnetUtils)
  require(DiagrammeR)
  require(jsonlite)
    
    
   # Call Op_fi5849/inaightNetwork first so you don't need these.
   objects.latest("Op_en3861", "formatted") # [[Insight network]] formatted
  #  objects.latest("Op_en3861",code_name="scrape.functions") # [[Insight network]] scrape.discussion .gssheet .webtable
 
   # objects.latest("Op_en3861",code_name="scrape.assessment") # [[Insight network]] scrape.assessment
   tst <- fromJSON(url(URL))
  nodes <- tst$data$nodes
  nodes <- data.frame(
    type = paste(nodes$indicator_level, nodes$type),
    Item = nodes$name,
    oldid = nodes$id,
    label = substr(nodes$name,1,30),
    tooltip = paste0(nodes$name,". ",nodes$id),
    URL = gsub("aplans.api","hnh",gsub("v1/","",nodes$url)),
    stringsAsFactors = FALSE
  )
  nodes$type <- gsub("NA ","",nodes$type)
    
    
   if(!exists("insightTables")) insightTables <- list() # Existing insightTale can be updated partly or wholly
   nodes <- merge(nodes, formatted, by.x="type", by.y="Resource")
 
  nodes$id <- 1:nrow(nodes)
   if("ovariable" %in% class(meta)) meta <- meta@data # meta is originally an ovariable
   nodes <- nodes[!grepl("edge.",colnames(nodes))]
   for(i in 1:ncol(meta)) meta[[i]] <- as.character(meta[[i]])
   colnames(nodes) <- gsub("node.","",colnames(nodes))
  for(i in c("Table","Firstrow")) meta[[i]] <- as.numeric(meta[[i]])
   nodes <- nodes[c("id",setdiff(colnames(nodes),"id"))]
   meta$Name <- gsub("[Öö]","o",gsub("[ÄÅäå]","a",meta$Name))
    
    
   for(i in 1:nrow(meta)) {
   edges <- tst$data$edges
    cat(i, meta$Name[i],"\n")
  edges$from <- match(edges$from, nodes$oldid)
    if(grepl("google.com", meta$URL[i])) {
  edges$to <- match(edges$to, nodes$oldid)
      out <- scrape.gssheet(meta$URL[i], meta$Firstrow[i])
  edges$oldid <- edges$id
    } else {
  edges$rel <- gsub("_", " ", edges$effect_type)
      if(meta$Type[i]=="keskustelu") {
  edges$label <- edges$rel
        if(is.na(meta$Table[i])) j <- NULL else j <- as.numeric(meta$Table[i])
  edges$tooltip <- paste0(edges$rel, " (", edges$confidence_level,") ", edges$id)
        out <- scrape.discussion(meta$URL[i], j)[[1]]
  edges <- merge(edges, formatted, by.x="rel", by.y="Resource")
      } else {
  edges$id <- 1:nrow(edges)
        if(meta$Type[i] %in% c("arviointi","assessment")) {
  edges <- edges[!grepl("node.",colnames(edges))]
          tmp <- strsplit(meta$URL[i], split="/")[[1]]
  colnames(edges) <- gsub("edge.","",colnames(edges))
          objects.latest(tmp[1],tmp[2])
  edges <- edges[c("from","to",setdiff(colnames(edges),c("from","to")))]
          dummy <- EvalOutput(get(tmp[3]))
          out <- scrape.assessment(get(tmp[3]))
          rm(dummy)
        } else {
          out <- scrape.webtable(meta$URL[i],meta$Table[i])
        }
      }
    }
    coln <- trimws(strsplit(as.character(types$`Column names`[types$Type==meta$Type[i]]),split=",")[[1]])
    if(colnames(out)[1]=="Obs") coln <- c("Oldid",coln)
    colnames(out) <- coln
    insightTables[[meta$Name[i]]] <- out
   
    #    if(savecsv) {
    #      wr#ite.csv(
    #        out,
    #        paste0(meta$Name[i],".csv"),
    #        quote=TRUE, row.names=FALSE, fileEncoding="UTF-8"
    #      )
    #    }
  }
    
    
   #  if(savecsv) {
   gr <- create_graph(nodes, edges)
  #    wr#ite.csv(meta, "meta.csv",fileEncoding = "UTF-8")
   return(gr)
  #    # Zippaus ei jostain syystä toimi minun uudella koneella
  #    zip("~/Näkemysverkkojen tietotauluja.zip", paste0(c("meta",meta$Name),".csv"))
  #  }
  insightTables$meta <- meta
   return(insightTables)
}
}


objects.store(makeInsightTables)
#objects.store(insightJSON) # NOT STORED.
cat("Function makeInsightTables stored.\n")
#cat("Function insightJSON stored.\n")
</rcode>
</rcode>


==== Insight network ====
==== Format tables ====
 
<rcode name="splizzeria" label="Initiate splizzeria (for developers only)" embed=1>
# This is code Op_en3861/splizzeria on page [[Insight network]]
library(OpasnetUtils)


This is an overall ovariable that automatically fetches all dependencies.
#' Split cells contents into vectors
#'
#' splizzeria function takes a data.frame and splits entries in cells of certain columns into separate rows. The idea is to make entries easier.
#'
#' @param df data.frame to be splitted
#' @param cols names of columns that have the splittable contents
#' @param split splitting character that separates individual entries in the cells
#' @return data.frame with the same columns but (possibly) more rows than df.


<rcode name="insightNetwork" label="Initiate insightNetwork ovariable (for developers only)" embed=1>
splizzeria <- function(
# This is code Op_en3861/insightNetwork on page [[Insight network]]
  df,
  cols,
  split=","
) { 
  require(reshape2)
  for(i in cols) {
    d <- as.character(df[[i]])
    d[d==""] <- NA # Because "" is incorrectly strsplitted
    d <- melt(strsplit(d, split=split), value.name=i)
    df$L1 <- 1:nrow(df)
    df <- merge(df[colnames(df)!=i], d)
    df[[i]] <- trimws(df[[i]])
    df[is.na(df[[i]]),i] <- ""
    df$L1 <- NULL
  }
  return(df)
}
 
objects.store(splizzeria)
cat("Function splizzeria stored.\n")
</rcode>
 
<rcode name="fillprev" label="Initiate function fillprev (for developers only)" embed=1>
# This is code Op_en3861/fillprev on page [[Insight network]]
library(OpasnetUtils)
library(OpasnetUtils)


insightNetwork <- Ovariable(
#' Filling empty cells
  "insightNetwork",
#'
  dependencies = data.frame(
#' fillprev fills empty cells in a data.frame by using content from the previous row.
    Name = c(
#'
      "meta",
#' @param df data.frame to be filled
      "seeds",
#' @param cols vector of column names or positions to be filled.
      "objtypes",
#' @return Returns a data.frame with the same shape as df.
      "makeInsightTables",
      "scrape.discussion","scrape.gssheet","scrape.webtable",
      "scrape.assessment",
      "makeGraphTable",
      "fillprev",
      "splizzeria",
      "grspec",
      "makeInsightGraph",
      "makeUi",
      "server"
    ),
    Ident = c(
      "Op_fi5849/meta",
      "Op_fi5849/seeds",
      "Op_fi5849/objtypes",
      "Op_en3861/makeInsightTables",
      rep("Op_en3861/scrape.functions",3), # These will be moved to OpasnetUtils package
      "Op_en3861/scrape.assessment",
      "Op_fi5849/makeGraphTable",
      "Op_en3861/fillprev",
      "Op_en3861/splizzeria",
      "Op_en3861/grspec",
      "Op_en3861/makeInsightGraph",
      "Op_en3861/makeUi",
      "Op_en3861/server"
    ),
    Description = c(
      "Contains metadata for the data tables and discussions to be fetched. Source: [[:op_fi:Näkemysverkko]]",
      "Seed nodes to be used as starting points for different graphs. Source: [[:op_fi:Näkemysverkko]]",
      "List of object types that you may deselect from the shiny graph. Source: [[:op_fi:Näkemysverkko]]",
      "Makes insight tables with minimal formatting. Source: [[Insight network]]",
      "Fetches data from a discussion", "Fetches data from a google sheet", "Fetches data from a regular webtable",
      "Fetches data from an assessment ovariable",
      "Converts insight tables to standard formatting. Source: [[:op_fi:Näkemysverkko]]",
      "Fills empty cells with content from a previous cell in that column. Source: [[Insight network]]",
      "Splits cell contents from a splitting character so that all other cells in that row multiply. Source: [[Insight network]]",
      "Updates generic graph formatting to object-specific formatting. Source: [[Insight network]]",
      "Creates DiagrammeR graph from data in standard structure. Source: [[Insight network]]",
      "Shiny user interface. Usage: ui <- makeUi(). Source: [[Insight network]]",
      "Shiny server code. Source: [[Insight network]]"
    )
  ),
  formula=function(...) {
    require(DiagrammeR)
    require(shiny)


     return(data.frame(Result=0))
fillprev <- function(df, cols) {
  out <- df
  for(i in cols) {
     for(j in 2:nrow(out)) {
      if(out[j,i] %in% c("", NA)) out[j,i] <- out[j-1,i]
    }
   }
   }
)
  return(out)
}


objects.store(insightNetwork)
objects.store(fillprev)
cat("Ovariable insightNetwork stored.\n")
cat("Function fillprev stored.\n")
</rcode>
</rcode>


==== Shiny server ====
==== Shiny server ====


<rcode name="makeUi" label="Initiate function ui (for developers only)" embed=1>
<rcode name="ui" label="Initiate function ui (for developers only)" embed=1>
# This is code Op_en3861/makeUi on page [[Insight network]]
# This is code Op_en3861/ui on page [[Insight network]]
library(OpasnetUtils)
library(OpasnetUtils)


Line 840: Line 841:
}
}


makeUi <- 0
objects.store(ui)
 
cat("Function ui stored (makeUi is depreciated and not stored). Usage: shinyApp(ui, server, enableBookmarking = 'url')\n")
objects.store(ui, makeUi)
cat("Function ui stored (makeUi is dummy). Usage: shinyApp(ui, server, enableBookmarking = 'url')\n")
</rcode>
</rcode>


Line 849: Line 848:
# This is code Op_en3861/server on page [[Insight diagram]].
# This is code Op_en3861/server on page [[Insight diagram]].
library(OpasnetUtils)
library(OpasnetUtils)
objects.latest("Op_en3861", code_name="chooseGr") # [[Insight network]] chooseGr


#### Create shiny server at file server.R
#### Create shiny server at file server.R


server <- function(input, output, session) {
server <- function(input, output, session) {
# grr <- reactive({
   output$plot1 <- renderGrViz({
   output$plot1 <- renderGrViz({
     nods <- union(c(
     gr2 <- chooseGr(gr = gr, input = input, seeds = seeds)
      match(seeds@data$Node[seeds@data$Topic==input$topic], gr$nodes_df$Oldid),
      match(input$addnodes, gr$nodes_df$label)),
      match(input$addnodesByOldid, gr$nodes_df$Oldid)
    )
    nods <- nods[!is.na(nods)]
    gr <- deselect_nodes(gr, get_selection(gr))
    gr <- select_nodes_by_id(gr, nods)
    if(input$steps>0) {
      for(i in 1:input$steps) {
        gr <- deselect_nodes(gr,match(input$removenodes, gr$nodes_df$label))
        gr <- trav_both(gr,add_to_selection = TRUE)
      }
      if("Remove branches only" %in% input$formatting) {
        gr <- select_nodes_by_id(gr,match(input$removenodes, gr$nodes_df$label))
      } else {
        gr <- deselect_nodes(gr,match(input$removenodes, gr$nodes_df$label))
      }
    }
    if("Show legend nodes" %in% input$formatting) {
      gr <- select_nodes_by_id(gr, match(seeds@data$Node[seeds@data$Topic=="Selitykset"], gr$nodes_df$Oldid))
    }
    gr <- deselect_nodes(gr, match(input$ignoreobj, gr$nodes_df$type))
#    gr <- deselect_nodes(gr, union( # This should find the INTERCEPT of from is selected AND to is selected and rel  %in% ignorerel.
#    gr <- deselect_nodes(gr, union( # This should find the INTERCEPT of from is selected AND to is selected and rel  %in% ignorerel.
# However, it is more complicated than that, because we may not want both from and to to disappear, only the one who is further away from core.
# However, it is more complicated than that, because we may not want both from and to to disappear, only the one who is further away from core.
Line 884: Line 862:
#      tmp$edges_df$to[tmp$edges_df$rel %in% input$ignorerel]
#      tmp$edges_df$to[tmp$edges_df$rel %in% input$ignorerel]
#    ))
#    ))
    gr
#  })


# output$plot1 <- renderGrViz({
#  gr2 <- grr()
    gr2 <- gr
     gr2$nodes_df$label <- gsub("(.{1,18})(\\s|$)", "\\1\n", gr2$nodes_df$label) # Cut labels to max 18 characters long on one line (except if a word is longer)
     gr2$nodes_df$label <- gsub("(.{1,18})(\\s|$)", "\\1\n", gr2$nodes_df$label) # Cut labels to max 18 characters long on one line (except if a word is longer)
     # Alternative possibility is to use strwrap function from {base} or stri_wrap from stringi.
     # Alternative possibility is to use strwrap function from {base} or stri_wrap from stringi.
     if("Hide node labels" %in% input$formatting) gr2$nodes_df$label <- ""
     if("Hide node labels" %in% input$formatting) gr2$nodes_df$label <- ""
     if("Hide edge labels" %in% input$formatting) gr2$edges_df$label <- " "
     if("Hide edge labels" %in% input$formatting) gr2$edges_df$label <- " "
   
 
     grViz(generate_dot(transform_to_subgraph_ws(gr2)))
     grViz(generate_dot(transform_to_subgraph_ws(gr2)))
   })
   })
Line 909: Line 882:
}
}


objects.store(server)
objects.store(chooseGr, server)
cat("Function server stored.\n")
cat("Functions chooseGr, server stored. Note! ChooseGr comes from its own code. Usage: shinyApp(ui, server, enableBookmarking = 'url')\n")
</rcode>
</rcode>


==== Scrape functions ====
==== Scrape functions ====


These functions will be placed in the OpasnetUtils package. For now, it must be manually copied to your code.
These functions were be placed in the OpasnetUtils package, which is [https://github.com/jtuomist/OpasnetUtils/blob/master/R/scrape.R maintained in Github]. To use the code, install a new version of the package by running R code


<rcode name="scrape.functions" label="Initiate scrape functions (for developers only)" embed=1>
devtools::install_github("jtuomist/OpasnetUtils")
# This is code Op_en3861/scrape.functions on page [[Insight network]]
library(OpasnetUtils)


#' Scrape structured (pragma-dialectical) discussions
Codes Op_en3861/scrape.discussion, Op_en3861/scrape.functions, and Op_en3861/scrape.assessment on this page are outdated.
#'
#' scrape.discussion is a function that takes a discussion in Opasnet and converts it to a standard graph table.
#'
#' @param page URL for the page to read.
#' @param n number of discussion on the page. If NULL, all discussions on the page will be read.
#' @return a list of two data.frames. The first has standard headings for a graph table. The second has columns id, type, title, content, sign, target, type, paradigm, relation, and Result; and is ready for creating ovariables from arguments.
 
scrape.discussion <- function(page, n=NULL) {
  require(rvest)
  require(xml2)
  require(reshape2)
  discall <- html_nodes(read_html(page), css="div.discussion")
  if(is.null(n)) n <- 1:length(discall)
  out <- list(data.frame(),data.frame())
  for(k in n) {
    disc <- discall[[k]]
    opeS <- html_text(html_nodes(disc, css=".openingStatement"), trim=TRUE)
    cloS <- html_text(html_nodes(disc, css=".closingStatement"), trim=TRUE)
    resd <- html_text(html_nodes(disc, css=".resolved"), trim=TRUE)
    title<- html_text(html_nodes(disc, css="b.title"), trim=TRUE)
    type <- tolower(trimws(substr(html_text(html_nodes(disc, css="font.type")),1,5)))
    type <- gsub("arvok", "value", type)
    type <- gsub("fakta", "fact", type)
    id <- html_attr(disc, "id")
    disc.id <- paste(id, c("openingStatement","closingStatement"),sep=".")
   
    # Make argument and paradigm id's specific to argument-target pairs.
    nods <- html_nodes(disc, css=".argumentation .argument")
    tmp <- html_attr(nods,"id")
    tmp <- paste(tmp, 1:length(tmp),sep="£££")
    xml_attrs(nods) <- lapply(tmp, function(x) {c(class="argument",id=x)})
    for(l in 1:length(tmp)) {
      nodtmp <- html_nodes(nods[[l]], css=".paradigm")
      xml_attrs(nodtmp) <- rep(list(c(id=tmp[l], class="paradigm")), length(nodtmp))
    }
   
    tmp <- data.frame(
      Oldid = disc.id,
      type = paste(type,c("opening statement","closing statement")),
      Item = disc.id,
      label = c(".",title),
      Relation = c("produces",""),
      Object = c(disc.id[2],""),
      Description = c(opeS, cloS),
      URL = paste(page, id, sep="#"),
      stringsAsFactors = FALSE
    )
    if(nrow(out[[1]])==0) out[[1]] <- tmp else out[[1]] <- orbind(out[[1]], tmp)
   
    ######## arg: Find parameters that are unique within the id-target pairs
    #  "id"  "title" "type"  "content" "sign"  "target"  "overtarget"
   
    arg <- data.frame(
      id = html_attr(html_nodes(disc, css=" .argument"), "id"),
      title = html_text(html_nodes(disc, css=" .argument .title")),
      type = html_text(html_nodes(disc, css=".argument i.type ")),
      content = html_text(html_nodes(disc, css=" .argument .content")),
      sign = html_text(html_nodes(disc, css=" .argument .sign a:first-of-type")),
      stringsAsFactors = FALSE
    )
   
    # Find the previous argument that is one level higher, i.e. the target argument, and the overtarget.
    findtarget <- function(arg, disc) {
     
      level <- rep(0,nrow(arg))
      for(j in 0:8) {
        level[arg$id %in% html_attr(html_nodes(disc, css=paste(paste(rep("dd", j), collapse=" ")," .argument")),"id")] <- j
      }
      test <- 1:length(level)
      arg$target <- rep("", length(level))
      for(j in test) {
        arg$target[j] <-  arg$id[max(c(-Inf,test[level == level[j]-1 & test < j]))]
        arg$overtarget[j] <- arg$id[max(c(-Inf,test[level == level[j]-2 & test < j]))]
      }
      arg$target[is.na(arg$target)] <- disc.id[1]
      arg$overtarget[is.na(arg$overtarget) & level == 1] <- disc.id[1]
      return(arg)
    }
   
    arg <- findtarget(arg, disc)
   
    ######### targ: find parameters that are unique in id-target-paradigm triples
    #  "id"        "paradigm"  "relation"  "relevance" "selftruth" "truth" 
   
    targ <- data.frame(
      id = html_attr(html_nodes(disc, css=" .argument .paradigm"), "id"),
      paradigm = html_text(html_nodes(disc, css=" .argument .paradigm")),
      relation = html_text(html_nodes(disc, css=" .argument .relation")),
      relevance = html_attr(html_nodes(disc, css=" .argument .relation"), "color"),
      selftruth = html_attr(html_nodes(disc, css=" .argument .selftruth"), "color"),
      stringsAsFactors = FALSE
    )
   
    targ$relation  <- c("attack","defense","comment","branch")[match(substr(targ$relation,1,3), c("\U21E4--","\U2190--","---","--\U2192"))]
    targ$truth    <- ifelse(targ$relevance=="gray",0,1)
    targ$relevance <- ifelse(targ$relevance=="gray",0,1)
    targ$selftruth <- ifelse(targ$selftruth=="gray",0,1)
    targ <- findtarget(targ, disc)[-8] # Remove redundant overtarget
   
    ### Create another data.frame with full argument structure for ovariable formation
   
    tmp <- arg # Add rows for selftruth
    tmp$type <- "selftruth"
    tmp <- rbind(arg,tmp)
    tmp <- tmp[!duplicated(arg$id, arg$type) , ]
   
    arg2 <- melt(
      targ,
      measure.vars = c("relevance","truth","selftruth"),
      variable.name="type",
      value.name="Result"
    )
    arg2 <- merge(tmp, arg2)
    out[[2]] <- rbind(out[[2]], arg2)
   
    # Produce a vector with the same nrow as arg but all paradigms combined.
   
    arg1 <- merge(arg,targ)
    selftruth <- c("false","true")[arg1$selftruth+1]
    tmp <- sapply(tapply(
      paste(arg1$paradigm, selftruth, sep=": "),
      arg1["id"], paste),function(x) paste(x, collapse="; "))
    tmp <- data.frame(id = names(tmp), par = tmp, stringsAsFactors = FALSE)
    arg1 <- merge(arg1,tmp) # Merge instead of cbind in case tapply mixes the order of arguments.
    arg1$id <- gsub("£££.*", "", arg1$id) # Replace argument-target-specific id's again with argument id's.
    arg1$target <- gsub("£££.*", "", arg1$target)
   
    out[[1]] <- orbind(out[[1]], data.frame(  ### Arguments
      Oldid = paste(id,arg1$id,sep="."),
      type = paste(selftruth,"argument"),
      Item = arg1$id,
      label = arg1$title,
      Relation = paste(c("irrelevat","relevant")[arg1$relevance+1], arg1$relation),
      Object = arg1$target,
      Description = paste(arg1$content, "| paradigms:", arg1$par),
      URL = paste(page, arg1$id,sep="#"),
      stringsAsFactors = FALSE
    ))
  }
  out[[1]]$label <- ifelse(out[[1]]$label==".",substr(out[[1]]$Description, 1, 30),out[[1]]$label)
  for(i in 1:ncol(out[[1]])) out[[1]][[i]] <- gsub("['\"]", "", out[[1]][[i]])
 
  return(out)
}
 
#' Scrape google sheets
#'
#' scrape.gssheet is a function for scraping google sheets and making data.frames
#'
#' @param page character vector with the URL of the google sheet
#' @param firstrow atom vector with the number of the first data row on the gsheet
#' @return a data.frame
 
scrape.gssheet <- function(page, firstrow) {
  require(gsheet)
 
  out <- gsheet2tbl(page)
  if(firstrow>2) out <- out[-(1:(firstrow-2)) , ]
  return(out)
}
 
#' Scrape tables on a webpage
#'
#' scrape.webpage is a function for scraping data from a table on a webpage.
#'
#' @param page URL of the page to be scraped.
#' @param table number of table on the page to be scraped.
#' @return a data.frame
 
scrape.webtable <- function(page, table) {
  require(rvest)
  out <- html_table(read_html(page),fill=TRUE)[[table]]
  return(out)
}
 
objects.store(scrape.discussion, scrape.gssheet, scrape.webtable)
cat("Functions scrape.discussion, scrape.gssheet, scrape.webtable stored.\n")
</rcode>
 
<rcode name="scrape.assessment" label="Function scrape.assessment (for developers only)" embed=1>
# This is code Op_en3861/scrape.assessment on page [[Insight network]]
 
library(OpasnetUtils)
 
#' Create URLs for objects
#'
#' makeurl creates a unique URL based on wiki page id and object name. Used to create hyperlinks to the knowledge crystal pages.
#' @param page wiki_page_id: character vector format "Op_en7748"
#' @param name name of the knowledge crystals: character vector
#' @return character vector of URLs
 
makeurl <- function(
  page,
  name
) {
  if(is.null(page)|is.null(name)) return(NA) else
    out <- paste0(
      c(
        en = "http://en.opasnet.org/w/index.php?curid=",
        fi = "http://fi.opasnet.org/fi/index.php?curid="
      )[substr(page, 4,5)], # is it en or fi?
      substr(page, 6,11), # id
      "#", gsub(" ", "_", name)
    )
  out <- ifelse(is.na(page)|is.na(name), NA, out)
  return(out)
}
 
#' Scrape ovariables and other objects in an assessment
#'
#' scrape.assessment makes standard data.frame for insight diagram out of all ovariables, odecisions, and data.frames and their dependencies in the global environment.
#'
#' @param assessment ovariable that contains other assessment objects as dependencies
#' @param objectives names of ovariables that are objectives in the model
#' @return a list of two data.frames. The first one is for making insight diagrams, the second for making discussion ovariables for analysis (the latter part not implemented yet)
 
scrape.assessment <- function(
  assessment,
  objectives = character()
) {
  #  require(DiagrammeR)
  require(OpasnetUtils)
  nod <- data.frame()
  ova <- character()
  dec <- character()
  dat <- character()
  plo <- character()
  dep <- assessment@dependencies
  URLass <- assessment@meta$wiki_page_id
 
  #### Find all objects (decisions, ovariables, data.frames and graphs)
  objs <- list()
  for(i in dep$Name) {
    cl <- class(get(i))
    if("ovariable" %in% cl) ova <- c(ova, i)
    if("odecision" %in% cl) dec <- c(dec, i)
    if("data.frame" %in% cl) dat <- c(dat, i)
    if(any(c("ggplot","dgr_graph") %in% cl)) plo <- c(plo, i)
    if(is.list(get(i))) objs <- c(objs, list(get(i))) else objs <- c(objs, get(i))
  }
  names(objs) <- dep$Name
 
  ###### Add all decisions and options
 
  for(i in dec) {
    deci <- objs[[i]]@dectable
    if(nrow(deci)>0) {
      tst <- !duplicated(deci[c("Option","Decision")])
      nod <- rbind(
        nod,
        data.frame(
          Oldid = paste("Opt", match(i, dec), sep=""),
          type = "option",
          Item = as.character(deci$Option[tst]),
#          label = as.character(deci$Option[tst]),
          Relation = "is option for",
          Object = as.character(deci$Decision[tst]),
          Description = if(is.null(deci$Description)) NA else
            as.character(deci$Description[tst]),
          URL = makeurl(URLass, deci$Option)[tst],
          stringsAsFactors = FALSE
        )
      )
     
      tst <- !duplicated(deci[c("Decision","Variable")])
      nod <- rbind(
        nod,
        data.frame(
          Oldid = paste("Dec", match(i, dec), sep=""),
          type = "decision",
          Item = as.character(deci$Decision[tst]),
#          label = as.character(deci$Decision[tst]),
          Relation = "affects",
          Object = as.character(deci$Variable[tst]),
          Description = if(is.null(deci$Description)) NA else
            as.character(deci$Description[tst]),
          URL = makeurl(URLass, deci$Decision)[tst],
          stringsAsFactors = FALSE
        )
      )
    }
  }
 
  ####### Add all ovariables
 
  for(i in ova) {
    obj <- objs[[i]]
    nod <- rbind( # Add dependencies
      nod,
      data.frame(
        Oldid = paste("Ova",match(i,ova),sep=""),
        type = "ovariable",
        Item = obj@name,
#        label = obj@name,
        Relation = "is affected by",
        Object = if(nrow(obj@dependencies)==0) NA else as.character(obj@dependencies$Name),
        Description = if(is.null(obj@meta$Description)) NA else
          obj@meta$Description,
        URL = makeurl(obj@meta$wiki_page_id, obj@name),
        stringsAsFactors = FALSE
      )
    )
    tmp <- colnames(obj@output)[                          # Add indices
      obj@marginal &
        !grepl("Source$", colnames(obj@output)) &
        ! colnames(obj@output) %in% c(deci, "Iter")
      ]
    if(length(tmp)>0) {
      nod <- rbind(
        nod,
        data.frame(
          Oldid = paste0("Ova",match(i,ova),tmp),
          type = "index",
          Item = tmp,
#          label = tmp,
          Relation = "is index for",
          Object = obj@name,
          Description = NA,
          URL = makeurl(URLass, tmp),
          stringsAsFactors = FALSE
        )
      )
    }
  }
 
  ### Add graphs
 
  nod <- orbind(
    nod,
    data.frame(
      Oldid = paste0("Plo", 1:length(plo)),
      type = "graph",
      Item = plo,
#      label = plo,
      stringsAsFactors = FALSE
    )
  )
 
  # V(dag)$Size[V(dag)$name == i] <- nrow(obj@output)    # Size
  # vertex.size = log(V(dag)$Size)+2, # Vertex size is (non-linearly) relative to rows in output.
 
  ### Add data.frames
 
  nod <- orbind(
    nod,
    data.frame(
      Oldid = paste("Dat", 1:length(dat), sep=""),
      type = "data",
      Item = dat,
#      label = dat,
      stringsAsFactors = FALSE
    )
  )
 
  # Retype objectives and assessments if available
  nod$type[nod$Item %in% objectives] <- "objective"
  nod$type[nod$Item %in% assessment@name] <- "assessment"
 
  # Add info from Page column if available and doesn't exist already
  if(!is.null(dep$Page)) {
    tst <- is.na(nod$Description)
    nod$Description[tst] <- as.character(dep$Description[match(nod$Item, dep$Name)][tst])
    tst <- is.na(nod$URL)
    nod$URL[tst] <- makeurl(
      dep$Page[match(nod$Item[tst], dep$Name)],
      dep$Name[match(nod$Item[tst], dep$Name)]
    )
  }
  tst <- is.na(nod$Description)
  nod$Description[tst] <- nod$type[tst]
 
  #Add info (with force) from type column in dep if available
  if(!is.null(dep$type)) {
    tst <- dep$Name[!(is.na(dep$type) | dep$type=="")]
    nod$type[match(tst,nod$Item)] <- as.character(dep$type[match(tst,dep$Name)])
  }
 
  # Add relations defined by hand on assessment@dependencies
  tst <- dep$Name[!(is.na(dep$Child) | dep$Child=="")]
  if(length(tst)>0) { # Does nothing if column Child does not exist
    nod <- orbind(
      nod,
      data.frame(
        Oldid = as.character(nod$Oldid[match(tst,nod$Item)]),
        Item = as.character(tst),
        Relation = c(
          rep("indirectly affects",3),
          "is data for",
          "describes"
        )[match(nod$type[match(tst,nod$Item)],c("ovariable","key ovariable","objective","data","graph"))],
        Object = as.character(dep$Child[match(tst,dep$Name)])
      )
    )
  }
  return(nod)
}
 
objects.store(scrape.assessment, makeurl)
cat("Functions scrape.assessment, makeurl stored.\n")
</rcode>


==== Copy descriptions to ovariables ====
==== Copy descriptions to ovariables ====
Line 1,475: Line 1,046:


== See also ==
== See also ==
* [http://en.opasnet.org/en-opwiki/index.php?title=Insight_network&oldid=42630 Arhived version] 15.1.2019 with several functionalities that are now depreciated and removed.
** T2b table [http://en.opasnet.org/w/Special:Opasnet_Base?id=op_en3861.table_types Table types] for different kinds of input tables.
** Code for function grspec. This is no longer needed as a generic formatted data.frame is used for formatting of all resources.
** Code for makeInsightGraph. This is replaced by makeGraph that has a better work flow.
** Code for makeInsightTables. Insighttables are no longer produced as they are replaced by context-specific ovariables that are on their respective knowledge crystal pages.
** Code for ovariable insightNetwork, which is an ovariable collecting all objects needed. Because of major updates, this is no longer useful.
** Code server: function chooseGr was updated and moved to an own code.


* [[Open policy practice]]
* [[Open policy practice]]

Latest revision as of 20:13, 11 August 2021


Insight networks are graphical representations of a particular situation, where the objects described are causally related to each other. In addition, the diagrams contain non-causal elements such as value judgements or inferences based on data. Insight networks utilise the ideas of directed acyclic graphs, but they have additional features.

Question

What notation is simple and flexible enough so that it can be used to represent all major issues related to a policy situation? It must be usable in both graphical and data formats.

Answer

+ Show code

Rationale

Process

Insight networks have been described in a scientific article manuscript From open assessment to shared understanding: practical experiences#Insight networks. Objects and their relations used in open policy practice are described on page Open policy ontology.

There is a need for methods facilitating the flow of information and understanding between science and policy. The principle is to describe a risk situation in a formal manner. Insight networks contain items along a causal pathway (or network) from e.g. abatement strategies to emissions to dispersion to exposure to effects. They have been designed to describe also non-causal connections such as non-causal reasoning, values, preferences, and arguments.

These diagrams use graph theory with vertices (or nodes) and arcs (or arrows). They are used to describe and define all the pieces needed for a description of the situation under scrutiny. Diagrams may be produced with any graphics software, providing that calculation functions are not required. If calculations are needed, we recommend the use of R software and OpasnetUtils package.

This is the process how data flows into insight diagrams:

  • List of data tables of different insight diagrams is found from https://yhteistyotilat.fi/wiki08/x/1oGxAg. It has the following columns:
    • Ilmio: Name of the phenomenon. This will become the name of a csv data file.
    • Id: Identifier of the phenomenon. This will be used in Oldid of the items and relations.
    • Tyyppi: Type of the table. In practice, it defines the columns that the data table has. Different types are listed on #Types of insight network tables.
    • URL: Location of the data table. If the URL contains "google.com", it is assumed to be a google sheet. If the type (Tyyppi) is "keskustelu", it is assumed to be an Opasnet page with discussions. Otherwise, it is assumed to be a table on a web page that can be scraped with read_html() function.
    • Taulu: If the data is a table on a web page, it is the number of the table on that page. If the data is a discussion, it is the number of discussion; missing value means that all discussions on that page are read.
    • Alkurivi: In case of google sheets, it is the first row with actual data.
    • Kuvaus: Description of the table, with possible links to relevant description page.

All data tables and discussions are listed, formatted and saved as csv files in a zip file called op_fi:File:Näkemysverkkojen tietotauluja.zip. From there, the data can be accessed from within Opasnet Rtools. (The code scraping web pages does not work in Opasnet, although it is stored there.) Little formatting is done here, mainly the column titles are standardised. But the number and type of columns is not changed.

In the next phase, each csv file is opened, interpreted, and defined as items and relations. This is done in code Op_fi5810/graphs on page op_fi:Ympäristöterveysindikaattori. All these are saved as a DiagrammeR graph, and each topic may be separately selected as a subgraph.

Data

Graphical properties of objects and relations

Graphical properties of objects and relations(-)
ObsPropertyValueParameterResultDescription
1defaultdefaultnode.shapecircleDefault values unless something else is specified
2defaultdefaultnode.stylefilled
3defaultdefaultnode.sides4
4defaultdefaultnode.skew0
5defaultdefaultnode.fillcolorwhite
6defaultdefaultnode.fontsize11
7defaultdefaultnode.height0.5
8defaultdefaultnode.width0.5
9defaultdefaultnode.colorbrown
10defaultdefaultnode.penwidth2
11defaultdefaultnode.fontcolorblack
12defaultdefaultnode.distortion0
13defaultdefaultedge.colorgrey
14defaultdefaultedge.fontsize10Not currently used
15defaultdefaultedge.fontcolorgrey
16defaultdefaultedge.styledotted
17defaultdefaultedge.penwidth2
18defaultdefaultedge.arrowsize1Not currently used
19typeunknownnode.fillcoloryellowThis formatting is used if there are undefined objects
20typeunknownnode.colorgreen
21typesubstancenode.shapecircleSubstantive type object
22typesubstancenode.fillcolorskyblue2Substantive type object
23typeknowledge crystalnode.colorgoldKnowledge crystal type object (including ovariables and key ovariables)
24typeoptionnode.colorpalevioletredOption for a decision
25typeoptionnode.fillcolorwhiteOption for a decision
26typeindexnode.shapepolygonIndex or other classifying determinant
27typeindexnode.sides4
28typeindexnode.skew0.5
29typeindexnode.fillcolorpurple1
30typeindexnode.height0.3
31typegraphnode.shapepolygonIndex or other classifying determinant
32typegraphnode.sides3
33typegraphnode.fillcolorpink
34typeassessmentnode.shapepolygonAssessment
35typeassessmentnode.sides8
36typeassessmentnode.fillcolorpurple1
37typestakeholdernode.shapehexagonStakeholder type object
38typestakeholdernode.fillcolorkhaki1Stakeholder type object
39typestakeholdernode.width0.8Stakeholder type object
40typemethodnode.shapepolygonMethod type object
41typemethodnode.sides6Method type object
42typemethodnode.fillcolorpurple1Method type object
43typeprocessnode.shapepentagonProcess type object
44typeprocessnode.fillcolorpurple1Process type object
45typeactionnode.fillcolor#009246Process type object, dark green (0,146,70)
46typeactionnode.shaperectangleDecision type object
47typetask 1node.colorbrownIllustration of the responsible organisation of the task
48typetask 2node.coloryellowIllustration of the responsible organisation of the task
49typetask 3node.colorblueIllustration of the responsible organisation of the task
50typetask 4node.colorgreenIllustration of the responsible organisation of the task
51typetask 5node.colorredIllustration of the responsible organisation of the task
52typedecisionnode.fillcolorredDecision type object
53typedatanode.shaperectangleData type object
54typedatanode.fillcolorgoldData type object
55typeobjectivenode.shapediamondObjective type object
56typeobjectivenode.fillcoloryellowObjective type object
57typeobjectivenode.width0.8Objective type object
58typepublicationnode.fillcolorgrayPublication type object
59typestatementnode.shapepolygonArgument type object
60typestatementnode.sides4Argument type object
61typestatementnode.width0.8Argument type object
62typestatementnode.distortion-0.5Argument type object
63typetrue statementnode.fillcolorgoldArgument type object
64typefalse statementnode.fillcolorgrayArgument type object
65typefact opening statementnode.fillcolorlightskyblue1Argument type object. Discussion start
66typevalue opening statementnode.fillcolorpalegreen1Argument type object
67typefact closing statementnode.fillcolorskyblueArgument type object. Discussion end
68typevalue closing statementnode.fillcolorspringgreenArgument type object.
69typefact discussionnode.fillcolorskyblueArgument type object. Not neede?
70typevalue discussionnode.fillcolorspringgreenValue judgement type object. Not needed?
71typerisk factornode.colorpinkAdditional information about object class
72typeindicatornode.colorbrownAdditional information about object class
73typeindicatornode.fillcolorgoldAdditional information about object class
74typeoperational indicatornode.fillcolor#00d7a7Additional information about object class light green (0,215,167)
75typetactical indicatornode.fillcolor#9fc9ebAdditional information about object class light blue (159,201,235)
76typestrategic indicatornode.fillcolor#0072c6Additional information about object class dark blue (0,114,198)
77typestrategic indicatornode.shapediamondAdditional information about object class
78typearviointikriteerinode.colororangeNot quite clear what criteria objects are: indicators or value statements, or something else
79typetasknode.colorgreenAdditional information about object class
80typedatanode.colororangeAdditional information about object class
81typehealth organisationnode.coloryellowAdditional information about object class
82Relationcausal linkedge.colorblackCausal link
83Relationcausal linkedge.stylesolidCausal link
84Relationpositive causal linkedge.fontcolor#009246Causal link, dark green (0,146,70)
85Relationincreasesedge.fontcolor#009246Causal link, dark green (0,146,70)
86Relationnegative causal linkedge.fontcolor#bd2719Causal link, red (189,39,25)
87Relationdecreasesedge.fontcolor#bd2719Causal link, red (189,39,25)
88Relationpart_ofedge.fontcolorgrayPart of (set theory link)
89Relationparticipatory linkedge.colorpurpleParticipatory link
90Relationparticipatory linkedge.styledashedParticipatory link
91Relationoperational linkedge.colorblackOperational link
92Relationoperational linkedge.styledashedOperational link
93Relationevaluative linkedge.colorgreenEvaluative link
94Relationrelevant attackedge.colorredAttacking argument
95Relationrelevant defenseedge.colorgreenDefending argument
96Relationrelevant commentedge.colorblueCommenting argument
97Relationirrelevant argumentedge.colorgrayInvalid argument
98Relationargumentative linkedge.styledottedArgumentative link
99Relationargumentative linkedge.penwidth4Argumentative link
100Relationreferential linkedge.colorredReferential link
101Relationreferential linkedge.styledashedReferential link

Calculations

Insight network 2.0

An updated version should improve the

  • a) context sensitivity (referring to primarily to objects within own context but secondarily to those from another context),
  • b) making graphs by default from a single context rather than a full list of contexts from a meta table,
  • c) compatibility with cytoscape.js,
  • d) merging ready-made graphs meaningfully,
  • e) have a reasonable intermediate object format that contains all data needed, such as
    • tables for nodes and edges, compatible with Diagrammer, Cytoscape.js, AND Gephi.
    • metadata for display, such as seeds, steps, object types to ignore, whether to show labels etc. Or should these just be implemented on the graph?

What should be done?

  1. Fetch the data table by scrape or other function and with data about URL, table, and initial row.
  2. Use splizzeria and fillprev if needed.
  3. Interpret columns based on a vector of column numbers (with possibly 1+2 notation to paste columns) to create the standard columns. If this is done in an ovariable formula, there is no need for a specific function.
    • Context
    • Item
    • type
    • label
    • rel
    • Object
    • Description
    • Reldescription
    • URL
    • Result (dummy, always 0)
  4. Create missing node rows from objects. Do NOT assume context.
  5. Create URL from permanent resource location trunk and the identifier (where does the identifier come from?)
  6. Item ja label laitetaan pötköön ja haetaan mätsi. Tulos onrow-pötköstä.
  7. Create an ovariable from the table.
  8. Add meta to the ovariable with formatting data.
    • insightGraph:
      • seed
      • removenodes
      • formatting (character vector with possible entries: Hide node labels, Hide edge labels, Show legend nodes, Remove branches only)
      • ignoreobj
      • steps
  1. (NOT NEEDED? Create Oldid if does not exist from context and numbering)
  2. If a relation is presented as item, the formatting is applied to the ring.

Combine graph objects

  • Find items without context. Match them with items with the same Item (label) that do have a type.

Tuplarelaatiot, voidaanko kategorisesti poistaa?


Out <- rep(NA, length(find)) For(x in cond,) For(i in 1:length(find) Tmp<-id[context==contextfind(i))])[Match(find(i), df$cond(x)(df$context==contextfind(i))] pitää etsiä id alkuperäisestä taulukosta heti muuten ei toimi Out<- ifelse(isna(out). Tmp,out) )) Sitten sama ioman contekstirajoitusta.


Insight network 1.0

There are three different identifiers for a subject item.

  • Oldid: a technical identifier typically of format context.number, where number is a sequential number within a context.
  • Item: the actual name of the item, detailed enough to give a good understanding of its meaning.
  • label: a short name shown on insight networks. Does not exmplain everything, just enough to distinguish it from other items.

If Oldid is not given, it is created from the context and a number. If label is not given in data, it is truncated from Item.

Object item has one column Object that may contain any of these. The priority is Item > label > Oldid > Object. The last option means that it is assumed that Object refers to a new item that is not mentioned in the Item column.

An insight network is produced in this order (last object mentioned first).

  1. gr: a diagrammer graph with all data and formatting for an insight network. Produced by makeInsightGraph.
  2. makeInsightGraph


Making insight graphs

+ Show code

+ Show code

+ Show code

+ Show code

Function insightJSON fetches a JSON file of an insight network through a REST API. Works on own computer only.

+ Show code

Format tables

+ Show code

+ Show code

Shiny server

+ Show code

+ Show code

Scrape functions

These functions were be placed in the OpasnetUtils package, which is maintained in Github. To use the code, install a new version of the package by running R code

devtools::install_github("jtuomist/OpasnetUtils")

Codes Op_en3861/scrape.discussion, Op_en3861/scrape.functions, and Op_en3861/scrape.assessment on this page are outdated.

Copy descriptions to ovariables

The function assessmentDescriptions scans through an assessment ovarible that has all relevant assessment objects as parents. Dependencies slot may also have additional information, such as the following.

  • Name: name of parent (obligatory)
  • Ident: Opasnet page identifier and code name where the parent object can be loaded (e.g. Op_en7748/hia). Note: This is typically the code for the whole assessment, not the individual codes for the objects.
  • Token: Token for the model run where the parent object can be loaded (e.g. xxNsLw5hWdM6xyYp)
  • Description: A short description about what the object is. This is typically shown when cursor hovers over the object on an online insight diagram.
  • Page: Opasnet page identifier for the object's knowledge crystal page, which contains the research question, answer, and description of the object, together with discussion, if any. Typically this is empty for ovariables, because this information can be found from ovariable@meta slot and there is no need to duplicate it here.
  • Child: An object to which this object links. This is typically needed for objects such as graphs and data.frames that do not contain this information in their own structure, unlike ovariables. The direction of a relation is away from this object because then this object is the subject in triple sentences and can be given other parameters as well in other columns. A typical sentence is "graph describes ovariable", but for illustrative purposes this is inversed on insight networks so that the arrow points from an ovariable to a graph ("ovariable is described by graph").
  • Other columns are allowed.

+ Show code

Old notation

⇤--#: . Look at the table below together with Open policy ontology and merge. Decide which things should be on this page and which should be on the other. --Jouni (talk) 06:55, 24 April 2018 (UTC) (type: truth; paradigms: science: attack)

Node type Object Colour code in Analytica Comments
General variable 8R3B (automatic) This is a deterministic function of the quantities it depends on.
Chance variable 11L4B (autom) This is a variable which is uncertain and uncontrollable (in a direct sense).
Data-driven variable 3R1B A general variable where the result is mostly driven by data (observations or literature).
Author judgement variable 4R2B A general variable where the result is mainly driven by author judgement (estimates with poor or no data).
Decision variable 9L3B This is the variable that a decision-maker has the power to control. The decision variable should always be at the top of the chain of causality, even if this is a subchain i.e. it should not have any parent variables. Essentially the decision variable should be regarded as a decision that has to be made; since many factors affect all decisions it is not (in the case of INTARESE) an efficient use of resources to attempt to model what leads a decision-maker to make his decision.
Indicator 1R3B (autom) This is a variable of special interest. One of the indicators in an assessment may be the quantitative criterion that you are trying to optimize.

A particularly important variable in relation to the interests of the intended users of the assessment output (i.e. it must be a means of effective communication of assessment results).

  • It must be in causal connection to the endpoints of the assessment and thus address causality throughout the full chain.
  • It should reflect the use/purpose of the assessment.
  • It should address and be adapted according to the target audience.
  • It should be the ‘leading component’ in the assessment process.
Value judgement variable 8L4B A preference or value that a person or a group assigns to a particular condition or state of the world.
Index (or dimension) 5R2B (autom) This identifies the dimensions of the variable to which it is linked. Note that these dimensions do not have to be numeric, but can also be classes etc.
Risk assessment 8R3B (autom)
Scope 6R1B The scope of the object
Conclusion 6L3B A conclusion of the risk assessment (Result/Conclusion attribute).
Module 6R3B (autom) A group of variables that are put together for illustrative or other practical reasons.
Data 2L3B (autom) Contents of the Definition/Data attribute of a variable. If the Result attribute of a variable is used as Data for another variable, the first variable is called a proxy, and this node is used in the diagram. If an arrow or line is drawn between these objects, it must be noticed that this is NOT a causal link but an inference link. The direction of the arrow would be from the proxy to the variable.
Argument 8R2B A piece of argumentation related to an object (variable, risk assessment, or class)
Formula 9L3B Contents of the Definition/Formula attribute of a variable.
Class 1L2B A class object (a set of objects that share a particular property).
Function 4R2B (autom) A special kind of class. The particular property that is shared contains a full description of the Scope and the Definition attributes with given parameters.
Causal arrow This states a causal relationship (or influence) of one variable onto another. Note that causal arrows can only exist between two arrows; any arrows to or from non-causal objects are non-causal inference arrows.
Non-causal arrow This states an inference relationship between two objects. This means that the object where the arrow starts from is in the Data attribute of the other object. It is thus used to infer something about the value of the result of the latter object. Either object can be a variable or a non-variable. Note that Analytica is only able to show one kind of arrows, so in some cases the nature of the arrow (causal or inference) must be concluded from the context.

Previous notations

Previous notation for insight networks. This version was optimised for Analytica use.

Insight networks have previously been called pyrkilo diagrams, extended causal diagrams, and factor-effect-value networks. These names are no longer in active use. An archived version of the notation can be found from an earlier version of this page.

See also

  • Arhived version 15.1.2019 with several functionalities that are now depreciated and removed.
    • T2b table Table types for different kinds of input tables.
    • Code for function grspec. This is no longer needed as a generic formatted data.frame is used for formatting of all resources.
    • Code for makeInsightGraph. This is replaced by makeGraph that has a better work flow.
    • Code for makeInsightTables. Insighttables are no longer produced as they are replaced by context-specific ovariables that are on their respective knowledge crystal pages.
    • Code for ovariable insightNetwork, which is an ovariable collecting all objects needed. Because of major updates, this is no longer useful.
    • Code server: function chooseGr was updated and moved to an own code.

References